Changeset 13279


Ignore:
Timestamp:
Dec 9, 2009, 7:48:38 PM (10 years ago)
Author:
gb
Message:

Lots of changes from "purify" branch, mostly involving:

  • new memory layout, to support x86 function purification, static cons
  • fasloader changes to load/save string constants faster

Fasl version, image version changed; new binaries for all platforms soon.

Location:
trunk/source
Files:
1 deleted
41 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/PPC/ppc-misc.lisp

    r13067 r13279  
    847847  (blr))
    848848
    849 (defppclapfunction %metering-info ((ptr arg_z))
    850   (ref-global imm0 metering-info)
    851   (stw imm0 target::macptr.address ptr)
    852   (blr))
     849
    853850
    854851(defppclapfunction %misc-address-fixnum ((misc-object arg_z))
     
    10251022  (%cdr arg_y arg_z)
    10261023  (strcx. arg_y rzero imm0)
     1024  (bne @again)
     1025  (li imm0 (+ (target-nil-value) (target::kernel-global free-static-conses)))
     1026  @decf
     1027  (lrarx imm1 rzero imm0)
     1028  (subi imm1 imm1 '1)
     1029  (strcx. imm1 rzero imm0)
     1030  (bne @decf)
    10271031  (isync)
    1028   (bne @again)
    10291032  (blr)
    10301033  @lose
     
    10331036  (blr))
    10341037
    1035 (defppclapfunction %augment-static-conses ((head arg_y) (tail arg_z))
    1036   (li imm0 (+ (target-nil-value) (target::kernel-global static-conses)))
    1037   @again
    1038   (lrarx temp0 rzero imm0)
    1039   (str temp0 target::cons.cdr tail)     ; static, no write-barrier issues
    1040   (strcx. head rzero imm0)
    1041   (bne @again)
    1042   (isync)
    1043   (li arg_z nil)
    1044   (blr))
     1038
    10451039
    10461040(defppclapfunction %staticp ((x arg_z))
    10471041  (check-nargs 1)
    1048   (ref-global temp0 tenured-area)
     1042  (ref-global temp0 static-cons-area)
    10491043  (ldr imm1 target::area.low temp0)
    10501044  (sub imm0 x imm1)
    1051   (ldr imm1 target::area.static-dnodes temp0)
     1045  (ldr imm1 target::area.ndnodes temp0)
    10521046  (srri imm0 imm0 target::dnode-shift)
    10531047  (li arg_z nil)
    1054   (cmplr imm0 imm1)
    1055   (bgelr)
    1056   (box-fixnum arg_z imm0)
     1048  (sub imm1 imm1 imm0)
     1049  (cmplri imm1 0)
     1050  (la imm1 128 imm1)
     1051  (blelr)
     1052  (box-fixnum arg_z imm1)
    10571053  (blr))
    10581054
    10591055(defppclapfunction %static-inverse-cons ((n arg_z))
    10601056  (check-nargs 1)
    1061   (ref-global temp0 tenured-area)
    1062   (ldr imm1 target::area.low temp0)
    1063   (add imm1 n imm1)
    1064   (add imm1 n imm1)
     1057  (ref-global temp0 static-cons-area)
     1058  (la n '-128 n)
     1059  (ldr imm1 target::area.high temp0)
     1060  (sub imm1 imm1 n)
     1061  (sub imm1 imm1 n)
    10651062  (la arg_z target::fulltag-cons imm1)
    10661063  (blr))
  • trunk/source/level-0/PPC/ppc-utils.lisp

    r13067 r13279  
    617617  (ba .SPnvalret))
    618618 
    619 
     619(defppclapfunction %ensure-static-conses ()
     620  (check-nargs 0)
     621  (li imm0 arch::gc-trap-function-ensure-static-conses)
     622  (trlgei allocptr 0)
     623  (li arg_z nil)
     624  (blr))
    620625
    621626;;; offset is a fixnum, one of the target::kernel-import-xxx constants.
  • trunk/source/level-0/X86/X8632/x8632-misc.lisp

    r13067 r13279  
    800800  (cmpxchgl (% temp0) (@ (+ (target-nil-value) (x8632::kernel-global static-conses))))
    801801  (jnz @again)
     802  (lock)
     803  (subl ($ '1) (@ (+ (target-nil-value) (x8632::kernel-global free-static-conses))))
    802804  @lose
    803805  (movl (% eax) (% arg_z))
    804806  (single-value-return))
    805807
    806 (defx8632lapfunction %augment-static-conses ((head arg_y) (tail arg_z))
    807   @again
    808   (movl (@ (+ (target-nil-value) (x8632::kernel-global static-conses))) (% eax))
    809   (movl (% eax) (@ target::cons.cdr (% tail)))
    810   (lock)
    811   (cmpxchgl (% head) (@ (+ (target-nil-value) (x8632::kernel-global static-conses))))
    812   (jnz @again)
    813   @lose
     808
     809
     810(defx8632lapfunction %staticp ((x arg_z))
     811  (check-nargs 1)
     812  (ref-global static-cons-area temp0)
     813  (movl (% x) (% imm0))
    814814  (movl ($ (target-nil-value)) (% arg_z))
    815   (single-value-return))
    816 
    817 (defx8632lapfunction %staticp ((x arg_z))
    818   (check-nargs 1)
    819   (ref-global tenured-area temp0)
    820   (movl (% x) (% imm0))
    821815  (subl (@ target::area.low (% temp0)) (% imm0))
    822816  (shrl ($ target::dnode-shift) (% imm0))
    823   (cmpl (@ target::area.static-dnodes (% temp0)) (% imm0))
    824   (leal (@ (% imm0) target::fixnumone) (% arg_z))
    825   (movl ($ (target-nil-value)) (%l imm0))
    826   (cmovael (% imm0) (% arg_z))
     817  (mark-as-imm temp1)
     818  (movl (@ target::area.ndnodes (% temp0)) (% temp1))
     819  (subl (% imm0) (% temp1))
     820  (lea (@ 128 (% temp1)) (% temp1))
     821  (leal (@ (% temp1) target::fixnumone) (% temp1))
     822  (cmoval (% temp1) (% arg_z))
     823  (mark-as-node temp1)
    827824  (single-value-return))
    828825
    829826(defx8632lapfunction %static-inverse-cons ((n arg_z))
    830827  (check-nargs 1)
    831   (ref-global tenured-area temp0)
    832   (movl (@ target::area.low (% temp0)) (% imm0))
    833   (leal (@ target::fulltag-cons (% imm0) (% n) 2) (% arg_z))
     828  (subl ($ '128) (% arg_z))
     829  (ref-global static-cons-area temp0)
     830  (movl (@ target::area.high (% temp0)) (% imm0))
     831  (subl (% arg_z) (% imm0))
     832  (subl (% arg_z) (% imm0))
     833  (lea (@ x8632::fulltag-cons (% imm0)) (% arg_z))
    834834  (single-value-return))
    835835
  • trunk/source/level-0/X86/X8632/x8632-utils.lisp

    r13067 r13279  
    428428  (jmp-subprim .SPnvalret))
    429429
     430(defx8632lapfunction %ensure-static-conses ()
     431  (check-nargs 0)
     432  (movl ($ arch::gc-trap-function-ensure-static-conses) (% imm0))
     433  (uuo-gc-trap)
     434  (movl ($ (target-nil-value)) (% arg_z))
     435  (single-value-return))
     436
    430437;;; offset is a fixnum, one of the x8632::kernel-import-xxx constants.
    431438;;; Returns that kernel import, a fixnum.
  • trunk/source/level-0/X86/x86-misc.lisp

    r13067 r13279  
    886886  (cmpxchgq (% temp0) (@ (+ (target-nil-value) (x8664::kernel-global static-conses))))
    887887  (jnz @again)
     888  (lock)
     889  (subq ($ x8664::fixnumone) (@ (+ (target-nil-value) (x8664::kernel-global free-static-conses))))
    888890  @lose
    889891  (movq (% rax) (% arg_z))
    890892  (single-value-return))
    891893
    892 (defx86lapfunction %augment-static-conses ((head arg_y) (tail arg_z))
    893   @again
    894   (movq (@ (+ (target-nil-value) (x8664::kernel-global static-conses))) (% rax))
    895   (movq (% rax) (@ target::cons.cdr (% tail)))
    896   (lock)
    897   (cmpxchgq (% head) (@ (+ (target-nil-value) (x8664::kernel-global static-conses))))
    898   (jnz @again)
    899   @lose
    900   (movl ($ (target-nil-value)) (% arg_z.l))
    901   (single-value-return))
     894
    902895 
    903896(defx86lapfunction %staticp ((x arg_z))
    904897  (check-nargs 1)
    905   (ref-global tenured-area temp0)
     898  (ref-global static-cons-area temp0)
    906899  (movq (% x) (% imm0))
     900  (movl ($ (target-nil-value)) (% arg_z.l))
    907901  (subq (@ target::area.low (% temp0)) (% imm0))
    908902  (shrq ($ target::dnode-shift) (% imm0))
    909   (cmpq (@ target::area.static-dnodes (% temp0)) (% imm0))
    910   (leaq (@ (% imm0) target::fixnumone) (% arg_z))
    911   (movl ($ (target-nil-value)) (%l imm0))
    912   (cmovaeq (% imm0) (% arg_z))
     903  (movq (@ target::area.ndnodes (% temp0)) (% imm1))
     904  (subq (% imm0) (% imm1))
     905  (lea (@ 128 (% imm1)) (% imm1))
     906  (leaq (@ (% imm1) target::fixnumone) (% imm1))
     907  (cmovaq (% imm1) (% arg_z))
    913908  (single-value-return))
    914909
    915910(defx86lapfunction %static-inverse-cons ((n arg_z))
    916911  (check-nargs 1)
    917   (ref-global tenured-area temp0)
    918   (movq (@ target::area.low (% temp0)) (% imm0))
    919   (leaq (@ target::fulltag-cons (% imm0) (% n) 2) (% arg_z))
     912  (subq ($ '128) (% arg_z))
     913  (ref-global static-cons-area temp0)
     914  (movq (@ target::area.high (% temp0)) (% imm0))
     915  (subq (% arg_z) (% imm0))
     916  (subq (% arg_z) (% imm0))
     917  (lea (@ x8664::fulltag-cons (% imm0)) (% arg_z))
    920918  (single-value-return))
    921919
  • trunk/source/level-0/X86/x86-utils.lisp

    r13067 r13279  
    468468  (jmp-subprim .SPnvalret))
    469469
    470  
     470
     471(defx86lapfunction %ensure-static-conses ()
     472  (check-nargs 0)
     473  (movl ($ arch::gc-trap-function-ensure-static-conses) (% imm0.l))
     474  (uuo-gc-trap)
     475  (movl ($ (target-nil-value)) (% arg_z.l))
     476  (single-value-return))
     477
    471478
    472479
  • trunk/source/level-0/l0-hash.lisp

    r13067 r13279  
    176176  (if sym   
    177177    (let* ((vector (%symptr->symvector sym))
    178            (cell (%svref vector target::symbol.plist-cell)))
    179       (or (car cell)
     178           (cell (%svref vector target::symbol.plist-cell))
     179           (consp (consp cell)))
     180      (or (if consp (%car cell) cell)
    180181          (let* ((pname (%svref vector target::symbol.pname-cell))
    181182                 (hash (mixup-hash-code (%pname-hash pname (uvsize pname)))))
    182             (declare (type simple-string pname))
    183             (if cell
    184               (setf (car cell) hash)
    185               (progn
    186                 (setf (%svref vector target::symbol.plist-cell)
    187                       (cons hash nil))
    188                 hash)))))
     183            (declare (type simple-string pname) (fixnum hash))
     184            (if consp
     185              (setf (%car cell) hash)
     186              (setf (%svref vector target::symbol.plist-cell) hash)))))
    189187    +nil-hash+))
    190188             
  • trunk/source/level-0/l0-misc.lisp

    r13067 r13279  
    294294         (stack-used)
    295295         (stack-free)
     296         (static-cons-reserved nil)
    296297         (stack-used-by-thread nil))
    297298    (progn
     
    326327                static (k static))
    327328        (when (and frozen-space-size (not (zerop frozen-space-size)))
    328           (format t "~&~,3f MB of static memory is \"frozen\" dynamic memory"
    329                   (/ frozen-space-size (float (ash 1 20)))))
     329          (setq static-cons-reserved (ash (reserved-static-conses) target::dnode-shift)
     330                frozen-space-size (- frozen-space-size static-cons-reserved))
     331          (unless (zerop static-cons-reserved)
     332            (format t "~&~,3f MB of reserved static conses (~d free, ~d reserved)"
     333                    (/ static-cons-reserved (float (ash 1 20)))
     334                    (free-static-conses)
     335                    (reserved-static-conses)))
     336
     337          (unless (zerop frozen-space-size)
     338                  (format t "~&~,3f MB of static memory is \"frozen\" dynamic memory"
     339                          (/ frozen-space-size (float (ash 1 20))))))
    330340        (format t "~&~,3f MB reserved for heap expansion."
    331341                (/ reserved (float (ash 1 20))))
  • trunk/source/level-0/l0-symbol.lisp

    r13067 r13279  
    5454        (error "Bad plist: ~s" plist))))
    5555  (let* ((vector (symptr->symvector (%symbol->symptr sym)))
    56          (cell (%svref vector target::symbol.plist-cell)))
     56         (cell (%svref vector target::symbol.plist-cell))
     57         (consp (consp cell)))
    5758    (if plist
    58       (if (consp cell)
     59      (if consp
    5960        (setf (cdr cell) plist)
    6061        (cdr (setf (%svref vector target::symbol.plist-cell) (cons nil plist))))
    61       (if (car cell)
    62         (setf (cdr cell) nil)
    63         (if cell (setf (cdr cell) nil))))))
     62      (progn
     63        (if consp
     64          (setf (%svref vector target::symbol.plist-cell) (%car cell)))
     65        nil))))
    6466
    6567
     
    8082(defun symbol-plist (sym)
    8183  "Return SYMBOL's property list."
    82   (cdr (%svref (symptr->symvector (%symbol->symptr sym)) target::symbol.plist-cell)))
     84  (let* ((cell (%svref (symptr->symvector (%symbol->symptr sym)) target::symbol.plist-cell)))
     85    (if (consp cell)
     86      (cdr cell))))
    8387
    8488
     
    8690  "Look on the property list of SYMBOL for the specified INDICATOR. If this
    8791  is found, return the associated value, else return DEFAULT."
    88   (let* ((tail (%pl-search
    89                 (cdr (%svref (symptr->symvector (%symbol->symptr sym)) target::symbol.plist-cell)) key)))
     92  (let* ((cell (%svref (symptr->symvector (%symbol->symptr sym)) target::symbol.plist-cell))
     93         (tail (if (consp cell)
     94                 (%pl-search (cdr cell ) key))))
    9095    (if tail (%cadr tail) default)))
    9196
     
    9499         (vector (symptr->symvector symptr))
    95100         (cell  (%svref vector target::symbol.plist-cell))
    96          (plist (cdr cell))
     101         (plist (if (consp cell) (cdr cell)))
    97102         (tail (%pl-search plist key)))
    98103    (if tail
     
    100105      (progn
    101106        (setq plist (cons key (cons value plist)))
    102         (if cell
     107        (if (consp cell)
    103108          (setf (cdr cell) plist)
    104109          (setf (%svref vector target::symbol.plist-cell) (cons nil plist)))))
  • trunk/source/level-0/l0-utils.lisp

    r13174 r13279  
    8989                                   (funcall f (lfun-vector-lfun obj))))))
    9090    (declare (dynamic-extent filter))
    91     (%map-areas filter '(:dynamic :static :managed-static))))
     91    (%map-areas filter '(:dynamic :static :managed-static :readonly))))
    9292
    9393
  • trunk/source/level-0/nfasload.lisp

    r13067 r13279  
    143143       
    144144
     145(defun %fasl-read-utf-8-string (s string nchars nextra)
     146  (declare (fixnum nchars nextra))
     147  (if (eql 0 nextra)
     148    (dotimes (i nchars)
     149      (setf (%scharcode string i) (%fasl-read-byte s)))
     150    (flet ((trailer-byte ()
     151             (when (> nextra 0)
     152               (decf nextra)
     153               (let* ((b (%fasl-read-byte s)))
     154                 (declare ((unsigned-byte 8) b))
     155                 (and (>= b #x80)
     156                      (< b #xc0)
     157                      (logand b #x3f))))))
     158      (declare (inline trailer-byte))
     159      (dotimes (i nchars)
     160        (let* ((b0 (%fasl-read-byte s)))
     161          (declare ((unsigned-byte 8) b0))
     162          (setf (%scharcode string i)
     163                (or
     164                 (cond ((< b0 #x80) b0)
     165                       ((and (>= b0 #xc2)
     166                             (< b0 #xe0))
     167                        (let* ((b1 (trailer-byte)))
     168                          (and b1 (logior (ash (logand b0 #x1f) 6) b1))))
     169                       ((and (>= b0 #xe0)
     170                             (< b0 #xf0))
     171                        (let* ((b1 (trailer-byte))
     172                               (b2 (trailer-byte)))
     173                          (and b1 b2 (logior (ash (logand b0 #x0f) 12)
     174                                             (logior (ash b1 6)
     175                                                     b2)))))
     176                       ((and (>= b0 #xf0)
     177                             (< b0 #xf5))
     178                        (let* ((b1 (trailer-byte))
     179                               (b2 (trailer-byte))
     180                               (b3 (trailer-byte)))
     181                          (and b1
     182                               b2
     183                               b3
     184                               (logior (ash (logand b0 #x7) 18)
     185                                       (logior (ash b1 12)
     186                                               (logior (ash b2 6)
     187                                                       b3)))))))
     188                 (char-code #\Replacement_Character))))))))
     189
     190
    145191(defun %fasl-vreadstr (s)
    146   (let* ((nbytes (%fasl-read-count s))
     192  (let* ((nchars (%fasl-read-count s))
     193         (nextra (%fasl-read-count s))
    147194         (copy t)
    148          (n nbytes)
     195         (n nchars)
    149196         (str (faslstate.faslstr s)))
    150     (declare (fixnum n nbytes))
     197    (declare (fixnum nchars n nextra))
    151198    (if (> n (length str))
    152         (setq str (make-string n :element-type 'base-char))
    153         (setq copy nil))
    154     (%fasl-read-n-bytes s str 0 nbytes)
    155     (values str n copy)))
     199      (setq str (make-string n :element-type 'base-char))
     200      (setq copy nil))
     201    (%fasl-read-utf-8-string s str nchars nextra)
     202    (values str nchars copy)))
    156203
    157204
     
    162209       ((<= n 0))
    163210    (declare (fixnum i n))
    164     (setf (schar string i) (code-char (%fasl-read-count s)))))
     211    (setf (%scharcode string i) (%fasl-read-byte s))))
    165212
    166213(defun %fasl-nvreadstr (s)
     
    206253(defun %fasl-vmake-symbol (s &optional idx)
    207254  (let* ((n (%fasl-read-count s))
     255         (nextra (%fasl-read-count s))
    208256         (str (make-string n :element-type 'base-char)))
    209257    (declare (fixnum n))
    210     (%fasl-read-n-bytes s str 0 n)
     258    (%fasl-read-utf-8-string s str n nextra)
    211259    (let* ((sym (make-symbol str)))
    212260      (when idx (ensure-binding-index sym))
     
    425473
    426474(deffaslop $fasl-vstr (s)
    427   (let* ((n (%fasl-read-count s))
    428          (str (make-string (the fixnum n) :element-type 'base-char)))
     475  (let* ((nchars (%fasl-read-count s))
     476         (nextra (%fasl-read-count s))
     477         (str (make-string (the fixnum nchars) :element-type 'base-char)))
    429478    (%epushval s str)
    430     (%fasl-read-n-bytes s str 0 n)))
     479    (%fasl-read-utf-8-string s str nchars nextra)))
     480
    431481
    432482(deffaslop $fasl-nvstr (s)
  • trunk/source/lib/ccl-export-syms.lisp

    r13174 r13279  
    452452     *trace-max-indent*
    453453     *trace-level*
    454      *static-cons-chunk*
    455454     static-cons
     455     free-static-conses
     456     reserved-static-conses
    456457
    457458     population
  • trunk/source/lib/misc.lisp

    r13174 r13279  
    11451145  (values))
    11461146
    1147 ;; The number of words to allocate for static conses when the user requests
    1148 ;; one and we don't have any left over
    1149 (defparameter *static-cons-chunk* 1048576)
    1150 
    1151 (defun initialize-static-cons ()
    1152   "Activates collection of garbage conses in the static-conses
    1153    list and allocates initial static conses."
    1154   ; There might be a race here when multiple threads call this
    1155   ; function.  However, the discarded static conses will become
    1156   ; garbage and be added right back to the list.  No harm here
    1157   ; except for additional garbage collections.
    1158   (%set-kernel-global 'static-conses nil)
    1159   (allocate-static-conses))
    1160 
    1161 (defun allocate-static-conses ()
    1162   "Allocates some memory, freezes it and lets it become garbage.
    1163    This will add the memory to the list of free static conses."
    1164   (let* ((nfullgc (full-gccount)))
    1165     (multiple-value-bind (head tail)
    1166         (%allocate-list 0 *static-cons-chunk*)
    1167       (if (eql (full-gccount) nfullgc)
    1168         (freeze)
    1169         (flash-freeze))
    1170       (%augment-static-conses head tail))))
     1147
    11711148
    11721149(defun static-cons (car-value cdr-value)
     
    11741151   and thus doesn't trigger re-hashing when used as a key in a hash
    11751152   table.  Usage is equivalent to regular CONS."
    1176   (when (eq (%get-kernel-global 'static-conses) 0)
    1177     (initialize-static-cons))
    1178   (let ((cell (%atomic-pop-static-cons)))
    1179     (if cell
    1180       (progn
    1181         (setf (car cell) car-value)
    1182         (setf (cdr cell) cdr-value)
    1183         cell)
    1184       (progn
    1185         (allocate-static-conses)
    1186         (static-cons car-value cdr-value)))))
     1153  (loop
     1154    (let ((cell (%atomic-pop-static-cons)))
     1155      (if cell
     1156        (progn
     1157          (setf (car cell) car-value)
     1158          (setf (cdr cell) cdr-value)
     1159          (return cell))
     1160        (progn
     1161          (%ensure-static-conses))))))
     1162
     1163(defun free-static-conses ()
     1164  (%get-kernel-global free-static-conses))
     1165
     1166(defun reserved-static-conses ()
     1167  (%fixnum-ref-natural (%get-kernel-global static-cons-area) target::area.ndnodes))
    11871168       
    11881169
  • trunk/source/lib/nfcomp.lisp

    r13067 r13279  
    11341134;These should be constants, but it's too much trouble when need to change 'em.
    11351135(defparameter FASL-FILE-ID #xFF00)  ;Overall file format, shouldn't change much
    1136 (defparameter FASL-VERSION #xFF5b)  ;Fasl block format. ($fasl-vers)
     1136(defparameter FASL-VERSION #xFF5e)  ;Fasl block format. ($fasl-vers)
    11371137
    11381138(defvar *fasdump-hash*)
     
    15011501    (double-float (fasl-dump-dfloat exp))
    15021502    (single-float (fasl-dump-sfloat exp))
    1503     (simple-string (let* ((n (length exp)))
    1504                      (fasl-out-opcode $fasl-nvstr exp)
    1505                      (fasl-out-count n)
    1506                      (fasl-out-simple-string exp 0 n)))
     1503    (simple-string
     1504     (let* ((nextra (utf-8-extra-bytes exp)))
     1505       (cond ((= 0 nextra)
     1506              (fasl-out-opcode $fasl-nvstr exp)
     1507              (fasl-out-nvstring exp))
     1508             (t (fasl-out-opcode $fasl-vstr exp)
     1509                (fasl-out-vstring exp nextra)))))
    15071510    (simple-bit-vector (fasl-dump-bit-vector exp))
    15081511    ((simple-array (unsigned-byte 8) (*))
     
    17791782
    17801783(defun fasl-dump-package (pkg)
    1781   (let ((name (package-name pkg)))
    1782     (fasl-out-opcode $fasl-nvpkg pkg)
    1783     (fasl-out-nvstring name)))
     1784  (let* ((name (package-name pkg))
     1785         (nextra (utf-8-extra-bytes name)))
     1786    (cond ((eql nextra 0)
     1787           (fasl-out-opcode $fasl-nvpkg pkg)
     1788           (fasl-out-nvstring name))
     1789          (t
     1790           (fasl-out-opcode $fasl-vpkg pkg)
     1791           (fasl-out-vstring name nextra)))))
    17841792
    17851793
     
    18271835  (let* ((pkg (symbol-package sym))
    18281836         (name (symbol-name sym))
     1837         (nextra (utf-8-extra-bytes name))
     1838         (ascii (eql nextra 0))
    18291839         (idx (let* ((i (%svref (symptr->symvector (%symbol->symptr sym)) target::symbol.binding-index-cell)))
    18301840                (declare (fixnum i))
     
    18321842    (cond ((null pkg)
    18331843           (progn
    1834              (fasl-out-opcode (if idx $fasl-nvmksym-special $fasl-nvmksym) sym)
    1835              (fasl-out-nvstring name)))
     1844             (fasl-out-opcode (if idx
     1845                                (if ascii $fasl-nvmksym-special $fasl-vmksym-special)
     1846                                (if ascii $fasl-nvmksym $fasl-vmksym))
     1847                              sym)
     1848             (if ascii
     1849               (fasl-out-nvstring name)
     1850               (fasl-out-vstring name nextra))))
    18361851          (*fasdump-epush*
    18371852           (progn
    18381853             (fasl-out-byte (fasl-epush-op (if idx
    1839                                              $fasl-nvpkg-intern-special
    1840                                              $fasl-nvpkg-intern)))
     1854                                             (if ascii $fasl-nvpkg-intern-special $fasl-vpkg-intern-special)
     1855                                             (if ascii $fasl-nvpkg-intern $fasl-vpkg-intern))))
    18411856             (fasl-dump-form pkg)
    18421857             (fasl-dump-epush sym)
    1843              (fasl-out-nvstring name)))
     1858             (if ascii
     1859               (fasl-out-nvstring name)
     1860               (fasl-out-vstring name nextra))))
    18441861          (t
    18451862           (progn
    18461863             (fasl-out-byte (if idx
    1847                               $fasl-nvpkg-intern-special
    1848                               $fasl-nvpkg-intern))
     1864                              (if ascii $fasl-nvpkg-intern-special $fasl-vpkg-intern-special)
     1865                              (if ascii $fasl-nvpkg-intern-special $fasl-vpkg-intern)))
    18491866             (fasl-dump-form pkg)
    1850              (fasl-out-nvstring name))))))
     1867             (if ascii
     1868               (fasl-out-nvstring name)
     1869               (fasl-out-vstring name nextra)))))))
    18511870
    18521871
     
    18591878       ((= k end))
    18601879    (declare (fixnum k))
    1861     (fasl-out-count (char-code (schar str k)))))
     1880    (fasl-out-byte (char-code (schar str k)))))
    18621881
    18631882(defun fasl-out-nvstring (str)
    18641883  (fasl-out-count (length str))
    18651884  (fasl-out-simple-string str 0 (length str)))
     1885
     1886(defun utf-8-extra-bytes (string)
     1887  (declare (simple-string string))
     1888  (let* ((extra 0))
     1889    (declare (fixnum extra))
     1890    (dotimes (i (length string) extra)
     1891      (let* ((code (%scharcode string i)))
     1892        (declare ((mod #x110000) code))
     1893        (cond ((>= code #x10000) (incf extra 3))
     1894              ((>= code #x800) (incf extra 2))
     1895              ((>= code #x80) (incf extra 1)))))))
     1896
     1897(defun fasl-out-vstring (str nextra)
     1898  (declare (fixnum nextra))
     1899  (let* ((len (length str)))
     1900    (declare (fixnum len))
     1901    (fasl-out-count len)
     1902    (fasl-out-count nextra)
     1903    (dotimes (i len)
     1904      (let* ((code (%scharcode str i)))
     1905        (declare ((mod #x110000) code))
     1906        (cond ((< code #x80) (fasl-out-byte code))
     1907              ((< code #x800)
     1908               (let* ((y (ldb (byte 5 6) code))
     1909                      (z (ldb (byte 6 0) code)))
     1910                 (declare (fixnum y z))
     1911                 (fasl-out-byte (logior #xc0 y))
     1912                 (fasl-out-byte (logior #x80 z))))
     1913              ((< code #x10000)
     1914               (let* ((x (ldb (byte 4 12) code))
     1915                      (y (ldb (byte 6 6) code))
     1916                      (z (ldb (byte 6 0) code)))
     1917                 (declare (fixnum x y z))
     1918                 (fasl-out-byte (logior #xe0 x))
     1919                 (fasl-out-byte (logior #x80 y))
     1920                 (fasl-out-byte (logior #x80 z))))
     1921              (t
     1922                (let* ((w (ldb (byte 3 18) code))
     1923                       (x (ldb (byte 6 12) code))
     1924                       (y (ldb (byte 6 6) code))
     1925                       (z (ldb (byte 6 0) code)))
     1926                  (declare (fixnum w x y z))
     1927                  (fasl-out-byte (logior #xf0 w))
     1928                  (fasl-out-byte (logior #x80 x))
     1929                  (fasl-out-byte (logior #x80 y))
     1930                  (fasl-out-byte (logior #x80 z)))))))))
     1931
    18661932
    18671933(defun fasl-out-ivect (iv &optional
  • trunk/source/library/elf.lisp

    r13180 r13279  
    1919
    2020
     21(defloadvar *readonly-area*
     22    (do-consing-areas (a)
     23      (when (eql (%fixnum-ref a target::area.code)
     24                 ccl::area-readonly)
     25        (return a))))
    2126
    2227;;; String tables: used both for symbol names and for section names.
     
    164169    (subseq (nsubstitute #\0 #\# (nsubstitute #\. #\Space name)) 1)))
    165170
    166 #+x8664-target
    167 (defx86lapfunction dynamic-dnode ((x arg_z))
    168   (movq (% x) (% imm0))
    169   (ref-global x86::heap-start arg_y)
    170   (subq (% arg_y) (% imm0))
    171   (shrq ($ x8664::dnode-shift) (% imm0))
    172   (box-fixnum imm0 arg_z)
    173   (single-value-return))
    174 
    175 #+x8632-target
    176 (defx8632lapfunction dynamic-dnode ((x arg_z))
    177   (movl (% x) (% imm0))
    178   (ref-global x86::heap-start arg_y)
    179   (subl (% arg_y) (% imm0))
    180   (shrl ($ x8632::dnode-shift) (% imm0))
    181   (box-fixnum imm0 arg_z)
    182   (single-value-return))
     171
    183172
    184173(defun collect-elf-static-functions ()
    185174  (collect ((functions))
    186     (freeze)
     175    (purify)
    187176    (block walk
    188       (let* ((frozen-dnodes (frozen-space-dnodes)))
    189         (%map-areas (lambda (o)
    190                       (when (>= (dynamic-dnode o) frozen-dnodes)
    191                         (return-from walk nil))
    192                       (when (typep o
    193                                    #+x8664-target 'function-vector
    194                                    #-x8664-target 'function)
    195                         (functions (function-vector-to-function o))))
    196                     ccl::area-dynamic
    197                     )))
     177      (%map-areas (lambda (o)
     178                    (when (typep o
     179                                 #+x8664-target 'function-vector
     180                                 #-x8664-target 'function)
     181                      (functions (function-vector-to-function o))))
     182                  ccl::area-readonly
     183                  ccl::area-readonly
     184                  ))
    198185    (functions)))
    199186
     
    361348                #+32-bit-target :<E>lf32_<S>hdr.sh_flags) (logior #$SHF_WRITE #$SHF_ALLOC #$SHF_EXECINSTR)
    362349          (pref lisp-section-header #+64-bit-target :<E>lf64_<S>hdr.sh_addr
    363                 #+32-bit-target :<E>lf32_<S>hdr.sh_addr) (ash (%get-kernel-global heap-start) target::fixnumshift)
     350                #+32-bit-target :<E>lf32_<S>hdr.sh_addr) (ash (%fixnum-ref *readonly-area* target::area.low) target::fixnumshift)
    364351          (pref lisp-section-header #+64-bit-target :<E>lf64_<S>hdr.sh_size
    365                 #+32-bit-target :<E>lf32_<S>hdr.sh_size) (ash (frozen-space-dnodes) target::dnode-shift)
     352                #+32-bit-target :<E>lf32_<S>hdr.sh_size) (ash (- (%fixnum-ref *readonly-area* target::area.active) (%fixnum-ref *readonly-area* target::area.low) )target::fixnumshift)
    366353          (pref lisp-section-header #+64-bit-target :<E>lf64_<S>hdr.sh_offset
    367354                #+32-bit-target :<E>lf32_<S>hdr.sh_offset) 0
     
    389376          (pref shstrtab-section-header #+64-bit-target :<E>lf64_<S>hdr.sh_flags
    390377                #+32-bit-target :<E>lf32_<S>hdr.sh_flags) (logior #$SHF_STRINGS #$SHF_ALLOC))
    391     (elf-make-empty-data-for-section object lisp-section (ash (frozen-space-dnodes) target::dnode-shift))
     378    (elf-make-empty-data-for-section object lisp-section (ash (- (%fixnum-ref *readonly-area* target::area.active) (%fixnum-ref *readonly-area* target::area.low) )target::fixnumshift))
    392379    (elf-init-section-data-from-string-table object strings-section (elf-symbol-table-strings symbols))
    393380    (elf-init-section-data-from-string-table object shstrtab-section section-names)
  • trunk/source/library/lispequ.lisp

    r13067 r13279  
    12871287  readonly                              ; readonly section
    12881288  watched                               ; static area containing a single object
     1289  static-cons                           ; static cons cells
    12891290  managed-static                        ; growable static area
    12901291  static                                ; static data in application
  • trunk/source/lisp-kernel/area.h

    r13067 r13279  
    3232  AREA_READONLY = 4<<fixnumshift, /* A (cfm) read-only section. */
    3333  AREA_WATCHED = 5<<fixnumshift, /* A static area containing a single object. */
    34   AREA_MANAGED_STATIC = 6<<fixnumshift, /* A resizable static area */
    35   AREA_STATIC = 7<<fixnumshift, /* A  static section: contains
     34  AREA_STATIC_CONS = 6<<fixnumshift, /* static, conses only */
     35  AREA_MANAGED_STATIC = 7<<fixnumshift, /* A resizable static area */
     36  AREA_STATIC = 8<<fixnumshift, /* A  static section: contains
    3637                                 roots, but not GCed */
    37   AREA_DYNAMIC = 8<<fixnumshift /* A heap. Only one such area is "the heap."*/
     38  AREA_DYNAMIC = 9<<fixnumshift /* A heap. Only one such area is "the heap."*/
    3839} area_code;
    3940
     
    139140#ifdef LINUX
    140141#ifdef PPC64
    141 #define IMAGE_BASE_ADDRESS 0x100000000L
     142#define IMAGE_BASE_ADDRESS 0x50000000000L
    142143#else
    143144#define IMAGE_BASE_ADDRESS 0x31000000
     
    146147#ifdef DARWIN
    147148#ifdef PPC64
    148 #define IMAGE_BASE_ADDRESS 0x100000000L
     149#define IMAGE_BASE_ADDRESS 0x300000000000L
    149150#else
    150151#define IMAGE_BASE_ADDRESS 0x04000000
     
    191192#endif
    192193
    193 #ifdef X8664
    194 #define PURESPACE_RESERVE 0x40000000 /* 1GB */
    195 #else
    196 #define PURESPACE_RESERVE 0x04000000 /* 64MB */
     194#if (WORD_SIZE==64)
     195#define PURESPACE_RESERVE 0x2000000000LL /* 128 GB */
     196#define PURESPACE_SIZE (1LL<<30LL)
     197#else
     198#define PURESPACE_RESERVE (128<<20) /* MB */
     199#define PURESPACE_SIZE (64<<20)
    197200#endif
    198201
     
    211214extern BytePtr static_space_start, static_space_active, static_space_limit;
    212215extern area *find_readonly_area(void);
     216extern BytePtr low_relocatable_address, high_relocatable_address,
     217  low_markable_address, high_markable_address;
    213218
    214219#endif /* __AREA_H__ */
  • trunk/source/lisp-kernel/gc-common.c

    r13067 r13279  
    924924  Boolean header_p;
    925925
    926   if (GCDebug) {
    927     check_refmap_consistency(p, p+(num_memo_dnodes << 1), refbits);
    928   }
    929 
    930   /* This is pretty straightforward, but we have to note
    931      when we move a key in a hash table vector that wants
    932      us to tell it about that. */
    933 
    934   set_bitidx_vars(refbits, 0, bitsp, bits, bitidx);
    935   while (memo_dnode < num_memo_dnodes) {
    936     if (bits == 0) {
    937       int remain = nbits_in_word - bitidx;
    938       memo_dnode += remain;
    939       p += (remain+remain);
    940       bits = *++bitsp;
    941       bitidx = 0;
    942     } else {
    943       nextbit = count_leading_zeros(bits);
    944       if ((diff = (nextbit - bitidx)) != 0) {
    945         memo_dnode += diff;
    946         bitidx = nextbit;
    947         p += (diff+diff);
    948       }
    949       x1 = p[0];
    950       x2 = p[1];
    951       tag_x1 = fulltag_of(x1);
    952       bits &= ~(BIT0_MASK >> bitidx);
    953       header_p = (nodeheader_tag_p(tag_x1));
    954 
    955       if (header_p &&
    956           (header_subtag(x1) == subtag_hash_vector)) {
    957         hashp = (hash_table_vector_header *) p;
    958         if (hashp->flags & nhash_track_keys_mask) {
    959           hash_dnode_limit = memo_dnode + ((header_element_count(x1)+2)>>1);
    960         } else {
    961           hashp = NULL;
    962         }
    963       }
    964 
    965 
    966       if (! header_p) {
    967         new = node_forwarding_address(x1);
    968         if (new != x1) {
     926  if (num_memo_dnodes) {
     927    if (GCDebug) {
     928      check_refmap_consistency(p, p+(num_memo_dnodes << 1), refbits);
     929    }
     930
     931    /* This is pretty straightforward, but we have to note
     932       when we move a key in a hash table vector that wants
     933       us to tell it about that. */
     934
     935    set_bitidx_vars(refbits, 0, bitsp, bits, bitidx);
     936    while (memo_dnode < num_memo_dnodes) {
     937      if (bits == 0) {
     938        int remain = nbits_in_word - bitidx;
     939        memo_dnode += remain;
     940        p += (remain+remain);
     941        bits = *++bitsp;
     942        bitidx = 0;
     943      } else {
     944        nextbit = count_leading_zeros(bits);
     945        if ((diff = (nextbit - bitidx)) != 0) {
     946          memo_dnode += diff;
     947          bitidx = nextbit;
     948          p += (diff+diff);
     949        }
     950        x1 = p[0];
     951        x2 = p[1];
     952        tag_x1 = fulltag_of(x1);
     953        bits &= ~(BIT0_MASK >> bitidx);
     954        header_p = (nodeheader_tag_p(tag_x1));
     955
     956        if (header_p &&
     957            (header_subtag(x1) == subtag_hash_vector)) {
     958          hashp = (hash_table_vector_header *) p;
     959          if (hashp->flags & nhash_track_keys_mask) {
     960            hash_dnode_limit = memo_dnode + ((header_element_count(x1)+2)>>1);
     961          } else {
     962            hashp = NULL;
     963          }
     964        }
     965
     966
     967        if (! header_p) {
     968          new = node_forwarding_address(x1);
     969          if (new != x1) {
     970            *p = new;
     971          }
     972        }
     973        p++;
     974
     975        new = node_forwarding_address(x2);
     976        if (new != x2) {
    969977          *p = new;
    970         }
    971       }
    972       p++;
    973 
    974       new = node_forwarding_address(x2);
    975       if (new != x2) {
    976         *p = new;
    977         if (memo_dnode < hash_dnode_limit) {
    978           /* If this code is reached, 'hashp' is non-NULL and pointing
    979              at the header of a hash_table_vector, and 'memo_dnode' identifies
    980              a pair of words inside the hash_table_vector.  It may be
    981              hard for program analysis tools to recognize that, but I
    982              believe that warnings about 'hashp' being NULL here can
    983              be safely ignored. */
    984           hashp->flags |= nhash_key_moved_mask;
    985           hash_dnode_limit = 0;
    986           hashp = NULL;
    987         }
    988       }
    989       p++;
    990       memo_dnode++;
    991       bitidx++;
    992 
     978          if (memo_dnode < hash_dnode_limit) {
     979            /* If this code is reached, 'hashp' is non-NULL and pointing
     980               at the header of a hash_table_vector, and 'memo_dnode' identifies
     981               a pair of words inside the hash_table_vector.  It may be
     982               hard for program analysis tools to recognize that, but I
     983               believe that warnings about 'hashp' being NULL here can
     984               be safely ignored. */
     985            hashp->flags |= nhash_key_moved_mask;
     986            hash_dnode_limit = 0;
     987            hashp = NULL;
     988          }
     989        }
     990        p++;
     991        memo_dnode++;
     992        bitidx++;
     993
     994      }
    993995    }
    994996  }
     
    10161018reclaim_static_dnodes()
    10171019{
    1018   natural nstatic = tenured_area->static_dnodes, i, bits, bitnum;
     1020  natural nstatic = tenured_area->static_dnodes,
     1021    i,
     1022    bits,
     1023    bitnum,
     1024    nfree = 0,
     1025    nstatic_conses = area_dnode(static_cons_area->high, static_cons_area->low);
    10191026  cons *c = (cons *)tenured_area->low, *d;
    10201027  bitvector bitsp = GCmarkbits;
    10211028  LispObj head = lisp_global(STATIC_CONSES);
    10221029
    1023   if (nstatic) {
    1024     if (head) {
    1025       for (i = 0; i < nstatic; i+= nbits_in_word, c+= nbits_in_word) {
    1026         bits = *bitsp++;
    1027         if (bits != ALL_ONES) {
    1028           for (bitnum = 0; bitnum < nbits_in_word; bitnum++) {
    1029             if (! (bits & (BIT0_MASK>>bitnum))) {
    1030               d = c + bitnum;
    1031               d->car = 0;
    1032               d->cdr = head;
    1033               head = ((LispObj)d)+fulltag_cons;
    1034             }
    1035           }
    1036         }
    1037       }
    1038       lisp_global(STATIC_CONSES) = head;
    1039     } else {
    1040       for (i = 0; i < nstatic; i+= nbits_in_word, c+= nbits_in_word) {
    1041         bits = *bitsp++;
    1042         if (bits != ALL_ONES) {
    1043           for (bitnum = 0; bitnum < nbits_in_word; bitnum++) {
    1044             if (! (bits & (BIT0_MASK>>bitnum))) {
    1045               d = c + bitnum;
    1046               d->car = 0;
    1047               d->cdr = 0;
    1048             }
    1049           }
    1050         }
    1051       }
    1052     }
    1053   }
     1030  for (i = 0; i < nstatic; i+= nbits_in_word, c+= nbits_in_word) {
     1031    bits = *bitsp++;
     1032    if (bits != ALL_ONES) {
     1033      for (bitnum = 0; bitnum < nbits_in_word; bitnum++) {
     1034        if (! (bits & (BIT0_MASK>>bitnum))) {
     1035          d = c + bitnum;
     1036          d->car = 0;
     1037          if (i < nstatic_conses) {               
     1038            d->cdr = head;
     1039            head = ((LispObj)d)+fulltag_cons;
     1040            nfree++;
     1041          } else {
     1042            d->cdr = 0;
     1043          }
     1044        }
     1045      }
     1046    }
     1047  }
     1048  lisp_global(STATIC_CONSES) = head;
     1049  lisp_global(FREE_STATIC_CONSES)+=(nfree<<fixnumshift);
    10541050}
    10551051
     
    10861082#endif
    10871083
     1084
     1085Boolean
     1086mark_static_ref(LispObj n, BytePtr dynamic_start, natural ndynamic_dnodes)
     1087{
     1088  int tag_n = fulltag_of(n);
     1089  natural dyn_dnode;
     1090
     1091  if (nodeheader_tag_p(tag_n)) {
     1092    return (header_subtag(n) == subtag_hash_vector);
     1093  }
     1094 
     1095  if (is_node_fulltag (tag_n)) {
     1096    dyn_dnode = area_dnode(n, dynamic_start);
     1097    if (dyn_dnode < ndynamic_dnodes) {
     1098      mark_root(n);             /* May or may not mark it */
     1099      return true;              /* but return true 'cause it's a dynamic node */
     1100    }
     1101  }
     1102  return false;                 /* Not a heap pointer or not dynamic */
     1103}
     1104
     1105void
     1106mark_managed_static_refs(area *a, BytePtr low_dynamic_address, natural ndynamic_dnodes)
     1107{
     1108  bitvector refbits = a->refbits;
     1109  LispObj *p = (LispObj *) a->low, x1, x2;
     1110  natural inbits, outbits, bits, bitidx, *bitsp, nextbit, diff, memo_dnode = 0,
     1111    num_memo_dnodes = a->ndnodes;
     1112  Boolean keep_x1, keep_x2;
     1113
     1114  if (num_memo_dnodes) {
     1115    if (GCDebug) {
     1116      check_refmap_consistency(p, p+(num_memo_dnodes << 1), refbits);
     1117    }
     1118
     1119 
     1120    set_bitidx_vars(refbits, 0, bitsp, bits, bitidx);
     1121    inbits = outbits = bits;
     1122    while (memo_dnode < num_memo_dnodes) {
     1123      if (bits == 0) {
     1124        int remain = nbits_in_word - bitidx;
     1125        memo_dnode += remain;
     1126        p += (remain+remain);
     1127        if (outbits != inbits) {
     1128          *bitsp = outbits;
     1129        }
     1130        bits = *++bitsp;
     1131        inbits = outbits = bits;
     1132        bitidx = 0;
     1133      } else {
     1134        nextbit = count_leading_zeros(bits);
     1135        if ((diff = (nextbit - bitidx)) != 0) {
     1136          memo_dnode += diff;
     1137          bitidx = nextbit;
     1138          p += (diff+diff);
     1139        }
     1140        x1 = *p++;
     1141        x2 = *p++;
     1142        bits &= ~(BIT0_MASK >> bitidx);
     1143        keep_x1 = mark_static_ref(x1, low_dynamic_address, ndynamic_dnodes);
     1144        keep_x2 = mark_static_ref(x2, low_dynamic_address, ndynamic_dnodes);
     1145        if ((keep_x1 == false) &&
     1146            (keep_x2 == false)) {
     1147          outbits &= ~(BIT0_MASK >> bitidx);
     1148        }
     1149        memo_dnode++;
     1150        bitidx++;
     1151      }
     1152    }
     1153    if (GCDebug) {
     1154      p = (LispObj *) a->low;
     1155      check_refmap_consistency(p, p+(num_memo_dnodes << 1), refbits);
     1156    }
     1157  }
     1158}
    10881159
    10891160void
     
    12621333    }
    12631334
     1335    mark_managed_static_refs(managed_static_area,low_markable_address,area_dnode(a->active,low_markable_address));
     1336   
    12641337    other_tcr = tcr;
    12651338    do {
     
    13941467    }
    13951468 
     1469    forward_memoized_area(managed_static_area,area_dnode(managed_static_area->active,managed_static_area->low));
    13961470    a->active = (BytePtr) ptr_from_lispobj(compact_dynamic_heap());
    13971471    if (to) {
  • trunk/source/lisp-kernel/gc.h

    r13067 r13279  
    143143#define GC_TRAP_FUNCTION_SET_LISP_HEAP_THRESHOLD 17
    144144#define GC_TRAP_FUNCTION_USE_LISP_HEAP_THRESHOLD 18
     145#define GC_TRAP_FUNCTION_ENSURE_STATIC_CONSES 19
    145146#define GC_TRAP_FUNCTION_EGC_CONTROL 32
    146147#define GC_TRAP_FUNCTION_CONFIGURE_EGC 64
    147 #define GC_TRAP_FUNCTION_SET_HONS_AREA_SIZE 128 /* deprecated */
    148148#define GC_TRAP_FUNCTION_FREEZE 129
    149149#define GC_TRAP_FUNCTION_THAW 130
     
    241241extern xmacptr_dispose_fn xmacptr_dispose_functions[];
    242242
     243extern bitvector global_mark_ref_bits, dynamic_mark_ref_bits;
     244
     245
    243246#endif                          /* __GC_H__ */
  • trunk/source/lisp-kernel/image.c

    r13175 r13279  
    231231
    232232  case AREA_MANAGED_STATIC:
    233     a = new_area(pure_space_limit, pure_space_limit, AREA_MANAGED_STATIC);
     233    a = new_area(pure_space_limit, pure_space_limit+align_to_power_of_2(mem_size,log2_page_size), AREA_MANAGED_STATIC);
     234    a->active = a->low+mem_size;
     235    if (mem_size) {
     236      natural
     237        refbits_size = align_to_power_of_2((((mem_size>>dnode_shift)+7)>>3),
     238                                           log2_page_size);
     239      if (!MapFile(a->low,
     240                   pos,
     241                   align_to_power_of_2(mem_size,log2_page_size),
     242                   MEMPROTECT_RWX,
     243                   fd)) {
     244        return;
     245      }
     246      /* Need to save/restore persistent refbits. */
     247      if (!MapFile(global_mark_ref_bits,
     248                   align_to_power_of_2(pos+mem_size,log2_page_size),
     249                   refbits_size,
     250                   MEMPROTECT_RW,
     251                   fd)) {
     252        return;
     253      }
     254      advance += refbits_size;
     255    }
    234256    sect->area = a;
     257    a->ndnodes = area_dnode(a->active, a->low);
     258    managed_static_area = a;
     259    lisp_global(REF_BASE) = (LispObj) a->low;
     260    break;
     261
     262    /* In many respects, the static_cons_area is part of the dynamic
     263       area; it's physically adjacent to it (immediately precedes the
     264       dynamic area in memory) and its contents are subject to full
     265       GC (but not compaction.)  It's maintained as a seperate section
     266       in the image file, at least for now. */
     267
     268
     269  case AREA_STATIC_CONS:
     270    addr = (void *) lisp_global(HEAP_START);
     271    a = new_area(addr-align_to_power_of_2(mem_size,log2_page_size), addr, AREA_STATIC_CONS);
     272    if (mem_size) {     
     273      if (!MapFile(a->low,
     274                   pos,
     275                   align_to_power_of_2(mem_size,log2_page_size),
     276                   MEMPROTECT_RWX,
     277                   fd)) {
     278        return;
     279      }
     280    }
     281    a->ndnodes = area_dnode(a->active, a->low);
     282    sect->area = a;
     283    static_cons_area = a;
    235284    break;
    236285
     
    299348       
    300349      case AREA_READONLY:
     350        if (bias &&
     351            (managed_static_area->active != managed_static_area->low)) {
     352          UnProtectMemory(a->low, a->active-a->low);
     353          relocate_area_contents(a, bias);
     354          ProtectMemory(a->low, a->active-a->low);
     355        }
    301356        readonly_area = a;
    302357        add_area_holding_area_lock(a);
     
    311366          relocate_area_contents(a, bias);
    312367        }
    313         managed_static_area = a;
    314368        add_area_holding_area_lock(a);
    315369        break;
     370      case AREA_STATIC_CONS:
     371        break;
    316372      case AREA_DYNAMIC:
     373        lower_heap_start(static_cons_area->low,a);
    317374        if (bias) {
    318375          relocate_area_contents(a, bias);
     
    418475#endif
    419476
     477  /*
     478    Coerce macptrs to dead_macptrs.
     479  */
     480 
     481  prepare_to_write_dynamic_space(active_dynamic_area);
     482
     483  /*
     484     If we ever support continuing after saving an image,
     485     undo this .. */
     486
     487  if (static_cons_area->high > static_cons_area->low) {
     488    active_dynamic_area->low = static_cons_area->high;
     489    tenured_area->static_dnodes -= area_dnode(static_cons_area->high, static_cons_area->low);
     490  }
     491
    420492  areas[0] = nilreg_area;
    421   areas[1] = active_dynamic_area;
    422   areas[2] = readonly_area;
     493  areas[1] = readonly_area;
     494  areas[2] = active_dynamic_area;
    423495  areas[3] = managed_static_area;
     496  areas[4] = static_cons_area;
    424497  for (i = 0; i < NUM_IMAGE_SECTIONS; i++) {
    425498    a = areas[i];
     
    460533#endif
    461534
    462   /*
    463     Coerce macptrs to dead_macptrs.
    464   */
    465  
    466   prepare_to_write_dynamic_space(active_dynamic_area);
    467535
    468536  {
     
    483551  for (i = MIN_KERNEL_GLOBAL; i < 0; i++) {
    484552    switch (i) {
     553    case FREE_STATIC_CONSES:
    485554    case FWDNUM:
    486555    case GC_NUM:
     
    506575        return errno;
    507576    }
     577    if (n &&  ((sections[i].code) == AREA_MANAGED_STATIC)) {
     578      natural ndnodes = area_dnode(a->active, a->low);
     579      natural nrefbytes = align_to_power_of_2((ndnodes+7)>>3,log2_page_size);
     580
     581      seek_to_next_page(fd);
     582      if (writebuf(fd,(char*)a->refbits,nrefbytes)) {
     583        return errno;
     584      }
     585    }
    508586  }
    509587
  • trunk/source/lisp-kernel/image.h

    r13067 r13279  
    9090
    9191
    92 #define ABI_VERSION_MIN 1033
    93 #define ABI_VERSION_CURRENT 1033
    94 #define ABI_VERSION_MAX 1033
     92#define ABI_VERSION_MIN 1036
     93#define ABI_VERSION_CURRENT 1036
     94#define ABI_VERSION_MAX 1036
    9595
    96 #define NUM_IMAGE_SECTIONS 4    /* used to be 3 */
     96#define NUM_IMAGE_SECTIONS 5    /* used to be 3 */
  • trunk/source/lisp-kernel/kernel-globals.h

    r13067 r13279  
    2121
    2222
    23 extern area *nilreg_area, *tenured_area, *g2_area, *g1_area, *managed_static_area, *readonly_area;
     23extern area *nilreg_area, *tenured_area, *g2_area, *g1_area, *managed_static_area, *readonly_area, *static_cons_area;
    2424extern area *all_areas;
    2525extern int cache_block_size;
  • trunk/source/lisp-kernel/lisp.h

    r13067 r13279  
    129129#endif
    130130
     131void ensure_static_conses(ExceptionInformation *, TCR *,natural);
     132
    131133#include <stdio.h>
    132134
  • trunk/source/lisp-kernel/lisp_globals.h

    r13067 r13279  
    5454#define LEXPR_RETURN1V (-31)    /* single-value &lexpr cleanup code */
    5555#define IN_GC (-32)             /* non-zero when lisp addresses may be invalid */
    56 #define METERING_INFO (-33)     /* address of lisp_metering global */
     56#define FREE_STATIC_CONSES (-33)     /* length of freelist */
    5757#define OBJC_2_END_CACTCH (-34)          /* address of ObjC 2.0 objc_end_catch() */
    5858#define SHORT_FLOAT_ZERO (-35)  /* low half of 1.0d0 */
    5959#define DOUBLE_FLOAT_ONE (-36)  /* high half of 1.0d0 */
    60 #define LISP_RETURN_HOOK (-37)  /* install lisp exception handling */
     60#define STATIC_CONS_AREA (-37)  /* static_cons_area */
    6161#define LISP_EXIT_HOOK (-38)    /* install foreign exception handling */
    6262#define OLDEST_EPHEMERAL (-39)  /* doubleword address of oldest ephemeral object or 0 */
    6363#define TENURED_AREA (-40)      /* the tenured area */
    64 #define ERRNO (-41)             /* address of errno */
     64#define REF_BASE (-41)          /* start of oldest pointer-bearing area */
    6565#define ARGV (-42)              /* pointer to &argv[0] */
    6666#define HOST_PLATFORM (-43)     /* for platform-specific initialization */
  • trunk/source/lisp-kernel/memory.c

    r13067 r13279  
    774774   
    775775  a->markbits = new_markbits;
    776   lisp_global(OLDSPACE_DNODE_COUNT) = area_dnode(curfree, lisp_global(HEAP_START));
     776  lisp_global(OLDSPACE_DNODE_COUNT) = area_dnode(curfree, lisp_global(REF_BASE));
    777777}
    778778
     
    809809      /* Everything's in the dynamic area */
    810810      lisp_global(OLDEST_EPHEMERAL) = 0;
    811       lisp_global(OLDSPACE_DNODE_COUNT) = 0;
     811      lisp_global(OLDSPACE_DNODE_COUNT) = area_dnode(managed_static_area->active,managed_static_area->low);
    812812
    813813    }
     
    945945}
    946946
    947 void
    948 release_readonly_area()
    949 {
    950   area *a = readonly_area;
    951   UnMapMemory(a->low,align_to_power_of_2(a->active-a->low, log2_page_size));
    952   a->active = a->low;
    953   a->ndnodes = 0;
    954   pure_space_active = pure_space_start;
    955 }
    956947
    957948void
  • trunk/source/lisp-kernel/pmcl-kernel.c

    r13067 r13279  
    138138
    139139LispObj lisp_nil = (LispObj) 0;
    140 bitvector global_mark_ref_bits = NULL;
     140bitvector global_mark_ref_bits = NULL, dynamic_mark_ref_bits = NULL;
    141141
    142142
     
    372372#endif
    373373#ifdef SOLARIS
    374 #define MAXIMUM_MAPPABLE_MEMORY (128L<<30L)
     374#define MAXIMUM_MAPPABLE_MEMORY (512L<<30L)
    375375#endif
    376376#ifdef LINUX
     
    379379#endif
    380380#ifdef PPC
    381 #define MAXIMUM_MAPPABLE_MEMORY (128L<<30L)
     381#define MAXIMUM_MAPPABLE_MEMORY (512L<<30L)
    382382#endif
    383383#endif
    384384#ifdef WINDOWS
    385385/* Supposedly, the high-end version of Vista allow 128GB of pageable memory */
    386 #define MAXIMUM_MAPPABLE_MEMORY (120LL<<30LL)
     386#define MAXIMUM_MAPPABLE_MEMORY (512LL<<30LL)
    387387#endif
    388388#else
     
    417417  *g1_area=NULL,
    418418  *managed_static_area=NULL,
     419  *static_cons_area=NULL,
    419420  *readonly_area=NULL;
    420421
     
    511512
    512513area *
    513 extend_readonly_area(unsigned more)
     514extend_readonly_area(natural more)
    514515{
    515516  area *a;
     
    590591  static_space_limit = static_space_start + STATIC_RESERVE;
    591592  pure_space_start = pure_space_active = start;
    592   pure_space_limit = start + PURESPACE_RESERVE;
    593   start = pure_space_limit;
     593  pure_space_limit = start + PURESPACE_SIZE;
     594  start += PURESPACE_RESERVE;
    594595
    595596  /*
     
    607608  reserved->pred = reserved->succ = reserved;
    608609  all_areas = reserved;
    609   reserved->markbits = global_mark_ref_bits;
    610610  return reserved;
    611611}
     
    632632
    633633BytePtr reloctab_limit = NULL, markbits_limit = NULL;
     634BytePtr low_relocatable_address = NULL, high_relocatable_address = NULL,
     635  low_markable_address = NULL, high_markable_address = NULL;
     636
     637void
     638map_initial_reloctab(BytePtr low, BytePtr high) 
     639{
     640  natural ndnodes, reloctab_size, n;
     641
     642  low_relocatable_address = low; /* will never change */
     643  high_relocatable_address = high;
     644  ndnodes = area_dnode(high,low);
     645  reloctab_size = (sizeof(LispObj)*(((ndnodes+((1<<bitmap_shift)-1))>>bitmap_shift)+1));
     646 
     647  reloctab_limit = (BytePtr)align_to_power_of_2(((natural)global_reloctab)+reloctab_size,log2_page_size);
     648  CommitMemory(global_reloctab,reloctab_limit-(BytePtr)global_reloctab);
     649}
     650
     651void
     652map_initial_markbits(BytePtr low, BytePtr high)
     653{
     654  natural
     655    prefix_dnodes = area_dnode(low, pure_space_limit),
     656    ndnodes = area_dnode(high, low),
     657    prefix_size = (prefix_dnodes+7)>>3,
     658    markbits_size = (3*sizeof(LispObj))+((ndnodes+7)>>3),
     659    n;
     660  low_markable_address = low;
     661  high_markable_address = high;
     662  dynamic_mark_ref_bits = (bitvector)(((BytePtr)global_mark_ref_bits)+prefix_size);
     663  n = align_to_power_of_2(markbits_size,log2_page_size);
     664  markbits_limit = ((BytePtr)dynamic_mark_ref_bits)+n;
     665  CommitMemory(dynamic_mark_ref_bits,n);
     666}
     667   
     668void
     669lower_heap_start(BytePtr new_low, area *a)
     670{
     671  natural new_dnodes = area_dnode(low_markable_address,new_low);
     672
     673  if (new_dnodes) {
     674    natural n = (new_dnodes+7)>>3;
     675
     676    BytePtr old_markbits = (BytePtr)dynamic_mark_ref_bits,
     677      new_markbits = old_markbits-n;
     678    CommitMemory(new_markbits,n);
     679    dynamic_mark_ref_bits = (bitvector)new_markbits;
     680    if (a->refbits) {
     681      a->refbits= dynamic_mark_ref_bits;
     682    }
     683    a->static_dnodes += new_dnodes;
     684    a->ndnodes += new_dnodes;
     685    a->low = new_low;
     686    low_markable_address = new_low;
     687    lisp_global(HEAP_START) = (LispObj)new_low;
     688    static_cons_area->ndnodes = area_dnode(static_cons_area->high,new_low);
     689  }
     690}
    634691
    635692void
     
    643700  BytePtr
    644701    new_reloctab_limit = (BytePtr)align_to_power_of_2(((natural)global_reloctab)+reloctab_size,log2_page_size),
    645     new_markbits_limit = (BytePtr)align_to_power_of_2(((natural)global_mark_ref_bits)+markbits_size,log2_page_size);
     702    new_markbits_limit = (BytePtr)align_to_power_of_2(((natural)dynamic_mark_ref_bits)+markbits_size,log2_page_size);
    646703
    647704  if (new_reloctab_limit > reloctab_limit) {
     
    677734  a->active = start+initsize;
    678735  add_area_holding_area_lock(a);
    679   a->markbits = reserved_area->markbits;
    680   reserved_area->markbits = NULL;
    681736  CommitMemory(start, end-start);
    682737  a->h = start;
    683738  a->softprot = NULL;
    684739  a->hardprot = NULL;
     740  map_initial_reloctab(a->low, a->high);
     741  map_initial_markbits(a->low, a->high);
    685742  lisp_global(HEAP_START) = ptr_to_lispobj(a->low);
    686743  lisp_global(HEAP_END) = ptr_to_lispobj(a->high);
    687   markbits_limit = (BytePtr)global_mark_ref_bits;
    688   reloctab_limit = (BytePtr)global_reloctab;
    689   ensure_gc_structures_writable();
    690744  return a;
    691745 }
     
    18951949    g2_area->older = tenured_area;
    18961950    tenured_area->younger = g2_area;
    1897     tenured_area->refbits = a->markbits;
     1951    tenured_area->refbits = dynamic_mark_ref_bits;
     1952    managed_static_area->refbits = global_mark_ref_bits;
     1953    a->markbits = dynamic_mark_ref_bits;
    18981954    tenured_area->static_dnodes = a->static_dnodes;
    18991955    a->static_dnodes = 0;
     
    19011957    a->static_used = 0;
    19021958    lisp_global(TENURED_AREA) = ptr_to_lispobj(tenured_area);
    1903     lisp_global(REFBITS) = ptr_to_lispobj(tenured_area->refbits);
     1959    lisp_global(STATIC_CONS_AREA) = ptr_to_lispobj(static_cons_area);
     1960    lisp_global(REFBITS) = ptr_to_lispobj(global_mark_ref_bits);
    19041961    g2_area->threshold = default_g2_threshold;
    19051962    g1_area->threshold = default_g1_threshold;
     
    19111968  init_threads((void *)(stack_base), tcr);
    19121969  thread_init_tcr(tcr, current_sp, current_sp-stack_base);
     1970
     1971  if (lisp_global(STATIC_CONSES) == 0) {
     1972    lisp_global(STATIC_CONSES) = lisp_nil;
     1973  }
    19131974
    19141975  lisp_global(EXCEPTION_LOCK) = ptr_to_lispobj(new_recursive_lock());
     
    23532414#endif
    23542415#endif
     2416
     2417void
     2418allocate_static_conses(natural n)
     2419{
     2420  BytePtr old_low = static_cons_area->low,
     2421    new_low = old_low - (n<<dnode_shift);
     2422  cons *c;
     2423  natural i;
     2424  LispObj prev;
     2425
     2426  CommitMemory(new_low,old_low-new_low);
     2427
     2428  static_cons_area->low = new_low;
     2429  lower_heap_start(new_low, tenured_area);
     2430  if (active_dynamic_area->low == old_low) {
     2431    active_dynamic_area->low = new_low;
     2432  }
     2433  if (g1_area->low == old_low) {
     2434    g1_area->low = new_low;
     2435  }
     2436  if (g1_area->high == old_low) {
     2437    g1_area->high = new_low;
     2438  }
     2439  if (g2_area->low == old_low) {
     2440    g2_area->low = new_low;
     2441  }
     2442  if (g2_area->high == old_low) {
     2443    g2_area->high = new_low;
     2444  }
     2445  for (i=0, prev=lisp_global(STATIC_CONSES), c=(cons *)new_low;
     2446       i < n;
     2447       i++, c++) {
     2448    c->cdr = prev;
     2449    prev = ((LispObj)c)+fulltag_cons;
     2450  }
     2451  lisp_global(STATIC_CONSES)=prev;
     2452  lisp_global(FREE_STATIC_CONSES)+=(n<<fixnumshift);
     2453}
     2454void
     2455ensure_static_conses(ExceptionInformation *xp, TCR *tcr, natural nconses)
     2456{
     2457  area *a = active_dynamic_area;
     2458  natural nbytes = nconses>>dnode_shift, have;
     2459  BytePtr p = a->high-nbytes;
     2460
     2461  if (p < a->active) {
     2462    untenure_from_area(tenured_area);
     2463    gc_from_xp(xp, 0L);
     2464  }
     2465
     2466  have = unbox_fixnum(lisp_global(FREE_STATIC_CONSES));
     2467  if (have < nconses) {
     2468    if ((a->high-a->active)>nbytes) {
     2469      shrink_dynamic_area(nbytes);
     2470    }
     2471    allocate_static_conses(nconses);
     2472    tcr->bytes_allocated += nbytes;
     2473  }
     2474}
     2475     
  • trunk/source/lisp-kernel/ppc-constants.s

    r13067 r13279  
    194194         _node(host_platform)           /* for runtime platform-specific stuff */
    195195         _node(argv)                    /* address of argv[0] */
    196          _node(errno)                   /* ADDRESS of errno */
     196         _node(ref_base)                        /* start of oldest pointer-bearing area */
    197197         _node(tenured_area)            /* the tenured_area */
    198198         _node(oldest_ephemeral)        /* dword address of oldest ephemeral object or 0 */
     
    209209         _node(kernel_path)             /* real executable name */
    210210         _node(objc2_begin_catch)       /* objc_begin_catch */
    211          _node(BAD_current_vs)          /* current value-stack area  */
     211         _node(stack_size)              /* from command-line */
    212212         _node(statically_linked)       /* non-zero if -static */
    213213         _node(heap_end)                /* end of lisp heap */
  • trunk/source/lisp-kernel/ppc-exceptions.c

    r13207 r13279  
    470470    break;
    471471
     472  case GC_TRAP_FUNCTION_ENSURE_STATIC_CONSES:
     473    ensure_static_conses(xp,tcr,32768);
     474    break;
     475
    472476  case GC_TRAP_FUNCTION_FLASH_FREEZE:
    473477    untenure_from_area(tenured_area);
     
    508512        /*        nrs_GC_EVENT_STATUS_BITS.vcell |= gc_integrity_check_bit; */
    509513        gc_from_xp(xp, 0L);
    510         release_readonly_area();
    511514      }
    512515      if (selector & GC_TRAP_FUNCTION_PURIFY) {
     
    528531      }
    529532      switch (selector) {
    530       case GC_TRAP_FUNCTION_SET_HONS_AREA_SIZE:
    531         xpGPR(xp, imm0) = 0;
    532         break;
     533
    533534
    534535      case GC_TRAP_FUNCTION_FREEZE:
     
    19851986    }
    19861987    if (need_check_memo) {
    1987       natural  bitnumber = area_dnode(ea, lisp_global(HEAP_START));
     1988      natural  bitnumber = area_dnode(ea, lisp_global(REF_BASE));
    19881989      if ((bitnumber < lisp_global(OLDSPACE_DNODE_COUNT)) &&
    19891990          ((LispObj)ea < val)) {
    19901991        atomic_set_bit(refbits, bitnumber);
    19911992        if (need_memoize_root) {
    1992           bitnumber = area_dnode(root, lisp_global(HEAP_START));
     1993          bitnumber = area_dnode(root, lisp_global(REF_BASE));
    19931994          atomic_set_bit(refbits, bitnumber);
    19941995        }
     
    30743075    terminate_lisp();
    30753076  }
    3076   lisp_global(LISP_EXIT_HOOK) = (LispObj) restore_foreign_exception_ports;
    3077   lisp_global(LISP_RETURN_HOOK) = (LispObj) tcr_establish_lisp_exception_port;
    30783077}
    30793078
  • trunk/source/lisp-kernel/ppc-spentry.s

    r13067 r13279  
    475475        __(_rplaca(arg_y,arg_z))
    476476        __(blelr cr2)
    477         __(ref_global(imm2,heap_start))
     477        __(ref_global(imm2,ref_base))
    478478        __(sub imm0,arg_y,imm2)
    479479        __(load_highbit(imm3))
     
    503503        __(_rplacd(arg_y,arg_z))
    504504        __(blelr cr2)
    505         __(ref_global(imm2,heap_start))
     505        __(ref_global(imm2,ref_base))
    506506        __(sub imm0,arg_y,imm2)
    507507        __(load_highbit(imm3))
     
    535535        __(blelr cr2)
    536536        __(add imm0,imm0,arg_x)
    537         __(ref_global(imm2,heap_start))
     537        __(ref_global(imm2,ref_base))
    538538        __(load_highbit(imm3))
    539539        __(ref_global(imm1,oldspace_dnode_count))
     
    568568        __(blelr cr2)
    569569        __(add imm0,imm0,arg_x)
    570         __(ref_global(imm2,heap_start))
     570        __(ref_global(imm2,ref_base))
    571571        __(load_highbit(imm3))
    572572        __(ref_global(imm1,oldspace_dnode_count))
     
    589589        __(isync)
    5905902:             
    591         __(ref_global(imm1,heap_start))
     591        __(ref_global(imm1,ref_base))
    592592        __(sub imm0,arg_x,imm1)
    593593        __(srri(imm0,imm0,dnode_shift))
     
    641641        __(isync)
    642642        __(add imm0,imm4,arg_x)
    643         __(ref_global(imm2,heap_start))
     643        __(ref_global(imm2,ref_base))
    644644        __(ref_global(imm1,oldspace_dnode_count))
    645645        __(sub imm0,imm0,imm2)
     
    679679        __(isync)
    680680        __(add imm0,imm4,arg_x)
    681         __(ref_global(imm2,heap_start))
     681        __(ref_global(imm2,ref_base))
    682682        __(ref_global(imm1,oldspace_dnode_count))
    683683        __(sub imm0,imm0,imm2)
     
    697697        __(isync)
    698698        /* Memoize hash table header */         
    699         __(ref_global(imm1,heap_start))
     699        __(ref_global(imm1,ref_base))
    700700        __(sub imm0,arg_x,imm1)
    701701        __(srri(imm0,imm0,dnode_shift))
  • trunk/source/lisp-kernel/thread_manager.c

    r13102 r13279  
    13331333  tcr->single_float_convert.tag = subtag_single_float;
    13341334#endif
    1335   lisp_global(TCR_COUNT) += (1<<fixnumshift);
    13361335  tcr->suspend = new_semaphore(0);
    13371336  tcr->resume = new_semaphore(0);
  • trunk/source/lisp-kernel/x86-constants.s

    r13067 r13279  
    7676         _node(host_platform)           /* for runtime platform-specific stuff   */
    7777         _node(argv)                    /* address of argv[0]   */
    78          _node(errno)                   /* ADDRESS of errno  */
     78         _node(ref_base)                /* start of oldest pointer-bearing area */
    7979         _node(tenured_area)            /* the tenured_area   */
    8080         _node(oldest_ephemeral)        /* dword address of oldest ephemeral object or 0   */
     
    9191         _node(kernel_path)             /* real executable name */
    9292         _node(objc2_begin_catch)       /* objc_begin_catch   */
    93          _node(BAD_current_vs)          /* current value-stack area  */
     93         _node(stack_size)              /* from the command line */
    9494         _node(statically_linked)       /* non-zero if -static   */
    9595         _node(heap_end)                /* end of lisp heap   */
  • trunk/source/lisp-kernel/x86-exceptions.c

    r13067 r13279  
    221221    break;
    222222
     223  case GC_TRAP_FUNCTION_ENSURE_STATIC_CONSES:
     224    ensure_static_conses(xp, tcr, 32768);
     225    break;
     226
    223227  case GC_TRAP_FUNCTION_FLASH_FREEZE: /* Like freeze below, but no GC */
    224228    untenure_from_area(tenured_area);
     
    259263        /*        nrs_GC_EVENT_STATUS_BITS.vcell |= gc_integrity_check_bit; */
    260264        gc_from_xp(xp, 0L);
    261         release_readonly_area();
    262265      }
    263266      if (selector & GC_TRAP_FUNCTION_PURIFY) {
    264         purify_from_xp(xp, 0L);
     267        purify_from_xp(xp, 1);
    265268        gc_from_xp(xp, 0L);
    266269      }
     
    281284      }
    282285      switch (selector) {
    283       case GC_TRAP_FUNCTION_SET_HONS_AREA_SIZE:
    284         xpGPR(xp, Iimm0) = 0;
    285         break;
    286286      case GC_TRAP_FUNCTION_FREEZE:
    287287        a->active = (BytePtr) align_to_power_of_2(a->active, log2_page_size);
     
    26202620    }
    26212621    if (need_check_memo) {
    2622       natural  bitnumber = area_dnode(ea, lisp_global(HEAP_START));
     2622      natural  bitnumber = area_dnode(ea, lisp_global(REF_BASE));
    26232623      if ((bitnumber < lisp_global(OLDSPACE_DNODE_COUNT)) &&
    26242624          ((LispObj)ea < val)) {
    26252625        atomic_set_bit(refbits, bitnumber);
    26262626        if (need_memoize_root) {
    2627           bitnumber = area_dnode(root, lisp_global(HEAP_START));
     2627          bitnumber = area_dnode(root, lisp_global(REF_BASE));
    26282628          atomic_set_bit(refbits, bitnumber);
    26292629        }
     
    35043504    terminate_lisp();
    35053505  }
    3506   lisp_global(LISP_EXIT_HOOK) = (LispObj) restore_foreign_exception_ports;
    3507   lisp_global(LISP_RETURN_HOOK) = (LispObj) tcr_establish_lisp_exception_port;
    35083506}
    35093507
     
    37813779    /* because wp_update_references doesn't update refbits */
    37823780    tenure_to_area(tenured_area);
     3781    /* Unwatching can (re-)introduce managed_static->dynamic references */
     3782    zero_bits(managed_static_area->refbits,managed_static_area->ndnodes);
     3783    update_managed_refs(managed_static_area, low_markable_address, area_dnode(active_dynamic_area->active, low_markable_address));
    37833784    check_all_areas(tcr);
    37843785    xpGPR(xp, Iarg_z) = new;
  • trunk/source/lisp-kernel/x86-gc.c

    r13255 r13279  
    21052105
    21062106
    2107 
    2108 
    2109 
    2110      
     2107#define PURIFY_IVECTORS (1<<0)
     2108#define PURIFY_FUNCTIONS (1<<1)
     2109#define PURIFY_ALL (-1)
     2110#define PURIFY_NOTHING (0)      /* update forwarding pointers, don't copy */
     2111
     2112
     2113
     2114Boolean
     2115immutable_function_p(LispObj thing)
     2116{
     2117  LispObj header = header_of(thing), lfbits;
     2118  if (header_subtag(header) == subtag_function) {
     2119    lfbits = deref(thing,header_element_count(header));
     2120    if (((lfbits & (lfbits_cm_mask | lfbits_method_mask)) !=
     2121         lfbits_cm_mask) &&
     2122        ((lfbits & (lfbits_gfn_mask | lfbits_method_mask)) !=
     2123         lfbits_gfn_mask)) {
     2124      return true;
     2125    }
     2126  }
     2127  return false;
     2128}
     2129
    21112130   
    21122131/*
     
    21152134
    21162135natural
    2117 unboxed_bytes_in_range(LispObj *start, LispObj *end)
     2136unboxed_bytes_in_range(LispObj *start, LispObj *end, Boolean include_functions)
    21182137{
    21192138  natural total=0, elements, tag, subtag, bytes;
     
    21282147      elements = header_element_count(header);
    21292148      if (nodeheader_tag_p(tag)) {
     2149        if (include_functions && immutable_function_p((LispObj)start)) {
     2150          total += (((elements+2)&~1)<<node_shift);
     2151        }
    21302152        start += ((elements+2) & ~1);
    21312153      } else {
     
    21772199
    21782200
    2179 /*
    2180   This assumes that it's getting called with a simple-{base,general}-string
    2181   or code vector as an argument and that there's room for the object in the
    2182   destination area.
    2183 */
    2184 
     2201void
     2202ensure_writable_space(area *target, natural need)
     2203{
     2204  BytePtr
     2205    oldlimit = (BytePtr)align_to_power_of_2(target->active,log2_page_size),
     2206    newlimit = (BytePtr)align_to_power_of_2(target->active+need,log2_page_size);
     2207  if (newlimit > oldlimit) {
     2208    CommitMemory(oldlimit,newlimit-oldlimit);
     2209  }
     2210}
    21852211
    21862212LispObj
     
    21962222    start = (natural)old,
    21972223    physbytes;
    2198 
    2199   physbytes = ((natural)(skip_over_ivector(start,header))) - start;
    2200 
     2224  int
     2225    header_tag = fulltag_of(header);
     2226#ifdef X8632
     2227  Boolean
     2228    is_function = (header_subtag(header)==subtag_function);
     2229#endif
     2230
     2231  if (immheader_tag_p(header_tag)) {
     2232    physbytes = ((natural)(skip_over_ivector(start,header))) - start;
     2233  } else if (nodeheader_tag_p(header_tag)) {
     2234    physbytes = ((header_element_count(header)+2)&~1) << node_shift;
     2235  } else {
     2236    physbytes = dnode_size;
     2237  }
     2238 
     2239  ensure_writable_space(dest, physbytes);
    22012240  dest->active += physbytes;
    22022241
     
    22042243
    22052244  memcpy(free, (BytePtr)old, physbytes);
    2206   /* Leave a trail of breadcrumbs.  Or maybe just one breadcrumb. */
    2207   /* Actually, it's best to always leave a trail, for two reasons.
    2208      a) We may be walking the same heap that we're leaving forwaring
    2209      pointers in, so we don't want garbage that we leave behind to
    2210      look like a header.
    2211      b) We'd like to be able to forward code-vector locatives, and
    2212      it's easiest to do so if we leave a {forward_marker, dnode_locative}
    2213      pair at every doubleword in the old vector.
    2214      */
     2245
     2246#ifdef X8632
     2247  if (is_function) {
     2248    update_self_references((LispObj *)free);
     2249  }
     2250#endif
     2251
     2252
    22152253  while(physbytes) {
    22162254    *old++ = (BytePtr) forward_marker;
     
    22292267
    22302268Boolean
    2231 copy_ivector_reference(LispObj *ref, BytePtr low, BytePtr high, area *dest)
     2269purify_locref(LispObj *ref,  BytePtr low, BytePtr high, area *dest, int what)
    22322270{
    22332271  LispObj obj = *ref, header, new;
     
    22352273  Boolean changed = false;
    22362274
    2237   if ((tag == fulltag_misc) &&
    2238       (((BytePtr)ptr_from_lispobj(obj)) > low) &&
     2275  if ((((BytePtr)ptr_from_lispobj(obj)) > low) &&
    22392276      (((BytePtr)ptr_from_lispobj(obj)) < high)) {
    22402277    header = deref(obj, 0);
     
    22442281    } else {
    22452282      header_tag = fulltag_of(header);
    2246       if (immheader_tag_p(header_tag)) {
    2247         if (header_subtag(header) != subtag_macptr) {
    2248           new = purify_object(obj, dest);
    2249           *ref = new;
    2250           changed = (new != obj);
    2251         }
     2283      if ((what == PURIFY_ALL) ||
     2284          ((what & PURIFY_IVECTORS) &&
     2285           immheader_tag_p(header_tag) &&
     2286           header_subtag(header) != subtag_macptr) ||
     2287          ((what & PURIFY_FUNCTIONS) &&
     2288           immutable_function_p(obj))) {
     2289        new = purify_object(obj, dest);
     2290        *ref = new;
     2291        changed = (new != obj);
    22522292      }
    22532293    }
     
    22562296}
    22572297
    2258 
    2259 void
    2260 purify_gcable_ptrs(BytePtr low, BytePtr high, area *to)
     2298Boolean
     2299copy_reference(LispObj *ref, BytePtr low, BytePtr high, area *dest, int what)
     2300{
     2301  LispObj obj = *ref;
     2302  natural tag = fulltag_of(obj);
     2303
     2304  if (
     2305#ifdef X8664
     2306      (tag == fulltag_tra_0) || (tag == fulltag_tra_1)
     2307#endif
     2308#ifdef X8632
     2309      tag == fulltag_tra
     2310#endif
     2311      ) {
     2312    what = PURIFY_NOTHING;
     2313  }
     2314  if (is_node_fulltag(tag)) {
     2315    return purify_locref(ref,low,high,dest,what);
     2316  }
     2317  return false;
     2318}
     2319
     2320
     2321
     2322void
     2323purify_gcable_ptrs(BytePtr low, BytePtr high, area *to, int what)
    22612324{
    22622325  LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next;
    22632326
    22642327  while ((*prev) != (LispObj)NULL) {
    2265     copy_ivector_reference(prev, low, high, to);
     2328    copy_reference(prev, low, high, to, what);
    22662329    next = *prev;
    22672330    prev = &(((xmacptr *)ptr_from_lispobj(untag(next)))->link);
     
    22702333
    22712334void
    2272 purify_headerless_range(LispObj *start, LispObj *end, BytePtr low, BytePtr high, area *to)
     2335purify_headerless_range(LispObj *start, LispObj *end, BytePtr low, BytePtr high, area *to, int what)
    22732336{
    22742337  while (start < end) {
    2275     copy_ivector_reference(start, low, high, to);
     2338    copy_reference(start, low, high, to, what);
    22762339    start++;
    22772340  }
     
    22792342   
    22802343void
    2281 purify_range(LispObj *start, LispObj *end, BytePtr low, BytePtr high, area *to)
     2344purify_range(LispObj *start, LispObj *end, BytePtr low, BytePtr high, area *to, int what)
    22822345{
    22832346  LispObj header;
     
    23062369          nwords -= skip;
    23072370          while(skip--) {
    2308             copy_ivector_reference(start, low, high, to);
     2371            copy_reference(start, low, high, to, what);
    23092372            start++;
    23102373          }
     
    23152378          nwords >>= 1;
    23162379          while(nwords--) {
    2317             if (copy_ivector_reference(start, low, high, to) && hashp) {
     2380            if (copy_reference(start, low, high, to, what) && hashp) {
    23182381              hashp->flags |= nhash_key_moved_mask;
    23192382              hashp = NULL;
    23202383            }
    23212384            start++;
    2322             copy_ivector_reference(start, low, high, to);
     2385            copy_reference(start, low, high, to, what);
    23232386            start++;
    23242387          }
     
    23402403          start++;
    23412404          while(nwords--) {
    2342             copy_ivector_reference(start, low, high, to);
     2405            copy_reference(start, low, high, to, what);
    23432406            start++;
    23442407          }
     
    23462409      } else {
    23472410        /* Not a header, just a cons cell */
    2348         copy_ivector_reference(start, low, high, to);
     2411        copy_reference(start, low, high, to, what);
    23492412        start++;
    2350         copy_ivector_reference(start, low, high, to);
     2413        copy_reference(start, low, high, to, what);
    23512414        start++;
    23522415      }
     
    23572420/* Purify references from tstack areas */
    23582421void
    2359 purify_tstack_area(area *a, BytePtr low, BytePtr high, area *to)
     2422purify_tstack_area(area *a, BytePtr low, BytePtr high, area *to, int what)
    23602423{
    23612424  LispObj
     
    23712434    next = (LispObj *) ptr_from_lispobj(*current);
    23722435    end = ((next >= start) && (next < limit)) ? next : limit;
    2373     purify_range(current+2, end, low, high, to);
     2436    purify_range(current+2, end, low, high, to, what);
    23742437  }
    23752438}
     
    23772440/* Purify a vstack area */
    23782441void
    2379 purify_vstack_area(area *a, BytePtr low, BytePtr high, area *to)
     2442purify_vstack_area(area *a, BytePtr low, BytePtr high, area *to, int what)
    23802443{
    23812444  LispObj
     
    23832446    *q = (LispObj *) a->high;
    23842447 
    2385   purify_headerless_range(p, q, low, high, to);
    2386 }
    2387 
    2388 
    2389 void
    2390 purify_xp(ExceptionInformation *xp, BytePtr low, BytePtr high, area *to)
     2448  purify_headerless_range(p, q, low, high, to, what);
     2449}
     2450
     2451
     2452void
     2453purify_xp(ExceptionInformation *xp, BytePtr low, BytePtr high, area *to, int what
     2454#ifdef X8632
     2455          ,natural node_regs_mask
     2456#endif
     2457)
    23912458{
    23922459  natural *regs = (natural *) xpGPRvector(xp);
     
    23942461
    23952462#ifdef X8664
    2396   copy_ivector_reference(&(regs[Iarg_z]), low, high, to);
    2397   copy_ivector_reference(&(regs[Iarg_y]), low, high, to);
    2398   copy_ivector_reference(&(regs[Iarg_x]), low, high, to);
    2399   copy_ivector_reference(&(regs[Isave3]), low, high, to);
    2400   copy_ivector_reference(&(regs[Isave2]), low, high, to);
    2401   copy_ivector_reference(&(regs[Isave1]), low, high, to);
    2402   copy_ivector_reference(&(regs[Isave0]), low, high, to);
    2403   copy_ivector_reference(&(regs[Ifn]), low, high, to);
    2404   copy_ivector_reference(&(regs[Itemp0]), low, high, to);
    2405   copy_ivector_reference(&(regs[Itemp1]), low, high, to);
    2406   copy_ivector_reference(&(regs[Itemp2]), low, high, to);
    2407 #if 0
    2408   purify_locref(&(regs[Iip]), low, high, to);
    2409 #endif
     2463  copy_reference(&(regs[Iarg_z]), low, high, to, what);
     2464  copy_reference(&(regs[Iarg_y]), low, high, to, what);
     2465  copy_reference(&(regs[Iarg_x]), low, high, to, what);
     2466  copy_reference(&(regs[Isave3]), low, high, to, what);
     2467  copy_reference(&(regs[Isave2]), low, high, to, what);
     2468  copy_reference(&(regs[Isave1]), low, high, to, what);
     2469  copy_reference(&(regs[Isave0]), low, high, to, what);
     2470  copy_reference(&(regs[Ifn]), low, high, to, what);
     2471  copy_reference(&(regs[Itemp0]), low, high, to, what);
     2472  copy_reference(&(regs[Itemp1]), low, high, to, what);
     2473  copy_reference(&(regs[Itemp2]), low, high, to, what);
     2474
     2475  purify_locref(&(regs[Iip]), low, high, to, PURIFY_NOTHING);
     2476
    24102477#else
    2411 #endif
    2412 }
    2413 
    2414 void
    2415 purify_tcr_tlb(TCR *tcr, BytePtr low, BytePtr high, area *to)
     2478  if (node_regs_mask & (1<<0)) {
     2479    copy_reference(&(regs[REG_EAX]), low, high, to, what);
     2480  }
     2481  if (node_regs_mask & (1<<1)) {
     2482    copy_reference(&(regs[REG_ECX]), low, high, to, what);
     2483  }
     2484  if (! (regs[REG_EFL] & EFL_DF)) {
     2485    if (node_regs_mask & (1<<2)) {
     2486      copy_reference(&(regs[REG_EDX]), low, high, to, what);
     2487    }
     2488  }
     2489  if (node_regs_mask & (1<<3)) {
     2490    copy_reference(&(regs[REG_EBX]), low, high, to, what);
     2491  }
     2492  if (node_regs_mask & (1<<4)) {
     2493    copy_reference(&(regs[REG_ESP]), low, high, to, what);
     2494  }
     2495  if (node_regs_mask & (1<<5)) {
     2496    copy_reference(&(regs[REG_EBP]), low, high, to, what);
     2497  }
     2498  if (node_regs_mask & (1<<6)) {
     2499    copy_reference(&(regs[REG_ESI]), low, high, to, what);
     2500  }
     2501  if (node_regs_mask & (1<<7)) {
     2502    copy_reference(&(regs[REG_EDI]), low, high, to, what);
     2503  }
     2504  purify_locref(&regs[REG_EIP], low, high, to, what);
     2505#endif
     2506}
     2507
     2508void
     2509purify_tcr_tlb(TCR *tcr, BytePtr low, BytePtr high, area *to, int what)
    24162510{
    24172511  natural n = tcr->tlb_limit;
    24182512  LispObj *start = tcr->tlb_pointer, *end = (LispObj *) ((BytePtr)start+n);
    24192513
    2420   purify_range(start, end, low, high, to);
    2421 }
    2422 
    2423 void
    2424 purify_tcr_xframes(TCR *tcr, BytePtr low, BytePtr high, area *to)
     2514  purify_range(start, end, low, high, to, what);
     2515}
     2516
     2517void
     2518purify_tcr_xframes(TCR *tcr, BytePtr low, BytePtr high, area *to, int what)
    24252519{
    24262520  xframe_list *xframes;
     
    24292523  xp = tcr->gc_context;
    24302524  if (xp) {
    2431     purify_xp(xp, low, high, to);
    2432   }
     2525#ifdef X8632
     2526    purify_xp(xp, low, high, to, what, tcr->node_regs_mask);
     2527#else
     2528    purify_xp(xp, low, high, to, what);
     2529#endif
     2530  }
     2531#ifdef X8632
     2532  copy_reference(&tcr->save0, low, high, to, what);
     2533  copy_reference(&tcr->save1, low, high, to, what);
     2534  copy_reference(&tcr->save2, low, high, to, what);
     2535  copy_reference(&tcr->save3, low, high, to, what);
     2536  copy_reference(&tcr->next_method_context, low, high, to, what);
     2537#endif
    24332538
    24342539  for (xframes = tcr->xframe; xframes; xframes = xframes->prev) {
    2435     purify_xp(xframes->curr, low, high, to);
    2436   }
    2437 }
    2438 
    2439 
    2440 void
    2441 purify_areas(BytePtr low, BytePtr high, area *target)
     2540    purify_xp(xframes->curr, low, high, to, what
     2541#ifdef X8632
     2542              , xframes->node_regs_mask
     2543#endif
     2544              );
     2545  }
     2546}
     2547
     2548
     2549void
     2550purify_areas(BytePtr low, BytePtr high, area *target, int what)
    24422551{
    24432552  area *next_area;
     
    24472556    switch (code) {
    24482557    case AREA_TSTACK:
    2449       purify_tstack_area(next_area, low, high, target);
     2558      purify_tstack_area(next_area, low, high, target, what);
    24502559      break;
    24512560     
    24522561    case AREA_VSTACK:
    2453       purify_vstack_area(next_area, low, high, target);
     2562      purify_vstack_area(next_area, low, high, target, what);
    24542563      break;
    24552564     
     
    24592568    case AREA_STATIC:
    24602569    case AREA_DYNAMIC:
    2461       purify_range((LispObj *) next_area->low, (LispObj *) next_area->active, low, high, target);
     2570    case AREA_MANAGED_STATIC:
     2571      purify_range((LispObj *) next_area->low, (LispObj *) next_area->active, low, high, target, what);
    24622572      break;
    24632573     
     
    24682578}
    24692579
     2580void
     2581update_managed_refs(area *a, BytePtr low_dynamic_address, natural ndynamic_dnodes)
     2582{
     2583  LispObj
     2584    *start = (LispObj *)a->low,
     2585    *end = (LispObj *)a->active,
     2586    x1,
     2587    *base = start, *prev = start;
     2588  int tag;
     2589  bitvector refbits = a->refbits;
     2590  natural ref_dnode, node_dnode;
     2591  Boolean intergen_ref;
     2592
     2593  while (start < end) {
     2594    x1 = *start;
     2595    prev = start;
     2596    tag = fulltag_of(x1);
     2597    if (immheader_tag_p(tag)) {
     2598      start = skip_over_ivector(ptr_to_lispobj(start), x1);
     2599    } else {
     2600      if (header_subtag(x1) == subtag_function) {
     2601#ifdef X8632
     2602        int skip = (unsigned short)deref(start,1);
     2603        /* XXX bootstrapping */
     2604        if (skip & 0x8000)
     2605          skip = header_element_count(x1) - (skip & 0x7fff);
     2606#else
     2607        int skip = (int) deref(start,1);
     2608#endif
     2609        start += ((1+skip)&~1);
     2610        x1 = *start;
     2611        tag = fulltag_of(x1);
     2612      }
     2613      intergen_ref = false;
     2614      if (is_node_fulltag(tag)) {       
     2615        node_dnode = area_dnode(x1, low_dynamic_address);
     2616        if (node_dnode < ndynamic_dnodes) {
     2617          intergen_ref = true;
     2618        }
     2619      }
     2620      if (intergen_ref == false) {       
     2621        x1 = start[1];
     2622        tag = fulltag_of(x1);
     2623        if (is_node_fulltag(tag)) {       
     2624          node_dnode = area_dnode(x1, low_dynamic_address);
     2625          if (node_dnode < ndynamic_dnodes) {
     2626            intergen_ref = true;
     2627          }
     2628        }
     2629      }
     2630      if (intergen_ref) {
     2631        ref_dnode = area_dnode(start, base);
     2632        set_bit(refbits, ref_dnode);
     2633      }
     2634      start += 2;
     2635    }
     2636  }
     2637  if (start > end) {
     2638    Bug(NULL, "Overran end of range!");
     2639  }
     2640}
     2641
    24702642/*
    24712643  So far, this is mostly for save_application's benefit.
     
    24792651purify(TCR *tcr, signed_natural param)
    24802652{
    2481   extern area *extend_readonly_area(unsigned);
     2653  extern area *extend_readonly_area(natural);
    24822654  area
    24832655    *a = active_dynamic_area,
    2484     *new_pure_area;
     2656    *pure_area;
    24852657
    24862658  TCR  *other_tcr;
     
    24892661    low = (a->low + (static_dnodes_for_area(a) << dnode_shift)),
    24902662    high = a->active;
    2491 
    2492 
    2493   max_pure_size = unboxed_bytes_in_range((LispObj *) low, (LispObj *) high);
    2494   new_pure_area = extend_readonly_area(max_pure_size);
    2495   if (new_pure_area) {
    2496     new_pure_start = new_pure_area->active;
     2663  Boolean purify_functions = (param != 0);
     2664  int flags = PURIFY_IVECTORS | (purify_functions ? PURIFY_FUNCTIONS : 0);
     2665
     2666  max_pure_size = unboxed_bytes_in_range((LispObj *) low, (LispObj *) high, purify_functions);
     2667  pure_area = extend_readonly_area(max_pure_size);
     2668  if (pure_area) {
     2669    new_pure_start = pure_area->active;
    24972670    lisp_global(IN_GC) = (1<<fixnumshift);
    24982671
    24992672    /*
    2500 
    2501        
    2502       Make the new_pure_area executable, just in case.
    2503 
    25042673      Caller will typically GC again (and that should recover quite a bit of
    25052674      the dynamic heap.)
     
    25082677
    25092678   
    2510     purify_areas(low, high, new_pure_area);
     2679    purify_areas(low, high, pure_area, flags);
    25112680   
    25122681    other_tcr = tcr;
    25132682    do {
    2514       purify_tcr_xframes(other_tcr, low, high, new_pure_area);
    2515       purify_tcr_tlb(other_tcr, low, high, new_pure_area);
     2683      purify_tcr_xframes(other_tcr, low, high, pure_area, flags);
     2684      purify_tcr_tlb(other_tcr, low, high, pure_area, flags);
    25162685      other_tcr = other_tcr->next;
    25172686    } while (other_tcr != tcr);
    25182687
    2519     purify_gcable_ptrs(low, high, new_pure_area);
    2520     {
    2521       natural puresize = (unsigned) (new_pure_area->active-new_pure_start);
    2522       if (puresize != 0) {
    2523         xMakeDataExecutable(new_pure_start, puresize);
    2524  
    2525       }
    2526     }
    2527     ProtectMemory(new_pure_area->low,
    2528                   align_to_power_of_2(new_pure_area->active-new_pure_area->low,
     2688    purify_gcable_ptrs(low, high, pure_area, flags);
     2689    if (purify_functions) {
     2690      /* We're likely to copy a lot of symbols to the managed static
     2691         area.  Lots of symbols will have incidental references to
     2692         a relatively small number of things that happen to initialy
     2693         be in dynamic space: the UNDEFINED-FUNCTION object, packages,
     2694         etc.  Doing a shallow copy of those things to the managed-static
     2695         area will reduce the number of static->dynamic references. */
     2696      LispObj package_list;
     2697
     2698      copy_reference(&nrs_UDF.vcell,low,high,managed_static_area,PURIFY_ALL);
     2699      for (package_list = nrs_ALL_PACKAGES.vcell;
     2700           package_list != lisp_nil;
     2701           package_list = deref(package_list,0)) {
     2702        copy_reference(&(deref(package_list,1)),low,high,managed_static_area,PURIFY_ALL);
     2703      }
     2704
     2705       
     2706
     2707      /* Do a shallow copy of the constants of all purified functions
     2708         from the dynamic area to the managed static area */
     2709      purify_range((LispObj*)(pure_area->low),
     2710                   (LispObj*)(pure_area->active),
     2711                   low,
     2712                   high,
     2713                   managed_static_area,
     2714                   PURIFY_ALL);
     2715      /* Go back through all areas, resolving forwarding pointers
     2716         (but without copying anything.) */
     2717      purify_areas(low, high, NULL, PURIFY_NOTHING);
     2718      other_tcr = tcr;
     2719      do {
     2720        purify_tcr_xframes(other_tcr, low, high, NULL, PURIFY_NOTHING);
     2721        purify_tcr_tlb(other_tcr, low, high, NULL, PURIFY_NOTHING);
     2722        other_tcr = other_tcr->next;
     2723      } while (other_tcr != tcr);
     2724     
     2725      purify_gcable_ptrs(low, high, NULL, PURIFY_NOTHING);
     2726
     2727      /* Update refbits for managed static area */
     2728      {
     2729        natural
     2730          managed_dnodes = area_dnode(managed_static_area->active,
     2731                                      managed_static_area->low),
     2732          refbytes = align_to_power_of_2((managed_dnodes+7)>>3,log2_page_size);
     2733       
     2734        managed_static_area->ndnodes = managed_dnodes;
     2735        CommitMemory(managed_static_area->refbits, refbytes); /* zeros them */
     2736        update_managed_refs(managed_static_area, low_markable_address, area_dnode(a->active,low_markable_address));
     2737      }
     2738    }
     2739    ProtectMemory(pure_area->low,
     2740                  align_to_power_of_2(pure_area->active-pure_area->low,
    25292741                                      log2_page_size));
    25302742    lisp_global(IN_GC) = 0;
     
    25352747}
    25362748
    2537 
     2749Boolean
     2750impurify_locref(LispObj *p, LispObj low, LispObj high, signed_natural delta)
     2751{
     2752  LispObj q = *p;
     2753
     2754  if ((q >= low) &&
     2755      (q < high)) {
     2756    *p = (q+delta);
     2757    return true;
     2758  }
     2759  return false;
     2760}
    25382761 
    25392762Boolean
    2540 impurify_noderef(LispObj *p, LispObj low, LispObj high, int delta)
     2763impurify_noderef(LispObj *p, LispObj low, LispObj high, signed_natural delta)
    25412764{
    25422765  LispObj q = *p;
     
    25662789
    25672790void
    2568 impurify_xp(ExceptionInformation *xp, LispObj low, LispObj high, signed_natural delta)
     2791impurify_xp(ExceptionInformation *xp, LispObj low, LispObj high, signed_natural delta
     2792#ifdef X8632
     2793            ,natural node_regs_mask
     2794#endif
     2795)
    25692796{
    25702797  natural *regs = (natural *) xpGPRvector(xp);
     
    25752802  impurify_noderef(&(regs[Iarg_y]), low, high, delta);
    25762803  impurify_noderef(&(regs[Iarg_x]), low, high, delta);
    2577 #ifndef WINDOWS
     2804#ifndef TCR_IN_GPR
    25782805  impurify_noderef(&(regs[Isave3]), low, high, delta);
    25792806#endif
     
    25842811  impurify_noderef(&(regs[Itemp0]), low, high, delta);
    25852812  impurify_noderef(&(regs[Itemp1]), low, high, delta);
    2586 #if 0
     2813
    25872814  impurify_locref(&(regs[Iip]), low, high, delta);
    2588 #endif
    25892815#else
     2816  if (node_regs_mask & (1<<0)) {
     2817    impurify_noderef(&(regs[REG_EAX]), low, high, delta);
     2818  }
     2819  if (node_regs_mask & (1<<1)) {
     2820    impurify_noderef(&(regs[REG_ECX]), low, high, delta);
     2821  }
     2822  if (! (regs[REG_EFL] & EFL_DF)) {
     2823    if (node_regs_mask & (1<<2)) {
     2824      impurify_noderef(&(regs[REG_EDX]), low, high, delta);
     2825    }
     2826  }
     2827  if (node_regs_mask & (1<<3)) {
     2828    impurify_noderef(&(regs[REG_EBX]), low, high, delta);
     2829  }
     2830  if (node_regs_mask & (1<<4)) {
     2831    impurify_noderef(&(regs[REG_ESP]), low, high, delta);
     2832  }
     2833  if (node_regs_mask & (1<<5)) {
     2834    impurify_noderef(&(regs[REG_EBP]), low, high, delta);
     2835  }
     2836  if (node_regs_mask & (1<<6)) {
     2837    impurify_noderef(&(regs[REG_ESI]), low, high, delta);
     2838  }
     2839  if (node_regs_mask & (1<<7)) {
     2840    impurify_noderef(&(regs[REG_EDI]), low, high, delta);
     2841  }
     2842  impurify_locref(&(regs[REG_EIP]), low, high, delta);
     2843
    25902844#endif
    25912845
     
    26952949  xp = tcr->gc_context;
    26962950  if (xp) {
     2951#ifdef X8632
     2952    impurify_xp(xp, low, high, delta, tcr->node_regs_mask);
     2953#else
    26972954    impurify_xp(xp, low, high, delta);
    2698   }
     2955#endif
     2956  }
     2957
     2958#ifdef X8632
     2959  impurify_noderef(&tcr->save0, low, high, delta);
     2960  impurify_noderef(&tcr->save1, low, high, delta);
     2961  impurify_noderef(&tcr->save2, low, high, delta);
     2962  impurify_noderef(&tcr->save3, low, high, delta);
     2963  impurify_noderef(&tcr->next_method_context, low, high, delta);
     2964#endif
    26992965
    27002966  for (xframes = tcr->xframe; xframes; xframes = xframes->prev) {
    2701     impurify_xp(xframes->curr, low, high, delta);
     2967    impurify_xp(xframes->curr, low, high, delta
     2968#ifdef X8632
     2969                ,xframes->node_regs_mask
     2970#endif
     2971);
    27022972  }
    27032973}
     
    27182988    next = (LispObj *) ptr_from_lispobj(*current);
    27192989    end = ((next >= start) && (next < limit)) ? next : limit;
    2720     if (current[1] == 0) {
    2721       impurify_range(current+2, end, low, high, delta);
    2722     }
     2990    impurify_range(current+2, end, low, high, delta);
    27232991  }
    27242992}
     
    27553023    case AREA_STATIC:
    27563024    case AREA_DYNAMIC:
     3025    case AREA_MANAGED_STATIC:
    27573026      impurify_range((LispObj *) next_area->low, (LispObj *) next_area->active, low, high, delta);
    27583027      break;
     
    27643033}
    27653034
     3035void
     3036impurify_from_area(TCR *tcr, area *src)
     3037{
     3038  area *a = active_dynamic_area;
     3039  BytePtr base = src->low, limit = src->active, oldfree = a->active,
     3040    oldhigh = a->high, newhigh;
     3041  natural n = limit-base;
     3042  signed_natural delta = oldfree-base;
     3043  TCR *other_tcr;
     3044
     3045  newhigh = (BytePtr) (align_to_power_of_2(oldfree+n,
     3046                                           log2_heap_segment_size));
     3047  if (newhigh > oldhigh) {
     3048    grow_dynamic_area(newhigh-oldhigh);
     3049  }
     3050  a->active += n;
     3051  memmove(oldfree, base, n);
     3052  UnCommitMemory((void *)base, n);
     3053  a->ndnodes = area_dnode(a, a->active);
     3054  src->active = src->low;
     3055  if (src == readonly_area) {
     3056    pure_space_active = src->low;
     3057  }
     3058  src->ndnodes = 0;
     3059 
     3060  impurify_areas(ptr_to_lispobj(base), ptr_to_lispobj(limit), delta);
     3061 
     3062  other_tcr = tcr;
     3063  do {
     3064    impurify_tcr_xframes(other_tcr, ptr_to_lispobj(base), ptr_to_lispobj(limit), delta);
     3065    impurify_tcr_tlb(other_tcr, ptr_to_lispobj(base), ptr_to_lispobj(limit), delta);
     3066    other_tcr = other_tcr->next;
     3067  } while (other_tcr != tcr);
     3068 
     3069  impurify_gcable_ptrs(ptr_to_lispobj(base), ptr_to_lispobj(limit), delta);
     3070}
     3071
    27663072signed_natural
    27673073impurify(TCR *tcr, signed_natural param)
    27683074{
    2769   area *r = find_readonly_area();
    2770 
    2771   if (r) {
    2772     area *a = active_dynamic_area;
    2773     BytePtr ro_base = r->low, ro_limit = r->active, oldfree = a->active,
    2774       oldhigh = a->high, newhigh;
    2775     unsigned n = ro_limit - ro_base;
    2776     signed_natural delta = oldfree-ro_base;
    2777     TCR *other_tcr;
    2778 
    2779     if (n) {
    2780       lisp_global(IN_GC) = 1;
    2781       newhigh = (BytePtr) (align_to_power_of_2(oldfree+n,
    2782                                                log2_heap_segment_size));
    2783       if (newhigh > oldhigh) {
    2784         grow_dynamic_area(newhigh-oldhigh);
    2785       }
    2786       a->active += n;
    2787       memmove(oldfree, ro_base, n);
    2788       UnMapMemory((void *)ro_base, n);
    2789       a->ndnodes = area_dnode(a, a->active);
    2790       pure_space_active = r->active = r->low;
    2791       r->ndnodes = 0;
    2792 
    2793       impurify_areas(ptr_to_lispobj(ro_base), ptr_to_lispobj(ro_limit), delta);
    2794 
    2795       other_tcr = tcr;
    2796       do {
    2797         impurify_tcr_xframes(other_tcr, ptr_to_lispobj(ro_base), ptr_to_lispobj(ro_limit), delta);
    2798         impurify_tcr_tlb(other_tcr, ptr_to_lispobj(ro_base), ptr_to_lispobj(ro_limit), delta);
    2799         other_tcr = other_tcr->next;
    2800       } while (other_tcr != tcr);
    2801 
    2802       impurify_gcable_ptrs(ptr_to_lispobj(ro_base), ptr_to_lispobj(ro_limit), delta);
    2803       lisp_global(IN_GC) = 0;
    2804     }
    2805     return 0;
    2806   }
    2807   return -1;
     3075  lisp_global(IN_GC)=1;
     3076  impurify_from_area(tcr, readonly_area);
     3077  impurify_from_area(tcr, managed_static_area);
     3078  lisp_global(IN_GC)=0;
     3079  return 0;
    28083080}
    28093081
  • trunk/source/lisp-kernel/x86-spentry32.s

    r13230 r13279  
    172417240:      __(repret)
    172517251:      __(movl %arg_y,%imm0)
    1726         __(subl lisp_global(heap_start),%imm0)
     1726        __(subl lisp_global(ref_base),%imm0)
    17271727        __(shrl $dnode_shift,%imm0)
    17281728        __(cmpl lisp_global(oldspace_dnode_count),%imm0)
     
    174317430:      __(repret)
    174417441:      __(movl %arg_y,%imm0)
    1745         __(subl lisp_global(heap_start),%imm0)
     1745        __(subl lisp_global(ref_base),%imm0)
    17461746        __(shrl $dnode_shift,%imm0)
    17471747        __(cmpl lisp_global(oldspace_dnode_count),%imm0)
     
    176417640:      __(repret)
    176517651:      __(lea misc_data_offset(%temp0,%arg_y),%imm0)
    1766         __(subl lisp_global(heap_start),%imm0)
     1766        __(subl lisp_global(ref_base),%imm0)
    17671767        __(shrl $dnode_shift,%imm0)
    17681768        __(cmpl lisp_global(oldspace_dnode_count),%imm0)
     
    178717870:      __(repret)
    178817881:      __(lea misc_data_offset(%temp0,%arg_y),%imm0)
    1789         __(subl lisp_global(heap_start),%imm0)
     1789        __(subl lisp_global(ref_base),%imm0)
    17901790        __(shrl $dnode_shift,%imm0)
    17911791        __(cmpl lisp_global(oldspace_dnode_count),%imm0)
     
    17971797        /* Now memoize the address of the hash vector */
    17981798        __(movl %temp0,%imm0)
    1799         __(subl lisp_global(heap_start),%imm0)
     1799        __(subl lisp_global(ref_base),%imm0)
    18001800        __(shrl $dnode_shift,%imm0)
    18011801        __(xorb $31,%imm0_b)
     
    18291829        __(jne 0b)
    18301830        __(leal misc_data_offset(%temp1,%temp0),%imm0)
    1831         __(subl lisp_global(heap_start),%imm0)
     1831        __(subl lisp_global(ref_base),%imm0)
    18321832        __(shrl $dnode_shift,%imm0)
    18331833        __(cmpl lisp_global(oldspace_dnode_count),%imm0)
     
    18621862        __(jne 0b)
    18631863        __(leal misc_data_offset(%temp1,%temp0),%imm0)
    1864         __(subl lisp_global(heap_start),%imm0)
     1864        __(subl lisp_global(ref_base),%imm0)
    18651865        __(shrl $dnode_shift,%imm0)
    18661866        __(cmpl lisp_global(oldspace_dnode_count),%imm0)
     
    18721872        /* Now memoize the address of the hash vector */
    18731873        __(movl %temp1,%imm0)
    1874         __(subl lisp_global(heap_start),%imm0)
     1874        __(subl lisp_global(ref_base),%imm0)
    18751875        __(shrl $dnode_shift,%imm0)
    18761876        __(xorb $31,%imm0_b)
  • trunk/source/lisp-kernel/x86-spentry64.s

    r13234 r13279  
    176817680:      __(repret)
    176917691:      __(movq %arg_y,%imm0)
    1770         __(subq lisp_global(heap_start),%imm0)
     1770        __(subq lisp_global(ref_base),%imm0)
    17711771        __(shrq $dnode_shift,%imm0)
    17721772        __(cmpq lisp_global(oldspace_dnode_count),%imm0)
     
    178717870:      __(repret)
    178817881:      __(movq %arg_y,%imm0)
    1789         __(subq lisp_global(heap_start),%imm0)
     1789        __(subq lisp_global(ref_base),%imm0)
    17901790        __(shrq $dnode_shift,%imm0)
    17911791        __(cmpq lisp_global(oldspace_dnode_count),%imm0)
     
    180918090:      __(repret)
    181018101:      __(lea misc_data_offset(%arg_x,%arg_y),%imm0)
    1811         __(subq lisp_global(heap_start),%imm0)
     1811        __(subq lisp_global(ref_base),%imm0)
    18121812        __(shrq $dnode_shift,%imm0)
    18131813        __(cmpq lisp_global(oldspace_dnode_count),%imm0)
     
    183318330:      __(repret)
    183418341:      __(lea misc_data_offset(%arg_x,%arg_y),%imm0)
    1835         __(subq lisp_global(heap_start),%imm0)
     1835        __(subq lisp_global(ref_base),%imm0)
    18361836        __(shrq $dnode_shift,%imm0)
    18371837        __(cmpq lisp_global(oldspace_dnode_count),%imm0)
     
    18431843        /* Now memoize the address of the hash vector   */
    18441844        __(movq %arg_x,%imm0)
    1845         __(subq lisp_global(heap_start),%imm0)
     1845        __(subq lisp_global(ref_base),%imm0)
    18461846        __(shrq $dnode_shift,%imm0)
    18471847        __(xorb $63,%imm0_b)
     
    18731873        __(jne 0b)
    18741874        __(lea (%arg_x,%imm1),%imm0)
    1875         __(subq lisp_global(heap_start),%imm0)
     1875        __(subq lisp_global(ref_base),%imm0)
    18761876        __(shrq $dnode_shift,%imm0)
    18771877        __(cmpq lisp_global(oldspace_dnode_count),%imm0)
     
    19051905        __(jne 0b)
    19061906        __(lea (%arg_x,%imm1),%imm0)
    1907         __(subq lisp_global(heap_start),%imm0)
     1907        __(subq lisp_global(ref_base),%imm0)
    19081908        __(shrq $dnode_shift,%imm0)
    19091909        __(cmpq lisp_global(oldspace_dnode_count),%imm0)
     
    19151915        /* Now memoize the address of the hash vector   */
    19161916        __(movq %arg_x,%imm0)
    1917         __(subq lisp_global(heap_start),%imm0)
     1917        __(subq lisp_global(ref_base),%imm0)
    19181918        __(shrq $dnode_shift,%imm0)
    19191919        __(xorb $63,%imm0_b)
  • trunk/source/xdump/faslenv.lisp

    r13067 r13279  
    4444(defconstant $fasl-file-id #xff00)
    4545(defconstant $fasl-file-id1 #xff01)
    46 (defconstant $fasl-vers #x5b)
    47 (defconstant $fasl-min-vers #x5b)
     46(defconstant $fasl-vers #x5e)
     47(defconstant $fasl-min-vers #x5e)
    4848(defconstant $faslend #xff)
    4949(defconstant $fasl-buf-len 2048)
  • trunk/source/xdump/heap-image.lisp

    r13067 r13279  
    9797
    9898
    99 (defparameter *image-abi-version* 1033)
     99(defparameter *image-abi-version* 1036)
    100100
    101101(defun write-image-file (pathname image-base spaces &optional (abi-version *image-abi-version*))
  • trunk/source/xdump/xfasload.lisp

    r13067 r13279  
    8282(defparameter *xload-managed-static-space-address* nil)
    8383(defparameter *xload-managed-static-space-size* 0)
     84(defparameter *xload-static-cons-space-address* nil)
     85(defparameter *xload-static-cons-space-size* 0)
    8486
    8587(defstruct backend-xload-info
     
    111113          (+ *xload-image-base-address*
    112114             *xload-purespace-reserve*))
    113     (setq *xload-managed-static-space-address* *xload-dynamic-space-address*)
     115    (setq *xload-managed-static-space-address* *xload-dynamic-space-address*
     116          *xload-static-cons-space-address* *xload-dynamic-space-address*)
    114117    (setq *xload-static-space-address*
    115118          (backend-xload-info-static-space-address
     
    345348(defparameter *xload-static-space* nil)
    346349(defparameter *xload-managed-static-space* nil)
     350(defparameter *xload-static-cons-space* nil)
    347351(defparameter *xload-symbols* nil)
    348352(defparameter *xload-symbol-addresses* nil)
     
    10291033         (*xload-static-space* (init-xload-space *xload-static-space-address* *xload-static-space-size* area-static))
    10301034         (*xload-managed-static-space* (init-xload-space *xload-managed-static-space-address* *xload-managed-static-space-size* area-managed-static))
     1035         (*xload-static-cons-space* (init-xload-space *xload-static-cons-space-address* *xload-static-cons-space-size* area-static-cons))
    10311036                                                 
    10321037         (*xload-package-alist* (xload-clone-packages (xload-initial-packages)))
     
    11371142  (write-image-file output-file
    11381143                    heap-start
    1139                     (list *xload-readonly-space*
    1140                           *xload-static-space*
     1144                    (list *xload-static-space*
     1145                          *xload-readonly-space*
    11411146                          *xload-dynamic-space*
    1142                           *xload-managed-static-space*)))
     1147                          *xload-managed-static-space*
     1148                          *xload-static-cons-space*)))
    11431149                   
    11441150
     
    11811187  (%epushval s (xload-make-sfloat *xload-readonly-space* (%fasl-read-long s))))
    11821188
     1189(defun xload-read-utf-8-string (s v o nchars nextra)
     1190  (declare (fixnum nchars nextra))
     1191  (if (eql 0 nextra)
     1192    (dotimes (i nchars)
     1193      (setf (u32-ref v (+ o (* i 4) *xload-target-misc-data-offset*))
     1194            (%fasl-read-byte s)) )
     1195    (flet ((trailer-byte ()
     1196             (when (> nextra 0)
     1197               (decf nextra)
     1198               (let* ((b (%fasl-read-byte s)))
     1199                 (declare ((unsigned-byte 8) b))
     1200                 (and (>= b #x80)
     1201                      (< b #xc0)
     1202                      (logand b #x3f))))))
     1203      (declare (inline trailer-byte))
     1204      (dotimes (i nchars)
     1205        (let* ((b0 (%fasl-read-byte s)))
     1206          (declare ((unsigned-byte 8) b0))
     1207          (setf (u32-ref v (+ o (* i 4) *xload-target-misc-data-offset*))
     1208                (or
     1209                 (cond ((< b0 #x80) b0)
     1210                       ((and (>= b0 #xc2)
     1211                             (< b0 #xe0))
     1212                        (let* ((b1 (trailer-byte)))
     1213                          (and b1 (logior (ash (logand b0 #x1f) 6) b1))))
     1214                       ((and (>= b0 #xe0)
     1215                             (< b0 #xf0))
     1216                        (let* ((b1 (trailer-byte))
     1217                               (b2 (trailer-byte)))
     1218                          (and b1 b2 (logior (ash (logand b0 #x0f) 12)
     1219                                             (logior (ash b1 6)
     1220                                                     b2)))))
     1221                       ((and (>= b0 #xf0)
     1222                             (< b0 #xf5))
     1223                        (let* ((b1 (trailer-byte))
     1224                               (b2 (trailer-byte))
     1225                               (b3 (trailer-byte)))
     1226                          (and b1
     1227                               b2
     1228                               b3
     1229                               (logior (ash (logand b0 #x7) 18)
     1230                                       (logior (ash b1 12)
     1231                                               (logior (ash b2 6)
     1232                                                       b3)))))))
     1233                 (char-code #\Replacement_Character))))))))
     1234
     1235
    11831236(defxloadfaslop $fasl-vstr (s)
    1184   (let* ((n (%fasl-read-count s)))
    1185     (multiple-value-bind (str v o) (xload-make-ivector *xload-readonly-space* :simple-string n)
     1237  (let* ((nchars (%fasl-read-count s))
     1238         (nextra (%fasl-read-count s)))
     1239    (multiple-value-bind (str v o) (xload-make-ivector *xload-readonly-space* :simple-string nchars)
    11861240      (%epushval s str)
    1187       (%fasl-read-n-bytes s v (+ o *xload-target-misc-data-offset*) n)
     1241      (xload-read-utf-8-string s v o nchars nextra)
    11881242      str)))
    11891243
     
    11961250         (dotimes (i n)
    11971251           (setf (u8-ref v (+ o i *xload-target-misc-data-offset*))
    1198                  (%fasl-read-count s))))
     1252                 (%fasl-read-byte s))))
    11991253        (t
    12001254         (dotimes (i n)
    12011255           (setf (u32-ref v (+ o (* i 4) *xload-target-misc-data-offset*))
    1202                  (%fasl-read-count s)))))
     1256                 (%fasl-read-byte s)))))
    12031257      str)))
    12041258
  • trunk/source/xdump/xppcfasload.lisp

    r13067 r13279  
    111111   :nil-relative-symbols ppc::*ppc-nil-relative-symbols*
    112112   :static-space-init-function 'ppc32-initialize-static-space
    113    :purespace-reserve (ash 64 20)
     113   :purespace-reserve (ash 128 20)
    114114   :static-space-address (ash 2 12)
    115115))
     
    133133   #+linuxppc-target :linuxppc64
    134134   #+darwinppc-target :darwinppc64
    135    :image-base-address #x100000000
     135   :image-base-address #+linuxppc-target #x50000000000 #+darwinppc-target #x300000000000
    136136   :nil-relative-symbols ppc::*ppc-nil-relative-symbols*
    137137   :static-space-init-function 'ppc64-initialize-static-space
    138    :purespace-reserve (ash 64 20)
     138   :purespace-reserve (ash 128 30)
    139139   :static-space-address (ash 2 12)
    140140   ))
  • trunk/source/xdump/xx8632-fasload.lisp

    r13067 r13279  
    5353   :nil-relative-symbols x86::*x86-nil-relative-symbols*
    5454   :static-space-init-function 'x8632-initialize-static-space
    55    :purespace-reserve (ash 1 26)
     55   :purespace-reserve (ash 128 20)
    5656   :static-space-address (+ (ash 1 16) (ash 2 12))
    5757))
     
    7272   :nil-relative-symbols x86::*x86-nil-relative-symbols*
    7373   :static-space-init-function 'x8632-initialize-static-space
    74    :purespace-reserve (ash 1 26)
     74   :purespace-reserve (ash 128 20)
    7575   :static-space-address (+ (ash 1 16) (ash 2 12))
    7676))
     
    9191   :nil-relative-symbols x86::*x86-nil-relative-symbols*
    9292   :static-space-init-function 'x8632-initialize-static-space
    93    :purespace-reserve (ash 1 26)
     93   :purespace-reserve (ash 128 20)
    9494   :static-space-address (+ (ash 1 16) (ash 2 12))
    9595))
     
    110110   :nil-relative-symbols x86::*x86-nil-relative-symbols*
    111111   :static-space-init-function 'x8632-initialize-static-space
    112    :purespace-reserve (ash 1 26)
     112   :purespace-reserve (ash 128 20)
    113113   :static-space-address (+ (ash 1 16) (ash 2 12))
    114114))
     
    129129   :nil-relative-symbols x86::*x86-nil-relative-symbols*
    130130   :static-space-init-function 'x8632-initialize-static-space
    131    :purespace-reserve (ash 1 26)
     131   :purespace-reserve (ash 128 20)
    132132   :static-space-address (+ (ash 1 16) (ash 2 12))
    133133))
  • trunk/source/xdump/xx8664-fasload.lisp

    r13067 r13279  
    7070   :nil-relative-symbols x86::*x86-nil-relative-symbols*
    7171   :static-space-init-function 'x8664-initialize-static-space
    72    :purespace-reserve (ash 1 30)
     72   :purespace-reserve (ash 128 30)
    7373   :static-space-address (+ (ash 1 16) (ash 2 12))
    7474))
     
    9191   :nil-relative-symbols x86::*x86-nil-relative-symbols*
    9292   :static-space-init-function 'x8664-initialize-static-space
    93    :purespace-reserve (ash 1 30)
     93   :purespace-reserve (ash 128 30)
    9494   :static-space-address (+ (ash 1 16) (ash 2 12))
    9595))
     
    110110   :nil-relative-symbols x86::*x86-nil-relative-symbols*
    111111   :static-space-init-function 'x8664-initialize-static-space
    112    :purespace-reserve (ash 1 30)
     112   :purespace-reserve (ash 128 30)
    113113   :static-space-address (+ (ash 1 16) (ash 2 12))
    114114))
     
    129129   :nil-relative-symbols x86::*x86-nil-relative-symbols*
    130130   :static-space-init-function 'x8664-initialize-static-space
    131    :purespace-reserve (ash 1 30)
     131   :purespace-reserve (ash 128 30)
    132132   :static-space-address (+ (ash 1 16) (ash 2 12))
    133133))
     
    148148   :nil-relative-symbols x86::*x86-nil-relative-symbols*
    149149   :static-space-init-function 'x8664-initialize-static-space
    150    :purespace-reserve (ash 1 30)
     150   :purespace-reserve (ash 128 30)
    151151   :static-space-address (+ (ash 1 16) (ash 2 12))
    152152))
Note: See TracChangeset for help on using the changeset viewer.