;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*- ;;; Reason: Fix X server initialization so it is only done once, ;;; even when multiple processes are attempting to do it. ;;; Fixes SPRs 10728 and 10725. ;;; RESTRICTED RIGHTS LEGEND ;;; ;;; Use, duplication, or disclosure by the Government is subject to ;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in ;;; Technical Data and Computer Software clause at 52.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED ;;; P.O. BOX 2909, M/S 2151 ;;; AUSTIN, TEXAS 78769 ;;; ;;; Copyright (C) 1989 Texas Instruments Incorporated. ;;; All rights reserved. ;;; Written 12/06/89 14:45:11 by HAGY, ;;; while running on Zwingli from band LOD1 ;;; With SYSTEM 6.25, VIRTUAL-MEMORY 6.2, EH 6.5, MAKE-SYSTEM 6.2, MICRONET 6.0, LOCAL-FILE 6.1, ;;; BASIC-PATHNAME 6.2, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.7, NETWORK-NAMESPACE 6.0, ;;; DISK-IO 6.1, DISK-LABEL 6.0, BASIC-FILE 6.6, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0, ;;; COMPILER 6.14, TV 6.19, DATALINK 6.0, CHAOSNET 6.5, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.2, ;;; SYSLOG 6.2, STREAMER-TAPE 6.5, UCL 6.0, INPUT-EDITOR 6.0, METER 6.1, ZWEI 6.8, ;;; DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.2, DATALINK-DISPLAYS 6.0, ;;; FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.3, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.2, ;;; IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.3, MAIL-READER 6.6, TELNET 6.0, VT100 6.0, ;;; NAMESPACE-EDITOR 6.4, PROFILE 6.2, VISIDOC 6.5, TI-CLOS 6.26, CLEH 6.5, IP 3.56, ;;; Experimental CLX 6.7, CLUE 6.34, X11M 6.18, Experimental BUG 11.17, microcode 430, ;;; Band Name: REL 6.0 + SLE 11/28 #!C ; From file DEFS.LISP#> X11M.SERVER; Hotel: #10R X11#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "X11")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: X11M.SERVER; DEFS.#" ;;; The following global variable is used to synchronize ;;; the X server initialization. The three states are: ;;; nil => the server is uninitialized ;;; :TRANS => the server is in transition (being initialized) ;;; :INIT => the server has been initialized (defparameter *monochrome-server-state* nil) )) #!C ; From file SERVER-INIT.LISP#> X11M.SERVER; Hotel: #10R X11#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "X11")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: X11M.SERVER; SERVER-INIT.#" (DEFUN INITIALIZE-MONOCHROME-SERVER (&OPTIONAL &REST ARGS) "Top-level initialization function for the monochrome server." (let ((previous-state nil)) (when (not (eq *monochrome-server-state* :INIT)) ; Do nothing if server already initialized (without-interrupts (setf previous-state *monochrome-server-state*) (when (null *monochrome-server-state*) ; If server is uninitialized (setf *monochrome-server-state* :TRANS))) ; set state to "in transition" (when (eq previous-state :TRANS) ; Server is in transition, wait for (process-wait "X Init" ; it to be initialized #'(lambda () (eq *monochrome-server-state* :INIT)))) (when (null previous-state) ; If server was uninitialized, initialize it (CREATE-INITIAL-SCREEN-CONFIGURATION) ;; Reset the search path for fonts back to what it is initially. (unless (equal *font-default-search-path* *font-initial-search-path*) (set-server-font-paths *font-initial-search-path*)) (INITIALIZE-EXPLORER-CURSOR) (INITIALIZE-MONOCHROME-SERVER-DEVICES ARGS) (SETUP-PREDEFINED-ATOMS) (INITIALIZE-PROCESSES) (SERVER-RESET) (setf *monochrome-server-state* :INIT) ; Set server state to initialized )))) )) #!C ; From file SERVER-INIT.LISP#> X11M.SERVER; Hotel: #10R X11#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "X11")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: X11M.SERVER; SERVER-INIT.#" (DEFUN KILL-X () "Kill off all X windows and X processes. Use this when you want to start off with a fresh new server." (flet ((substring-equal (a b) (string-equal a b :end1 (length b)))) (LOOP FOR PROCESS IN SI:ALL-PROCESSES DO (WHEN (MEMBER (SEND PROCESS :NAME) '("X Server" "X Dispatcher" "X Mouse") :TEST #'substring-equal) (SEND PROCESS :KILL))) (LOOP FOR WINDOW IN (FUNCALL TV:MAIN-SCREEN :INFERIORS) DO (WHEN (substring-equal (FUNCALL WINDOW :NAME) "X SERVER") (FUNCALL WINDOW :KILL))) ;; To make sure we really kill it off, we need to do this twice. (LOOP FOR PROCESS IN SI:ALL-PROCESSES DO (WHEN (MEMBER (string (SEND PROCESS :NAME)) '("X Server" "X Dispatcher" "X Mouse") :TEST #'substring-equal) (SEND PROCESS :KILL)))) (setq dispatcher-process nil mouse-process nil) ;; Don't try to close a connection when we have killed off the server. (when (and (find-package "XLIB") ;; What a hack! What's this supposed to be doing, anyway? - LGO (find-symbol "EXPLORER-SERVER" "XLIB")) (setf (symbol-value (find-symbol "EXPLORER-SERVER" "XLIB")) nil)) (setf *monochrome-server-state* nil) ; Set server state to uninitialized ) )) #!C ; From file SERVER-FDEFS.LISP#> X11M.SERVER; Hotel: #10R X11#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "X11")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: X11M.SERVER; SERVER-FDEFS.#" (DEFUN ALLOCATE-CONNECTION-NUMBER () "Allocate a connection for a client." ;; We start with an index of 1 because 0 is reserved for atoms. (without-interrupts ; Eliminate dual access by independent processes (LOOP FOR INDEX FROM 1 BELOW (LENGTH *CONNECTIONS-LIST*) WHEN (ZEROP (AREF *CONNECTIONS-LIST* INDEX)) DO (PROGN (SETF (AREF *CONNECTIONS-LIST* INDEX) 1) (RETURN INDEX)) FINALLY (RETURN NIL)))) ))