;; *************************************************************************************** ;;
;; lisp debug v0.8  : source level debugger for lisp                                             ;;
;; Copyright (C) 1998 Marc Mertens                                                         ;;
;;                                                                                         ;;
;;     This program is free software; you can redistribute it and/or modify                ;;
;;    it under the terms of the GNU General Public License as published by                 ;;
;;    the Free Software Foundation; either version 2 of the License, or                    ;;
;;    (at your option) any later version.                                                  ;;
;;                                                                                         ;;
;;    This program is distributed in the hope that it will be useful,                      ;;
;;    but WITHOUT ANY WARRANTY; without even the implied warranty of                       ;;
;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the                        ;;
;;    GNU General Public License for more details.                                         ;;
;;                                                                                         ;;
;;    You should have received a copy of the GNU General Public License                    ;;
;;    along with this program; if not, write to the Free Software                          ;;
;;    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA            ;;
;;                                                                                         ;;
;; Contact me on mmertens@akam.be                                                          ;;
;; ********************************************************************************************
;;
;; The following functions must be defined to get a link to the interface of the debugger
;;
;; (process-incoming)  ;; Should read the commandos from the interface and process them
;; (send-command)      ;; Should send the commandos from the lisp system to the server
;; (start-interface)   ;; should start the interface
;; (stop-interface)    ;; Should stop the interface
;; (get-unix-env "var" "default") ;; Get a unix evironment value
;;
;; ********************************************************************************************

;; ********************************************************************************************
;; PAckage stuff
;; ********************************************************************************************

(in-package "DEBUGGER")

;; ********************************************************************************************
;; Global variables used in this interface
;; ********************************************************************************************

(defparameter **socket** nil)
(defparameter **socket-fd** nil)

;; ********************************************************************************************
;; Process the incoming commands
;; ********************************************************************************************

(defun process-incoming (&optional fd)
  (when (and fd (null **end-debug-eventloop**))
    (return-from process-incoming))
  (if (and (streamp **socket**) (open-stream-p **socket**))
      (when (listen **socket**)
	(let ((command (read **socket** nil nil)))
	  (eval command)))
    (stop-interface)))

;; ********************************************************************************************
;; Start interface of the debugger and open a socket to it
;; ********************************************************************************************

(defun start-interface ()
  (let ((error nil)
	(i 0))
    ;; Stops old interface if needed
    (stop-interface)
    ;; Starts the interface
    (user::run-shell-command "interface -9001 &" :wait t)
    ;; Create a socket and connect this to the socket created by the interface
    (loop
      (multiple-value-setq (**socket** error)
	(ignore-errors (acl-socket::make-socket :remote-host "127.0.0.1" :remote-port 9001)))
      (cond ((null error) (return))
	    ((= i 5) (format t "Failed to connect to interface")
		     (terpri)
		     (return-from start-interface))
	    (t
	     (sleep 1)
	     (setf i (1+ i)))))
    ;; Find the filedescriptor of the socket-stream , needed for a sigio handler
    (setf **socket-fd** (acl-socket::socket-os-fd **socket**))
    ;; Create a sigio handler for the socket
    (system:set-sigio-handler **socket-fd** 'process-incoming)
    ))

;; ******************************************************************************************
;; Stop connection to the old interface
;; ******************************************************************************************

(defun stop-interface ()
  (when (and (streamp **socket**)
	     (open-stream-p **socket**))
    (system:remove-sigio-handler **socket-fd**)
    (close **socket**))
  (end-debug-eventloop))






;; ***************************************************************************
;; Main interface to the lisp system to send commands to the interface
;; ***************************************************************************

(defun send-command (command &rest arg-lst)
  (when (streamp **socket**)
    (princ command **socket**)
    (mapc #'(lambda (arg)
	      (princ " " **socket**)
	      (cond ((stringp arg)
		     (princ (length arg) **socket**)
		     (princ " " **socket**)
		     (princ arg **socket**))
		    (t
		     (princ arg **socket**))))
	  arg-lst)
    (terpri **socket**)
    (finish-output **socket**)))


;; ******************************************************************************
;; Get value of a unix systemvariable
; *******************************************************************************

(defun get-unix-env (var default)
  (cond ((system::getenv var))
	(t default)))
