Changeset 8372


Ignore:
Timestamp:
Jan 30, 2008, 2:17:07 AM (13 years ago)
Author:
rme
Message:

Merged changes 7685:8261 from branches/1.1/ccl.

Location:
branches/ia32
Files:
2 deleted
65 edited
39 copied

Legend:

Unmodified
Added
Removed

  • branches/ia32/cocoa-ide/README

    r6955 r8372  
    1 July 22, 2007
     1November 20, 2007
    22
    33This directory contains sources and other resources needed to build
    4 a Cocoa-based IDE for OpenMCL on OSX.
     4a Cocoa-based IDE for Clozure CL on OSX.
    55
    66The IDE uses the ObjC bridge (in ccl/objc-bridge/) to communicate
    77with the ObjC runtime.
    88
    9 "./OpenMCL.app" is a skeletal application bundle which contains nib
    10 files, icons, and other resources used by the IDE.
     9The "./ide-contents" directory contains nib files, icons and other
     10resources used by the IDE.  These are copied to the application bundle
     11by the build process.
    1112
    1213The "./hemlock" directory contains a hacked up version of Portable
    13 Hemlock (forked from the main Portable Hemlock tree a few years ago.)
     14Hemlock (forked from the main Portable Hemlock tree some years ago.)
    1415Hemlock is public domain Emacs-like editor that comes with CMUCL;
    1516Portable Hemlock is an attempt to "free Hemlock from its CMUCL prison"
    1617(e.g., remove dependencies on CMUCL).  Hemlock (and Portable Hemlock)
    1718were designed to use CLX for display and event processing; the version
    18 distributed here tries to use the Cocoa text system for that
    19 functionality. Much of the initial work on Portable Hemlock was done
    20 by Gilbert Baumann.
     19distributed here uses the Cocoa text system for that functionality.
     20Much of the initial work on Portable Hemlock was done by Gilbert Baumann.
    2121
    22 To run the IDE from within an OpenMCL session (a shell, Emacs shell
     22To run the IDE from within a ccl command-line session (a shell, Emacs shell
    2323buffer, under SLIME or ILisp or ...), do:
    2424
    2525? (require "COCOA")
    2626
    27 The first time this is run, it'll compile the Hemlock sources; that'll
    28 take several seconds and generate lots of compiler warnings.  You'll
    29 also see messages noting that various new ObjC-callable methods are
    30 being define.  When the loading process completes, you should see
    31 a new menubar, an OpenMCL Dock icon (an aqua-colored Lambda originally
    32 contributed by Brendan Burns), and a Listener window.  The listener
    33 process from which the REQUIRE was issued will remain active; you
    34 may see warning/diagnostic/error messages from the IDE directed to
     27The first time this is run, it'll compile the sources, generating lots
     28of compiler warnings.  You'll also see messages noting that various
     29new ObjC-callable methods are being defined.  When the loading process
     30completes, it creates a temporary application bundle in "ccl:temp
     31bundle.app" and activates it.  You should see a new menubar, a
     32listener window, and a Clozure CL icon in the Dock. The non-GUI
     33listener process from which the REQUIRE was issued will remain active;
     34you may see warning/diagnostic/error messages from the IDE directed to
    3535the standard output/error streams associated with that listener.
    3636(Under SLIME, these messages might appear in the *inferior lisp*
    3737buffer.)
    3838
    39 It's also possible to populate the "OpenMCL.app" application bundle,
    40 effectively making it a double-clickable application.  To do this,
    41 you can do:
     39It's also possible to save the loaded IDE in a populated bundle,
     40effectively making it a double-clickable application.  To do this, you
     41can do:
    4242
    4343? (require "COCOA-APPLICATION")
    4444
    45 which will do what (REQUIRE "COCOA") does, then save an executable
    46 lisp image inside the "OpenMCL.app" bundle. Double-clicking on
     45which will create an application bundle in "ccl:Clozure CL.app"
     46and save an executable lisp image inside it. Double-clicking on
    4747that bundle in the Finder will launch the IDE; any diagnostic
    48 messages/warnings/etc. will be written to /var/log/system.log.
    49 (Probably; this may depend on OS version.)
     48messages/warnings/etc. will be written to the system log, which
     49can be examined with the Console application.
    5050
    5151The IDE depends on functionality introduced in OSX 10.4 (Tiger).
    5252
    53 Note: CCL directory and IDE, preferences changes.
    5453
    55 The IDE uses the value of a key in the application's preferences
    56 database in order to find the "ccl" directory (and to thereby
    57 enable M-. to find source files and to enable the FFI and ObjC
    58 bridge to find interface definitions, among other things.) 
    5954
    60 (Unlike some earlier versions, the IDE application itself shouldn't
    61 need access to interfaces at runtime.)
     55*Note: CCL directory and IDE Preferences
    6256
    63 The key can be set via the "CCL Directory" entry in the "Paths" pane
    64 of the Preferences dialog.  (The text associated with that entry is
    65 static; the "Select ..." button near that entry can be used to
    66 invoke a directory-selection dialog.)
     57Normally, the IDE assumes it is located at the top level of the "CCL"
     58directory.  It uses the CCL directory to enable Meta-. to find the
     59system source files and require'd modules, among other things.  If you
     60want to move the IDE somewhere else, e.g. to put it in the
     61Applications folder, but still want to be able to Meta-. and require
     62stuff from the CCL directory, you can set the "CCL Directory" entry in
     63the "Paths" pane of the Preferences dialog to the absolute path of the
     64directory containing the system sources.
    6765
    6866The values of changed application preferences are stored in
    69 "~/Library/Preferences/com.clozure.OpenMCL.plist"; if you have
     67"~/Library/Preferences/com.clozure.Clozure CL.plist"; if you have
    7068an old version of this file, it might be desirable to delete it
    7169before invoking the IDE for the first time.
    7270
    7371
    74 Note: rebuilding Hemlock
     72*Note: Interface files
    7573
    76 All of the Hemlock sources that are used in the IDE basically
    77 have to be recompiled whenever any of them change; some of the
    78 Hemlock files have load-time side-effects and can only be
    79 loaded once, and some files have to have been loaded in order
    80 for others to compile.  (Yes, this is possibly a job for
    81 ASDF or some other DEFSYSTEM-like thing.)
    82 
    83 To rebuild Hemlock (from the "tty" environment), do:
    84 
    85 ? (require "COMPILE-HEMLOCK")
    86 
    87 ? (ccl::compile-hemlock t)
    88 
    89 That'll compile all of the Hemlock sources that the IDE uses, then
    90 concatenate the resulting FASL files into a single
    91 "ccl:cocoa-ide;hemlock.FASL" (where "FASL" denotes the
    92 platform-specific FASL file extension.)
    93 
    94 This happens automatically when HEMLOCK is REQUIREd and
    95 "ccl:cocoa-ide;hemlock.lisp" is newer than the corresponding FASL (or
    96 the FASL is missing); if the Hemlock FASL is present, it'll be used
    97 (even if it's out-of-date with respect to the
    98 ccl:cocoa-ide;hemlock;src;*lisp" files from which it's derived.)
    99 
    100 In previous OpenMCL releases, "hemlock" and "OpenMCL" were both
    101 at top-level in the "ccl" tree, and many of the files in the
    102 "cocoa-ide" and "objc-bridge" directories were in "ccl:examples;".
    103 
    104 Note: This README file should be much longer.
     74The standalone IDE bundle contains a copy of the FFI/ObjC interface
     75definition databases (i.e. the .cdb files) for its target platform in
     76Clozure CL.app/Contents/Resources/xxx-headers.  If you create
     77additional databases that you want the IDE to access, you can just
     78copy them into the bundle.  Conversely, if you'd rather use the
     79interface definitions in the CCL directory, just delete the ones in
     80the bundle.

  • branches/ia32/cocoa-ide/app-delegate.lisp

    r7666 r8372  
    1 (in-package "CCL")
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
    24
    3 (require "COCOA-DEFAULTS")
    4 (require "PREFERENCES")
    5 (require "PROCESSES-WINDOW")
    6 (require "APROPOS-WINDOW")
     5(in-package "GUI")
    76
    87(defclass lisp-application-delegate (ns:ns-object)

  • branches/ia32/cocoa-ide/apropos-window.lisp

    r7666 r8372  
    1 (in-package "CCL")
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
     4
     5(in-package "GUI")
    26
    37(defclass package-combo-box (ns:ns-combo-box)
    … …  
    9094        (if shows-external-symbols
    9195          (do-external-symbols (sym package)
    92             (when (%apropos-substring-p input (symbol-name sym))
     96            (when (ccl::%apropos-substring-p input (symbol-name sym))
    9397              (push sym symbol-list)))
    9498          (do-symbols (sym package)
    95             (when (%apropos-substring-p input (symbol-name sym))
     99            (when (ccl::%apropos-substring-p input (symbol-name sym))
    96100              (push sym symbol-list))))
    97101        (if shows-external-symbols
    98102          (dolist (p (list-all-packages))
    99103            (do-external-symbols (sym p)
    100               (when (%apropos-substring-p input (symbol-name sym))
     104              (when (ccl::%apropos-substring-p input (symbol-name sym))
    101105                (push sym symbol-list))))
    102106          (do-all-symbols (sym)
    103             (when (%apropos-substring-p input (symbol-name sym))
     107            (when (ccl::%apropos-substring-p input (symbol-name sym))
    104108              (push sym symbol-list)))))
    105109      (setf symbol-list (sort symbol-list #'string-lessp)))))

  • branches/ia32/cocoa-ide/build-application.lisp

    r7666 r8372  
    2828;;; dev-environment nibfiles.
    2929
     30#|
     31temporarily removed for debugging
     32(save-application image-path
     33                      :application-class application-class
     34                      :toplevel-function toplevel-function
     35                      :prepend-kernel t)
     36|#
     37
    3038(defun build-application (&key
    3139                          (name "MyApplication")
    … …  
    3442                          (directory (current-directory))
    3543                          (nibfiles nil) ; a list of user-specified nibfiles
    36                                          ; to be copied into the app bundle
    37                           (main-nib-name); the name of the nib that is to be loaded
    38                                          ; as the app's main. this name gets written
    39                                          ; into the Info.plist on the "NSMainNibFile" key
    40                           (application-class 'cocoa-application)
    41                           (toplevel-function nil)
    42                           (swank-loader nil)
    43                           (autostart-swank-on-port nil))
    44   ;;; if the path to swank-loader.lisp is given, then load
    45   ;;; swank before building the application
    46   (when swank-loader
    47     (assert (probe-file swank-loader)(swank-loader)
    48             "Swank loader not found at path '~A'" swank-loader)
    49     (load swank-loader)
    50     ;; when autostart-swank-on-port is also given, setup
    51     ;; swank to start up on launch (still don't know how
    52     ;; we're actually going to do this)
    53     (when autostart-swank-on-port
    54       (assert (integerp autostart-swank-on-port)(autostart-swank-on-port)
    55               "The port for :autostart-swank-on-port must be an integer or nil, not '~S'"
    56               autostart-swank-on-port)
    57       ;; if we get this far, setup the swank autostart
    58       ;; (however we're going to do that...)
    59       ))
    60   ;;; build the application
     44                                        ; to be copied into the app bundle
     45                          (main-nib-name) ; the name of the nib that is to be loaded
     46                                        ; as the app's main. this name gets written
     47                                        ; into the Info.plist on the "NSMainNibFile" key
     48                          (application-class 'gui::cocoa-application)
     49                          (toplevel-function nil))
     50
    6151  (let* ((ide-bundle (#/mainBundle ns:ns-bundle))
    6252         (ide-bundle-path-nsstring (#/bundlePath ide-bundle))
    … …  
    6454                           (ensure-directory-pathname
    6555                            (lisp-string-from-nsstring ide-bundle-path-nsstring))))
     56         ;; create the bundle directory
    6657         (app-bundle (make-application-bundle name type-string creator-string directory
    6758                                              :main-nib-name main-nib-name))
    6859         (image-path (namestring (path app-bundle "Contents" "MacOS" name))))
    69 
    70     ;; copy IDE resources into the application bundle
     60    ;; copy IDE resources to the bundle
    7161    (recursive-copy-directory (path ide-bundle-path "Contents" "Resources/")
    7262                              (path app-bundle  "Contents" "Resources/")
    73                               :if-exists :overwrite)
    74     ;; copy user-supplied nibfiles into the bundle
     63                              :if-exists :overwrite)
     64    ;; copy user nibfiles into the bundle
    7565    (when nibfiles
    7666      (let ((nib-paths (mapcar #'pathname nibfiles)))
    77         (assert (and (every #'probe-file nib-paths)
    78                      (every #'directoryp nib-paths))
     67        (assert (and (every #'probe-file nib-paths))
    7968                (nibfiles)
    80                 "The nibfiles parameter must be a list of valid pathnames to existing directories")
    81         ;; for each input nibfile, construct the destination path and copy it to that path
    82         ;; checking first whether doing so would clobber an existing nib. if it would,
    83         ;; signal an error
     69                "The nibfiles parameter must be a list of valid pathnames to existing files or directories")
    8470        (dolist (n nib-paths)
    85           ;; TODO: handle cases where there are nibs for languages other than English
    86           (let ((dest (path app-bundle  "Contents" "Resources" "English.lproj/" (namestring (basename n)))))
    87             (if (probe-file dest)
    88                 (error "The destination nibfile '~A' already exists" dest)
    89                 (recursive-copy-directory n dest :if-exists :overwrite))))))
    90     ;; save the application image
     71          (let ((dest (path app-bundle  "Contents" "Resources" "English.lproj/")))
     72            (copy-nibfile n dest :if-exists :overwrite)))))
     73    ;; save the application image into the bundle
    9174    (save-application image-path
    9275                      :application-class application-class
    … …  
    9578
    9679
    97 

  • branches/ia32/cocoa-ide/builder-utilities.lisp

    r7666 r8372  
    2828                   app)
    2929         app))
     30
     31(defun copy-nibfile (srcnib dest-directory &key (if-exists :overwrite))
     32  (setq if-exists (require-type if-exists '(member :overwrite :error)))
     33  (let* ((basename (basename srcnib))
     34         (dest (path dest-directory basename)))
     35    (if (probe-file dest)
     36        (case if-exists
     37          (:overwrite (progn
     38                        (if (directoryp dest)
     39                            (recursive-delete-directory dest)
     40                            (delete-file dest))))
     41          (:error (error "The nibfile '~A' already exists" dest))))
     42    (if (directoryp srcnib)
     43        (recursive-copy-directory srcnib dest)
     44        (copy-file srcnib dest))))
    3045
    3146;;; BASENAME path

  • branches/ia32/cocoa-ide/cocoa-application.lisp

    r7666 r8372  
    1818(in-package "CCL")                      ; for now.
    1919
    20 (eval-when (:compile-toplevel :execute)
    21   (use-interface-dir :cocoa))
    2220
    23 ;;; loading cocoa.lisp creates an IDE bundle in *cocoa-application-path*,
    24 ;;; perhaps copying headers as per *cocoa-application-copy-headers-p*
    2521(defvar *cocoa-application-path* "ccl:Clozure CL.app;")
    2622(defvar *cocoa-application-copy-headers-p* t)
    27 (require "COCOA")
    28 
    29 (defclass cocoa-application (application)
    30     ())
    31 
    32 (defmethod application-error ((a application) condition error-pointer)
    33   (break-loop-handle-error condition error-pointer))
    34 
    35 
    36 ;;; If we're launched via the Finder, the only argument we'll
    37 ;;; get is of the form -psnXXXXXX.  That's meaningless to us;
    38 ;;; it's easier to pretend that we didn't get any arguments.
    39 ;;; (If it seems like some of this needs to be thought out a
    40 ;;; bit better ... I'd tend to agree.)
    41 (defmethod parse-application-arguments ((a cocoa-application))
    42   (values nil nil nil nil))
    43 
    44 (defmethod toplevel-function ((a cocoa-application) init-file)
    45   (declare (ignore init-file))
    46   (when (< #&NSAppKitVersionNumber 824)
    47     (#_NSLog #@"This application requires features introduced in OSX 10.4.")
    48     (#_ _exit -1))
    49   (setq *standalone-cocoa-ide* t)
    50   ;; TODO: to avoid confusion, should now reset *cocoa-application-path* to
    51   ;; actual bundle path where started up.
    52   (start-cocoa-application))
    53 
    54 
    55   ;;; The saved image will be an instance of COCOA-APPLICATION (mostly
    56   ;;; so that it'll ignore its argument list.)  When it starts up, it'll
    57   ;;; run the Cocoa event loop in the cocoa event process.
    58   ;;; If you use an init file ("home:ccl-init"), it'll be loaded
    59   ;;; in an environment in which *STANDARD-INPUT* always generates EOF
    60   ;;; and where output and error streams are directed to the OSX console
    61   ;;; (see below).  If that causes problems, you may want to suppress
    62   ;;; the loading of your init file (via an :INIT-FILE nil arg to
    63   ;;; the call to SAVE-APPLICATION, below.)
    64 
    65 (defun build-ide (bundle-path)
    66   (setq bundle-path (ensure-directory-pathname bundle-path))
    67 
    68   ;; The bundle is expected to exists, we'll just add the executable into it.
    69   (assert (probe-file bundle-path))
    70 
    71   ;; Wait until we're sure that the Cocoa event loop has started.
    72   (wait-on-semaphore *cocoa-application-finished-launching*)
    73 
    74   (require :easygui)
    75 
    76   (maybe-map-objc-classes t)
    77   (let* ((missing ()))
    78     (do-interface-dirs (d)
    79       (cdb-enumerate-keys
    80        (db-objc-classes d)
    81        (lambda (name)
    82          (let* ((class (lookup-objc-class name nil))) (unless (objc-class-id  class) (push name missing))))))
    83     (when missing
    84       (break "ObjC classes ~{~&~a~} are declared but not defined." missing)))
    85 
    86   (touch bundle-path)
    87 
    88   (let ((image-file (make-pathname :name (standard-kernel-name) :type nil :version nil
    89                                    :defaults (merge-pathnames ";Contents;MacOS;" bundle-path))))
    90     (format *error-output* "~2%Saving application to ~a~2%" (truename bundle-path))
    91     (force-output *error-output*)
    92     (ensure-directories-exist image-file)
    93     (save-application image-file
    94                       :prepend-kernel t
    95                       :application-class 'cocoa-application)))
     23(load "ccl:cocoa-ide;defsystem.lisp")
     24(load-ide)
    9625
    9726;;; If things go wrong, you might see some debugging information via

  • branches/ia32/cocoa-ide/cocoa-backtrace.lisp

    r7244 r8372  
    1 ; -*- Mode: Lisp; Package: CCL; -*-
    2 
    3 (in-package "CCL")
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
     4
     5(in-package "GUI")
    46
    57(defclass ns-lisp-string (ns:ns-string)
    … …  
    5961(def-cocoa-default *backtrace-font-size* :float 9.0f0 "Size of font used in backtrace views")
    6062
     63
     64(defun context-process (context)
     65  (and context (ccl::tcr->process (ccl::bt.tcr context))))
    6166
    6267(objc:defmethod (#/windowDidLoad :void) ((self backtrace-window-controller))
    … …  
    9297      (unless (%null-ptr-p window)
    9398        (let* ((context (backtrace-controller-context self))
    94                (process (tcr->process (bt.tcr context)))
     99               (process (context-process context))
    95100               (listener-window (if (typep process 'cocoa-listener-process)
    96101                                  (cocoa-listener-process-window process))))
    … …  
    107112                                        (process-name process)
    108113                                        (process-serial-number process)
    109                                         (bt.break-level context)))))))))
     114                                        (ccl::bt.break-level context)))))))))
    110115
    111116(objc:defmethod (#/continue: :void) ((self backtrace-window-controller) sender)
    112117  (declare (ignore sender))
    113118  (let* ((context (backtrace-controller-context self))
    114          (process (and context (tcr->process (bt.tcr context)))))
     119         (process (context-process context)))
    115120    (when process (process-interrupt process #'continue))))
    116121
    … …  
    118123  (declare (ignore sender))
    119124  (let* ((context (backtrace-controller-context self))
    120          (process (and context (tcr->process (bt.tcr context)))))
     125         (process (context-process context)))
    121126    (when process (process-interrupt process #'abort-break))))
    122127
    … …  
    191196                                          (inspector::line-n inspector index)))
    192197                                    (if value
    193                                       (%lfun-name-string value)
     198                                      (ccl::%lfun-name-string value)
    194199                                      ":kernel")))))
    195200             label))
    … …  
    234239
    235240(defun backtrace-controller-for-context (context)
    236   (or (bt.dialog context)
    237       (setf (bt.dialog context)
     241  (or (ccl::bt.dialog context)
     242      (setf (ccl::bt.dialog context)
    238243            (make-instance 'backtrace-window-controller
    239244                           :with-window-nib-name #@"backtrace"
    … …  
    257262        (setf (cocoa-listener-process-backtrace-contexts proc)
    258263              (cdr (cocoa-listener-process-backtrace-contexts proc)))
    259         (let* ((btwindow (prog1 (bt.dialog context)
    260                            (setf (bt.dialog context) nil)))
     264        (let* ((btwindow (prog1 (ccl::bt.dialog context)
     265                           (setf (ccl::bt.dialog context) nil)))
    261266               (restartswindow
    262                 (prog1 (car (bt.restarts context))
    263                            (setf (bt.restarts context) nil))))
     267                (prog1 (car (ccl::bt.restarts context))
     268                           (setf (ccl::bt.restarts context) nil))))
    264269          (when btwindow
    265270            (#/performSelectorOnMainThread:withObject:waitUntilDone: btwindow (@selector #/close)  +null-ptr+ t))

  • branches/ia32/cocoa-ide/cocoa-defaults.lisp

    r7666 r8372  
    1 ;;;-*-Mode: LISP; Package: CCL -*-
     1;;;-*-Mode: LISP; Package: GUI -*-
    22;;;
    33;;;   Copyright (C) 2004 Clozure Associates
    … …  
    1515;;;   http://opensource.franz.com/preamble.html
    1616
    17 (in-package "CCL")
    18 
    19 (eval-when (:compile-toplevel :execute)
    20   (use-interface-dir :cocoa)
    21   #+nomore
    22   (use-interface-dir :carbon))
    23 
    24 (require "OBJC-SUPPORT")
     17(in-package "GUI")
    2518
    2619(defstruct cocoa-default
    … …  
    4639(defun set-cocoa-default (name string type value doc &optional change-hook)
    4740  (check-type name symbol)
    48   (check-type string objc-constant-string)
     41  (check-type string ccl::objc-constant-string)
    4942  (check-type type keyword)
    5043  (check-type doc (or null string))
    … …  
    6255;;; Names which contain #\* confuse Cocoa Bindings.
    6356(defun objc-default-key (name)
    64   (ns-constant-string (lisp-to-objc-message (list (make-symbol (remove #\* (string name)))))))
     57  (ccl::ns-constant-string (ccl::lisp-to-objc-message (list (make-symbol (remove #\* (string name)))))))
    6558 
    6659
    … …  
    6962  ;; Make the variable "GLOBAL": its value can be changed, but it can't
    7063  ;; have a per-thread binding.
    71   (%symbol-bits name (logior (ash 1 $sym_vbit_global)
    72                              (the fixnum (%symbol-bits name))))
     64  (ccl::%symbol-bits name (logior (ash 1 ccl::$sym_vbit_global)
     65                                  (the fixnum (ccl::%symbol-bits name))))
    7366  (record-source-file name 'variable)
    7467  (setf (documentation name 'variable) doc)
    … …  
    8174  `(progn
    8275     (eval-when (:compile-toplevel)
    83        (note-variable-info ',name :global ,env))
     76       (ccl::note-variable-info ',name :global ,env))
    8477    (declaim (special ,name))
    8578    (defloadvar ,name nil)
    … …  
    9689    (let* ((name (cocoa-default-symbol d))
    9790           (type (cocoa-default-type d))
    98            (key (objc-constant-string-nsstringptr (cocoa-default-string d))))
     91           (key (ccl::objc-constant-string-nsstringptr (cocoa-default-string d))))
    9992      (let* ((hook (cocoa-default-change-hook d))
    10093             (old-value (symbol-value name)))
    … …  
    136129                               (t
    137130                                (%make-nsstring (format nil "~a" (cocoa-default-value d)))))
    138                              (objc-constant-string-nsstringptr (cocoa-default-string d)))))))
     131                             (ccl::objc-constant-string-nsstringptr (cocoa-default-string d)))))))

  • branches/ia32/cocoa-ide/cocoa-doc.lisp

    r7666 r8372  
    1 (in-package "CCL")
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
     4
     5(in-package "GUI")
    26
    37(def-cocoa-default *hyperspec-url-string* :string "http://www.lispworks.com/documentation/HyperSpec/" "HTTP URL for HyperSpec lookup")

  • branches/ia32/cocoa-ide/cocoa-editor.lisp

    r7685 r8372  
    1 ;;;-*- Mode: LISP; Package: CCL -*-
    2 
    3 
    4 (in-package "CCL")
    5 
    6 (eval-when (:compile-toplevel :load-toplevel :execute)
    7   (require "COCOA-WINDOW")
    8   (require "HEMLOCK"))
    9 
    10 (eval-when (:compile-toplevel :execute)
    11   (use-interface-dir :cocoa))
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
     4
     5(in-package "GUI")
    126
    137;;; In the double-float case, this is probably way too small.
    … …  
    1610;;; integral values.
    1711(eval-when (:compile-toplevel :load-toplevel :execute)
    18   (defconstant large-number-for-text (float 1.0f7 +cgfloat-zero+)))
     12  (defconstant large-number-for-text (cgfloat 1.0f7)))
    1913
    2014(def-cocoa-default *editor-font* :font #'(lambda ()
    … …  
    3428
    3529(defmacro nsstring-encoding-to-nsinteger (n)
    36   (target-word-size-case
    37    (32 `(u32->s32 ,n))
     30  (ccl::target-word-size-case
     31   (32 `(ccl::u32->s32 ,n))
    3832   (64 n)))
    3933
    4034(defmacro nsinteger-to-nsstring-encoding (n)
    41   (target-word-size-case
    42    (32 `(s32->u32 ,n))
     35  (ccl::target-word-size-case
     36   (32 `(ccl::s32->u32 ,n))
    4337   (64 n)))
    4438
    … …  
    433427     (selection-set-by-search :foreign-type :<BOOL>))
    434428  (:metaclass ns:+ns-object))
     429(declaim (special hemlock-text-storage))
    435430
    436431
    … …  
    666661                                         (let* ((w (#/window tv))
    667662                                                (proc (slot-value w 'command-thread)))
    668                                            (process-interrupt proc #'dbg))))
    669       (dbg))
     663                                           (process-interrupt proc #'ccl::dbg))))
     664      (ccl::dbg))
    670665    (let* ((attrs (#/attributesAtIndex:effectiveRange: mirror index rangeptr)))
    671666      (when (eql 0 (#/count attrs))
    … …  
    815810     (peer :foreign-type :id))
    816811  (:metaclass ns:+ns-object))
     812(declaim (special hemlock-textstorage-text-view))
    817813
    818814
    … …  
    939935    (update-blink self))
    940936  (rlet ((range :ns-range :location pos :length length))
    941         (%call-next-objc-method self
    942                                 hemlock-textstorage-text-view
    943                                 (@selector #/setSelectedRange:affinity:stillSelecting:)
    944                                 '(:void :<NSR>ange :<NSS>election<A>ffinity :<BOOL>)
    945                                 range
    946                                 affinity
    947                                 nil)
    948         (assume-not-editing self)
    949         (#/scrollRangeToVisible: self range)
    950         (when (> length 0)
    951           (let* ((ts (#/textStorage self)))
    952             (with-slots (selection-set-by-search) ts
    953               (when (prog1 (eql #$YES selection-set-by-search)
    954                       (setq selection-set-by-search #$NO))
    955                 (highlight-search-selection self pos length)))))
    956 ))
     937    (ccl::%call-next-objc-method self
     938                                 hemlock-textstorage-text-view
     939                                 (@selector #/setSelectedRange:affinity:stillSelecting:)
     940                                 '(:void :<NSR>ange :<NSS>election<A>ffinity :<BOOL>)
     941                                 range
     942                                 affinity
     943                                 nil)
     944    (assume-not-editing self)
     945    (#/scrollRangeToVisible: self range)
     946    (when (> length 0)
     947      (let* ((ts (#/textStorage self)))
     948        (with-slots (selection-set-by-search) ts
     949          (when (prog1 (eql #$YES selection-set-by-search)
     950                  (setq selection-set-by-search #$NO))
     951            (highlight-search-selection self pos length)))))
     952    ))
    957953
    958954(defloadvar *can-use-show-find-indicator-for-range*
    … …  
    10921088      (progn
    10931089        (#/setUsesFontPanel: self t)
    1094         (%call-next-objc-method
     1090        (ccl::%call-next-objc-method
    10951091         self
    10961092         hemlock-textstorage-text-view
    … …  
    17261722                                        containersize))))
    17271723        (#/addLayoutManager: textstorage layout)
     1724        (#/setUsesScreenFonts: layout *use-screen-fonts*)
    17281725        (#/addTextContainer: layout container)
    17291726        (#/release layout)
    … …  
    17731770     (echo-area-stream :initform nil :accessor hemlock-frame-echo-area-stream))
    17741771  (:metaclass ns:+ns-object))
     1772(declaim (special hemlock-frame))
    17751773
    17761774(defun double-%-in (string)
    … …  
    18171815         (message (nsstring-for-lisp-condition condition))
    18181816         (sem-value (make-instance 'ns:ns-number
    1819                                    :with-unsigned-long (%ptr-to-int (semaphore.value semaphore)))))
     1817                                   :with-unsigned-long (%ptr-to-int (ccl::semaphore.value semaphore)))))
    18201818    #+debug
    18211819    (#_NSLog #@"created semaphore with value %lx" :address (semaphore.value semaphore))
    … …  
    21732171      (when has-vertical-scroller
    21742172        (#/setVerticalLineScroll: scrollview char-height)
    2175         (#/setVerticalPageScroll: scrollview +cgfloat-zero+ #|char-height|#))
     2173        (#/setVerticalPageScroll: scrollview (cgfloat 0.0) #|char-height|#))
    21762174      (when has-horizontal-scroller
    21772175        (#/setHorizontalLineScroll: scrollview char-width)
    2178         (#/setHorizontalPageScroll: scrollview +cgfloat-zero+ #|char-width|#))
     2176        (#/setHorizontalPageScroll: scrollview (cgfloat 0.0) #|char-width|#))
    21792177      (let* ((sv-size (#/frameSizeForContentSize:hasHorizontalScroller:hasVerticalScroller:borderType: ns:ns-scroll-view tv-size has-horizontal-scroller has-vertical-scroller (#/borderType scrollview)))
    21802178             (pane-frame (#/frame pane))
    … …  
    22112209              (#/defaultCStringEncoding ns:ns-string)
    22122210              ns)))))))
     2211
     2212(defclass hemlock-document-controller (ns:ns-document-controller)
     2213    ((last-encoding :foreign-type :<NSS>tring<E>ncoding))
     2214  (:metaclass ns:+ns-object))
     2215(declaim (special hemlock-document-controller))
     2216
     2217(objc:defmethod #/init ((self hemlock-document-controller))
     2218  (prog1
     2219      (call-next-method)
     2220    (setf (slot-value self 'last-encoding) 0)))
     2221
    22132222
    22142223;;; The HemlockEditorDocument class.
    … …  
    26892698
    26902699
    2691 (defclass hemlock-document-controller (ns:ns-document-controller)
    2692     ((last-encoding :foreign-type :<NSS>tring<E>ncoding))
    2693   (:metaclass ns:+ns-object))
    2694 
    2695 (objc:defmethod #/init ((self hemlock-document-controller))
    2696   (prog1
    2697       (call-next-method)
    2698     (setf (slot-value self 'last-encoding) 0)))
    2699 
    27002700(defun iana-charset-name-of-nsstringencoding (ns)
    27012701  (#_CFStringConvertEncodingToIANACharSetName
    … …  
    27132713;;; (localized) name of each encoding.
    27142714(defun supported-nsstring-encodings ()
    2715   (collect ((ids))
     2715  (ccl::collect ((ids))
    27162716    (let* ((ns-ids (#/availableStringEncodings ns:ns-string)))
    27172717      (unless (%null-ptr-p ns-ids)
    … …  
    28852885
    28862886(defun hi::edit-definition (name)
    2887   (let* ((info (get-source-files-with-types&classes name)))
     2887  (let* ((info (ccl::get-source-files-with-types&classes name)))
    28882888    (when (null info)
    28892889      (let* ((seen (list name))
    … …  
    28932893          (let ((sym (find-symbol pname pkg)))
    28942894            (when (and sym (not (member sym seen)))
    2895               (let ((new (get-source-files-with-types&classes sym)))
     2895              (let ((new (ccl::get-source-files-with-types&classes sym)))
    28962896                (when new
    28972897                  (setq info (append new info))
    … …  
    30233023               (typep arg 'pathname))
    30243024           (unless (probe-file arg)
    3025              (touch arg))
     3025             (ccl::touch arg))
    30263026           (with-autorelease-pool
    30273027             (let* ((url (pathname-to-url arg))
    … …  
    30473047                  +null-ptr+
    30483048                  t)))))
    3049           ((valid-function-name-p arg)
     3049          ((ccl::valid-function-name-p arg)
    30503050           (hi::edit-definition arg))
    3051           (t (report-bad-arg arg '(or null string pathname (satisifies valid-function-name-p)))))
     3051          (t (report-bad-arg arg '(or null string pathname (satisfies ccl::valid-function-name-p)))))
    30523052    t))
    30533053
    30543054(setq ccl::*resident-editor-hook* 'cocoa-edit)
    30553055
    3056 (provide "COCOA-EDITOR")

  • branches/ia32/cocoa-ide/cocoa-grep.lisp

    r7666 r8372  
    1 ; -*- Mode: Lisp; Package: CCL; -*-
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
    24
    3 (in-package "CCL")
     5(in-package "GUI")
    46
    57(defvar *grep-program* "grep")
    … …  
    112114                                           "--no-messages"
    113115                                           "-e" pattern
    114                                            (native-untranslated-namestring directory)))
     116                                           (ccl::native-untranslated-namestring directory)))
    115117                              :input nil
    116118                              :output stream)))

  • branches/ia32/cocoa-ide/cocoa-inspector.lisp

    r6952 r8372  
    1 (in-package "CCL")
     1;;;-*-Mode: LISP; Package: GUI -*-
     2
     3(in-package "GUI")
    24
    35#|
    … …  
    5557|#
    5658
    57 (require "COCOA")
    58 
    5959;;; This is useful when @ won't work, dynamically creating a NSString
    6060;;; pointer from a string.
    6161
    6262(defun nsstringptr (string)
    63   (objc-constant-string-nsstringptr
    64    (ns-constant-string string)))
     63  (ccl::objc-constant-string-nsstringptr
     64   (ccl::ns-constant-string string)))
    6565
    6666#+old

  • branches/ia32/cocoa-ide/cocoa-listener.lisp

    r7666 r8372  
    1 ;;-*- Mode: LISP; Package: CCL -*-
    2 
    3 (in-package "CCL")
    4 
    5 (eval-when (:compile-toplevel :load-toplevel :execute)
    6   (require "COCOA-EDITOR")
    7   (require "PTY"))
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
     4
     5(in-package "GUI")
    86
    97(def-cocoa-default *listener-input-font* :font #'(lambda ()
    … …  
    6159
    6260(defun new-cocoa-listener-process (procname input-fd output-fd peer-fd window buffer)
    63   (let* ((input-stream (make-selection-input-stream
     61  (let* ((input-stream (ccl::make-selection-input-stream
    6462                        input-fd
    6563                        :peer-fd peer-fd
    … …  
    6866                                              #$_PC_MAX_INPUT)
    6967                        :encoding :utf-8))
    70          (output-stream (make-fd-stream output-fd :direction :output
    71                                         :sharing :lock
    72                                         :elements-per-buffer
    73                                         (#_fpathconf
    74                                          output-fd
    75                                          #$_PC_MAX_INPUT)
    76                                         :encoding :utf-8))
    77          (peer-stream (make-fd-stream peer-fd :direction :output
    78                                       :sharing :lock
    79                                       :elements-per-buffer
    80                                       (#_fpathconf
    81                                          peer-fd
    82                                          #$_PC_MAX_INPUT)
    83                                       :encoding :utf-8))
     68         (output-stream (ccl::make-fd-stream output-fd :direction :output
     69                                             :sharing :lock
     70                                             :elements-per-buffer
     71                                             (#_fpathconf
     72                                              output-fd
     73                                              #$_PC_MAX_INPUT)
     74                                             :encoding :utf-8))
     75         (peer-stream (ccl::make-fd-stream peer-fd :direction :output
     76                                           :sharing :lock
     77                                           :elements-per-buffer
     78                                           (#_fpathconf
     79                                            peer-fd
     80                                            #$_PC_MAX_INPUT)
     81                                           :encoding :utf-8))
    8482         (proc
    85           (make-mcl-listener-process
     83          (ccl::make-mcl-listener-process
    8684           procname
    8785           input-stream
    8886           output-stream
    89            #'(lambda ()`
     87           #'(lambda ()
    9088               (let* ((buf (find *current-process* hi:*buffer-list*
    9189                                 :key #'hi::buffer-process))
    … …  
    10098           :initial-function
    10199           #'(lambda ()
    102                (setq *listener-autorelease-pool* (create-autorelease-pool))
    103                (listener-function))
     100               (setq ccl::*listener-autorelease-pool* (create-autorelease-pool))
     101               (ccl::listener-function))
    104102           :class 'cocoa-listener-process)))
    105103    (setf (slot-value proc 'input-stream) input-stream)
    … …  
    114112    ()
    115113  (:metaclass ns:+ns-object))
     114(declaim (special hemlock-listener-frame))
    116115
    117116
    … …  
    125124  (:metaclass ns:+ns-object)
    126125  )
    127 
     126(declaim (special hemlock-listener-window-controller))
    128127
    129128;;; Listener documents are never (or always) ediited.  Don't cause their
    … …  
    184183      (let* ((total (+ n data-length)))
    185184        (multiple-value-bind (nchars noctets-used)
    186             (funcall (character-encoding-length-of-memory-encoding-function encoding)
     185            (funcall (ccl::character-encoding-length-of-memory-encoding-function encoding)
    187186                     xlate
    188187                     total
    189188                     0)
    190189          (let* ((string (make-string nchars)))
    191             (funcall (character-encoding-memory-decode-function encoding)
     190            (funcall (ccl::character-encoding-memory-decode-function encoding)
    192191                     xlate
    193192                     noctets-used
    … …  
    235234    ()
    236235  (:metaclass ns:+ns-object))
     236(declaim (special hemlock-listener-document))
    237237
    238238(defmethod update-buffer-package ((doc hemlock-listener-document) buffer)
    … …  
    413413
    414414(defun restarts-controller-for-context (context)
    415   (or (car (bt.restarts context))
    416       (setf (car (bt.restarts context))
    417             (let* ((tcr (bt.tcr context))
     415  (or (car (ccl::bt.restarts context))
     416      (setf (car (ccl::bt.restarts context))
     417            (let* ((tcr (ccl::bt.tcr context))
    418418                   (tsp-range (inspector::make-tsp-stack-range tcr context))
    419419                   (vsp-range (inspector::make-vsp-stack-range tcr context))
    420420                   (csp-range (inspector::make-csp-stack-range tcr context))
    421                    (process (tcr->process (bt.tcr context))))
     421                   (process (context-process context)))
    422422              (make-instance 'sequence-window-controller
    423                              :sequence (cdr (bt.restarts context))
     423                             :sequence (cdr (ccl::bt.restarts context))
    424424                             :result-callback #'(lambda (r)
    425425                                                  (process-interrupt
    … …  
    435435                                            (process-name process)
    436436                                            (process-serial-number process)
    437                                             (bt.break-level context)))))))
     437                                            (ccl::bt.break-level context)))))))
    438438                           
    439439(objc:defmethod (#/restarts: :void) ((self hemlock-listener-document) sender)
    … …  
    482482              t
    483483              (and context
    484                    (find 'continue (cdr (bt.restarts context))
     484                   (find 'continue (cdr (ccl::bt.restarts context))
    485485                         :key #'restart-name)))))
    486486          ((or (eql action (@selector #/backtrace:))
    … …  
    548548
    549549(defun hemlock::evaluate-input-selection (selection)
    550   (application-ui-operation *application* :eval-selection selection))
     550  (ccl::application-ui-operation *application* :eval-selection selection))
    551551 
    552552(defmethod ui-object-choose-listener-for-selection ((app ns:ns-application)

  • branches/ia32/cocoa-ide/cocoa-prefs.lisp

    r7666 r8372  
    1 ;;;-*-Mode: LISP; Package: CCL -*-
     1;;;-*-Mode: LISP; Package: GUI -*-
    22;;;
    33;;;   Copyright (C) 2004 Clozure Associates
    … …  
    1515;;;   http://opensource.franz.com/preamble.html
    1616
    17 (in-package "CCL")
    18 
    19 (eval-when (:compile-toplevel :execute)
    20   (use-interface-dir :cocoa))
    21 
     17(in-package "GUI")
    2218
    2319(defloadvar *lisp-preferences-panel* nil)
    … …  
    4440  (#/displayName (make-instance ns:ns-font
    4541                                :with-name value
    46                                 :size (float 12.0 +cgfloat-zero+))))
     42                                :size (cgfloat 12.0))))
    4743
    4844
    … …  
    5147    ()
    5248  (:metaclass ns:+ns-object))
     49(declaim (special lisp-preferences-window-controller))
    5350
    5451(objc:defmethod (#/fontPanelForDefaultFont: :void)

  • branches/ia32/cocoa-ide/cocoa-typeout.lisp

    r7666 r8372  
    1 (in-package "CCL")
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
    24
    3 (eval-when (:compile-toplevel :execute)
    4   (use-interface-dir :cocoa))
     5(in-package "GUI")
    56
    67;;
    … …  
    1011;; the window is implicitly bound to a stream, and text written to
    1112;; the stream is written into the text-view object. The stream is
    12 ;; available via the function (ccl::typeout-stream)
     13;; available via the function (gui::typeout-stream)
    1314;;
    1415
    … …  
    1920   (text-view :foreign-type :id :reader typeout-view-text-view))
    2021  (:metaclass ns:+ns-object))
     22(declaim (special typeout-view))
    2123
    2224(defclass typeout-text-view (ns:ns-text-view)
    2325    ()
    2426  (:metaclass ns:+ns-object))
     27(declaim (special typeout-text-view))
    2528
    2629(objc:defmethod (#/clearAll: :void) ((self typeout-text-view))
    … …  
    7780    ((typeout-view :foreign-type :id :accessor typeout-window-typeout-view))
    7881  (:metaclass ns:+ns-object))
     82(declaim (special typeout-window))
    7983
    8084(defloadvar *typeout-windows* ())

  • branches/ia32/cocoa-ide/cocoa-utils.lisp

    r7666 r8372  
    1 ; -*- Mode: Lisp; Package: CCL; -*-
     1; -*- Mode: Lisp; Package: GUI; -*-
    22
    3 (in-package "CCL")
    4 
    5 (eval-when (:compile-toplevel :execute)
    6   (use-interface-dir :cocoa))
     3(in-package "GUI")
    74
    85(defclass sequence-window-controller (ns:ns-window-controller)
    … …  
    6158                                            notification)
    6259  (declare (ignore notification))
     60  (#/setDataSource: (slot-value self 'table-view) +null-ptr+)
    6361  (#/autorelease self))
    6462
    … …  
    10199                 (%make-nsstring (native-translated-namestring pathname))))
    102100
     101(defun cgfloat (number)
     102  (float number ccl::+cgfloat-zero+))
     103
    103104(defun color-values-to-nscolor (red green blue alpha)
    104105  (#/colorWithCalibratedRed:green:blue:alpha: ns:ns-color
    105                                               (float red +cgfloat-zero+)
    106                                               (float green +cgfloat-zero+)
    107                                               (float blue +cgfloat-zero+)
    108                                               (float alpha +cgfloat-zero+)))
     106                                              (cgfloat red)
     107                                              (cgfloat green)
     108                                              (cgfloat blue)
     109                                              (cgfloat alpha)))
    109110
    110111(defun windows ()

  • branches/ia32/cocoa-ide/cocoa-window.lisp

    r7666 r8372  
    1 ;;;-*-Mode: LISP; Package: CCL -*-
     1;;;-*-Mode: LISP; Package: GUI -*-
    22;;;
    3 ;;;   Copyright (C) 2002-2003 Clozure Associates
     3;;;   Copyright (C) 2002-2007 Clozure Associates
    44;;;   This file is part of OpenMCL. 
    55;;;
    … …  
    1616
    1717
    18 (in-package "CCL")                      ; for now.
     18(in-package "GUI")
    1919
    2020(eval-when (:compile-toplevel :load-toplevel :execute)
    21   (require "OBJC-SUPPORT")
    22   ;;
    23   ;;  this stuff should all be integrated with a preferences file in ~/Library/OpenMCL/
    24   ;; (Um, it -is- integrated with the preferences file.)
    25   ;;
    26   (require "COCOA-DEFAULTS")
    2721  (def-cocoa-default *default-font-name* :string "Courier" "Name of font to use in editor windows")
    2822  (def-cocoa-default *default-font-size* :float 12.0f0 "Size of font to use in editor windows, as a positive SINGLE-FLOAT")
    29   (def-cocoa-default *tab-width* :int 8 "Width of editor tab stops, in characters")
    30   (require "COCOA-PREFS")
    31   (require "COCOA-TYPEOUT"))
    32 
    33 (eval-when (:compile-toplevel :execute)
    34   (use-interface-dir #+apple-objc  :cocoa #+gnu-objc :gnustep))
    35 
     23  (def-cocoa-default *tab-width* :int 8 "Width of editor tab stops, in characters"))
    3624
    3725(defun init-cocoa-application ()
    … …  
    115103(defparameter *event-process-reported-conditions* () "Things that we've already complained about on this event cycle.")
    116104
    117 (defmethod process-debug-condition ((process appkit-process) condition frame-pointer)
     105(defmethod ccl::process-debug-condition ((process appkit-process) condition frame-pointer)
    118106  "Better than nothing.  Not much better."
    119107  (when *debug-in-event-process*
    120     (let* ((c (if (typep condition 'ns-lisp-exception)
    121                 (ns-lisp-exception-condition condition)
     108    (let* ((c (if (typep condition 'ccl::ns-lisp-exception)
     109                (ccl::ns-lisp-exception-condition condition)
    122110                condition)))
    123111      (unless (member c *event-process-reported-conditions*)
    … …  
    125113        (catch 'need-a-catch-frame-for-backtrace
    126114          (let* ((*debug-in-event-process* nil)
    127                  (context (new-backtrace-info nil
    128                                               frame-pointer
    129                                               (if *backtrace-contexts*
    130                                                 (or (child-frame
    131                                                      (bt.youngest (car *backtrace-contexts*))
    132                                                      nil)
    133                                                     (last-frame-ptr))
    134                                                 (last-frame-ptr))
    135                                               (%current-tcr)
    136                                               condition
    137                                               (%current-frame-ptr)
    138                                               #+ppc-target *fake-stack-frames*
    139                                               #+x86-target (%current-frame-ptr)
    140                                               (db-link)
    141                                               (1+ *break-level*)))
    142                  (*backtrace-contexts* (cons context *backtrace-contexts*))) 
     115                 (context (ccl::new-backtrace-info nil
     116                                                   frame-pointer
     117                                                   (if ccl::*backtrace-contexts*
     118                                                       (or (ccl::child-frame
     119                                                            (ccl::bt.youngest (car ccl::*backtrace-contexts*))
     120                                                            nil)
     121                                                           (ccl::last-frame-ptr))
     122                                                       (ccl::last-frame-ptr))
     123                                                   (ccl::%current-tcr)
     124                                                   condition
     125                                                   (ccl::%current-frame-ptr)
     126                                                   #+ppc-target ccl::*fake-stack-frames*
     127                                                   #+x86-target (ccl::%current-frame-ptr)
     128                                                   (ccl::db-link)
     129                                                   (1+ ccl::*break-level*)))
     130                 (ccl::*backtrace-contexts* (cons context ccl::*backtrace-contexts*))) 
    143131            (format t "~%~%*** Error in event process: ~a~%~%" condition)
    144132            (print-call-history :context context :detailed-p t :count 20 :origin frame-pointer)
    … …  
    185173
    186174
    187 (defmethod process-exit-application ((process appkit-process) thunk)
    188   (when (eq process *initial-process*)
     175(defmethod ccl::process-exit-application ((process appkit-process) thunk)
     176  (when (eq process ccl::*initial-process*)
    189177    (%set-toplevel thunk)
    190178    (#/terminate: *NSApp* +null-ptr+)))
    … …  
    212200                                 #'(lambda ()
    213201                                     (loop
    214                                        (%nanosleep *periodic-task-seconds*
    215                                                    *periodic-task-nanoseconds*)
    216                                        (housekeeping))))
     202                                       (ccl::%nanosleep ccl::*periodic-task-seconds*
     203                                                        ccl::*periodic-task-nanoseconds*)
     204                                       (ccl::housekeeping))))
    217205           
    218206           (with-autorelease-pool
    … …  
    222210               (unless (%null-ptr-p icon)
    223211                 (#/setApplicationIconImage: *NSApp* icon)))
    224              (setf (application-ui-object *application*) *NSApp*)
     212             (setf (ccl::application-ui-object *application*) *NSApp*)
    225213             (when application-proxy-class-name
    226                (let* ((classptr (%objc-class-classptr
    227                                  (load-objc-class-descriptor application-proxy-class-name)))
     214               (let* ((classptr (ccl::%objc-class-classptr
     215                                 (ccl::load-objc-class-descriptor application-proxy-class-name)))
    228216                      (instance (#/init (#/alloc classptr))))
    229217
    … …  
    257245                          (attributes ()))
    258246                               
    259   (setq size (float size +cgfloat-zero+))
     247  (setq size (cgfloat size))
    260248  (with-cstrs ((name name))
    261249    (with-autorelease-pool
    … …  
    298286    (#/setTabStops: p (#/array ns:ns-array))
    299287    ;; And set the "default tab interval".
    300     (#/setDefaultTabInterval: p (float (* *tab-width* charwidth) +cgfloat-zero+))
     288    (#/setDefaultTabInterval: p (cgfloat (* *tab-width* charwidth)))
    301289    p))
    302290   

  • branches/ia32/cocoa-ide/cocoa.lisp

    r7666 r8372  
    11(in-package "CCL")
    2 
    3 ;;; We need to be able to point the CoreFoundation and Cocoa libraries
    4 ;;; at some bundle very early in the process, so do that before anything
    5 ;;; else.
    6 ;;;
    7 ;;; If you're using this file to load something other than the IDE,
    8 ;;; you might want to change create-ide-bundle...
    92
    103(defvar *cocoa-application-path* "ccl:temp bundle.app;")
    114(defvar *cocoa-application-copy-headers-p* nil)
    12 
    13 (defun create-ide-bundle (bundle-path &key (source "ccl:cocoa-ide;ide-contents;")
    14                                            (source-ignore '(".svn" "cvs" ".cvsignore"))
    15                                            (copy-headers *cocoa-application-copy-headers-p*)
    16                                            (if-exists :overwrite))
    17   ;; TODO: Right now if the bundle exists, we leave alone any files that we don't replace.
    18   ;; I'd like :if-exists :supersede mean to remove such files, for clean builds, but
    19   ;; recursive-copy-directory doesn't support :if-exists :supersede yet...
    20   (flet ((subdir (dir sub)
    21            (ensure-directory-pathname (make-pathname :name sub :defaults dir)))
    22          (ignore-test (p)
    23            (flet ((backup-p (name)
    24                     (and (stringp name)
    25                          (let ((len (length name)))
    26                            (and (> len 0)
    27                                 (or (eql (aref name (1- len)) #\~)
    28                                     (eql (aref name 0) #\#)))))))
    29              (not (or (member (car (last (pathname-directory p))) source-ignore :test #'equalp)
    30                       (backup-p (pathname-name p))
    31                       (backup-p (pathname-type p))
    32                       (member (pathname-name p) source-ignore :test #'equalp))))))
    33     (let* ((source-dir (ensure-directory-pathname source))
    34            (target-dir (ensure-directory-pathname bundle-path))
    35            (contents-dir (subdir target-dir "Contents")))
    36       (recursive-copy-directory source-dir contents-dir :if-exists if-exists :test #'ignore-test)
    37       (when copy-headers
    38         (let* ((subdirs (cdb-subdirectory-path))
    39                (ccl-headers (make-pathname :host "ccl" :directory `(:absolute ,@subdirs)))
    40                (dest-headers (make-pathname :host (pathname-host contents-dir)
    41                                             :directory (append (pathname-directory contents-dir)
    42                                                                (cons "Resources" subdirs)))))
    43           (recursive-copy-directory ccl-headers dest-headers :if-exists if-exists :test #'ignore-test)))
    44       ;; Is this necessary?
    45       (let* ((image-name (standard-kernel-name))
    46              (ccl-image (make-pathname :name image-name :host "ccl"))
    47              (dest-image (make-pathname :name image-name
    48                                         :defaults (subdir contents-dir "MacOS"))))
    49         (ensure-directories-exist dest-image)
    50         (copy-file ccl-image dest-image :if-exists :supersede :preserve-attributes t))
    51       (touch target-dir))))
    52 
    53 #+darwin-target
    54 (progn
    55   (require "FAKE-CFBUNDLE-PATH")
    56   (create-ide-bundle *cocoa-application-path*)
    57   (fake-cfbundle-path *cocoa-application-path* "ccl:cocoa-ide;Info.plist-proto" "com.clozure"))
    58 
    59 
    60 (require "OBJC-SUPPORT")
    61 
    62 (if (< #&NSAppKitVersionNumber 824)
    63   (error "This application requires features introduced in OSX 10.4."))
    64 
    65 (defparameter *standalone-cocoa-ide* nil)
    66 
    67  
    68 (defvar *ide-files*
    69   '("cocoa-utils"
    70     "cocoa-defaults"
    71     "cocoa-prefs"
    72     "cocoa-typeout"
    73     "cocoa-window"
    74     "cocoa-doc"
    75     "cocoa-editor" ;; this loads hemlock
    76     "cocoa-listener"
    77     ;; tools
    78     "cocoa-grep"
    79     "cocoa-backtrace"
    80     "cocoa-inspector"
    81     "preferences"
    82     "processes-window"
    83     "apropos-window"
    84     "app-delegate"
    85     ))
    86 
    87 (defun load-ide (&optional force-compile)
    88   (with-compilation-unit ()
    89      (dolist (name *ide-files*)
    90        (let* ((source (merge-pathnames *.lisp-pathname* (make-pathname :name name :defaults "ccl:cocoa-ide;")))
    91               (fasl (merge-pathnames *.fasl-pathname* source)))
    92          (if (needs-compile-p fasl (list source) force-compile)
    93            (compile-file source :output-file fasl :verbose t :load t)
    94            (load fasl :verbose t))
    95          (provide (string-upcase name))))))
    96 
    97 (load-ide t)
    98 
    99 
    100 (def-cocoa-default *ccl-directory* :string "" nil #'(lambda (old new)
    101                                                       (when (equal new "") (setq new nil))
    102                                                       (unless (and new (equal old new))
    103                                                         (init-interfaces-root)
    104                                                         (replace-base-translation "ccl:"
    105                                                                                   (or new (find-ccl-directory))))))
    106 
    107 ;; If there are interfaces inside the bundle, use those rather than the ones
    108 ;; in CCL:, since they're more likely to be valid.  CCL: could be some random
    109 ;; sources we're just using just for meta-.
    110 (defun init-interfaces-root ()
    111   (let* ((subpath (cdb-subdirectory-path))
    112          (path (pathname-directory (ccl-directory))))
    113     (when (and *standalone-cocoa-ide*
    114                (equalp (last path 2) '("Contents" "MacOS")))
    115       (setq path (butlast path))
    116       (when (or (probe-file (make-pathname :directory (append path subpath)))
    117                 (probe-file (make-pathname :directory (append (setq path `(,@path "Resources")) subpath))))
    118         (setq *interfaces-root* (make-pathname :directory path))))))
    119 
    120 (defun find-ccl-directory ()
    121   (let* ((path (ccl-directory))
    122          (dir (pathname-directory path)))
    123     (if (equalp (last dir 2) '("Contents" "MacOS"))
    124         (make-pathname :directory (butlast dir 3))
    125         path)))
    126 
    127 (defmethod ui-object-do-operation ((o ns:ns-application)
    128                                    operation
    129                                    &rest args)
    130   (declare (ignore operation args))
    131   ;; Do nothing.  Would it be better to warn and/or log this ?
    132   )
    133 
    134 (defmethod ui-object-do-operation ((o ns:ns-application)
    135                                    (operation (eql :note-current-package))
    136                                    &rest args)
    137   (ui-object-note-package o (car args)))
    138 
    139 (defmethod ui-object-do-operation ((o ns:ns-application)
    140                                    (operation (eql :eval-selection))
    141                                    &rest args)
    142   (ui-object-eval-selection o (car args)))
    143 
    144 (defmethod ui-object-do-operation ((o ns:ns-application)
    145                                    (operation (eql :enter-backtrace-context))
    146                                    &rest args)
    147   (ui-object-enter-backtrace-context o (car args)))
    148 
    149 (defmethod ui-object-do-operation ((o ns:ns-application)
    150                                    (operation (eql :exit-backtrace-context))
    151                                    &rest args)
    152   (ui-object-exit-backtrace-context o (car args)))
    153 
    154 
    155 
    156 
    157 (start-cocoa-application)
    158 
     5(load "ccl:cocoa-ide;defsystem.lisp")
     6(load-ide)

  • branches/ia32/cocoa-ide/compile-hemlock.lisp

    r7666 r8372  
    104104  (provide "HEMLOCK")
    105105  )
     106
     107
     108(provide "COMPILE-HEMLOCK")

  • branches/ia32/cocoa-ide/hemlock/src/indent.lisp

    r7666 r8372  
    2222   everywhere in Hemlock yet, so do not change it."
    2323  :value 8)
     24
     25(defhvar "Indent with Tabs"
     26  "If true, indentation is done using a mixture of tabs and spaces.  If false,
     27   only spaces are used."
     28  :value nil)
     29
    2430
    2531(defun indent-using-tabs (mark column)
    … …  
    3642
    3743
    38 (defhvar "Indent with Tabs"
    39   "Function that takes a mark and a number of spaces and inserts tabs and spaces
    40    to indent that number of spaces using \"Spaces per Tab\"."
    41   :value #'indent-using-tabs)
    42 
    43 
    44 (defun tab-to-tab-stop (mark)
    45   (insert-character mark #\tab))
     44(defun indent-to-column (mark column)
     45  "Inserts whitespace to move MARK to COLUMN, assuming mark is at column 0"
     46  (if (value indent-with-tabs)
     47      (indent-using-tabs mark column)
     48      (indent-using-spaces mark column)))
     49
     50(defun indent-to-tab-stop (mark)
     51  (if (value indent-with-tabs)
     52      (insert-character mark #\tab)
     53      (let* ((tab (value spaces-per-tab)))
     54        (dotimes (i (- tab (mod (mark-column mark) tab)))
     55          (insert-character mark #\space)))))
    4656
    4757(defhvar "Indent Function"
    4858  "Indentation function which is invoked by \"Indent\" command.
    4959   It takes a :left-inserting mark that may be moved."
    50   :value #'tab-to-tab-stop)
     60  :value #'indent-to-tab-stop)
    5161
    5262
    … …  
    6171      (line-start mark line)
    6272      (delete-horizontal-space mark)
    63       (funcall (value indent-with-tabs) mark indentation))))
     73      (indent-to-column mark indentation))))
    6474
    6575
    … …  
    142152   it is used instead of the \"Fill Column\"."
    143153  "Centers current line using fill-column."
    144   (let* ((indent-function (value indent-with-tabs))
    145          (region (if (region-active-p)
     154  (let* ((region (if (region-active-p)
    146155                     (current-region)
    147156                     (region (current-point) (current-point))))
    … …  
    156165          (if (and (plusp spaces)
    157166                   (not (zerop len)))
    158               (funcall indent-function temp (ceiling spaces 2)))
     167              (indent-to-column temp (ceiling spaces 2)))
    159168          (unless (line-offset temp 1) (return))
    160169          (line-start temp))))))
    … …  
    290299                   (delete-characters mark1 (- (mark-charpos mark1)))
    291300                   (if (plusp new-column)
    292                        (funcall (value indent-with-tabs) mark1 new-column)))))
     301                       (indent-to-column mark1 new-column)))))
    293302        (line-offset mark1 1 0)))))

  • branches/ia32/cocoa-ide/hemlock/src/lispmode.lisp

    r7666 r8372  
    12451245            (t
    12461246             (delete-horizontal-space m)
    1247              (funcall (value indent-with-tabs) m col))))))
     1247             (indent-to-column m col))))))
    12481248
    12491249
    … …  
    17121712           (hack (make-empty-region)))
    17131713      ;; Generate prefix.
    1714       (funcall (value indent-with-tabs)
    1715                (region-end hack) (1+ (mark-column mark)))
     1714      (indent-to-column (region-end hack) (1+ (mark-column mark)))
    17161715      ;; Skip opening double quote and fill string starting on its own line.
    17171716      (mark-after mark)

  • branches/ia32/cocoa-ide/hemlock/src/listener.lisp

    r7362 r8372  
    103103      )
    104104    (let* ((input-mark (variable-value 'buffer-input-mark :buffer buffer)))
    105       (when ccl::*read-only-listener*
     105      (when gui::*read-only-listener*
    106106        (setf (hi::buffer-protected-region buffer)
    107107              (region (buffer-start-mark buffer) input-mark)))

  • branches/ia32/cocoa-ide/hemlock/src/macros.lisp

    r7666 r8372  
    560560  (let ((stream (gensym)))
    561561    `(let ()
    562        (let ((,stream (ccl::typeout-stream ,title)))
     562       (let ((,stream (gui::typeout-stream ,title)))
    563563         (clear-output ,stream)
    564564       (unwind-protect

  • branches/ia32/cocoa-ide/hemlock/src/symbol-completion.lisp

    r7666 r8372  
    103103
    104104(defmethod dabbrev-sources-in ((state (eql :other-buffers)) context)
    105   (let* ((buffers (mapcar #'window-buffer (ccl::ordered-hemlock-windows))))
     105  (let* ((buffers (mapcar #'window-buffer (gui::ordered-hemlock-windows))))
    106106    ;; Remove duplicates, always keeping the first occurance (frontmost window)
    107107    (loop for blist on buffers do (setf (cdr blist) (delete (car blist) (cdr blist))))

  • branches/ia32/cocoa-ide/preferences.lisp

    r7666 r8372  
    1 ;;;-*-Mode: LISP; Package: CCL -*-
     1;;;-*-Mode: LISP; Package: GUI -*-
    22;;;
    33;;;   Copyright (C) 2007 Clozure Associates
    4 ;;;   This file is part of OpenMCL. 
    54;;;
    6 ;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
    7 ;;;   License , known as the LLGPL and distributed with OpenMCL as the
    8 ;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
    9 ;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
    10 ;;;   conflict, the preamble takes precedence. 
    11 ;;;
    12 ;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
    13 ;;;
    14 ;;;   The LLGPL is also available online at
    15 ;;;   http://opensource.franz.com/preamble.html
    16 
    175;;; How to add a new preference pane:
    186;;;
    … …  
    3523;;; 8. Implement actions, if needed.
    3624
    37 (in-package "CCL")
    38 
    39 (eval-when (:compile-toplevel :execute)
    40   (use-interface-dir :cocoa))
     25
     26(in-package "GUI")
    4127
    4228;;; A view that keeps track of its initial size.

  • branches/ia32/cocoa-ide/processes-window.lisp

    r7666 r8372  
    1 (in-package "CCL")
     1;;;-*-Mode: LISP; Package: GUI -*-
     2;;;
     3;;;   Copyright (C) 2007 Clozure Associates
     4
     5(in-package "GUI")
    26
    37(defclass processes-window-controller (ns:ns-window-controller)

  • branches/ia32/examples/cocoa/currency-converter/HOWTO.html

    r7435 r8372  
    1515    <div class="subtitle">
    1616      <h2>Creating Apple's <a
    17       href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/chapter01/chapter_1_section_1.html">
     17      href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/index.html">
    1818            Currency Converter</a> example<br/>
    19           with OpenMCL
     19          with Clozure CL
    2020      </h2></div>
    2121
    … …  
    3131
    3232    <div class="body-text">
    33       <p>This HOWTO guide explains how to use OpenMCL to create a
    34       Cocoa application that is functionally identical to Apple's
     33      <p>This HOWTO guide explains how to use Clozure CL (formerly
     34      OpenMCL) to create a Cocoa application that is functionally
     35      identical to Apple's
    3536      <a
    36       href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/chapter01/chapter_1_section_1.html">
     37      href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/index.html">
    3738        Currency Converter</a> example. The most important
    3839        difference between Apple's example and this one is that this
    3940        one is implemented in Common Lisp instead of Objective C. It
    40         uses OpenMCL's Objective-C bridge to provide communication
     41        uses Clozure CL's Objective-C bridge to provide communication
    4142        between the Lisp code that you write and Apple's Cocoa
    4243        frameworks. The resulting application looks and acts just
    … …  
    4748      Apple's document handy for reference, and we just describe the
    4849      specific steps needed to build the example using
    49       Apple's InterfaceBuilder application and OpenMCL.</p>
     50      Apple's InterfaceBuilder application and Clozure CL.</p>
    5051
    51       <p>The current version of the OpenMCL Objective-C bridge
     52      <p>The current version of the Clozure CL Objective-C bridge
    5253      includes code that was formerly distributed separately as the
    5354      "Bosco" application framework. Because that framework has been
    54       integrated with OpenMCL proper, it no longer exists as a
     55      integrated with Clozure CL proper, it no longer exists as a
    5556      separate project. "Bosco" now names only the decorative rodent
    5657      at the top of this page.</p>
    … …  
    6364    <div class="body-text">
    6465      <p>It will be helpful in understanding this example if you can
    65       easily refer to Apple's <a
    66       href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/chapter01/chapter_1_section_1.html">
    67         Currency Converter</a> example while working through this
     66      easily refer to
     67      Apple's <a href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/index.html">
     68      Currency Converter</a> tutorial while working through this
    6869      HOWTO. You might consider opening a separate window or tab, and
    6970      keeping the Apple example handy while you work.</p>
    … …  
    7374      same. In particular, the Lisp example follows the same
    7475      <a
    75       href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/chapter02/chapter_2_section_3.html#//apple_ref/doc/uid/20002050-TPXREF104">
    76         Model-View-Controller</a> paradigm that the Apple example
     76      href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/02Essence/chapter_2_section_4.html#//apple_ref/doc/uid/TP40000863-CH3-DontLinkElementID_6">
     77        Model-View-Controller</a> paradigm that the Apple tutorial
    7778        uses. If you are new to Cocoa programming, or if you are not
    7879        familiar with how it uses the Model-View-Controller paradigm,
    79         it's probably a good idea to read through the Apple example
    80         in full, paying special attention to the
    81         Model-View-Controller section. Once you've done that, keep
    82         the Apple pages handy in a window for easy reference.</p>
     80        it's probably a good idea to read through the Apple example in
     81        full, paying special attention to the Model-View-Controller
     82        section. Once you've done that, keep the Apple pages handy in
     83        a window for easy reference.</p>
    8384
    8485      <p>This Common Lisp version of the Currency Converter example
    8586      uses Apple's InterfaceBuilder application to build a window and
    8687      main menu, and then uses Common Lisp code to load and operate
    87       that user interface. The Common Lisp code relies on OpenMCL's
     88      that user interface. The Common Lisp code relies on Clozure CL's
    8889      Objective-C bridge to provide communication between the running
    8990      Lisp code and Apple's Cocoa frameworks. Once the code is
    … …  
    102103
    103104      <ul>
    104         <li><p>A PowerPC Mac (future versions of this HOWTO will also
    105         support Intel Macs)</p></li>
    106         <li><p>Mac OS X Tiger (version 10.4.x)</p></li>
     105        <li><p>Mac OS X Leopard (version 10.5.x) or Mac OS X Tiger
     106        (version 10.4.x)</p></li>
    107107        <li><p>Apple's XCode development tools</p></li>
    108108        <li><p>Apple's InterfaceBuilder application (included with XCode)</p></li>
    109         <li><p>A recent version of OpenMCL</p></li>
    110         <li><p>The OpenMCL Cocoa IDE (see <a href="HOWTO_files/pages/building_ide.html">this sidebar</a> for
    111         instructions on building it)</p></li>
     109        <li><p>A recent version of Clozure CL</p></li>
    112110        <li><p>The Apple <a
    113       href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/chapter01/chapter_1_section_1.html">
     111      href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/index.html">
    114112        Currency Converter</a> example, for reference</p></li>
    115113      </ul>

  • branches/ia32/examples/cocoa/currency-converter/HOWTO_files/pages/build_app.html

    r7435 r8372  
    1919      application bundle. Apple's tutorial relies on XCode to build
    2020      the application from Objective C source files; we will use the
    21       OpenMCL IDE to build it from our Lisp source file.</p>
     21      Clozure CL IDE to build it from our Lisp source file.</p>
    2222
    2323      <p>We build the application using the optional
    24       BUILD-APPLICATION feature, distributed as part of OpenMCL. The
     24      BUILD-APPLICATION feature, distributed as part of Clozure CL. The
    2525      steps to build the Cocoa application are:</p>
    2626
    … …  
    3131      </ul>
    3232
    33       <p>This sequence of steps causes OpenMCL to construct a Cocoa
     33      <p>This sequence of steps causes Clozure CL to construct a Cocoa
    3434      application bundle and write out the application executable to
    3535      it, then quit. If all goes well, you should be able to run the
    … …  
    4444    <div class="body-text">
    4545      <ol>
    46         <li><p>Launch the OpenMCL IDE. It's safest to build the
     46        <li><p>Launch the Clozure CL IDE. It's safest to build the
    4747        application with a fresh IDE session, so if you have it
    4848        running, you may wish to quit and relaunch before following
    … …  
    6666        <li><p>Run BUILD-APPLICATION (be sure to correct the pathname
    6767        to your CurrencyConverter nibfile. It is safest to use a full,
    68         absolute pathname):</p>
     68        absolute pathname&mdash;not the relative pathname you see
     69        below):</p>
    6970          <p><pre>
    7071(ccl::build-application :name "CurrencyConverter"
    … …  
    119120      <p>You'll notice when you run the application that, even though
    120121      you named it CurrencyConverter, the name in the main menu
    121       appears as "OpenMCL". That's because OS X takes the
     122      appears as "Clozure CL". That's because OS X takes the
    122123      application's name, not from the application bundle's name, nor
    123124      from the running code, but from an InfoPlist.strings file hidden
    … …  
    128129
    129130      <p>Find the entry named "CFBundleName" and change its value
    130       from "OpenMCL" to "CurrencyConverter". The application's name
     131      from "Clozure CL" to "CurrencyConverter". The application's name
    131132      in the main menu bar should now appear correctly, as
    132133      "CurrencyConverter". You may also want to change the other

  • branches/ia32/examples/cocoa/currency-converter/HOWTO_files/pages/building_ui.html

    r7435 r8372  
    1717      converter application is to construct the user
    1818      interface. Apple's
    19       tutorial <a href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/chapter03/chapter_3_section_1.html">
     19      tutorial <a href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/05View/chapter_5_section_1.html#//apple_ref/doc/uid/TP40000863-CH7-SW1">
    2020      describes in detail</a> how to do this.</p>
     21
     22<div class="section-head">
     23  <h2>Apple's Tutorial</h2>
     24</div>
    2125
    2226<p>Apple's tutorial explains how to use InterfaceBuilder to create the
    … …  
    2630  the part of the tutorial that explains how to use XCode.</p>
    2731
    28 <p>Begin by launching InterfaceBuilder, which you will find in the
    29   "/Developer/Applications/" folder. Create a new nibfile by using
    30   InterfaceBuilder's "Starting Point" dialog. If the "Starting Point"
    31   dialog doesn't appear when you launch InterfaceBuilder, you can
    32   display it by choosing "New" from the File menu. Choose "Cocoa
    33   Application", and click the "New" button to create the
    34   nibfile.</p>
    35 
    36     <div class="subtitle">
    37       <img src="../images/ibwin1.jpg"alt=""
    38            border='0'/>
    39     </div>
    40 
    41 
    42 <p>Save the nibfile in your "currency-converter" folder. Name it
    43   "CurrencyConverter.nib". Apple's tutorial names it "MainMenu.nib",
    44   but we won't use that name. When building an application with
    45   OpenMCL, we gradually change the behavior of the OpenMCL application
    46   until it behaves the way we want for our application. OpenMCL's IDE
    47   already has a nibfile built into it with the name "MainMenu.nib",
    48   and if we wanted to use that name for the CurrencyConverter
    49   application, we would have to replace OpenMCL's "MainMenu.nib". It's
    50   generally a good idea to avoid destroying or replacing things unless
    51   you really have to, so, in order to preserve the OpenMCL nibfile,
    52   give yours the name "CurrencyConverter.nib".</p>
    53 
    54 <p>Now you can use this nibfile to create your application's user
    55   interface. When Apple's tutorial tells you to find and open the main
    56   nibfile created by XCode, use your "CurrencyConverter.nib"
    57   instead.</p>
     32<div class="section-head">
     33  <h2>Using InterfaceBuilder to Create the UI</h2>
     34</div>
     35
     36      <p>We'll begin by using Apple's InterfaceBuilder application to
     37        create a nibfile. The nibfile contains
     38        archived versions of the Objective C objects that define the
     39        application's user interface. When you launch an application,
     40        Mac OS X uses the archived objects in the nibfile to create the
     41        windows and menus you see on the screen. </p>
     42
     43      <p>Start by locating Apple's InterfaceBuilder application. If
     44        you installed Apple's Developer Tools, InterfaceBuilder should
     45        be in the folder "/Developer/Applications/":</p>
     46
     47      <div class="inline-image">
     48        <img src="../images/finder-win1.jpg"alt=""
     49             border='0'/>
     50      </div>
     51     
     52
     53      <p class= "note"><strong><em>NOTE:</em></strong> If you have not installed Apple's Developer Tools, you should
     54        do that now. You will not be able to build the CurrencyConverter
     55        example without them. The Developer Tools are distributed as an
     56        optional install with Mac OS X 10.5 ("Leopard"). Look for the
     57        "XCode Tools" package in the "Optional Installs" folder on the
     58        Mac OS 10.5 install disk.</p>
     59
     60      <p>Once you have located InterfaceBuilder, double-click to launch
     61        the application. InterfaceBuilder presents a window you can use
     62        to choose a template for the nibfile you are going to create.</p>
     63
     64      <div class="inline-image">
     65        <img src="../images/ibwin-leopard1.jpg"alt=""
     66             border='0'/>
     67      </div>
     68
     69      <p>Click the "Application" icon and then click the "Choose" button to
     70        create an application nibfile. InterfaceBuilder creates a new
     71        application nibfile, but doesn't immediately save it. The
     72        Objective C objects that represent the new application's
     73        interface appear in a new untitled window:</p>
     74
     75      <div class="inline-image">
     76        <img src="../images/ibwin-leopard2.jpg"alt=""
     77             border='0'/>
     78      </div>
     79
     80      <p>The intial window and menubar also appear on the screen. The
     81      new application's name appears in the menus as
     82      "NewApplication". Save the new nibfile into the
     83      "currency-converter" folder that you created earlier
     84      (on <a href="making_project.html">this
     85      page</a>). InterfaceBuilder 3.0 gives you a choice of file
     86      formats when you save a new nibfile; use the "NIB 3.x"
     87      format&mdash;the "XIB 3.x" format works fine for editing your
     88      user interface, but will not work correctly if you try to use it
     89      in a working application. Give the new file the name
     90      "CurrencyConverter.nib".</p>
     91
     92      <div class="note">
     93        <p><strong><em>NOTE:</em></strong> Most Objective C application projects use a main
     94        nibfile called "MainMenu.nib", and if you use XCode to create
     95        a new application project, it creates a nibfile with that
     96        name. Apple's CurrencyConverter tutorial assumes that the
     97        name of the main nibfile is "MainMenu.nib".</p>
     98
     99        <p>So, why do we tell you to use a different name? Clozure CL
     100          has a main nibfile built into it, whose name is
     101          "MainMenu.nib". Normally you don't see it, and don't even
     102          need to know that it exists. But the Clozure CL
     103          application-building tools create a new application by
     104          copying resources from the Clozure CL application, so that
     105          your new application has available to it all the built-in
     106          Clozure CL tools. We ask you to name your nibfile
     107          "CurrencyConverter.nib" so that it can coexist with the
     108          Clozure CL main nibfile without causing any problems.</p>
     109
     110        <p>This difference between a Lisp project and an Objective C
     111        project might be a little confusing at first. Just try to keep
     112        in mind that whenever Apple's tutorial refers to the
     113        "MainMenu.nib" file, it means the file we have just created
     114        and named "CurrencyConverter.nib". In a Clozure CL project,
     115        "MainMenu.nib" is the name of the main Lisp nibfile, not your
     116        application's main nibfile.</p>
     117      </div>
     118
    58119
    59120<p>Skip straight to the part of Apple's tutorial
    60 called <a href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/chapter03/chapter_3_section_3.html">Creating
    61 the Currency Converter Interface</a>. Read the introduction to
     121called <a href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/05View/chapter_5_section_1.html#//apple_ref/doc/uid/TP40000863-CH7-SW1">Defining
     122    the View: Building the User Interface</a>. Read
     123  the introduction to
    62124nibfiles, and follow the instructions to create the Currency Converter
    63125interface. (Remember that when the tutorial tells you to open and edit
    64126"MainMenu.nib", you will instead open and edit your
    65127"CurrencyConverter.nib".) When you reach the end of the section
    66 called <a href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/chapter03/chapter_3_section_6.html">Defining
    67 the Converter Class</a>, you are done creating the interface for your
    68 application. Save your nibfile and continue with the next section of
    69 this HOWTO, on writing the Lisp code that provides the application's
    70 behavior.</p>
    71 
    72 <p></p>
    73      
     128called <a href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/05View/chapter_5_section_5.html#//apple_ref/doc/uid/TP40000863-CH7-DontLinkElementID_38">Test
     129    the Interface</a>, and move on to the short section afterward
     130  called <a href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/05View/chapter_5_section_6.html#//apple_ref/doc/uid/TP40000863-CH7-DontLinkElementID_39">What's Next</a>,
     131  you are done creating the interface for your
     132application. Save your nibfile and continue with the next section.</p>
     133
     134<div class="section-head">
     135  <h2>What if You Need to Use InterfaceBuilder 2.x?</h2>
     136</div>
     137
     138<p>If you are still using Mac OS X 10.4.x ("Tiger"), you can still
     139  create a working nibfile and you can still follow the instructions
     140  in this HOWTO to create a Cocoa application with Clozure CL. The
     141  main obstacle to doing so is that the earlier versions of
     142  InterfaceBuilder have a significantly different user interface, and
     143  so you may find it hard to follow Apple's tutorial when working with
     144  InterfaceBuilder.</p>
     145
     146<p>If you are working with Mac OS X 10.4.x ("Tiger"), you can
     147  look <a href="building_ui_tiger.html">here</a> to find a description
     148  of how to build the user interface files with the earlier version of
     149  InterfaceBuilder. When you have finished building your user
     150  interface, you can continue with the <a href="create_lisp.html">next
     151  section</a>, "Creating a Lisp File".</p>
     152
     153<p>One other thing: if you are using Mac OS X 10.4.x ("Tiger"), you
     154  will be able to build Cocoa applications only on PPC Macs. The
     155  Clozure CL Objective C support for Intel systems works only on Mac
     156  OS X 10.5.x ("Leopard").</p>
     157
     158
     159<div class="section-head">
     160  <h2>Adding Custom Classes to the nibfile</h2>
     161</div>
     162
     163<p>Once the user interface for your application looks right, there is
     164  still one important task to complete before you can use it. You must
     165  record some information in the nibfile about the classes of the
     166  objects, so that the application can create them with the right
     167  connections in place.</p>
     168
     169<p>When you use XCode to write an Objective C application,
     170  InterfaceBuilder can read the Objective C header files and use the
     171  information in them to create descriptions of the classes in the
     172  Objective C code. When the application is written in Lisp,
     173  InterfaceBuilder can't read the class descriptions from the code,
     174  and so we'll have to manually tell the nibfile about any classes
     175  that we use in the user interface.</p>
     176
     177<p>As you will see in the following sections, we'll use Lisp code to
     178  define two Objective C classes: Converter, and
     179  ConverterController. The Converter class implements the method that
     180  performs the actual currency conversion for our application; the
     181  ConverterController class provides communication between the user
     182  interface and the Converter object. We need a way to create instaces
     183  of these two classes in the nibfile, so that launching the
     184  application creates these instances and the connections between them
     185  and the rest of the user interface.</p>
     186
     187<div class="section-head">
     188  <h2>Create Instances of Custom Classes</h2>
     189</div>
     190
     191<p>In InterfaceBuilder's Library window, select the Cocoa Objects and
     192  Controllers view:</p>
     193
     194      <div class="inline-image">
     195        <img src="../images/ibwin-leopard3.jpg"alt=""
     196             border='0'/>
     197      </div>
     198
     199<p>Drag an Object from the Library window and drop it into the main
     200  CurrencyConverter window:</p>
     201
     202      <div class="inline-image">
     203        <img src="../images/ibwin-leopard4.jpg"alt=""
     204             border='0'/>
     205      </div>
     206
     207<p>Now tell InterfaceBuilder the name of the new object's class. With
     208  the Object icon selected in the main CurrencyConverter window,
     209  choose the Identity tab of the Inspector. At the top of the
     210  Identity view is a "Class" field; type the name of your custom
     211  class (in this case, "Converter") into the "Class" field and save
     212  the nibfile:</p>
     213
     214      <div class="inline-image">
     215        <img src="../images/ibwin-leopard5.jpg"alt=""
     216             border='0'/>
     217      </div>
     218
     219<p>Repeat the previous steps to create an instance of the
     220  ConverterController class: drag an "Object" icon and drop it in the
     221  main CurrencyConverter window. Then, change the name of the
     222  Object's class to "ConverterController".</p>
     223
     224<p>That's all it takes to add an instance of a custom class to the
     225  nibfile. We do still have to add the names of instance variables and
     226  actions, and we need to create the connections between the
     227  instances.</p>
     228
     229<div class="section-head">
     230  <h2>Add Outlets and Actions</h2>
     231</div>
     232
     233<p>Now, using the "+" button below the "Class Outlets" section of the
     234  Inspector, add outlets to the ConverterController class. The
     235  outlets you need to add are named "amountField", "converter",
     236  "dollarField", and "rateField".</p>
     237
     238      <div class="inline-image">
     239        <img src="../images/ibwin-leopard6.jpg"alt=""
     240             border='0'/>
     241      </div>
     242
     243<p>We'll connect each of the "field" outlets to one of the text
     244  fields in the CurrencyConverter UI, and we'll connect the
     245  "converter" outlet to the Converter instance that we created
     246  before. When the application launches, it creates the Converter and
     247  ConverterController instances and establishes the connections that
     248  we specify in the nibfile.</p>
     249
     250
     251<p>First, though, we need to tell the nibfile about actions as well as
     252  outlets. With the "ConverterController" instance selected, use the
     253  "+" button below the "Class Actions" section to add a new
     254  action. Name the action "convert:":</p>
     255
     256      <div class="inline-image">
     257        <img src="../images/ibwin-leopard7.jpg"alt=""
     258             border='0'/>
     259      </div>
     260
     261<p>In this application, the "convert:" action is the only action
     262  defined for the user interface, so we are done with actions now. In
     263  more complex applications you may need to define many actions and
     264  outlets.</p>
     265
     266<p>Now we'll connect outlets to objects and actions.</p>
     267
     268<div class="section-head">
     269  <h2>Add Connections</h2>
     270</div>
     271
     272<p>InterfaceBuilder enables you to connect objects by
     273  "Control-dragging" from one to another. To "Control-drag", you hold
     274  down the Control key while dragging from one object to the next.</p>
     275
     276<p>Select the "ConverterController" instance in the nibfile's main
     277  window, and Control-drag a connection to the "Exchange rate" text
     278  field in the application's main window. (Be sure to connect to the
     279  text field, not to its label!) When you release the mouse button,
     280  InterfaceBuilder pops up a menu that lists the available
     281  outlets. Choose "rateField" from the menu. The "rateField" outlet of
     282  the "ConverterController" instance is now connected to the "Exchange
     283  rate" text field.</p>
     284
     285<p>Repeat the same steps for the "Dollars" field and the "Amount"
     286  field, connecting them to the "dollarField" and "amountField"
     287  outlets, respectively.</p>
     288
     289<p>Finally, Control-drag a connection from the "ConverterController"
     290  instance to the "Converter" instance. Choose "converter" from the
     291  popup menu to connect the "converter" field of the
     292  "ConverterController" instance to the "Converter" instance.</p>
     293
     294<p>To confirm that the connections are correct, you can use the
     295  Connections view in the inspector. With the "ConverterController"
     296  instance selected, click the blue arrow icon at the top of the
     297  Inspector window to display connections. You should see a list of
     298  outlets and the types of objects they are connected to:</p>
     299
     300      <div class="inline-image">
     301        <img src="../images/ibwin-leopard8.jpg"alt=""
     302             border='0'/>
     303      </div>
     304
     305<p>We need to add one more connection: from the "Convert" button in
     306  the application window to the "ConverterController"
     307  instance. Control drag a connection from the "Convert" button in the
     308  application window to the "ConverterController" instance in the
     309  nibfile's main window. InterfaceBuilder pops up a menu; choose the
     310  "convert:" action from the menu to connect the button to the
     311  action.</p>
     312
     313<p>The nibfile now contains descriptions of the needed cusstom
     314  classes and their connections. You can continue with the next
     315  section, which explains how to write the Lisp code that implements
     316  the application's behavior.</p>
     317
    74318    <div class="nav">
    75       <p><a href="../../HOWTO.html">start</a>|<a href="building_ui.html">previous</a>|<a href="create_lisp.html">next</a></p>
     319      <p><a href="../../HOWTO.html">start</a>|<a href="making_project.html">previous</a>|<a href="create_lisp.html">next</a></p>
    76320    </div>
    77321

  • branches/ia32/examples/cocoa/currency-converter/HOWTO_files/pages/conclusion.html

    r7435 r8372  
    1515    <div class="body-text">
    1616      <p>This concludes our HOWTO on building the Apple
    17       CurrencyConverter example in Lisp with OpenMCL. Your own Lisp
     17      CurrencyConverter example in Lisp with Clozure CL. Your own Lisp
    1818      applications are likely to be considerably more complex than the
    1919      Currency Converter, which, after all, just does a simpe
    … …  
    2929      standalone Cocoa applications.</p>
    3030
    31       <p>You should now be able to use OpenMCL to accomplish anything
     31      <p>You should now be able to use Clozure CL to accomplish anything
    3232      that an Objective C user can accomplish with Cocoa. Good luck!</p>
    3333

  • branches/ia32/examples/cocoa/currency-converter/HOWTO_files/pages/create_lisp.html

    r7435 r8372  
    2020      application to create and manage projects, to edit Objective C
    2121      source files, and to build the final application. In this HOWTO,
    22       Clozure's OpenMCL application takes the place of XCode. The
    23       Lisp project structure is much simpler than the XCode project
     22      the Clozure CL application takes the place of XCode. The Lisp
     23      project structure is much simpler than the XCode project
    2424      structure: to build the Lisp application we need only the
    2525      nibfile created in the previous section, and a single Lisp
    2626      source file.</p>
    2727     
    28       <p>Before you continue, make sure you have followed the
    29       instructions
    30       in <a href="HOWTO_files/pages/building_ide.html">this
    31       sidebar</a> on building the OpenMCL IDE. We'll use the IDE to
    32       create and load Lisp files.</p>
    33 
    34       <p>Once you have a working IDE, launch it by double-clicking
    35       the OpenMCL application. OpenMCL displays a Listener window:</p>
     28      <p>Double-click Clozure CL to launch it. Clozure CL displays a Listener window:</p>
    3629
    3730      <div class="subtitle">
    … …  
    5144
    5245    <div class="nav">
    53       <p><a href="../../HOWTO.html">start</a>|<a href="writing_lisp.html">next</a></p>
     46      <p><a href="../../HOWTO.html">start</a>|<a href="building_ui.html">previous</a>|<a href="writing_lisp.html">next</a></p>
    5447    </div>
    5548

  • branches/ia32/examples/cocoa/currency-converter/HOWTO_files/pages/making_project.html

    r7435 r8372  
    1919    <div class="body-text">
    2020      <p>This HOWTO is distributed with example files that include a
    21       working nibfile and a Lisp source file, named
    22       "CurrencyConverter.nib" and "CurrencyConverter.lisp",
    23       respectively. You can build a working copy of
    24       the example application by using these files, but, if you wish
    25       to understand how to build your own Lisp application projects,
    26       you should probably follow the instructions here to create your
    27       own source file and nibfile, and use the example files only for
    28       reference in case something goes wrong.</p>
     21      working <em>nibfile</em> (a file of user-interface objects,
     22      named "CurrencyConverter.nib") and a Lisp source file (named
     23      "CurrencyConverter.lisp"). You can build a working copy of the
     24      example application by using these files, but you probably
     25      shouldn't. If you want to understand how to build your own Lisp
     26      application projects, you should follow the instructions here to
     27      create your own source file and nibfile, and use the example
     28      files only for reference in case something goes wrong.</p>
    2929    </div>
    3030
    … …  
    3636      <p>First, create a project folder to hold the files you are
    3737      going to create. When your project is complete, the folder will
    38       contain a <em>nibfile</em> that defines the user interface, and
     38      contain a nibfile that defines the user interface, and
    3939      a Lisp source file that defines the behavior of the
    4040      application. Those two files are really all there is to a Lisp
    4141      application, though not all applications are as simple as this
    4242      currency converter. For more complex applications it makes sense
    43       to split you UI into several nibfiles, and to split your
     43      to split your UI into several nibfiles, and to split your
    4444      implementation into several source files. The basic principle
    4545      remains the same, however: nibfiles define your user interface,

  • branches/ia32/examples/cocoa/currency-converter/HOWTO_files/pages/writing_lisp.html

    r7435 r8372  
    1515    <div class="body-text">
    1616      <p>In this section we'll write Lisp code that duplicates the
    17       features provided by the Objective C code in Apple's example. In
    18       Apple's example, the explanation of the Objective C code begins
    19       with the
    20       section <a href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/chapter04/chapter_4_section_1.html">Implementing
    21       Currency Converter</a>.</p>
     17      features provided by the Objective C code in Apple's
     18      tutorial. In Apple's tutorial, the explanation of the Objective
     19      C code begins with the
     20      section <a href="http://developer.apple.com/documentation/Cocoa/Conceptual/ObjCTutorial/06Controller/chapter_6_section_1.html#//apple_ref/doc/uid/TP40000863-CH8-SW1">Bridging
     21      the Model and View: The Controller</a>.</p>
    2222
    2323      <p>The Lisp code in this section of the HOWTO is considerably
    … …  
    2525      because we can ignore the conventions that XCode uses for
    2626      laying out source files. We can just write all our definitions
    27       into a single Lisp source file, and load that file into OpenMCL
     27      into a single Lisp source file, and load that file into Clozure CL
    2828      when we are ready to build the application.</p>
    2929
    … …  
    3737      <pre>(in-package "CCL")</pre>
    3838
    39       <p>OpenMCL's Objective C bridge code is defined in the "CCL"
     39      <p>Clozure CL's Objective C bridge code is defined in the "CCL"
    4040      package. Usually, when building an application, you'll create a
    4141      package for that application and import the definitions you need
    … …  
    6868      simple wrinkles. First, the superclass it inherits from is the
    6969      NS-OBJECT class in the "NS" package. NS-OBJECT is an Objective C
    70       class, the ancestor of all Objective C objects. This CLOSE
     70      class, the ancestor of all Objective C objects. This CLOS
    7171      definition actually creates a new Objective C class named
    7272      "Converter".</p>
    7373
    74       <p>We tell OpenMCL how to build the right kind of class object
     74      <p>We tell Clozure CL how to build the right kind of class object
    7575      by including the :METACLASS option in the definition:</p>
    7676
    … …  
    9494      <p>This is the method that actually does the currency
    9595      conversion. It's very simple&mdash;really, it just multiples
    96       currency times rate. Most of the text in the definition is
     96      <code>currency</code> times <code>rate</code>. Most of the text in the definition is
    9797      Objective C bridge code that links the definition to the right
    9898      class with the right argument and return types.</p>
    … …  
    102102
    103103      <p>The syntax <code>#/convertCurrency:atRate:</code> uses the
    104       "#/" reader macro to read a symbol in mixed case, so that you
    105       can see in your code the same name that Objective C uses for the
    106       method, without worrying about how the name might be converted
    107       between Lisp and Objective C conventions. The number of
    108       arguments to an Objective C method is the number of colons in
    109       the name, plus one. Each colon indicates an argument, and there
    110       is always an extra "self" argument that refers to the object
    111       that receives the message. These are normal Objective C
    112       conventions, but we perhaps need to emphasize the details, since
    113       we are using Lisp code to call the Objective C methods.</p>
     104      "#/" reader macro to read a symbol with case preserved, so that
     105      you can see in your code the same name that Objective C uses for
     106      the method, without worrying about how the name might be
     107      converted between Lisp and Objective C conventions.</p>
     108
     109      <p>The number of arguments to an Objective C method is the
     110      number of colons in the name, plus one. Each colon indicates an
     111      argument, and there is always an extra "self" argument that
     112      refers to the object that receives the message. These are normal
     113      Objective C conventions, but we perhaps need to emphasize the
     114      details, since we are using Lisp code to call the Objective C
     115      methods.</p>
    114116
    115117      <p>We indicate the return type and the types of arguments in
    … …  
    169171
    170172      <p>Each field in the definition of the ConverterController class
    171       corresponds to one of the UI fields that you created in
    172       InterfaceBuilder. For example, <code>amount-field</code>
    173       corresponds to the "Amount in Other Currency" text field. The
    174       exception is the <code>converter</code> field, which at launch
    175       time contains a reference to the Converter object, whose class
    176       definition is in the previous section.</p>
     173      is an outlet that will be used to store a reference to one of
     174      the UI fields that you created in InterfaceBuilder. For
     175      example, <code>amount-field</code> will be connected to the
     176      "Amount" text field.</p>
     177
     178      <p>Why did we spell the name "amount-field" in Lisp code, and
     179      "amountField" when creating the outlet in InterfaceBuilder?  The
     180      Objective C bridge automatically converts Lisp-style field names
     181      (like "amount-field") to Objective C-style field names (like
     182      "amountField"), when handling class definitions.</p>
     183
     184      <p>The <code>converter</code> field at launch time contains a
     185      reference to the Converter object, whose class definition is in
     186      the previous section.</p>
    177187
    178188      <p>The final piece of the implementation is a definition of the
    … …  
    197207      "convertCurrency:atRate:" method of the Converter class. It then
    198208      sets the text of the amount-field to reflect the result of the
    199       conversion. The only singificant difference between this
     209      conversion. The only significant difference between this
    200210      implementation and Apple's is that the code is written in Lisp
    201211      rather than Objective C.</p>
    … …  
    208218
    209219    <div class="nav">
    210       <p><a href="../../HOWTO.html">start</a>|<a href="build_app.html">next</a></p>
     220      <p><a href="../../HOWTO.html">start</a>|<a href="create_lisp.html">previous</a>|<a href="build_app.html">next</a></p>
    211221    </div>
    212222

  • branches/ia32/examples/cocoa/currency-converter/HOWTO_files/stylesheets/styles.css

    r7435 r8372  
    3333}
    3434
     35.note {
     36        font: 12pt Georgia, "Times New Roman", Times, serif;
     37        margin-left: 6em;
     38        margin-right: 6em;
     39        text-indent: 0em;
     40}
     41
    3542.inline-image {
    3643        text-align: center;

  • branches/ia32/examples/cocoa/currency-converter/currency-converter.lisp

    r7435 r8372  
    4343  (ccl::build-application :name "CurrencyConverter"
    4444                          :main-nib-name "CurrencyConverter"
    45                           :nibfiles '(#P"/Users/mikel/Valise/clozure/openmcl/example-code/currency-converter/CurrencyConverter.nib")))
     45                          :directory "/Users/mikel/Desktop/"
     46                          :nibfiles '(#P"/usr/local/openmcl/trunk/ccl/examples/cocoa/currency-converter/CurrencyConverter.xib")))
    4647
    4748TODO NOTES:

  • branches/ia32/examples/cocoa/easygui/package.lisp

    r7641 r8372  
    2020           #:add-entry #:add-entries #:editable-p
    2121           #:draw-view-rectangle
    22            #:entry-text #:nth-cell #:selection #:redisplay
     22           #:entry-text #:cell-count #:nth-cell #:selection #:redisplay
    2323           #:string-value-of #:integer-value-of #:float-value-of
    2424           #:double-value-of))

  • branches/ia32/examples/cocoa/easygui/views.lisp

    r7641 r8372  
    340340                                    (slot-value view 'autosize-cells-p)))))
    341341
     342(defmethod cell-count ((view form-view))
     343  (dcc (#/numberOfRows (cocoa-ref view))))
     344
    342345(defmethod nth-cell (index view)
     346  (assert (< index (cell-count view)))
    343347  (let ((cocoa-cell (dcc (#/cellAtIndex: (cocoa-ref view) index))))
    344348    (when cocoa-cell

  • branches/ia32/level-0/X86/x86-array.lisp

    r8366 r8372  
    220220  (jmp-subprim .SParef2))
    221221
    222 (defx86lapfunction %aref3 ((array 0) (i arg_x) (j arg_y) (k arg_z))
     222(defx86lapfunction %aref3 ((array 8) #|(ra 0)|# (i arg_x) (j arg_y) (k arg_z))
    223223  (check-nargs 4)
     224  (pop (% ra0))
    224225  (pop (% temp0))
    225226  (discard-reserved-frame)
     227  (push (% ra0))
    226228  (jmp-subprim .SParef3))
    227229
    228 (defx86lapfunction %aset2 ((array 0) (i arg_x) (j arg_y) (newval arg_z))
     230(defx86lapfunction %aset2 ((array 8) #|(ra 0)|# (i arg_x) (j arg_y) (newval arg_z))
    229231  (check-nargs 4)
     232  (pop (% ra0))
    230233  (pop (% temp0))
    231234  (discard-reserved-frame)
     235  (push (% ra0))
    232236  (jmp-subprim .SPaset2))
    233237
    234 (defx86lapfunction %aset3 ((array 8) (i 0) (j arg_x) (k arg_y) (newval arg_z))
     238(defx86lapfunction %aset3 ((array 16) (i 8) #|(ra 0)|# (j arg_x) (k arg_y) (newval arg_z))
    235239  (check-nargs 5)
     240  (pop (% ra0))
    236241  (pop (% temp0))
    237242  (pop (% temp1))
    238243  (discard-reserved-frame)
     244  (push (% ra0))
    239245  (jmp-subprim .SPaset3))
    240246
    241 
    242 
    243 
    244 
    245  
    246 
    247247)  ; #+x8664-target
     248

  • branches/ia32/level-0/X86/x86-io.lisp

    r8366 r8372  
    2626  (movq (@ (% :rcontext) x8664::tcr.errno-loc) (% imm1))
    2727  (movslq (@ (% imm1)) (% imm0))
    28   (movss (% fp0) (@ (% imm1)))
     28  (movss (% fpzero) (@ (% imm1)))
    2929  (negq (% imm0))
    3030  (box-fixnum imm0 arg_z)

  • branches/ia32/level-0/X86/x86-misc.lisp

    r8366 r8372  
    255255  (trap-unless-typecode= ptr x8664::subtag-macptr)
    256256  (call-subprim .SPgetu64)
    257   (macptr-ptr ptr ptr)
     257  (macptr-ptr ptr imm2)
    258258  (unbox-fixnum offset imm1)
    259   (movq (% imm0) (@ (% ptr) (% imm1)))
     259  (movq (% imm0) (@ (% imm2) (% imm1)))
    260260  (restore-simple-frame)
    261261  (single-value-return))
    … …  
    268268  (trap-unless-typecode= ptr x8664::subtag-macptr)
    269269  (call-subprim .SPgets64)
    270   (macptr-ptr ptr ptr)
     270  (macptr-ptr ptr imm2)
    271271  (unbox-fixnum offset imm1)
    272   (movq (% imm0) (@ (% ptr) (% imm1)))
     272  (movq (% imm0) (@ (% imm2) (% imm1)))
    273273  (restore-simple-frame)
    274274  (single-value-return))
    … …  
    450450
    451451(defx86lapfunction %atomic-incf-ptr ((ptr arg_z))
    452   (macptr-ptr ptr ptr)
    453   @again
    454   (movq (@ (% ptr)) (% rax))
     452  (macptr-ptr ptr imm2)
     453  @again
     454  (movq (@ (% imm2)) (% rax))
    455455  (lea (@ 1 (% rax)) (% imm1))
    456456  (lock)
    457   (cmpxchgq (% imm1) (@ (% ptr)))
     457  (cmpxchgq (% imm1) (@ (% imm2)))
    458458  (jne @again)
    459459  (box-fixnum imm1 arg_z)
    … …  
    461461
    462462(defx86lapfunction %atomic-incf-ptr-by ((ptr arg_y) (by arg_z))
    463   (macptr-ptr ptr ptr)
    464   @again
    465   (movq (@ (% ptr)) (% rax))
     463  (macptr-ptr ptr imm2)
     464  @again
     465  (movq (@ (% imm2)) (% rax))
    466466  (unbox-fixnum by imm1)
    467467  (add (% rax) (% imm1))
    468468  (lock)
    469   (cmpxchgq (% imm1) (@ (% ptr)))
     469  (cmpxchgq (% imm1) (@ (% imm2)))
    470470  (jnz @again)
    471471  (box-fixnum imm1 arg_z)
    … …  
    474474
    475475(defx86lapfunction %atomic-decf-ptr ((ptr arg_z))
    476   (macptr-ptr ptr ptr)
    477   @again
    478   (movq (@ (% ptr)) (% rax))
     476  (macptr-ptr ptr imm2)
     477  @again
     478  (movq (@ (% imm2)) (% rax))
    479479  (lea (@ -1 (% rax)) (% imm1))
    480480  (lock)
    481   (cmpxchgq (% imm1) (@ (% ptr)))
     481  (cmpxchgq (% imm1) (@ (% imm2)))
    482482  (jnz @again)
    483483  (box-fixnum imm1 arg_z)
    … …  
    485485
    486486(defx86lapfunction %atomic-decf-ptr-if-positive ((ptr arg_z))
    487   (macptr-ptr ptr ptr)                  ;must be fixnum-aligned
    488   @again
    489   (movq (@ (% ptr)) (% rax))
     487  (macptr-ptr ptr imm2)
     488  @again
     489  (movq (@ (% imm2)) (% rax))
    490490  (testq (% rax) (% rax))
    491491  (lea (@ -1 (% rax)) (% imm1))
    492492  (jz @done)
    493493  (lock)
    494   (cmpxchgq (% imm1) (@ (% ptr)))
     494  (cmpxchgq (% imm1) (@ (% imm2)))
    495495  (jnz @again)
    496496  @done
    … …  
    510510;;; was equal to OLDVAL.  Return the old value
    511511(defx86lapfunction %ptr-store-conditional ((ptr arg_x) (expected-oldval arg_y) (newval arg_z))
    512   (macptr-ptr ptr ptr)                  ;  must be fixnum-aligned
    513   @again
    514   (movq (@ (% ptr)) (% imm0))
     512  (macptr-ptr ptr imm2)
     513  @again
     514  (movq (@ (% imm2)) (% imm0))
    515515  (box-fixnum imm0 temp0)
    516516  (cmpq (% temp0) (% expected-oldval))
    … …  
    518518  (unbox-fixnum newval imm1)
    519519  (lock)
    520   (cmpxchgq (% imm1) (@ (% ptr)))
     520  (cmpxchgq (% imm1) (@ (% imm2)))
    521521  (jne @again)
    522522  @done

  • branches/ia32/level-0/l0-init.lisp

    r7666 r8372  
    6868    #+darwinppc-target :darwinppc-target
    6969    #+darwinppc-target :darwinppc-host
    70     #+darwinppc-target :darwin
    7170    #+darwinppc-target :darwin-target
    7271    #+freebsd-target :freebsd-host
    … …  
    9190    #+x86-target :little-endian-target
    9291    #+x86-target :little-endian-host
     92    #+darwin-target :darwin
     93    #+linux-target :linux
     94    #+freebsd-target :freebsd
    9395    :mcl                                ;deprecated
    9496    )

  • branches/ia32/level-1/l1-application.lisp

    r7666 r8372  
    283283             :class 'tty-listener
    284284             :process initial-listener-process))))
    285   (%set-toplevel #'(lambda ()
    286                      (with-standard-abort-handling nil
    287                        (loop
    288                          (%nanosleep *periodic-task-seconds* *periodic-task-nanoseconds*)
    289                          (housekeeping)))))
     285  (%set-toplevel #'housekeeping-loop)
    290286  (toplevel))
    291287
    292 
     288(defun housekeeping-loop ()
     289  (with-standard-abort-handling nil
     290    (loop
     291      (%nanosleep *periodic-task-seconds* *periodic-task-nanoseconds*)
     292      (housekeeping))))
     293 
    293294
    294295(defmethod application-init-file ((app lisp-development-system))

  • branches/ia32/level-1/l1-boot-lds.lisp

    r7666 r8372  
    7979                                  (value-stack-size *default-value-stack-size*)
    8080                                  (temp-stack-size *default-temp-stack-size*)
     81                                  (echoing t)
    8182                                  (process))
    8283  (let ((p (if (typep process class)
    … …  
    9293    (process-preset p #'(lambda ()
    9394                          (let ((*terminal-io*
    94                                  (make-echoing-two-way-stream
    95                                   input-stream output-stream)))
     95                                 (if echoing
     96                                   (make-echoing-two-way-stream
     97                                    input-stream output-stream)
     98                                   (make-two-way-stream
     99                                    input-stream output-stream))))
    96100                            (unwind-protect
    97101                                 (progn

  • branches/ia32/level-1/l1-error-system.lisp

    r7244 r8372  
    439439(define-condition arithmetic-error (error)
    440440  ((operation :initform nil :initarg :operation :reader arithmetic-error-operation)
    441    (operands :initform nil :initarg :operands :reader arithmetic-error-operands))
    442   (:report (lambda (c s) (format s "~S detected ~&performing ~S on ~:S"
    443                                  (type-of c)
    444                                  (arithmetic-error-operation c)
    445                                  (arithmetic-error-operands c)))))
     441   (operands :initform nil :initarg :operands :reader arithmetic-error-operands)
     442   (status :initform nil :initarg :status :reader arithmetic-error-status))
     443  (:report (lambda (c s)
     444             (format s "~S detected "
     445                     (type-of c))
     446             (let* ((operands (arithmetic-error-operands c)))
     447               (when operands
     448                 (format s "~&performing ~S on ~:S"
     449                         (arithmetic-error-operation c)
     450                         operands))))))
    446451
    447452(define-condition division-by-zero (arithmetic-error))
    … …  
    10201025    (mod #x110000)
    10211026    (array * (* *))                     ;2d array
    1022     (array * (* *))                     ;3d array
     1027    (array * (* * *))                   ;3d array
    10231028    (array t)
    10241029    (array bit)

  • branches/ia32/level-1/l1-lisp-threads.lisp

    r7666 r8372  
    197197          (lisp-thread.startup-function thread)
    198198          (thread-make-startup-function thread tcr)))
     199  (thread-change-state thread :exit :reset)
    199200  thread)
    200201
    … …  
    300301          (lisp-thread.startup-function thread)
    301302          (thread-make-startup-function thread tcr))
     303    (thread-change-state thread :exit :reset)
    302304    tcr))
    303305 

  • branches/ia32/level-1/l1-readloop-lds.lisp

    r7244 r8372  
    218218              (setq *in-read-loop* nil
    219219                    *break-level* break-level)
    220               (multiple-value-bind (form path print-result)
     220              (multiple-value-bind (form env print-result)
    221221                  (toplevel-read :input-stream input-stream
    222222                                 :output-stream output-stream
    … …  
    232232                    (exit-interactive-process *current-process*))
    233233                    (or (check-toplevel-command form)
    234                         (let* ((values (toplevel-eval form path)))
     234                        (let* ((values (toplevel-eval form env)))
    235235                          (if print-result (toplevel-print values))))))))
    236236           (format *terminal-io* "~&Cancelled")))
    … …  
    291291    form))
    292292
    293 (defun toplevel-eval (form &optional *loading-file-source-file*)
    294   (setq +++ ++ ++ + + - - form)
    295   (let* ((package *package*)
    296          (values (multiple-value-list (cheap-eval-in-environment form nil))))
    297     (unless (eq package *package*)
    298       (application-ui-operation *application* :note-current-package *package*))
    299     values))
     293(defun toplevel-eval (form &optional env)
     294  (destructuring-bind (vars . vals) (or env '(nil . nil))
     295    (progv vars vals
     296      (setq +++ ++ ++ + + - - form)
     297      (unwind-protect
     298          (let* ((package *package*)
     299                 (values (multiple-value-list (cheap-eval-in-environment form nil))))
     300            (unless (eq package *package*)
     301              ;; If changing a local value (e.g. buffer-local), not useful to notify app
     302              ;; without more info.  Perhaps should have a *source-context* that can send along?
     303              (unless (member '*package* vars)
     304                (application-ui-operation *application* :note-current-package *package*)))
     305            values)
     306        (loop for var in vars as pval on vals
     307          do (setf (car pval) (symbol-value var)))))))
     308
    300309
    301310(defun toplevel-print (values &optional (out *standard-output*))
    … …  
    307316    (dolist (val values) (write val :stream out) (terpri out))))
    308317
     318(defparameter *listener-prompt-format* "~[?~:;~:*~d>~] ")
     319
     320 
    309321(defun print-listener-prompt (stream &optional (force t))
    310322  (unless *quiet-flag*
    311323    (when (or force (neq *break-level* *last-break-level*))
    312324      (let* ((*listener-indent* nil))
    313         (fresh-line stream)           
    314         (if (%izerop *break-level*)
    315           (%write-string "?" stream)
    316           (format stream "~s >" *break-level*)))       
    317       (write-string " " stream)       
     325        (fresh-line stream)
     326        (format stream *listener-prompt-format* *break-level*))
    318327      (setq *last-break-level* *break-level*)))
    319328    (force-output stream))

  • branches/ia32/level-1/l1-readloop.lisp

    r6018 r8372  
    124124
    125125
    126 (defglobal *quitting* nil)
     126(defloadvar *quitting* nil)
    127127
    128128
    … …  
    161161        (close (car streams))))
    162162    (setf (interrupt-level) -1)         ; can't abort after this
    163     ))
     163    )
     164  ;; Didn't abort, so really quitting.
     165  (setq *quitting* t))
    164166
    165167

  • branches/ia32/level-1/l1-streams.lisp

    r7761 r8372  
    53755375(defun fd-stream-force-output (s ioblock count finish-p)
    53765376  (when (or (ioblock-dirty ioblock) finish-p)
    5377     (setf (ioblock-dirty ioblock) nil)
    53785377    (let* ((fd (ioblock-device ioblock))
    53795378           (io-buffer (ioblock-outbuf ioblock))
    … …  
    53835382      (declare (fixnum octets))
    53845383      (declare (dynamic-extent buf))
    5385       (%setf-macptr buf (io-buffer-bufptr io-buffer))
    5386       (setf (io-buffer-idx io-buffer) 0
    5387             (io-buffer-count io-buffer) 0)
    5388       (do* ()
    5389            ((= octets 0)
    5390             (when finish-p
    5391               (case (%unix-fd-kind fd)
    5392                 (:file (fd-fsync fd))))
    5393             octets-to-write)
    5394         (let* ((written (with-eagain fd :output
    5395                           (fd-write fd buf octets))))
    5396           (declare (fixnum written))
    5397           (if (< written 0)
    5398             (stream-io-error s (- written) "write"))
    5399           (decf octets written)
    5400           (unless (zerop octets)
    5401             (%incf-ptr buf written)))))))
     5384      (without-interrupts
     5385       (setf (ioblock-dirty ioblock) nil)
     5386       (%setf-macptr buf (io-buffer-bufptr io-buffer))
     5387       (setf (io-buffer-idx io-buffer) 0
     5388             (io-buffer-count io-buffer) 0)
     5389       (do* ()
     5390            ((= octets 0)
     5391             (when finish-p
     5392               (case (%unix-fd-kind fd)
     5393                 (:file (fd-fsync fd))))
     5394             octets-to-write)
     5395         (let* ((written (with-eagain fd :output
     5396                                      (fd-write fd buf octets))))
     5397           (declare (fixnum written))
     5398           (if (< written 0)
     5399             (stream-io-error s (- written) "write"))
     5400           (decf octets written)
     5401           (unless (zerop octets)
     5402             (%incf-ptr buf written))))))))
    54025403
    54035404(defmethod stream-read-line ((s buffered-input-stream-mixin))
    … …  
    54325433
    54335434(defclass selection-input-stream (fd-character-input-stream)
    5434     ((package :initform nil :reader selection-input-stream-package)
    5435      (pathname :initform nil :reader selection-input-stream-pathname)
    5436      (peer-fd  :reader selection-input-stream-peer-fd)))
     5435  ((package :initform nil :reader selection-input-stream-package)
     5436   (pathname :initform nil :reader selection-input-stream-pathname)
     5437   (env :initform nil :reader selection-input-stream-env)
     5438   (peer-fd  :reader selection-input-stream-peer-fd)))
    54375439
    54385440(defmethod select-stream-class ((class (eql 'selection-input-stream))
    … …  
    54585460;;; else raw data
    54595461(defmethod stream-read-char ((s selection-input-stream))
    5460   (with-slots (package pathname) s
     5462  (with-slots (env package pathname) s
    54615463    (let* ((quoted nil))
    54625464      (loop
    … …  
    54655467            (return ch)
    54665468            (case ch
    5467               (#\^p (setq package nil)
     5469              (#\^p (setq package nil env nil)
    54685470                    (let* ((p (read-line s nil nil)))
    54695471                      (unless (zerop (length p))
    54705472                        (setq package p))))
    5471               (#\^v (setq pathname nil)
     5473              (#\^v (setq pathname nil env nil)
    54725474                    (let* ((p (read-line s nil nil)))
    54735475                      (unless (zerop (length p))
    … …  
    56435645
    56445646;;; Interaction with the REPL.  READ-TOPLEVEL-FORM should return 3
    5645 ;;; values: a form, a (possibly null) pathname, and a boolean that
     5647;;; values: a form, a (possibly null) evaluation env, and a boolean that
    56465648;;; indicates whether or not the result(s) of evaluating the form
    56475649;;; should be printed.  (The last value has to do with how selections
    … …  
    56935695                               eof-value)
    56945696  (if (eq (stream-peek-char stream) :eof)
    5695     (values eof-value nil t)
    5696     (let* ((*package* *package*)
    5697            (pkg-name (selection-input-stream-package stream)))
    5698       (when pkg-name (setq *package* (pkg-arg pkg-name)))
    5699       (let* ((form (call-next-method))
     5697    (with-slots (env package pathname) stream
     5698      (setf env nil package nil pathname nil)
     5699      (values eof-value nil t))
     5700    (with-slots (env package pathname) stream
     5701      (when (and (or package pathname) (null env))
     5702        (setf env (cons '(*package* *loading-file-source-file*)
     5703                        (list (or (and package (pkg-arg package)) *package*) pathname))))
     5704      (let* ((form (progv (car env) (cdr env)
     5705                     (call-next-method)))
    57005706             (last-form-in-selection (not (listen stream))))
    5701         (values form
    5702                 (selection-input-stream-pathname stream)
    5703                 (or last-form-in-selection *verbose-eval-selection*))))))
    5704 
    5705                              
     5707        (values form env (or last-form-in-selection *verbose-eval-selection*))))))
     5708
     5709
    57065710(defun column (&optional stream)
    57075711  (let* ((stream (real-print-stream stream)))

  • branches/ia32/level-1/l1-sysio.lisp

    r7362 r8372  
    6262                (do* ((i 0 (1+ i))
    6363                      (last-was-cr nil))
    64                      ((= nchars) (if last-was-cr :cr))
     64                     ((= i nchars) (if last-was-cr :cr))
    6565                  (declare (fixnum i))
    6666                  (let* ((char (schar string i)))
    … …  
    7373                        (#\Line_Separator (return :unicode))
    7474                        (#\Return (setq last-was-cr t))))))))
    75         (when line-termination
    76           (install-ioblock-input-line-termination file-ioblock line-termination)
    77           (when (file-ioblock-outbuf file-ioblock)
    78             (install-ioblock-output-line-termination file-ioblock line-termination))))))))
     75          (when line-termination
     76            (install-ioblock-input-line-termination file-ioblock line-termination)
     77            (when (file-ioblock-outbuf file-ioblock)
     78              (install-ioblock-output-line-termination file-ioblock line-termination))))))))
    7979
    8080

  • branches/ia32/level-1/x86-trap-support.lisp

    r7812 r8372  
    2929  (defconstant flags-register-offset #$REG_EFL)
    3030  (defconstant rip-register-offset #$REG_RIP)
     31  (defun xp-mxcsr (xp)
     32    (pref xp :ucontext.uc_mcontext.fpregs.mxcsr))
    3133  (defparameter *encoded-gpr-to-indexed-gpr*
    3234    #(13                                ;rax
    … …  
    5456  (defconstant flags-register-offset 22)
    5557  (defconstant rip-register-offset 20)
     58  (defun xp-mxcsr (xp)
     59    (with-macptrs ((state (pref xp :__ucontext.uc_mcontext.mc_fpstate)))
     60      (pref state :savefpu.sv_env.en_mxcsr)))
    5661  (defparameter *encoded-gpr-to-indexed-gpr*
    5762    #(7                                 ;rax
    … …  
    97102                 (:uc_mcsize (:unsigned 64))
    98103                 (:uc_mcontext64 (:* (:struct :portable_mcontext64))))))
     104  (defun xp-mxcsr (xp)
     105    (%get-unsigned-long
     106     (pref (pref xp :portable_ucontext64.uc_mcontext64) :portable_mcontext64.fs) 32))
    99107  (defconstant gp-regs-offset 0)
    100108  (defmacro xp-gp-regs (xp)
    … …  
    222230           (multiple-value-bind (operation operands)
    223231               (decode-arithmetic-error xp xcf)
     232             
    224233             (let* ((condition-name
    225234                     (cond ((or (= code #$FPE_INTDIV)
    … …  
    236245               (%error (make-condition condition-name
    237246                                       :operation operation
    238                                        :operands operands)
     247                                       :operands operands
     248                                       :status (xp-mxcsr xp))
    239249                       ()
    240250                       frame-ptr))))

  • branches/ia32/lib/ccl-export-syms.lisp

    r7340 r8372  
    4444     toplevel-function
    4545     toplevel
     46     *listener-prompt-format*
    4647     cancel
    4748     catch-cancel

  • branches/ia32/lib/format.lisp

    r4537 r8372  
    17971797            (format-write-field stream (princ-to-string number) w 1 0 #\space t)))))))
    17981798
    1799 ; do something ad hoc if d > w - happens if (format nil "~15g" (- 2.3 .1))
    1800 ; called with w = 11 d = 16 - dont do it after all.
     1799;;; do something ad hoc if d > w - happens if (format nil "~15g" (- 2.3 .1))
     1800;;; called with w = 11 d = 16 - dont do it after all.
     1801
     1802(defvar format-digits-limit 100)
    18011803
    18021804(defun format-fixed-aux (stream number w d k ovf pad atsign)
    1803   (and w (<= w 0) (setq w nil))  ; if width is unreasonable, ignore it.
    1804   (if (not (or w d))  ; perhaps put this back when prin1 is better
    1805     (prin1 number stream)
    1806     (let ((spaceleft w)
    1807           (abs-number (abs number))
    1808           strlen zsuppress flonum-to-string-width)
    1809       (when (and w (or atsign (minusp number)))
    1810         (decf spaceleft))
    1811       (when (and d w (<= w (+ 1 d (if atsign 1 0))))
    1812         (setq zsuppress t))
    1813       (when (and d (minusp d))
    1814           (format-error "Illegal value for d"))
    1815       (setq flonum-to-string-width
    1816             (and w
    1817                  (if (and (< abs-number 1) (not zsuppress))
    1818                    (1- spaceleft)   ; room for leading 0
    1819                    spaceleft)))
    1820       (when (and w (not (plusp flonum-to-string-width)))
    1821         (if ovf
    1822           (progn
    1823             (dotimes (i w) (write-char ovf stream))
    1824             (return-from format-fixed-aux))
    1825           (setq spaceleft nil w nil)))
    1826       (multiple-value-bind (str before-pt after-pt)
    1827                            (flonum-to-string abs-number
    1828                                              flonum-to-string-width
    1829                                              d k)
    1830         (setq strlen (length str))
    1831         (cond (w (decf spaceleft (+ (max before-pt 0) 1))
    1832                  (when (and (< before-pt 1) (not zsuppress))
    1833                    (decf spaceleft))
    1834                  (if d
    1835                    (decf spaceleft d)
    1836                    (setq d (max (min spaceleft (- after-pt))
    1837                                 (if (> spaceleft 0) 1 0))
    1838                          spaceleft (- spaceleft d))))
    1839               ((null d) (setq d (max (- after-pt) 1))))
    1840         (cond ((and w (< spaceleft 0) ovf)
    1841                ;;field width overflow
    1842                (dotimes (i w) (declare (fixnum i)) (write-char ovf stream)))
    1843               (t (when w (dotimes (i spaceleft) (declare (fixnum i)) (write-char pad stream)))
    1844                  (if (minusp (float-sign number)) ; 5/25
    1845                    (write-char #\- stream)
    1846                    (if atsign (write-char #\+ stream)))
    1847                  (cond
    1848                   ((> before-pt 0)
    1849                    (cond ((> strlen before-pt)
    1850                           (write-string str stream :start  0 :end before-pt)
    1851                           (write-char #\. stream)
    1852                           (write-string str stream :start  before-pt :end strlen)
    1853                           (dotimes (i (- d (- strlen before-pt)))
    1854                             (write-char #\0 stream)))
    1855                          (t ; 0's after
    1856                           (stream-write-entire-string stream str)
    1857                           (dotimes (i (-  before-pt strlen))
    1858                             (write-char #\0 stream))
    1859                           (write-char #\. stream)
    1860                           (dotimes (i d)
    1861                             (write-char #\0 stream)))))
    1862                   (t (unless zsuppress (write-char #\0 stream))
    1863                      (write-char #\. stream)
    1864                      (dotimes (i (- before-pt)) 
    1865                        (write-char #\0 stream))
    1866                      (stream-write-entire-string stream str)
    1867                      (dotimes (i (+ d after-pt))
    1868                       (write-char #\0 stream))))))))))
     1805  (and w (<= w 0) (setq w nil))         ; if width is unreasonable, ignore it.
     1806  (let ((spaceleft w)
     1807        (abs-number (abs number))
     1808        strlen zsuppress flonum-to-string-width)
     1809    (when (and w (or atsign (minusp number)))
     1810      (decf spaceleft))
     1811    (when (and d w (<= w (+ 1 d (if atsign 1 0))))
     1812      (setq zsuppress t))
     1813    (when (and d (minusp d))
     1814      (format-error "Illegal value for d"))
     1815    (setq flonum-to-string-width
     1816          (and w
     1817               (if (and (< abs-number 1) (not zsuppress))
     1818                 (1- spaceleft)         ; room for leading 0
     1819                 spaceleft)))
     1820    (when (and w (not (plusp flonum-to-string-width)))
     1821      (if ovf
     1822        (progn
     1823          (dotimes (i w) (write-char ovf stream))
     1824          (return-from format-fixed-aux))
     1825        (setq spaceleft nil w nil)))
     1826    (multiple-value-bind (str before-pt after-pt)
     1827        (flonum-to-string abs-number
     1828                          flonum-to-string-width
     1829                          d k)
     1830      (setq strlen (length str))
     1831           (cond 
     1832             ((and (not (or w d)) (> (max (abs before-pt )(abs after-pt)) format-digits-limit))
     1833              (prin1 number stream))
     1834             (t
     1835              (cond (w (decf spaceleft (+ (max before-pt 0) 1))
     1836                       (when (and (< before-pt 1) (not zsuppress))
     1837                         (decf spaceleft))
     1838                       (if d
     1839                         (decf spaceleft d)
     1840                         (setq d (max (min spaceleft (- after-pt))
     1841                                      (if (> spaceleft 0) 1 0))
     1842                               spaceleft (- spaceleft d))))
     1843                    ((null d) (setq d (max (- after-pt) 1))))
     1844              (cond ((and w (< spaceleft 0) ovf)
     1845                     ;;field width overflow
     1846                     (dotimes (i w) (declare (fixnum i)) (write-char ovf stream)))
     1847                    (t (when w (dotimes (i spaceleft) (declare (fixnum i)) (write-char pad stream)))
     1848                       (if (minusp (float-sign number)) ; 5/25
     1849                         (write-char #\- stream)
     1850                         (if atsign (write-char #\+ stream)))
     1851                       (cond
     1852                         ((> before-pt 0)
     1853                          (cond ((> strlen before-pt)
     1854                                 (write-string str stream :start  0 :end before-pt)
     1855                                 (write-char #\. stream)
     1856                                 (write-string str stream :start  before-pt :end strlen)
     1857                                 (dotimes (i (- d (- strlen before-pt)))
     1858                                   (write-char #\0 stream)))
     1859                                (t              ; 0's after
     1860                                 (stream-write-entire-string stream str)
     1861                                 (dotimes (i (-  before-pt strlen))
     1862                                   (write-char #\0 stream))
     1863                                 (write-char #\. stream)
     1864                                 (dotimes (i d)
     1865                                   (write-char #\0 stream)))))
     1866                         (t (unless zsuppress (write-char #\0 stream))
     1867                            (write-char #\. stream)
     1868                            (dotimes (i (- before-pt))   
     1869                              (write-char #\0 stream))
     1870                            (stream-write-entire-string stream str)
     1871                            (dotimes (i (+ d after-pt))
     1872                              (write-char #\0 stream)))))))))))
    18691873#|
    18701874; (format t "~7,3,-2f" 8.88)
    … …  
    21502154        (princ " (y or n)  " *query-io*)
    21512155        (setq response (read-char *query-io*))
     2156        ;; Consume input up to trailing newline
    21522157        (when (peek-char #\NewLine *query-io* nil)
    2153           (unread-char #\NewLine *query-io*)
     2158          ;; And consume the #\newline
    21542159          (read-char *query-io*))
    21552160        (clear-input *query-io*)

  • branches/ia32/lib/nfcomp.lisp

    r8072 r8372  
    12691269    ((simple-array (signed-byte 64) (*))
    12701270     (fasl-dump-64-bit-ivector exp $fasl-s64-vector))
    1271     (vector (fasl-dump-gvector exp $fasl-vector-header))
    1272     (array (fasl-dump-gvector exp $fasl-array-header))
    12731271    (ivector
    12741272     (unless (eq (backend-target-arch-name *target-backend*)
    … …  
    12831281       (fasl-out-count n)
    12841282       (fasl-out-ivect exp 0 nb)))
     1283    (vector (fasl-dump-gvector exp $fasl-vector-header))
     1284    (array (fasl-dump-gvector exp $fasl-array-header))
     1285
    12851286    (gvector
    12861287     (if (= (typecode exp) target::subtag-istruct)

  • branches/ia32/lib/pathnames.lisp

    r7666 r8372  
    133133(defun recursive-copy-directory (source-path dest-path &key test (if-exists :error))
    134134  ;; TODO: Support :if-exists :supersede to blow away any files not in source dir
     135  (assert (directoryp source-path)(source-path)
     136          "source-path is not a directory in RECURSIVE-COPY-DIRECTORY")
    135137  (setq if-exists (require-type if-exists '(member :overwrite :error)))
    136138  (setq dest-path (ensure-directory-pathname dest-path))
    … …  
    138140    (when (probe-file dest-path)
    139141      (if-exists if-exists dest-path))
    140     ;; Skip the probe-file in recursive calls, already know ok.
     142    ;; Skip the probe-file in recursive calls, we already know it's ok.
    141143    (setq if-exists :overwrite))
    142144  (let* ((source-dir (ensure-directory-pathname source-path))
    143         (pattern (make-pathname :name :wild :type :wild :defaults source-dir))
    144         (source-files (directory pattern :test test :directories t :files t)))
     145        (pattern (make-pathname :name :wild :type :wild :defaults source-dir))
     146        (source-files (directory pattern :test test :directories t :files t)))
    145147    (ensure-directories-exist dest-path)
    146148    (dolist (f source-files)
    147149      (when (or (null test) (funcall test f))
    148         (if (directory-pathname-p f)
    149             (let ((dest-file (make-pathname :name (first (last (pathname-directory f)))
    150                                             :defaults dest-path)))
    151               (recursive-copy-directory f dest-file :test test :if-exists if-exists))
    152             (let* ((dest-file (make-pathname :name (pathname-name f)
    153                                              :type (pathname-type f)
    154                                              :defaults dest-path)))
    155               (copy-file f dest-file :if-exists :supersede :preserve-attributes t)))))))
     150        (if (directory-pathname-p f)
     151            (let ((dest-file (make-pathname :name (first (last (pathname-directory f)))
     152                                            :defaults dest-path)))
     153              (recursive-copy-directory f dest-file :test test :if-exists if-exists))
     154            (let* ((dest-file (make-pathname :name (pathname-name f)
     155                                             :type (pathname-type f)
     156                                             :defaults dest-path)))
     157              (copy-file f dest-file :if-exists :supersede :preserve-attributes t)))))))
    156158
    157159;;; use with caution!

  • branches/ia32/lisp-kernel/gc.h

    r8070 r8372  
    109109#endif
    110110
     111#ifdef DARWIN
     112#include <mach/task_info.h>
     113typedef struct task_events_info paging_info;
     114#else
     115#ifndef WINDOWS
     116#include <sys/resource.h>
     117typedef struct rusage paging_info;
     118#endif
     119#endif
     120
     121#include <stdio.h>
     122
     123void sample_paging_info(paging_info *);
     124void report_paging_info_delta(FILE*, paging_info *, paging_info *);
    111125
    112126#define GC_TRAP_FUNCTION_IMMEDIATE_GC (-1)

  • branches/ia32/lisp-kernel/lisp-debug.c

    r7287 r8372  
    510510}
    511511
     512debug_command_return
     513debug_thread_info(ExceptionInformation *xp, siginfo_t *info, int arg)
     514{
     515  TCR * tcr = get_tcr(false);
     516 
     517  if (tcr) {
     518    area *vs_area = tcr->vs_area, *cs_area = tcr->cs_area;
     519
     520    fprintf(stderr, "Current Thread Context Record (tcr) = 0x%lx\n", tcr);
     521    fprintf(stderr, "Control (C) stack area:  low = 0x%lx, high = 0x%lx\n",
     522            cs_area->low, cs_area->high);
     523    fprintf(stderr, "Value (lisp) stack area: low = 0x%lx, high = 0x%lx\n",
     524            vs_area->low, vs_area->high);
     525    if (xp) {
     526      fprintf(stderr, "Exception stack pointer = 0x%lx\n",
     527#ifdef PPC
     528              xpGPR(xp,1)
     529#endif
     530#ifdef X86
     531              xpGPR(xp,Isp)
     532#endif
     533              );
     534    }
     535  }
     536  return debug_continue;
     537}
    512538     
    513539
    … …  
    736762   NULL,
    737763   'B'},
     764  {debug_thread_info,
     765   "Show info about current thread",
     766   0,
     767   NULL,
     768   'T'},
    738769  {debug_win,
    739770   "Exit from this debugger, asserting that any exception was handled",
    … …  
    834865              siginfo_t *info,
    835866              int why,
     867              Boolean in_foreign_code,
    836868              char *message,
    837869              ...)
    … …  
    839871  va_list args;
    840872  debug_command_return state = debug_continue;
    841   int in_foreign_code = (why & debug_foreign_exception);
    842873
    843874  if (threads_initialized) {
    … …  
    851882  if (in_foreign_code) {
    852883    fprintf(stderr, "Exception occurred while executing foreign code\n");
    853     why = (why & ~debug_foreign_exception);
    854   }
    855 
     884  }
    856885  if (lisp_global(BATCH_FLAG)) {
    857886    abort();
    858887  }
     888#ifdef DARWIN
     889#ifdef X8664
     890  if (xp) {
     891    extern void *_sigtramp();
     892    extern int os_major_version;
     893
     894    if (xpPC(xp) == (natural)_sigtramp) {
     895      xp = (ExceptionInformation *) xpGPR(xp, REG_R8);
     896      fprintf(stderr, "Exception raised at _sigtramp; using context passed to _sigtramp.  Raw register values (R) may be more interesting then lisp values or lisp backtrace\n");
     897    }
     898  }
     899#endif
     900#endif
     901
     902
    859903  if (xp) {
    860904    if (why > debug_entry_exception) {
    … …  
    893937  vsnprintf(s, sizeof(s),format, args);
    894938  va_end(args);
    895   lisp_Debugger(xp, NULL, debug_entry_bug, s);
     939  lisp_Debugger(xp, NULL, debug_entry_bug, false, s);
    896940
    897941}
    … …  
    906950  vsnprintf(s, sizeof(s),format, args);
    907951  va_end(args);
    908   lisp_Debugger(xp, NULL, debug_entry_bug | debug_foreign_exception , s);
     952  lisp_Debugger(xp, NULL, debug_entry_bug, true, s);
    909953
    910954}

  • branches/ia32/lisp-kernel/lisp-exceptions.h

    r7287 r8372  
    4242
    4343OSStatus
    44 lisp_Debugger(ExceptionInformation *, siginfo_t *, int, char *, ...);
     44lisp_Debugger(ExceptionInformation *, siginfo_t *, int, Boolean, char *, ...);
    4545
    4646OSStatus

  • branches/ia32/lisp-kernel/pmcl-kernel.c

    r8070 r8372  
    12861286#endif
    12871287
     1288int
     1289os_major_version = 0;
     1290
    12881291void
    12891292check_os_version(char *progname)
    … …  
    12961299    exit(1);
    12971300  }
     1301  sscanf(uts.release,"%d",&os_major_version);
     1302
    12981303#ifdef PPC
    12991304#ifdef DARWIN
    … …  
    18801885
    18811886
     1887#ifdef DARWIN
     1888void
     1889sample_paging_info(paging_info *stats)
     1890{
     1891  mach_msg_type_number_t count = TASK_EVENTS_INFO_COUNT;
     1892
     1893  task_info(mach_task_self(),
     1894            TASK_EVENTS_INFO,
     1895            (task_info_t)stats,
     1896            &count);
     1897}
     1898
     1899void
     1900report_paging_info_delta(FILE *out, paging_info *start, paging_info *stop)
     1901{
     1902  fprintf(out,";;; %d soft faults, %d faults, %d pageins\n\n",
     1903          stop->cow_faults-start->cow_faults,
     1904          stop->faults-start->faults,
     1905          stop->pageins-start->pageins);
     1906}
     1907
     1908#else
     1909#ifndef WINDOWS
     1910void
     1911sample_paging_info(paging_info *usage)
     1912{
     1913  getrusage(RUSAGE_SELF, usage);
     1914}
     1915
     1916void
     1917report_paging_info_delta(FILE *out, paging_info *start, paging_info *stop)
     1918{
     1919  fprintf(out,";;; %d soft faults, %d faults, %d pageins\n\n",
     1920          stop->ru_minflt-start->ru_minflt,
     1921          stop->ru_majflt-start->ru_majflt,
     1922          stop->ru_nswap-start->ru_nswap);
     1923}
     1924
     1925#endif
     1926#endif

  • branches/ia32/lisp-kernel/ppc-exceptions.c

    r7244 r8372  
    15491549        message = "Lisp Breakpoint";
    15501550      }
    1551       lisp_Debugger(xp, info, debug_entry_dbg, message);
     1551      lisp_Debugger(xp, info, debug_entry_dbg, false, message);
    15521552      return noErr;
    15531553    }
    15541554    if (the_trap == QUIET_LISP_BREAK_INSTRUCTION) {
    15551555      adjust_exception_pc(xp,4);
    1556       lisp_Debugger(xp, info, debug_entry_dbg, "Lisp Breakpoint");
     1556      lisp_Debugger(xp, info, debug_entry_dbg, false, "Lisp Breakpoint");
    15571557      return noErr;
    15581558    }
    … …  
    17621762  wait_for_exception_lock_in_handler(tcr, context, &xframe_link);
    17631763  if ((noErr != PMCL_exception_handler(signum, context, tcr, info, old_valence))) {
     1764    Boolean foreign = (old_valence != TCR_STATE_LISP);
    17641765    char msg[512];
    17651766    snprintf(msg, sizeof(msg), "Unhandled exception %d at 0x%lx, context->regs at #x%lx", signum, xpPC(context), (natural)xpGPRvector(context));
    1766     if (lisp_Debugger(context, info, signum, msg)) {
     1767    if (lisp_Debugger(context, info, signum, foreign, msg)) {
    17671768      SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PROPAGATE_EXCEPTION);
    17681769    }

  • branches/ia32/lisp-kernel/ppc-gc.c

    r7244 r8372  
    2525#include <string.h>
    2626#include <sys/time.h>
     27
     28void
     29comma_output_decimal(char *buf, int len, natural n)
     30{
     31  int nout = 0;
     32
     33  buf[--len] = 0;
     34  do {
     35    buf[--len] = n%10+'0';
     36    n = n/10;
     37    if (n == 0) {
     38      while (len) {
     39        buf[--len] = ' ';
     40      }
     41      return;
     42    }
     43    if (len == 0) return;
     44    nout ++;
     45    if (nout == 3) {
     46      buf[--len] = ',';
     47      nout = 0;
     48    }
     49  } while (len >= 0);
     50}
    2751
    2852/* Heap sanity checking. */
    … …  
    24332457  area *a = active_dynamic_area, *to = NULL, *from = NULL, *note = NULL;
    24342458  unsigned timeidx = 1;
     2459  paging_info paging_info_start;
    24352460  xframe_list *x;
    24362461  LispObj
    … …  
    24852510
    24862511  if (GCverbose) {
     2512    char buf[16];
     2513
     2514    sample_paging_info(&paging_info_start);
     2515    comma_output_decimal(buf,16,area_dnode(oldfree,a->low) << dnode_shift);
    24872516    if (GCephemeral_low) {
    24882517      fprintf(stderr,
    2489               "\n\n;;; Starting Ephemeral GC of generation %d",
     2518              "\n\n;;; Starting EGC of generation %d",
    24902519              (from == g2_area) ? 2 : (from == g1_area) ? 1 : 0);
    24912520    } else {
    24922521      fprintf(stderr,"\n\n;;; Starting full GC");
    24932522    }
    2494     fprintf(stderr, ",  %ld bytes allocated.\n", area_dnode(oldfree,a->low) << dnode_shift);
     2523    fprintf(stderr, ", %s bytes allocated.\n", buf);
    24952524  }
    24962525
    … …  
    27982827      *( (long long *) ptr_from_lispobj(((macptr *) ptr_from_lispobj(untag(val)))->address)) += justfreed;
    27992828      if (GCverbose) {
     2829        char buf[16];
     2830        paging_info paging_info_stop;
     2831
     2832        sample_paging_info(&paging_info_stop);
    28002833        if (justfreed <= heap_segment_size) {
    28012834          justfreed = 0;
    28022835        }
    28032836        if (note == tenured_area) {
    2804           fprintf(stderr,";;; Finished full GC.  Freed %lld bytes in %d.%06d s\n\n", justfreed, elapsed.tv_sec, elapsed.tv_usec);
     2837          fprintf(stderr,";;; Finished full GC. %s bytes freed in %d.%06d s\n\n", buf, elapsed.tv_sec, elapsed.tv_usec);
    28052838        } else {
    2806           fprintf(stderr,";;; Finished Ephemeral GC of generation %d.  Freed %lld bytes in %d.%06d s\n\n",
     2839          fprintf(stderr,";;; Finished EGC of generation %d. %s bytes freed in %d.%06d s\n\n",
    28072840                  (from == g2_area) ? 2 : (from == g1_area) ? 1 : 0,
    2808                   justfreed,
     2841                  buf,
    28092842                  elapsed.tv_sec, elapsed.tv_usec);
    28102843        }
     2844        report_paging_info_delta(stderr, &paging_info_start, &paging_info_stop);
    28112845      }
    28122846    }

  • branches/ia32/lisp-kernel/x86-exceptions.c

    r8210 r8372  
    885885        case UUO_DEBUG_TRAP:
    886886          xpPC(context) = (natural) (program_counter+1);
    887           lisp_Debugger(context, info, debug_entry_dbg, "Lisp Breakpoint");
     887          lisp_Debugger(context, info, debug_entry_dbg, false, "Lisp Breakpoint");
    888888          return true;
    889889
    … …  
    894894
    895895            get_lisp_string(xpGPR(context,Iarg_z),msg, sizeof(msg)-1);
    896             lisp_Debugger(context, info, debug_entry_dbg, msg);
     896            lisp_Debugger(context, info, debug_entry_dbg, false,  msg);
    897897          }
    898898          return true;
    … …  
    10621062  if (! handle_exception(signum, info, context, tcr, old_valence)) {
    10631063    char msg[512];
    1064     int foreign = (old_valence == TCR_STATE_LISP) ? 0 : debug_foreign_exception;
     1064    Boolean foreign = (old_valence != TCR_STATE_LISP);
    10651065
    10661066    snprintf(msg, sizeof(msg), "Unhandled exception %d at 0x%lx, context->regs at #x%lx", signum, xpPC(context), (natural)xpGPRvector(context));
    10671067   
    1068     if (lisp_Debugger(context, info, signum | foreign, msg)) {
     1068    if (lisp_Debugger(context, info, signum, foreign, msg)) {
    10691069      SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PROPAGATE_EXCEPTION);
    10701070    }
    … …  
    13161316        natural old_foreign_exception = tcr->flags & (1 << TCR_FLAG_BIT_FOREIGN_EXCEPTION);
    13171317
     1318        {
     1319          BytePtr interrupted_sp = (BytePtr)xpGPR(context, Isp);
     1320          area *vs_area = tcr->vs_area;
     1321
     1322          if ((interrupted_sp < vs_area->low) ||
     1323              (interrupted_sp > vs_area->high)) {
     1324            Bug(context, "lisp stack pointer not in lisp stack");
     1325          }
     1326        }
     1327         
    13181328        tcr->flags &= ~(1 << TCR_FLAG_BIT_FOREIGN_EXCEPTION);
    13191329           

  • branches/ia32/lisp-kernel/x86-gc.c

    r8070 r8372  
    4949  } while (0)
    5050#endif
     51
     52
     53void
     54comma_output_decimal(char *buf, int len, natural n)
     55{
     56  int nout = 0;
     57
     58  buf[--len] = 0;
     59  do {
     60    buf[--len] = n%10+'0';
     61    n = n/10;
     62    if (n == 0) {
     63      while (len) {
     64        buf[--len] = ' ';
     65      }
     66      return;
     67    }
     68    if (len == 0) return;
     69    nout ++;
     70    if (nout == 3) {
     71      buf[--len] = ',';
     72      nout = 0;
     73    }
     74  } while (len >= 0);
     75}
    5176
    5277
    … …  
    25352560  area *a = active_dynamic_area, *to = NULL, *from = NULL, *note = NULL;
    25362561  unsigned timeidx = 1;
     2562  paging_info paging_info_start;
    25372563  xframe_list *x;
    25382564  LispObj
    … …  
    25872613
    25882614  if (GCverbose) {
     2615    char buf[16];
     2616
     2617    sample_paging_info(&paging_info_start);
     2618    comma_output_decimal(buf,16,area_dnode(oldfree,a->low) << dnode_shift);
    25892619    if (GCephemeral_low) {
    25902620      fprintf(stderr,
    2591               "\n\n;;; Starting Ephemeral GC of generation %d",
     2621              "\n\n;;; Starting EGC of generation %d",
    25922622              (from == g2_area) ? 2 : (from == g1_area) ? 1 : 0);
    25932623    } else {
    25942624      fprintf(stderr,"\n\n;;; Starting full GC");
    25952625    }
    2596     fprintf(stderr, ",  %ld bytes allocated.\n", area_dnode(oldfree,a->low) << dnode_shift);
     2626    fprintf(stderr, ", %s bytes allocated.\n", buf);
    25972627  }
    25982628
    … …  
    28922922      *( (long long *) ptr_from_lispobj(((macptr *) ptr_from_lispobj(untag(val)))->address)) += justfreed;
    28932923      if (GCverbose) {
     2924        char buf[16];
     2925        paging_info paging_info_stop;
     2926       
     2927        sample_paging_info(&paging_info_stop);
    28942928        if (justfreed <= heap_segment_size) {
    28952929          justfreed = 0;
    28962930        }
     2931        comma_output_decimal(buf,16,justfreed);
    28972932        if (note == tenured_area) {
    2898           fprintf(stderr,";;; Finished full GC.  Freed %lld bytes in %d.%06d s\n\n", justfreed, elapsed.tv_sec, elapsed.tv_usec);
     2933          fprintf(stderr,";;; Finished full GC. %s bytes freed in %d.%06d s\n\n", buf, elapsed.tv_sec, elapsed.tv_usec);
    28992934        } else {
    2900           fprintf(stderr,";;; Finished Ephemeral GC of generation %d.  Freed %lld bytes in %d.%06d s\n\n",
     2935          fprintf(stderr,";;; Finished EGC of generation %d. %s bytes freed in %d.%06d s\n",
    29012936                  (from == g2_area) ? 2 : (from == g1_area) ? 1 : 0,
    2902                   justfreed,
     2937                  buf,
    29032938                  elapsed.tv_sec, elapsed.tv_usec);
    29042939        }
     2940        report_paging_info_delta(stderr, &paging_info_start, &paging_info_stop);
    29052941      }
    29062942    }

  • branches/ia32/objc-bridge/bridge.lisp

    r7666 r8372  
    10881088      method-info)))
    10891089
     1090(defvar *objc-verbose* nil)
     1091
    10901092;;; Still not right; we have to worry about type conflicts with
    10911093;;; shadowed methods, as well.
    … …  
    10931095  (let* ((info (get-objc-message-info message-name)))
    10941096    (unless info
    1095       (format *error-output* "~&; Note: defining new ObjC message ~c[~a ~a]" (if class-p #\+ #\-) class-name message-name)
     1097      (when (or *objc-verbose* *compile-print*)
     1098        (format *error-output* "~&; Note: defining new ObjC message ~c[~a ~a]" (if class-p #\+ #\-) class-name message-name))
    10961099      (setq info (make-objc-message-info :message-name message-name))
    10971100      (setf (gethash message-name *objc-message-info*) info))

  • branches/ia32/scripts/openmcl64

    r6969 r8372  
    3737    ;;
    3838    Linux)
    39     case `arch` in
     39    case `uname -m` in
    4040      ppc64)
    4141      OPENMCL_KERNEL=ppccl64
Note: See TracChangeset for help on using the changeset viewer.