;;; -*- Mode: LISP; Syntax: Common-lisp; Base: 10; Lowercase: T; -*- ;;; ;;; TEXAS INSTRUMENTS INCORPORATED ;;; P.O. BOX 2909 ;;; AUSTIN, TEXAS 78769 ;;; ;;; Portions Copyright (C) 1987 Texas Instruments Incorporated. ;;; Portions Copyright (C) 1988, 1989 Franz Inc, Berkeley, Ca. ;;; ;;; Permission is granted to any individual or institution to use, copy, modify, ;;; and distribute this software, provided that this complete copyright and ;;; permission notice is maintained, intact, in all copies and supporting ;;; documentation. ;;; ;;; Texas Instruments Incorporated provides this software "as is" without ;;; express or implied warranty. ;;; ;;; Franz Incorporated provides this software "as is" without express or ;;; implied warranty. ;;; #+ features used in this file ;;; clx-ansi-common-lisp ;;; lispm ;;; genera ;;; minima ;;; lucid ;;; lcl3.0 ;;; apollo ;;; kcl ;;; ibcl ;;; excl #+(or Genera Minima) (eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:pushnew :clx-ansi-common-lisp common-lisp:*features*)) #+(and Genera clx-ansi-common-lisp) (eval-when (:compile-toplevel :load-toplevel :execute) (setf *readtable* si:*ansi-common-lisp-readtable*)) #-clx-ansi-common-lisp (lisp:in-package :user) #+clx-ansi-common-lisp (common-lisp:in-package :common-lisp-user) ;;;; Lisp Machines #+(and lispm (not genera)) (global:defsystem CLX (:pathname-default "clx:clx;") (:patchable "clx:patch;" clx-ti) (:initial-status :experimental) (:module package "package") (:module depdefs "depdefs") (:module clx "clx") (:module dependent "dependent") (:module macros "macros") (:module bufmac "bufmac") (:module buffer "buffer") (:module display "display") (:module gcontext "gcontext") (:module requests "requests") (:module input "input") (:module fonts "fonts") (:module graphics "graphics") (:module text "text") (:module attributes "attributes") (:module translate "translate") (:module keysyms "keysyms") (:module manager "manager") (:module image "image") (:module resource "resource") (:module doc "doc") (:compile-load package) (:compile-load depdefs (:fasload package)) (:compile-load clx (:fasload package depdefs)) (:compile-load dependent (:fasload package depdefs clx)) ;; Macros only needed for compilation (:skip :compile-load macros (:fasload package depdefs clx dependent)) ;; Bufmac only needed for compilation (:skip :compile-load bufmac (:fasload package depdefs clx dependent macros)) (:compile-load buffer (:fasload package depdefs clx dependent macros bufmac)) (:compile-load display (:fasload package depdefs clx dependent macros bufmac buffer)) (:compile-load gcontext (:fasload package depdefs clx dependent macros bufmac buffer display)) (:compile-load input (:fasload package depdefs clx dependent macros bufmac buffer display)) (:compile-load requests (:fasload package depdefs clx dependent macros bufmac buffer display input)) (:compile-load fonts (:fasload package depdefs clx dependent macros bufmac buffer display)) (:compile-load graphics (:fasload package depdefs clx dependent macros fonts bufmac buffer display fonts)) (:compile-load text (:fasload package depdefs clx dependent macros fonts bufmac buffer display gcontext fonts)) (:compile-load-init attributes (dependent) (:fasload package depdefs clx dependent macros bufmac buffer display)) (:compile-load translate (:fasload package depdefs clx dependent macros bufmac buffer display)) (:compile-load keysyms (:fasload package depdefs clx dependent macros bufmac buffer display translate)) (:compile-load manager (:fasload package depdefs clx dependent macros bufmac buffer display)) (:compile-load image (:fasload package depdefs clx dependent macros bufmac buffer display)) (:compile-load resource (:fasload package depdefs clx dependent macros bufmac buffer display)) (:auxiliary doc) ) ;;; Symbolics Lisp Machines #+Genera (scl:defsystem CLX (:default-pathname "SYS:X11;CLX;" :pretty-name "CLX" :maintaining-sites (:scrc) :distribute-sources t :distribute-binaries t :source-category :basic) (:module doc ("doc") (:type :lisp-example)) (:serial "package" "depdefs" "generalock" "clx" "dependent" "macros" "bufmac" "buffer" "display" "gcontext" "input" "requests" "fonts" "graphics" "text" "attributes" "translate" "keysyms" "manager" "image" "resource")) ;;; Franz ;; ;; The following is a suggestion. If you comment out this form be ;; prepared for possible deadlock, since no interrupts will be recognized ;; while reading from the X socket if the scheduler is not running. ;; #+excl (setq compiler::generate-interrupt-checks-switch (compile nil '(lambda (safety size speed &optional debug) (declare (ignore size debug)) (or (< speed 3) (> safety 0))))) ;;; Allegro #+allegro (excl:defsystem :clx () |package| (|excldep| :load-before-compile (|package|) :recompile-on (|package|)) (|depdefs| :load-before-compile (|package| |excldep|) :recompile-on (|excldep|)) (|clx| :load-before-compile (|package| |excldep| |depdefs|) :recompile-on (|package| |excldep| |depdefs|)) (|dependent| :load-before-compile (|package| |excldep| |depdefs| |clx|) :recompile-on (|clx|)) (|exclcmac| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|) :recompile-on (|dependent|)) (|macros| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac|) :recompile-on (|exclcmac|)) (|bufmac| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros|) :recompile-on (|macros|)) (|buffer| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros| |bufmac|) :recompile-on (|bufmac|)) (|display| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros| |bufmac| |buffer|) :recompile-on (|buffer|)) (|gcontext| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros| |bufmac| |buffer| |display|) :recompile-on (|display|)) (|input| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros| |bufmac| |buffer| |display|) :recompile-on (|display|)) (|requests| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros| |bufmac| |buffer| |display| |input|) :recompile-on (|display|)) (|fonts| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros| |bufmac| |buffer| |display|) :recompile-on (|display|)) (|graphics| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros| |bufmac| |buffer| |display| |fonts|) :recompile-on (|fonts|)) (|text| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros| |bufmac| |buffer| |display| |gcontext| |fonts|) :recompile-on (|gcontext| |fonts|) :load-after (|translate|)) ;; The above line gets around a compiler macro expansion bug. (|attributes| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros| |bufmac| |buffer| |display|) :recompile-on (|display|)) (|translate| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros| |bufmac| |buffer| |display| |text|) :recompile-on (|display|)) (|keysyms| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros| |bufmac| |buffer| |display| |translate|) :recompile-on (|translate|)) (|manager| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros| |bufmac| |buffer| |display|) :recompile-on (|display|)) (|image| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros| |bufmac| |buffer| |display|) :recompile-on (|display|)) ;; Don't know if l-b-c list is correct. XX (|resource| :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent| |exclcmac| |macros| |bufmac| |buffer| |display|) :recompile-on (|display|)) ) #+allegro (excl:defsystem :clx-debug (:default-pathname "debug/" :needed-systems (:clx) :load-before-compile (:clx)) |describe| |keytrans| |trace| |util|) ;;;; Compile CLX ;;; COMPILE-CLX compiles the lisp source files and loads the binaries. ;;; It goes to some trouble to let the source files be in one directory ;;; and the binary files in another. Thus the same set of sources can ;;; be used for different machines and/or lisp systems. It also allows ;;; you to supply explicit extensions, so source files do not have to ;;; be renamed to fit into the naming conventions of an implementation. ;;; For example, ;;; (compile-clx "*.lisp" "machine/") ;;; compiles source files from the connected directory and puts them ;;; into the "machine" subdirectory. You can then load CLX out of the ;;; machine directory. ;;; The code has no knowledge of the source file types (eg, ".l" or ;;; ".lisp") or of the binary file types (eg, ".b" or ".sbin"). Calling ;;; compile-file and load with a file type of NIL usually sorts things ;;; out correctly, but you may have to explicitly give the source and ;;; binary file types. ;;; An attempt at compiling the C language sources is also made, ;;; but you may have to set different compiler switches ;;; should be. If it doesn't do the right thing, then do ;;; (compile-clx "" "" :compile-c NIL) ;;; to prevent the compilation. ;;; compilation notes ;;; lucid2.0/hp9000s300 ;;; must uudecode the file make-sequence-patch.uu #+(or lucid kcl ibcl) (defun clx-foreign-files (binary-path) #+(and lucid (not lcl3.0) (or mc68000 mc68020)) (load (merge-pathnames "make-sequence-patch" binary-path)) #+(and lucid apollo) (lucid::load-foreign-file (namestring (merge-pathnames "socket" binary-path)) :preserve-pathname t) #+(and lucid (not apollo)) (lucid::load-foreign-files (list (namestring (merge-pathnames "socket.o" binary-path))) '("-lc")) #+(or kcl ibcl) (progn (let ((pathname (merge-pathnames "sockcl.o" binary-path)) (options (concatenate 'string (namestring (merge-pathnames "socket.o" binary-path)) " -lc"))) (format t "~&Faslinking ~A with ~A.~%" pathname options) (si:faslink (namestring pathname) options) (format t "~&Finished faslinking ~A.~%" pathname))) ) #-(or lispm allegro) (defun compile-clx (&optional (source-pathname-defaults "") (binary-pathname-defaults "") &key (compile-c t)) ;; The pathname-defaults above might only be strings, so coerce them ;; to pathnames. Build a default binary path with every component ;; of the source except the file type. This should prevent ;; (compile-clx "*.lisp") from destroying source files. (let* ((source-path (pathname source-pathname-defaults)) (path (make-pathname :host (pathname-host source-path) :device (pathname-device source-path) :directory (pathname-directory source-path) :name (pathname-name source-path) :type nil :version (pathname-version source-path))) (binary-path (merge-pathnames binary-pathname-defaults path)) #+clx-ansi-common-lisp (*compile-verbose* t) (*load-verbose* t)) ;; Make sure source-path and binary-path file types are distinct so ;; we don't accidently overwrite the source files. NIL should be an ;; ok type, but anything else spells trouble. (if (and (equal (pathname-type source-path) (pathname-type binary-path)) (not (null (pathname-type binary-path)))) (error "Source and binary pathname defaults have same type ~s ~s" source-path binary-path)) (format t "~&;;; Default paths: ~s ~s~%" source-path binary-path) ;; In lucid make sure we're using the compiler in production mode. #+lcl3.0 (progn (unless (member :pqc *features*) (cerror "Go ahead anyway." "Lucid's production mode compiler must be loaded to compile CLX.")) (proclaim '(optimize (speed 3) (safety 1) (space 0) (compilation-speed 0)))) (labels ((compile-lisp (filename) (let ((source (merge-pathnames filename source-path)) (binary (merge-pathnames filename binary-path))) ;; If the source and binary pathnames are the same, ;; then don't supply an output file just to be sure ;; compile-file defaults correctly. #+(or kcl ibcl) (load source) (if (equal source binary) (compile-file source) (compile-file source :output-file binary)) binary)) (compile-and-load (filename) (load (compile-lisp filename))) #+(or lucid kcl ibcl) (compile-c (filename) (let* ((c-filename (concatenate 'string filename ".c")) (o-filename (concatenate 'string filename ".o")) (src (merge-pathnames c-filename source-path)) (obj (merge-pathnames o-filename binary-path)) (args (list "-c" (namestring src) "-o" (namestring obj) #+mips "-G 0" #+(or hp sysv) "-DSYSV" #+(and mips (not dec)) "-I/usr/include/bsd" #-(and mips (not dec)) "-DUNIXCONN" #+(and lucid pa) "-DHPUX -DHPUX7.0" ))) (format t ";;; cc~{ ~A~}~%" args) (unless (zerop #+lucid (multiple-value-bind (iostream estream exitstatus pid) ;; in 2.0, run-program is exported from system: ;; in 3.0, run-program is exported from lcl: ;; system inheirits lcl (system::run-program "cc" :arguments args) (declare (ignore iostream estream pid)) exitstatus) #+(or kcl ibcl) (system (format nil "cc~{ ~A~}" args))) (error "Compile of ~A failed." src))))) ;; Now compile and load all the files. ;; Defer compiler warnings until everything's compiled, if possible. (#+clx-ansi-common-lisp with-compilation-unit #+lcl3.0 lucid::with-deferred-warnings #-(or lcl3.0 clx-ansi-common-lisp) progn () (compile-and-load "package") #+(or lucid kcl ibcl) (when compile-c (compile-c "socket")) #+(or kcl ibcl) (compile-lisp "sockcl") #+(or lucid kcl ibcl) (clx-foreign-files binary-path) #+excl (compile-and-load "excldep") (compile-and-load "depdefs") (compile-and-load "clx") (compile-and-load "dependent") #+excl (compile-and-load "exclcmac") ; these are just macros (compile-and-load "macros") ; these are just macros (compile-and-load "bufmac") ; these are just macros (compile-and-load "buffer") (compile-and-load "display") (compile-and-load "gcontext") (compile-and-load "input") (compile-and-load "requests") (compile-and-load "fonts") (compile-and-load "graphics") (compile-and-load "text") (compile-and-load "attributes") (compile-and-load "translate") (compile-and-load "keysyms") (compile-and-load "manager") (compile-and-load "image") (compile-and-load "resource") )))) ;;;; Load CLX ;;; This procedure loads the binaries for CLX. All of the binaries ;;; should be in the same directory, so setting the default pathname ;;; should point load to the right place. ;;; You should have a module definition somewhere so the require/provide ;;; mechanism can avoid reloading CLX. In an ideal world, somebody would ;;; just put ;;; (REQUIRE 'CLX) ;;; in their file (some implementations don't have a central registry for ;;; modules, so a pathname needs to be supplied). ;;; The REQUIRE should find a file that does ;;; (IN-PACKAGE 'XLIB :USE '(LISP)) ;;; (PROVIDE 'CLX) ;;; (LOAD ) ;;; (LOAD-CLX ) #-(or lispm allegro) (defun load-clx (&optional (binary-pathname-defaults "") &key (macrosp nil)) (let* ((source-path (pathname "")) (path (make-pathname :host (pathname-host source-path) :device (pathname-device source-path) :directory (pathname-directory source-path) :name (pathname-name source-path) :type nil :version (pathname-version source-path))) (binary-path (merge-pathnames binary-pathname-defaults path)) (*load-verbose* t)) (flet ((load-binary (filename) (let ((binary (merge-pathnames filename binary-path))) (load binary)))) (load-binary "package") #+(or lucid kcl ibcl) (clx-foreign-files binary-path) #+excl (load-binary "excldep") (load-binary "depdefs") (load-binary "clx") (load-binary "dependent") (when macrosp #+excl (load-binary "exclcmac") (load-binary "macros") (load-binary "bufmac")) (load-binary "buffer") (load-binary "display") (load-binary "gcontext") (load-binary "input") (load-binary "requests") (load-binary "fonts") (load-binary "graphics") (load-binary "text") (load-binary "attributes") (load-binary "translate") (load-binary "keysyms") (load-binary "manager") (load-binary "image") (load-binary "resource") )))