Changeset 6436 for branches/x8664-call


Ignore:
Timestamp:
May 8, 2007, 1:03:01 AM (13 years ago)
Author:
gb
Message:

More file-mapping stuff.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/x8664-call/ccl/level-1/linux-files.lisp

    r6431 r6436  
    11701170                                           (1- *host-page-size*))
    11711171                                        (1- *host-page-size*))))
    1172                    (addr (#_mmap +null-ptr+
    1173                                  nbytes
    1174                                  #$PROT_NONE
    1175                                  (logior #$MAP_ANON #$MAP_PRIVATE)
    1176                                  -1
    1177                                  0))
     1172
    11781173                   (ndata-elements
    11791174                    (ash len
     
    11921187                           (32 -5)
    11931188                           (64 -6)))))
    1194               (if (eql addr (%int-to-ptr -1)) ; #$MAP_FAILED
    1195                 (let* ((errno (%get-errno)))
     1189              (if (>= (+ ndata-elements nalignment-elements)
     1190                      array-total-size-limit)
     1191                (progn
    11961192                  (fd-close fd)
    1197                   (error "Can't map ~d bytes: ~a" nbytes (%strerror errno)))
     1193                  (error "Can't make a vector with ~s elements in this implementation." (+ ndata-elements nalignment-elements)))
     1194                (let* ((addr (#_mmap +null-ptr+
     1195                                     nbytes
     1196                                     #$PROT_NONE
     1197                                     (logior #$MAP_ANON #$MAP_PRIVATE)
     1198                                     -1
     1199                                     0)))             
     1200                  (if (eql addr (%int-to-ptr (1- (ash 1 target::nbits-in-word)))) ; #$MAP_FAILED
     1201                    (let* ((errno (%get-errno)))
     1202                      (fd-close fd)
     1203                      (error "Can't map ~d bytes: ~a" nbytes (%strerror errno)))
    11981204              ;;; Remap the first page so that we can put a vector header
    11991205              ;;; there; use the first word on the first page to remember
    12001206              ;;; the file descriptor.
    1201                 (progn
    1202                   (#_mmap addr
    1203                           *host-page-size*
    1204                           (logior #$PROT_READ #$PROT_WRITE)
    1205                           (logior #$MAP_ANON #$MAP_PRIVATE #$MAP_FIXED)
    1206                           -1
    1207                           0)
    1208                   (setf (pref addr :int) fd)
    1209                   (let* ((header-addr (%inc-ptr addr (- *host-page-size*
    1210                                                         (* 2 target::node-size)))))
    1211                     (setf (pref header-addr :unsigned-long)
    1212                           (logior (element-type-subtype upgraded-type)
    1213                                   (ash (+ ndata-elements nalignment-elements) target::num-subtag-bits)))
    1214                     (when (> len 0)
    1215                       (let* ((target-addr (%inc-ptr header-addr (* 2 target::node-size))))
    1216                         (unless (eql target-addr
    1217                                      (#_mmap target-addr
    1218                                              len
    1219                                              #$PROT_READ
    1220                                              (logior #$MAP_PRIVATE #$MAP_FIXED)
    1221                                              fd
    1222                                              0))
    1223                           (let* ((errno (%get-errno)))
    1224                             (fd-close fd)
    1225                             (#_munmap addr nbytes)
    1226                             (error "Mapping failed: ~a" (%strerror errno))))))
    1227                     (with-macptrs ((v (%inc-ptr header-addr target::fulltag-misc)))
    1228                       (let* ((vector (rlet ((p :address v)) (%get-object p 0))))
    1229                         ;; Tell some parts of OpenMCL - notably the
    1230                         ;; printer - that this thing off in foreign
    1231                         ;; memory is a real lisp object and not
    1232                         ;; "bogus".
    1233                         (with-lock-grabbed (*heap-ivector-lock*)
    1234                           (push vector *heap-ivectors*))
    1235                         (make-array ndata-elements
    1236                                     :element-type upgraded-type
    1237                                     :displaced-to vector
    1238                                     :adjustable t
    1239                                     :displaced-index-offset nalignment-elements)))))))))))))
     1207                    (progn
     1208                      (#_mmap addr
     1209                              *host-page-size*
     1210                              (logior #$PROT_READ #$PROT_WRITE)
     1211                              (logior #$MAP_ANON #$MAP_PRIVATE #$MAP_FIXED)
     1212                              -1
     1213                              0)
     1214                      (setf (pref addr :int) fd)
     1215                      (let* ((header-addr (%inc-ptr addr (- *host-page-size*
     1216                                                            (* 2 target::node-size)))))
     1217                        (setf (pref header-addr :unsigned-long)
     1218                              (logior (element-type-subtype upgraded-type)
     1219                                      (ash (+ ndata-elements nalignment-elements) target::num-subtag-bits)))
     1220                        (when (> len 0)
     1221                          (let* ((target-addr (%inc-ptr header-addr (* 2 target::node-size))))
     1222                            (unless (eql target-addr
     1223                                         (#_mmap target-addr
     1224                                                 len
     1225                                                 #$PROT_READ
     1226                                                 (logior #$MAP_PRIVATE #$MAP_FIXED)
     1227                                                 fd
     1228                                                 0))
     1229                              (let* ((errno (%get-errno)))
     1230                                (fd-close fd)
     1231                                (#_munmap addr nbytes)
     1232                                (error "Mapping failed: ~a" (%strerror errno))))))
     1233                        (with-macptrs ((v (%inc-ptr header-addr target::fulltag-misc)))
     1234                          (let* ((vector (rlet ((p :address v)) (%get-object p 0))))
     1235                            ;; Tell some parts of OpenMCL - notably the
     1236                            ;; printer - that this thing off in foreign
     1237                            ;; memory is a real lisp object and not
     1238                            ;; "bogus".
     1239                            (with-lock-grabbed (*heap-ivector-lock*)
     1240                              (push vector *heap-ivectors*))
     1241                            (make-array ndata-elements
     1242                                        :element-type upgraded-type
     1243                                        :displaced-to vector
     1244                                        :adjustable t
     1245                                        :displaced-index-offset nalignment-elements)))))))))))))))
    12401246
    12411247(defun map-file-to-octet-vector (pathname)
Note: See TracChangeset for help on using the changeset viewer.