Changeset 13279 for trunk/source/level-0


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/level-0
Files:
11 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)
Note: See TracChangeset for help on using the changeset viewer.