Changeset 6129


Ignore:
Timestamp:
Apr 4, 2007, 3:58:39 AM (12 years ago)
Author:
gb
Message:

DEFLOADVAR makes the variable static.
Move MULTIPLE-VALUE-xxx macros to end of file for obscure reasons.
(May hide a compiler bug ?)
WITH-MACPTRS name-conflict stuff.
WITH-ENCODED-CSTR does #\nul-termination.
Add COPY-RECORD; should export it.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/objc-gf/ccl/lib/macros.lisp

    r6100 r6129  
    706706     (%defglobal ',var ,value ,doc)))
    707707
     708
    708709(defmacro defglobal (&rest args)
    709710  "Synonym for DEFSTATIC."
     
    713714(defmacro defloadvar (&environment env var value &optional doc)
    714715  `(progn
    715      (defvar ,var ,@(if doc `(nil ,doc)))
     716     (defstatic ,var ,nil ,@(if doc `(,doc)))
    716717     (def-ccl-pointers ,var ()
    717718       (setq ,var ,value))
    718719     ',var))
     720
     721
    719722
    720723
     
    11601163  `(multiple-value-call #'list ,form))
    11611164
    1162 (defmacro multiple-value-bind (varlist values-form &body body &environment env)
    1163   (multiple-value-bind (body decls)
    1164                        (parse-body body env)
    1165     (let ((ignore (make-symbol "IGNORE")))
    1166       `(multiple-value-call #'(lambda (&optional ,@varlist &rest ,ignore)
    1167                                 (declare (ignore ,ignore))
    1168                                 ,@decls
    1169                                 ,@body)
    1170                             ,values-form))))
    1171 
    1172 (defmacro multiple-value-setq (vars val)
    1173   (if vars
    1174     `(values (setf (values ,@(mapcar #'(lambda (s) (require-type s 'symbol)) vars))  ,val))
    1175     `(prog1 ,val)))
    1176 
    1177 (defmacro nth-value (n form)
    1178   "Evaluate FORM and return the Nth value (zero based). This involves no
    1179   consing when N is a trivial constant integer."
    1180   `(car (nthcdr ,n (multiple-value-list ,form))))
     1165
    11811166
    11821167
     
    13341319(defmacro with-macptrs (varlist &rest body &environment env)
    13351320  (multiple-value-bind (body other-decls) (parse-body body env)
    1336     (collect ((bindings)
     1321    (collect ((temp-bindings)
     1322              (temp-decls)
     1323              (bindings)
    13371324              (our-decls)
    13381325              (inits))
    13391326      (dolist (var varlist)
     1327        (let* ((temp (gensym)))
     1328          (temp-decls temp)
    13401329        (if (consp var)
    13411330          (progn
    13421331            (our-decls (car var))
    1343             (bindings `(,(car var) (%null-ptr)))
     1332            (temp-bindings `(,temp (%null-ptr)))
     1333            (bindings `(,(car var) ,temp))
    13441334            (if (cdr var)
    1345               (inits `(%setf-macptr ,(car var) ,@(cdr var)))))
     1335              (inits `(%setf-macptr ,temp ,@(cdr var)))))
    13461336          (progn
    13471337            (our-decls var)
    1348             (bindings `(,var (%null-ptr))))))
    1349   `(let* ,(bindings)
    1350      (declare (dynamic-extent ,@(our-decls))
    1351      (declare (type macptr ,@(our-decls)))
    1352      ,@other-decls)
     1338            (temp-bindings  `(,temp  (%null-ptr)))
     1339            (bindings `(,var ,temp))))))
     1340  `(let* ,(temp-bindings)
     1341    (declare (dynamic-extent ,@(temp-decls)))
     1342    (declare (type macptr ,@(temp-decls)))
    13531343    ,@(inits)
    1354      ,@body))))
     1344    (let* ,(bindings)
     1345      (declare (type macptr ,@(our-decls)))
     1346      ,@other-decls
     1347      ,@body)))))
     1348
    13551349
    13561350(defmacro with-loading-file (filename &rest body)
     
    16021596                                 &rest body &environment env)
    16031597  (let* ((encoding (get-character-encoding encoding-name))
    1604          (str (gensym)))
     1598         (nul-vector (character-encoding-nul-encoding encoding))
     1599         (str (gensym))
     1600         (len (gensym))
     1601         (i (gensym)))
    16051602    (multiple-value-bind (body decls) (parse-body body env nil)
    16061603      `(let* ((,str ,string))
    16071604        (%stack-block ((,sym (cstring-encoded-length-in-bytes ,encoding ,str ,start ,end) :clear t))
    16081605          ,@decls
    1609           (encode-string-to-memory ,encoding ,sym 0 ,str ,start ,end)
     1606          (let* ((,len (encode-string-to-memory ,encoding ,sym 0 ,str ,start ,end)))
     1607            (declare (fixnum ,len))
     1608            (dotimes (,i (length ,nul-vector))
     1609              (setf (%get-unsigned-byte ,sym ,len) (aref ,nul-vector ,i))
     1610              (incf ,len)))
    16101611          ,@body)))))
    16111612
     
    28712872  (apply 'make-record-form record-name '%new-gcable-ptr initforms))
    28722873
     2874(defmacro copy-record (type source dest)
     2875  (let* ((size (* (%foreign-type-or-record-size type :words) #+64-bit-target 1 #+32-bit-target 2))
     2876         (src (gensym "SRC"))
     2877         (dst (gensym "DST"))
     2878         (accessor #64-bit-target '%get-unsigned-long #+32-bit-target '%get-unsigned-word)
     2879         (i (gensym "I"))
     2880         (j (gensym "J")))
     2881    `(with-macptrs ((,src ,source)
     2882                    (,dst ,dest))
     2883      (do* ((,i 0 (+ ,i #+64-bit-target 4 #+32-bit-target 2))
     2884            (,j 0 (+ ,j 1)))
     2885           ((= ,j ,size))
     2886        (declare (fixnum ,i))
     2887        (setf (,accessor ,dst ,i) (,accessor ,src ,i))))))
     2888
     2889     
     2890   
     2891
    28732892(defmacro with-terminal-input (&body body)
    28742893  "Execute body in an environment with exclusive read access to the terminal."
     
    34363455                                            (the (unsigned-byte 8) (ash ,arg -24)))))))))))
    34373456   
     3457
     3458(defmacro multiple-value-bind (varlist values-form &body body &environment env)
     3459  (multiple-value-bind (body decls)
     3460                       (parse-body body env)
     3461    (let ((ignore (make-symbol "IGNORE")))
     3462      `(multiple-value-call #'(lambda (&optional ,@varlist &rest ,ignore)
     3463                                (declare (ignore ,ignore))
     3464                                ,@decls
     3465                                ,@body)
     3466                            ,values-form))))
     3467
     3468(defmacro multiple-value-setq (vars val)
     3469  (if vars
     3470    `(values (setf (values ,@(mapcar #'(lambda (s) (require-type s 'symbol)) vars))  ,val))
     3471    `(prog1 ,val)))
     3472
     3473(defmacro nth-value (n form)
     3474  "Evaluate FORM and return the Nth value (zero based). This involves no
     3475  consing when N is a trivial constant integer."
     3476  `(car (nthcdr ,n (multiple-value-list ,form))))
Note: See TracChangeset for help on using the changeset viewer.