Ignore:
Timestamp:
Oct 14, 2008, 6:30:00 PM (13 years ago)
Author:
gz
Message:

Merge/bootstrap assorted low level stuff from trunk - kernel, syscall stuff, lowmem-bias, formatting tweaks, a few bug fixes included

File:
1 edited

Legend:

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

    r11069 r11089  
    16551655
    16561656
    1657 
     1657(defmacro with-native-utf-16-cstr ((sym str) &body body)
     1658  (let* ((data (gensym))
     1659         (offset (gensym))
     1660         (string (gensym))
     1661         (len (gensym))
     1662         (noctets (gensym))
     1663         (end (gensym)))
     1664    `(let* ((,string ,str)
     1665            (,len (length ,string)))
     1666      (multiple-value-bind (,data ,offset) (array-data-and-offset ,string)
     1667        (let* ((,end (+ ,offset ,len))
     1668               (,noctets (utf-16-octets-in-string ,data ,offset ,end)))
     1669          (%stack-block ((,sym (1+ ,noctets)))
     1670            (native-utf-16-memory-encode ,data ,sym 0 ,offset ,end)
     1671            (setf (%get-unsigned-word ,sym ,noctets) 0)
     1672            ,@body))))))
    16581673
    16591674(defmacro with-pointers (speclist &body body)
     
    16671682(defmacro with-utf-8-cstrs (speclist &body body)
    16681683   (with-specs-aux 'with-utf-8-cstr speclist body))
     1684
     1685(defmacro with-native-utf-16-cstrs (speclist &body body)
     1686  (with-specs-aux 'with-native-utf-16-cstr speclist body))
    16691687
    16701688(defmacro with-encoded-cstr ((encoding-name (sym string &optional start end))
     
    16851703                                             bindings) body))
    16861704
     1705(defmacro with-filename-cstrs (&rest rest)
     1706  `(,(case (target-os-name)
     1707      (:darwin 'with-utf-8-cstrs)
     1708      (:windows 'with-native-utf-16-cstrs)
     1709      (t 'with-cstrs)) ,@rest))
     1710
    16871711
    16881712(defun with-specs-aux (name spec-list original-body)
     
    17001724(defsetf type-predicate set-type-predicate)
    17011725
     1726(defun adjust-defmethod-lambda-list (ll)
     1727  ;; If the lambda list contains &key, ensure that it also contains
     1728  ;; &allow-other-keys
     1729  (if (or (not (memq '&key ll))
     1730          (memq '&allow-other-keys ll))
     1731    ll
     1732    (if (memq '&aux ll)
     1733      (let* ((ll (copy-list ll))
     1734             (aux (memq '&aux ll)))
     1735        (setf (car aux) '&allow-other-keys
     1736              (cdr aux) (cons '&aux (cdr aux)))
     1737        ll)
     1738      (append ll '(&allow-other-keys)))))
     1739
    17021740(defun encode-gf-lambda-list (lambda-list)
    17031741  (let* ((bits (encode-lambda-list lambda-list)))
     
    17061744      (logior bits (ash 1 $lfbits-aok-bit))
    17071745      bits)))
    1708        
     1746
    17091747(defmacro defmethod (name &rest args &environment env)
    17101748  (multiple-value-bind (function-form specializers-form qualifiers lambda-list documentation specializers)
     
    19952033  (fboundp function-name)             ; type-check
    19962034  (multiple-value-bind (method-combination generic-function-class options methods)
    1997                        (parse-defgeneric function-name t lambda-list options-and-methods)
     2035      (parse-defgeneric function-name t lambda-list options-and-methods)
    19982036    (let ((gf (gensym)))
    19992037      `(progn
     
    26492687         (go ,TOP))))))
    26502688
     2689
    26512690(defmacro check-type (place typespec &optional string)
    26522691  "CHECK-TYPE Place Typespec [String]
     
    26602699          ((typep ,val ',typespec))
    26612700        (setf ,place (ensure-value-of-type ,val ',typespec ',place ,string))))))
     2701
    26622702
    26632703
     
    36653705             ,@body)
    36663706        (setf (stream-output-timeout ,stream) ,old-output-timeout)))))
     3707
     3708;;; FORM returns a signed integer.  If it's non-negative, return that
     3709;;; value, otherwise, return the (negative) errnor value returned by
     3710;;; %GET-ERRNO
     3711(defmacro int-errno-call (form)
     3712  (let* ((value (gensym)))
     3713    `(let* ((,value ,form))
     3714      (if (< ,value 0)
     3715        (%get-errno)
     3716        ,value))))
     3717
     3718(defmacro int-errno-ffcall (entry &rest args)
     3719  `(int-errno-call (ff-call ,entry ,@args)))
Note: See TracChangeset for help on using the changeset viewer.