Changeset 7294


Ignore:
Timestamp:
Sep 26, 2007, 2:53:18 AM (12 years ago)
Author:
gb
Message:

Merge version-tracking changes from trunk.

Location:
branches/working-0709/ccl
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0709/ccl/level-1/version.lisp

    r7176 r7294  
    2020(defparameter *openmcl-minor-version* 1)
    2121(defparameter *openmcl-revision* 0)
    22 (defparameter *openmcl-suffix* "pre-070906x")
     22;;; May be set by xload-level-0
     23(defvar *openmcl-svn-revision* nil)
    2324(defparameter *openmcl-dev-level* nil)
    2425
    25 (defparameter *openmcl-version* (format nil "~d.~d~@[.~d~]~@[-~a~] (~@[~A: ~]~~A)"
     26(defparameter *openmcl-version* (format nil "~d.~d~@[.~d~]~@[-r~a~] (~@[~A: ~]~~A)"
    2627                                        *openmcl-major-version*
    2728                                        *openmcl-minor-version*
    2829                                        (unless (zerop *openmcl-revision*)
    2930                                          *openmcl-revision*)
    30                                         *openmcl-suffix*
     31                                        *openmcl-svn-revision*
    3132                                        *openmcl-dev-level*))
    3233
    3334
     35
     36
    3437;;; end
  • branches/working-0709/ccl/lib/compile-ccl.lisp

    r6927 r7294  
    536536                                                 
    537537               
     538(defun create-interfaces (dirname &key target populate-arg)
     539  (let* ((backend (if target (find-backend target) *target-backend*))
     540         (*default-pathname-defaults* nil)
     541         (ftd (backend-target-foreign-type-data backend))
     542         (d (use-interface-dir dirname ftd))
     543         (populate (merge-pathnames "C/populate.sh"
     544                                    (merge-pathnames
     545                                     (interface-dir-subdir d)
     546                                     (ftd-interface-db-directory ftd))))
     547         (cdir (make-pathname :directory (pathname-directory (translate-logical-pathname populate))))
     548         (args (list "-c"
     549                     (format nil "cd ~a && /bin/sh ~a ~@[~a~]"
     550                             (native-translated-namestring cdir)
     551                             (native-translated-namestring populate)
     552                             populate-arg))))
     553    (format t "~&;[Running interface translator via ~s to produce .ffi file(s) from headers]~&" populate)
     554    (force-output t)
     555    (multiple-value-bind (status exit-code)
     556        (external-process-status
     557         (run-program "/bin/sh" args :output t))
     558      (if (and (eq status :exited)
     559               (eql exit-code 0))
     560        (let* ((f 'parse-standard-ffi-files))
     561          (require "PARSE-FFI")
     562          (format t "~%~%;[Parsing .ffi files; may create new .cdb files for ~s]" dirname)
     563          (funcall f dirname target)
     564          (format t "~%~%;[Parsing .ffi files again to resolve forward-referenced constants]")
     565          (funcall f dirname target))))))
  • branches/working-0709/ccl/lib/misc.lisp

    r7205 r7294  
    300300  (documentation c 'type))
    301301
    302 
    303302(defmethod (setf documentation) ((new t)
    304303                                 (c structure-class)
    305304                                 (doc-type (eql 't)))
    306305  (setf (documentation c 'type) new))
    307 
    308 (defmethod documentation ((slot slot-definition) (doc-type (eql 't)))
    309   (standard-slot-definition.documentation slot))
    310 
    311 (defmethod (setf documentation) (new (slot slot-definition) (doc-type (eql 't)))
    312   (setf (standard-slot-definition.documentation slot) new))
    313 
    314 
    315306
    316307;;; This is now deprecated; things which call it should stop doing so.
     
    705696
    706697(%fhave 'df #'disassemble)
     698
     699(defun local-svn-revision ()
     700  (or
     701   ;; svn2cvs uses a .svnrev file to sync CVS and SVN; if present,
     702   ;; it contains the svn revision in decimal.
     703   (with-open-file (f "ccl:\\.svnrev" :direction :input :if-does-not-exist nil)
     704     (when f (read f)))
     705   (with-output-to-string (s)
     706    (multiple-value-bind (status exit-code)
     707        (external-process-status
     708         (run-program "svnversion"  (list  (native-translated-namestring "ccl:") "/trunk/ccl"):output s))
     709      (when (and (eq :exited status) (zerop exit-code))
     710        (with-input-from-string (output (get-output-stream-string s))
     711          (let* ((line (read-line output nil nil)))
     712            (when (and line (parse-integer line :junk-allowed t) )
     713              (return-from local-svn-revision line)))))))))
Note: See TracChangeset for help on using the changeset viewer.