Changeset 7414 for branches/working-0710


Ignore:
Timestamp:
Oct 12, 2007, 9:50:48 AM (12 years ago)
Author:
gb
Message:

WITH-SELF-BOUND-IO-CONTROL-VARS moved here.
WITH-UTF8-CSTRS, ASSERT-POINTER-TYPE, deferred GC stuff.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0710/ccl/lib/macros.lisp

    r7263 r7414  
    14931493       ,@body)))
    14941494
     1495(defmacro with-self-bound-io-control-vars (&body body)
     1496  `(let (
     1497         (*print-array* *print-array*)
     1498         (*print-base* *print-base*)
     1499         (*print-case* *print-case*)
     1500         (*print-circle* *print-circle*)
     1501         (*print-escape* *print-escape*)
     1502         (*print-gensym* *print-gensym*)
     1503         (*print-length* *print-length*)
     1504         (*print-level* *print-level*)
     1505         (*print-lines* *print-lines*)
     1506         (*print-miser-width* *print-miser-width*)
     1507         (*print-pprint-dispatch* *print-pprint-dispatch*)
     1508         (*print-pretty* *print-pretty*)
     1509         (*print-radix* *print-radix*)
     1510         (*print-readably* *print-readably*)
     1511         (*print-right-margin* *print-right-margin*)
     1512         (*read-base* *read-base*)
     1513         (*read-default-float-format* *read-default-float-format*)
     1514         (*read-eval* *read-eval*)
     1515         (*read-suppress* *read-suppress*)
     1516         (*readtable* *readtable*))
     1517     ,@body))
     1518
    14951519(defmacro print-unreadable-object (&environment env (object stream &key type identity) &body forms)
    14961520  "Output OBJECT to STREAM with \"#<\" prefix, \">\" suffix, optionally
     
    15801604                `(%cstr-pointer ,strname ,sym))
    15811605             ,@body))))))
     1606
     1607(defmacro with-utf-8-cstr ((sym str) &body body)
     1608  (let* ((data (gensym))
     1609         (offset (gensym))
     1610         (string (gensym))
     1611         (len (gensym))
     1612         (noctets (gensym))
     1613         (end (gensym)))
     1614    `(let* ((,string ,str)
     1615            (,len (length ,string)))
     1616      (multiple-value-bind (,data ,offset) (array-data-and-offset ,string)
     1617        (let* ((,end (+ ,offset ,len))
     1618               (,noctets (utf-8-octets-in-string ,data ,offset ,end)))
     1619          (%stack-block ((,sym (1+ ,noctets)))
     1620            (utf-8-memory-encode ,data ,sym 0 ,offset ,end)
     1621            (setf (%get-unsigned-byte ,sym ,noctets) 0)
     1622            ,@body))))))
    15821623
    15831624
     
    29072948        (setf (,accessor ,dst ,i) (,accessor ,src ,i))))))
    29082949
    2909      
     2950(defmacro assert-pointer-type (pointer type)
     2951  "Assert that the pointer points to an instance of the specified foreign type.
     2952Return the pointer."
     2953  (let* ((ptr (gensym)))
     2954    `(let* ((,ptr ,pointer))
     2955      (%set-macptr-type ,ptr (foreign-type-ordinal (load-time-value (parse-foreign-type ',type))))
     2956      ,ptr)))
     2957
    29102958   
    29112959
     
    29883036      ,@body)
    29893037    (%unlock-gc-lock)))
     3038
     3039(defmacro with-deferred-gc (&body body)
     3040  "Execute BODY without responding to the signal used to suspend
     3041threads for GC.  BODY must be very careful not to do anything which
     3042could cause an exception (note that attempting to allocate lisp memory
     3043may cause an exception.)"
     3044  `(let* ((*interrupt-level* -2))
     3045    ,@body))
     3046
     3047(defmacro allowing-deferred-gc (&body body)
     3048  "Within the extent of a surrounding WITH-DEFERRED-GC, allow GC."
     3049  `(let* ((*interrupt-level* -1))
     3050    (%check-deferred-gc)
     3051    ,@body))
     3052 
     3053
    29903054
    29913055(defmacro with-pointer-to-ivector ((ptr ivector) &body body)
Note: See TracChangeset for help on using the changeset viewer.