Changeset 15021


Ignore:
Timestamp:
Oct 13, 2011, 7:52:46 PM (8 years ago)
Author:
gz
Message:

New file "remote-lisp.lisp", initially just containing the non-ide aspects of the swank loader taken from the ide, cleaned up a bit.

Location:
trunk/source
Files:
1 added
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/preferences.lisp

    r13448 r15021  
    143143                                         sender)
    144144  (declare (ignore sender))
    145   (unless (or *ccl-swank-active-p*
    146               (maybe-start-swank-listener :override-user-preference t))
     145  (unless (maybe-start-swank-listener :override-user-preference t)
    147146    (alert-window :message "Unable to start the Swank server.")))
    148147
  • trunk/source/cocoa-ide/swank-listener.lisp

    r12214 r15021  
    11;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: cl-user -*-
     2;;;
     3;;;   Copyright (C) 2011 Clozure Associates
     4;;;   This file is part of Clozure CL. 
     5;;;
     6;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
     7;;;   License , known as the LLGPL and distributed with Clozure CL as the
     8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
     9;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
     10;;;   conflict, the preamble takes precedence. 
     11;;;
     12;;;   Clozure CL 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
    217;;;; ***********************************************************************
    318;;;; FILE IDENTIFICATION
     
    1530(in-package :GUI)
    1631
    17 (defparameter *ccl-swank-active-p* nil)
     32(defparameter *active-gui-swank-listener-port* nil)
    1833(defparameter *default-swank-listener-port* 4884)
    19 (defparameter *active-gui-swank-listener-port* nil)
    20 (defparameter *ccl-swank-listener-active-p* nil)
    21 (defvar *swank-listener-process* nil)
    22 
    23 (defun swank-listener-active? ()
    24   (and *swank-listener-process*
    25        (typep *swank-listener-process* 'process)
    26        (not (member (process-whostate *swank-listener-process*)
    27                     '("Reset" "Exhausted")
    28                     :test 'string-equal))))
    2934
    3035;;; preference-swank-listener-port
     
    3338  (with-autorelease-pool
    3439    (let* ((defaults (handler-case (#/values (#/sharedUserDefaultsController ns:ns-user-defaults-controller))
    35                        (serious-condition (c)
     40                       (error (c)
    3641                         (progn (log-debug "~%ERROR: Unable to get preferences from the Shared User Defaults Controller: ~A"
    3742                                           c)
     
    4853                         (or port *default-swank-listener-port*))
    4954           ;; parsing the port number failed
    50            (serious-condition (c)
     55           (error (c)
    5156             (declare (ignore c))
    52              (setf *ccl-swank-listener-active-p* nil)
    5357             (#_NSLog #@"\nError starting swank listener; the user preference is not a valid port number: %@\n"
    5458                    :id swank-port-pref)
     
    6670  (with-autorelease-pool
    6771   (let* ((defaults (handler-case (#/values (#/sharedUserDefaultsController ns:ns-user-defaults-controller))
    68                      (serious-condition (c)
     72                     (error (c)
    6973                       (progn (log-debug "~%ERROR: Unable to get preferences from the Shared User Defaults Controller: ~a" c)
    7074                              nil))))
     
    99103           nil))))))
    100104
    101 ;;; start-swank-listener
    102 ;;; -----------------------------------------------------------------
    103 ;;; starts up CCL's swank-listener server on the specified port
    104 
    105 ;;; aux utils
    106 
    107 (defvar $emacs-ccl-swank-request-marker "[emacs-ccl-swank-request]")
    108 
    109 (defvar $last-swank-message-sent nil)
    110 
    111 (defun swank-server-running? ()
    112   (and (find-package :swank)
    113        (let ((active-listeners (symbol-value (intern "*LISTENER-SOCKETS*" :swank))))
    114          (and (not (null active-listeners))
    115               (first active-listeners)))))
    116 
    117 (defstruct (swank-status (:conc-name swank-))
    118   (active? nil :read-only t)
    119   (message nil :read-only t)
    120   (requested-loader nil :read-only t)
    121   (requested-port nil :read-only t))
    122 
    123 (defun read-swank-ping (tcp-stream)
    124   (read-line tcp-stream nil nil nil))
    125 
    126 (defun parse-swank-ping (p)
    127   (let ((sentinel-end (length $emacs-ccl-swank-request-marker)))
    128     (if (typep p 'string)
    129         (if (string= p $emacs-ccl-swank-request-marker :start1 0 :end1 sentinel-end)
    130             (let* ((request (subseq p sentinel-end))
    131                    (split-pos (position #\: request))
    132                    (port-str (if split-pos
    133                                  (subseq request 0 split-pos)
    134                                  nil))
    135                    (port (when port-str (parse-integer port-str :junk-allowed nil)))
    136                    (path-str (if split-pos
    137                                  (subseq request (1+ split-pos))
    138                                  request)))
    139               (values (string-trim '(#\space #\tab #\return #\newline) path-str) port))
    140             nil)
    141         nil)))
    142 
    143 
    144 (defun load-and-start-swank (path requested-port)
    145   (handler-case (let* ((active-swank-port (swank-server-running?))
    146                        (msg (format nil "A swank server is already running on port ~A" active-swank-port)))
    147                   (if active-swank-port
    148                       (progn
    149                         (log-debug msg)
    150                         (make-swank-status :active? t :message msg :requested-loader path :requested-port requested-port))
    151                       (progn
    152                         (load path)
    153                         (let ((swank-loader-package (find-package :swank-loader)))
    154                           (if swank-loader-package
    155                               ;; swank loaded. start the server
    156                               (progn
    157                                 (funcall (intern "LOAD-SWANK" swank-loader-package))
    158                                 (funcall (intern "CREATE-SERVER" (find-package :swank)) :port requested-port :dont-close t)
    159                                 (make-swank-status :active? t :requested-loader path :requested-port requested-port))
    160                               ;; swank failed to load. return failure status
    161                               (make-swank-status :active? nil :message "swank load failed" :requested-loader path :requested-port requested-port))))))
    162     (ccl::socket-creation-error (e) (log-debug "Unable to start a swank server on port: ~A; ~A"
    163                                                requested-port e)
    164                                 (make-swank-status :active? nil :message "socket-creation error"
    165                                                    :requested-loader path :requested-port requested-port))
    166     (serious-condition (e) (log-debug "There was a problem creating the swank server on port ~A: ~A"
    167                                       requested-port e)
    168                        (make-swank-status :active? nil :message "error loading or starting swank"
    169                                           :requested-loader path :requested-port requested-port))))
    170 
    171 (defun swank-ready? (status)
    172   (swank-active? status))
    173 
    174 (defun send-swank-response (tcp-stream status)
    175   (let ((response
    176          (let ((*print-case* :downcase))
    177            (format nil "(:active ~S :loader ~S :message ~S :port ~D)"
    178                    (swank-active? status)
    179                    (swank-requested-loader status)
    180                    (swank-message status)
    181                    (swank-requested-port status)))))
    182     (format tcp-stream response)
    183     (finish-output tcp-stream)))
    184 
    185 (defun handle-swank-client (c)
    186   (let* ((msg (read-swank-ping c)))
    187     (multiple-value-bind (swank-path requested-port)
    188         (parse-swank-ping msg)
    189       (load-and-start-swank swank-path requested-port))))
    190 
    191 (defun stop-swank-listener ()
    192   (process-kill *swank-listener-process*)
    193   (setq *swank-listener-process* nil))
    194 
    195 ;;; the real deal
    196 ;;; if it succeeds, it returns a PROCESS object
    197 ;;; if it fails, it returns a CONDITION object
    198 (defun start-swank-listener (&optional (port *default-swank-listener-port*))
    199   (handler-case
    200       (if (swank-listener-active?)
    201           (log-debug "in start-swank-listener: the swank listener process is already running")
    202           (setq *swank-listener-process*
    203                 (process-run-function "Swank Listener"
    204                                       #'(lambda ()
    205                                           (with-open-socket (sock :type :stream :connect :passive
    206                                                                   :local-port port :reuse-address t :auto-close t)
    207                                             (loop
    208                                                (let* ((client-sock (accept-connection sock))
    209                                                       (status (handle-swank-client client-sock)))
    210                                                  (send-swank-response client-sock status))))))))
    211     (ccl::socket-creation-error (c) (nslog-condition c "Unable to create a socket for the swank-listener: ") c)
    212     (ccl::socket-error (c) (nslog-condition c "Swank-listener failed trying to accept a client connection: ") c)
    213     (serious-condition (c) (nslog-condition c "Error starting in the swank-listener:") c)))
    214 
    215105;;; maybe-start-swank-listener
    216106;;; -----------------------------------------------------------------
     
    218108;;; warranted.
    219109(defun maybe-start-swank-listener (&key (override-user-preference nil))
    220   (unless *ccl-swank-listener-active-p*
    221110    ;; try to determine the user preferences concerning the
    222111    ;; swank-listener port number and whether the swank listener
     
    225114    (let* ((start-swank-listener? (or (preference-start-swank-listener?) override-user-preference))
    226115           (swank-listener-port (or (preference-swank-listener-port) *default-swank-listener-port*)))
    227       (if (and start-swank-listener? swank-listener-port)
    228           ;; try to start the swank listener
    229           (handler-case (let ((swank-listener (start-swank-listener swank-listener-port)))
    230                           (if (typep swank-listener 'process)
    231                               (progn
    232                                 (setf *active-gui-swank-listener-port* swank-listener-port)
    233                                 (setf *ccl-swank-listener-active-p* t)
    234                                 swank-listener-port)
    235                               (progn
    236                                 (setf *active-gui-swank-listener-port* nil)
    237                                 (setf *ccl-swank-listener-active-p* nil)
    238                                 nil)))
    239             ;; swank listener creation failed
    240             (serious-condition (c)
    241               (setf *active-gui-swank-listener-port* nil)
    242               (setf *ccl-swank-listener-active-p* nil)
    243               (log-debug "~%Error starting swank listener: ~A~%" c)
    244               nil))
    245           ;; don't try to start the swank listener
    246           (progn
    247             (setf *active-gui-swank-listener-port* nil)
    248             (setf *ccl-swank-listener-active-p* nil)
    249             nil)))))
     116      (unless (and start-swank-listener?
     117                   (eql swank-listener-port *active-gui-swank-listener-port*)
     118                   ccl::*swank-loader-process*
     119                   (not (process-exhausted-p ccl::*swank-loader-process*)))
     120        (ccl::stop-swank-loader)
     121        (setf *active-gui-swank-listener-port* nil)
     122        (when (and start-swank-listener?
     123                   swank-listener-port
     124                   (ccl::start-swank-loader swank-listener-port))
     125          (setf *active-gui-swank-listener-port* swank-listener-port)))))
    250126
    251127(provide :swank-listener)
  • trunk/source/level-1/l1-boot-2.lisp

    r14911 r15021  
    353353      (bin-load-provide "CORE-FILES" "core-files")
    354354      (bin-load-provide "DOMINANCE" "dominance")
     355      (bin-load-provide "REMOTE-LISP" "remote-lisp")
    355356      (bin-load-provide "MCL-COMPAT" "mcl-compat")
    356357      (require "LOOP")
  • trunk/source/lib/compile-ccl.lisp

    r14911 r15021  
    230230    core-files
    231231    dominance
     232    remote-lisp
    232233    ;; asdf has peculiar compile-time side-effects
    233234    ;;asdf
  • trunk/source/lib/systems.lisp

    r14911 r15021  
    227227    (core-files       "ccl:bin;core-files"       ("ccl:library;core-files.lisp"))
    228228    (dominance        "ccl:bin;dominance"        ("ccl:library;dominance.lisp"))
     229    (remote-lisp      "ccl:bin;remote-lisp"    ("ccl:library;remote-lisp.lisp"))
    229230 
    230231    (prepare-mcl-environment "ccl:bin;prepare-mcl-environment" ("ccl:lib;prepare-mcl-environment.lisp"))
Note: See TracChangeset for help on using the changeset viewer.