Changeset 12243 for branches


Ignore:
Timestamp:
Jun 10, 2009, 1:57:40 PM (11 years ago)
Author:
gz
Message:

ffi parsing and chud changes from trunk

Location:
branches/working-0711/ccl/library
Files:
1 added
2 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/library/chud-metering.lisp

    r9916 r12243  
    120120  (single-value-return))
    121121
     122#+x8632-target
     123(ccl::defx8632lapfunction dynamic-dnode ((x arg_z))
     124  (movl (% x) (% imm0))
     125  (ref-global x86::heap-start arg_y)
     126  (subl (% arg_y) (% imm0))
     127  (shrl ($ x8632::dnode-shift) (% imm0))
     128  (box-fixnum imm0 arg_z)
     129  (single-value-return))
     130
    122131#+x8664-target
    123132(defun identify-functions-with-pure-code ()
     
    131140                           (when (typep o 'ccl::function-vector)
    132141                             (functions (ccl::function-vector-to-function o))))
     142                         ccl::area-dynamic
     143                         ccl::area-dynamic
     144                         )))
     145    (functions)))
     146
     147#+x8632-target
     148(defun identify-functions-with-pure-code ()
     149  (ccl::freeze)
     150  (ccl::collect ((functions))
     151    (block walk
     152      (let* ((frozen-dnodes (ccl::frozen-space-dnodes)))
     153        (ccl::%map-areas (lambda (o)
     154                           (when (>= (dynamic-dnode o) frozen-dnodes)
     155                             (return-from walk nil))
     156                           (when (typep o 'function)
     157                             (functions o)))
    133158                         ccl::area-dynamic
    134159                         ccl::area-dynamic
  • branches/working-0711/ccl/library/parse-ffi.lisp

    r12198 r12243  
    1818
    1919(defvar *parse-ffi-target-ftd* *target-ftd*)
    20 (defvar *ffi-struct-return-explicit* nil)
    2120(defvar *ffi-lisp-readtable* (copy-readtable nil))
    2221(defvar *ffi-ordinal* -1)
     
    5554(defvar *ffi-global-objc-classes* nil)
    5655(defvar *ffi-global-objc-messages* nil)
    57 (defvar *ffi-macros*)
    58 (defvar *ffi-vars*)
     56;;; Some things are just too hard to parse, but are important.
     57;;; Override those things with simpler versions.
     58(defvar *ffi-macro-overrides*
     59  '((:macro ("{override}" 0) "_IOC_TYPECHECK ( t )" "sizeof(t)")))
    5960
    6061(defvar *ffi-void-reference* '(:primitive :void))
     
    715716    (if (eq (car (last args)) *ffi-void-reference*)
    716717      (setq args (butlast args)))
    717     (when (ffi-record-type-p retval)
    718       (if  *ffi-struct-return-explicit*
    719         (format t "~&;; Note: explict struct return in function ~s" (ffi-function-string  ffi-function))
    720         (progn
    721           (push retval args)
    722           (push `(:pointer ,retval) (ffi-function-arglist ffi-function))
    723           (setf (ffi-function-return-value ffi-function) *ffi-void-reference*)
    724           (setq retval *ffi-void-reference*))))
    725718    (dolist (arg args) (ensure-referenced-type-defined arg))
    726719    (ensure-referenced-type-defined retval)
    727720    (record-global-function ffi-function)))
    728  
     721
     722
     723(defun read-ffi-toplevel-form (stream eof-value)
     724  (loop
     725    (let* ((ch (peek-char  nil stream nil eof-value)))
     726      (cond ((eq ch eof-value) (return eof-value))
     727            ((eql ch #\() (return (read stream nil eof-value)))
     728            (t (read-line stream))))))
     729
    729730(defun parse-ffi (inpath)
    730731  (let* ((*ffi-typedefs* (make-hash-table :test 'string= :hash-function 'sxhash))
     
    742743        (let* ((*ffi-ordinal* -1))
    743744          (let* ((*package* (find-package "KEYWORD")))
    744             (do* ((form (read in nil :eof) (read in nil :eof)))
     745            (do* ((form (read-ffi-toplevel-form in :eof)
     746                        (read-ffi-toplevel-form in :eof)))
    745747                 ((eq form :eof))
    746748              (case (car form)
     
    758760                          (if args
    759761                            (setf (gethash (string (ffi-macro-name m)) argument-macros) args)
    760                             (push m defined-macros))))
     762                            (push m defined-macros))))
    761763                (:type (push (process-ffi-typedef form) defined-types))
    762764                (:var (push (process-ffi-var form) defined-vars))
     
    765767                (:union (push (process-ffi-union form) defined-types))
    766768                (:transparent-union (push (process-ffi-transparent-union form) defined-types)))))
     769          (dolist (override *ffi-macro-overrides*)
     770            (let* ((m (process-ffi-macro override))
     771                   (args (ffi-macro-args m)))
     772              (if args
     773                (setf (gethash (string (ffi-macro-name m)) argument-macros) args)
     774                (push m defined-macros))))
    767775          (multiple-value-bind (new-constants new-macros)
    768776              (process-defined-macros defined-macros (reverse defined-constants) argument-macros)
     
    790798         (*target-ftd* ftd)
    791799         (*target-backend* backend)
    792          (*ffi-struct-return-explicit* nil)
    793800         (d (use-interface-dir dirname ftd))
    794801         (interface-dir (merge-pathnames
     
    11871194               (if (eq (peek) 'c::|?|)
    11881195                 (let ((then (progn (next) (parse-expression)))
    1189                        (else (if (eq (peek) '|:|)
     1196                       (else (if (eq (peek) 'c::|:|)
    11901197                               (progn (next) (parse-conditional))
    11911198                               (fail "~A where : was expected" (peek)))))
     
    12931300                                         `(c::cast ,(evaluate-type-name (list left))
    12941301                                           ,@(parse-argument-list)))
    1295                                         (t `(c::call ,left ,@(parse-argument-list))))))
     1302                                        (t nil #|`(c::call ,left ,@(parse-argument-list))|#))))
    12961303                               ((memq right '(c::|.| c::|->|))
    12971304                                (next)          ; swallow operator
Note: See TracChangeset for help on using the changeset viewer.