home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / lisp / clx_tar.z / clx_tar / clx / defsystem.lsp < prev    next >
Encoding:
Text File  |  1993-02-05  |  17.4 KB  |  522 lines
  1. ;;; -*- Mode: LISP; Syntax: Common-lisp; Base: 10; Lowercase: T;  -*-
  2.  
  3. ;;;
  4. ;;;             TEXAS INSTRUMENTS INCORPORATED
  5. ;;;                  P.O. BOX 2909
  6. ;;;                   AUSTIN, TEXAS 78769
  7. ;;;
  8. ;;; Portions Copyright (C) 1987 Texas Instruments Incorporated.
  9. ;;; Portions Copyright (C) 1988, 1989 Franz Inc, Berkeley, Ca.
  10. ;;;
  11. ;;; Permission is granted to any individual or institution to use, copy, modify,
  12. ;;; and distribute this software, provided that this complete copyright and
  13. ;;; permission notice is maintained, intact, in all copies and supporting
  14. ;;; documentation.
  15. ;;;
  16. ;;; Texas Instruments Incorporated provides this software "as is" without
  17. ;;; express or implied warranty.
  18. ;;;
  19. ;;; Franz Incorporated provides this software "as is" without express or
  20. ;;; implied warranty.
  21.  
  22. ;;; #+ features used in this file
  23. ;;;   clx-ansi-common-lisp
  24. ;;;   lispm
  25. ;;;   genera
  26. ;;;   minima
  27. ;;;   lucid
  28. ;;;   lcl3.0
  29. ;;;   apollo
  30. ;;;   kcl
  31. ;;;   ibcl
  32. ;;;   excl
  33. ;;;   CMU
  34. ;;;   CLISP
  35.  
  36. #+(or Genera Minima)
  37. (eval-when (:compile-toplevel :load-toplevel :execute)
  38.   (common-lisp:pushnew :clx-ansi-common-lisp common-lisp:*features*))
  39.  
  40. #+(and Genera clx-ansi-common-lisp)
  41. (eval-when (:compile-toplevel :load-toplevel :execute)
  42.   (setf *readtable* si:*ansi-common-lisp-readtable*))
  43.  
  44. #-clx-ansi-common-lisp 
  45. (lisp:in-package :user)
  46.  
  47. #+clx-ansi-common-lisp
  48. (common-lisp:in-package :common-lisp-user)
  49.  
  50.  
  51. ;;;; Lisp Machines
  52.  
  53. #+(and lispm (not genera))
  54. (global:defsystem CLX
  55.   (:pathname-default "clx:clx;")
  56.   (:patchable "clx:patch;" clx-ti)
  57.   (:initial-status :experimental)
  58.  
  59.   (:module package "package")
  60.   (:module depdefs "depdefs")
  61.   (:module clx "clx")
  62.   (:module dependent "dependent")
  63.   (:module macros "macros")
  64.   (:module bufmac "bufmac")
  65.   (:module buffer "buffer")
  66.   (:module display "display")
  67.   (:module gcontext "gcontext")
  68.   (:module requests "requests")
  69.   (:module input "input")
  70.   (:module fonts "fonts")
  71.   (:module graphics "graphics")
  72.   (:module text "text")
  73.   (:module attributes "attributes")
  74.   (:module translate "translate")
  75.   (:module keysyms "keysyms")
  76.   (:module manager "manager")
  77.   (:module image "image")
  78.   (:module resource "resource")
  79.   (:module doc "doc")
  80.  
  81.   (:compile-load package)
  82.   (:compile-load depdefs
  83.    (:fasload package))
  84.   (:compile-load clx
  85.    (:fasload package depdefs))
  86.   (:compile-load dependent
  87.    (:fasload package depdefs clx))
  88.   ;; Macros only needed for compilation
  89.   (:skip :compile-load macros
  90.    (:fasload package depdefs clx dependent))
  91.   ;; Bufmac only needed for compilation
  92.   (:skip :compile-load bufmac
  93.    (:fasload package depdefs clx dependent macros))
  94.   (:compile-load buffer
  95.    (:fasload package depdefs clx dependent macros bufmac))
  96.   (:compile-load display
  97.    (:fasload package depdefs clx dependent macros bufmac buffer))
  98.   (:compile-load gcontext
  99.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  100.   (:compile-load input
  101.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  102.   (:compile-load requests
  103.    (:fasload package depdefs clx dependent macros bufmac buffer display input))
  104.   (:compile-load fonts
  105.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  106.   (:compile-load graphics
  107.    (:fasload package depdefs clx dependent macros fonts bufmac buffer display
  108.          fonts))
  109.   (:compile-load text
  110.    (:fasload package depdefs clx dependent macros fonts bufmac buffer display
  111.          gcontext fonts))
  112.   (:compile-load-init attributes
  113.    (dependent)
  114.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  115.   (:compile-load translate
  116.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  117.   (:compile-load keysyms
  118.    (:fasload package depdefs clx dependent macros bufmac buffer display
  119.          translate))
  120.   (:compile-load manager
  121.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  122.   (:compile-load image
  123.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  124.   (:compile-load resource
  125.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  126.   (:auxiliary doc)
  127.   )
  128.  
  129.  
  130. ;;; Symbolics Lisp Machines
  131. #+Genera
  132. (scl:defsystem CLX
  133.     (:default-pathname "SYS:X11;CLX;"
  134.      :pretty-name "CLX"
  135.      :maintaining-sites (:scrc)
  136.      :distribute-sources t
  137.      :distribute-binaries t
  138.      :source-category :basic)
  139.   (:module doc ("doc")
  140.        (:type :lisp-example))
  141.   (:serial
  142.     "package" "depdefs" "generalock" "clx" "dependent" "macros" "bufmac"
  143.     "buffer" "display" "gcontext" "input" "requests" "fonts" "graphics"
  144.     "text" "attributes" "translate" "keysyms" "manager" "image" "resource"))
  145.  
  146.  
  147. ;;; Franz
  148.  
  149. ;;
  150. ;; The following is a suggestion.  If you comment out this form be
  151. ;; prepared for possible deadlock, since no interrupts will be recognized
  152. ;; while reading from the X socket if the scheduler is not running.
  153. ;;
  154. #+excl
  155. (setq compiler::generate-interrupt-checks-switch
  156.       (compile nil
  157.            '(lambda (safety size speed &optional debug)
  158.           (declare (ignore size debug))
  159.           (or (< speed 3) (> safety 0)))))
  160.  
  161.  
  162. ;;; Allegro
  163.  
  164. #+allegro
  165. (excl:defsystem :clx 
  166.   ()
  167.   |package|
  168.   (|excldep|
  169.     :load-before-compile (|package|)
  170.     :recompile-on (|package|))
  171.   (|depdefs|
  172.     :load-before-compile (|package| |excldep|)
  173.     :recompile-on (|excldep|))
  174.   (|clx|
  175.     :load-before-compile (|package| |excldep| |depdefs|)
  176.     :recompile-on (|package| |excldep| |depdefs|))
  177.   (|dependent|
  178.     :load-before-compile (|package| |excldep| |depdefs| |clx|)
  179.     :recompile-on (|clx|))
  180.   (|exclcmac|
  181.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|)
  182.     :recompile-on (|dependent|))
  183.   (|macros|
  184.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  185.               |exclcmac|)
  186.     :recompile-on (|exclcmac|))
  187.   (|bufmac|
  188.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  189.               |exclcmac| |macros|)
  190.     :recompile-on (|macros|))
  191.   (|buffer|
  192.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  193.               |exclcmac| |macros| |bufmac|)
  194.     :recompile-on (|bufmac|))
  195.   (|display|
  196.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  197.               |exclcmac| |macros| |bufmac| |buffer|)
  198.     :recompile-on (|buffer|))
  199.   (|gcontext|
  200.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  201.               |exclcmac| |macros| |bufmac| |buffer| |display|)
  202.     :recompile-on (|display|))
  203.   (|input|
  204.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  205.               |exclcmac| |macros| |bufmac| |buffer| |display|)
  206.     :recompile-on (|display|))
  207.   (|requests|
  208.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  209.               |exclcmac| |macros| |bufmac| |buffer| |display|
  210.               |input|)
  211.     :recompile-on (|display|))
  212.   (|fonts|
  213.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  214.               |exclcmac| |macros| |bufmac| |buffer| |display|)
  215.     :recompile-on (|display|))
  216.   (|graphics|
  217.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  218.               |exclcmac| |macros| |bufmac| |buffer| |display|
  219.               |fonts|)
  220.     :recompile-on (|fonts|))
  221.   (|text|
  222.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  223.               |exclcmac| |macros| |bufmac| |buffer| |display|
  224.               |gcontext| |fonts|)
  225.     :recompile-on (|gcontext| |fonts|)
  226.     :load-after (|translate|))
  227.   ;; The above line gets around a compiler macro expansion bug.
  228.   
  229.   (|attributes|
  230.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  231.               |exclcmac| |macros| |bufmac| |buffer| |display|)
  232.     :recompile-on (|display|))
  233.   (|translate|
  234.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  235.               |exclcmac| |macros| |bufmac| |buffer| |display|
  236.               |text|)
  237.     :recompile-on (|display|))
  238.   (|keysyms|
  239.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  240.               |exclcmac| |macros| |bufmac| |buffer| |display|
  241.               |translate|)
  242.     :recompile-on (|translate|))
  243.   (|manager|
  244.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  245.               |exclcmac| |macros| |bufmac| |buffer| |display|)
  246.     :recompile-on (|display|))
  247.   (|image|
  248.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  249.               |exclcmac| |macros| |bufmac| |buffer| |display|)
  250.     :recompile-on (|display|))
  251.   
  252.   ;; Don't know if l-b-c list is correct.  XX
  253.   (|resource|
  254.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  255.               |exclcmac| |macros| |bufmac| |buffer| |display|)
  256.     :recompile-on (|display|))
  257.   )
  258.  
  259. #+allegro
  260. (excl:defsystem :clx-debug
  261.     (:default-pathname "debug/"
  262.      :needed-systems (:clx)
  263.      :load-before-compile (:clx))
  264.   |describe| |keytrans| |trace| |util|)
  265.  
  266.  
  267. ;;;; Compile CLX
  268.  
  269. ;;; COMPILE-CLX compiles the lisp source files and loads the binaries.
  270. ;;; It goes to some trouble to let the source files be in one directory
  271. ;;; and the binary files in another.  Thus the same set of sources can
  272. ;;; be used for different machines and/or lisp systems.  It also allows
  273. ;;; you to supply explicit extensions, so source files do not have to
  274. ;;; be renamed to fit into the naming conventions of an implementation.
  275.  
  276. ;;; For example,
  277. ;;;     (compile-clx "*.lisp" "machine/")
  278. ;;; compiles source files from the connected directory and puts them
  279. ;;; into the "machine" subdirectory.  You can then load CLX out of the
  280. ;;; machine directory.
  281.  
  282. ;;; The code has no knowledge of the source file types (eg, ".l" or
  283. ;;; ".lisp") or of the binary file types (eg, ".b" or ".sbin").  Calling
  284. ;;; compile-file and load with a file type of NIL usually sorts things
  285. ;;; out correctly, but you may have to explicitly give the source and
  286. ;;; binary file types.
  287.  
  288. ;;; An attempt at compiling the C language sources is also made,
  289. ;;; but you may have to set different compiler switches
  290. ;;; should be.  If it doesn't do the right thing, then do
  291. ;;;     (compile-clx "" "" :compile-c NIL)
  292. ;;; to prevent the compilation.
  293.  
  294. ;;; compilation notes
  295. ;;;   lucid2.0/hp9000s300
  296. ;;;     must uudecode the file make-sequence-patch.uu
  297.  
  298. #+(or lucid kcl ibcl)
  299. (defun clx-foreign-files (binary-path)
  300.  
  301.   #+(and lucid (not lcl3.0) (or mc68000 mc68020))
  302.   (load (merge-pathnames "make-sequence-patch" binary-path))
  303.  
  304.   #+(and lucid apollo)
  305.   (lucid::load-foreign-file
  306.     (namestring (merge-pathnames "socket" binary-path))
  307.     :preserve-pathname t)
  308.  
  309.   #+(and lucid (not apollo))
  310.   (lucid::load-foreign-files
  311.     (list (namestring (merge-pathnames "socket.o" binary-path)))
  312.     '("-lc"))
  313.  
  314.   #+(or kcl ibcl)
  315.   (progn
  316.     (let ((pathname (merge-pathnames "sockcl.o" binary-path))
  317.       (options
  318.         (concatenate
  319.           'string
  320.           (namestring (merge-pathnames "socket.o" binary-path))
  321.           " -lc")))
  322.       (format t "~&Faslinking ~A with ~A.~%" pathname options)
  323.       (si:faslink (namestring pathname) options)
  324.       (format t "~&Finished faslinking ~A.~%" pathname)))
  325.   )
  326.  
  327. #-(or lispm allegro)
  328. (defun compile-clx (&optional
  329.             (source-pathname-defaults "")
  330.             (binary-pathname-defaults "")
  331.             &key
  332.             (compile-c t))
  333.  
  334.   ;; The pathname-defaults above might only be strings, so coerce them
  335.   ;; to pathnames.  Build a default binary path with every component
  336.   ;; of the source except the file type.  This should prevent
  337.   ;; (compile-clx "*.lisp") from destroying source files.
  338.   (let* ((source-path (pathname source-pathname-defaults))
  339.      (path        (make-pathname
  340.             :host      (pathname-host      source-path)
  341.             :device    (pathname-device    source-path)
  342.             :directory (pathname-directory source-path)
  343.             :name      (pathname-name      source-path)
  344.             :type      nil
  345.             :version   (pathname-version   source-path)))
  346.      (binary-path (merge-pathnames binary-pathname-defaults
  347.                        path))
  348.      #+clx-ansi-common-lisp (*compile-verbose* t)
  349.      (*load-verbose* t))
  350.                        
  351.     ;; Make sure source-path and binary-path file types are distinct so
  352.     ;; we don't accidently overwrite the source files.  NIL should be an
  353.     ;; ok type, but anything else spells trouble.
  354.     (if (and (equal (pathname-type source-path)
  355.             (pathname-type binary-path))
  356.          (not (null (pathname-type binary-path))))
  357.     (error "Source and binary pathname defaults have same type ~s ~s"
  358.            source-path binary-path))
  359.  
  360.     (format t "~&;;; Default paths: ~s ~s~%" source-path binary-path)
  361.  
  362.     ;; In lucid make sure we're using the compiler in production mode.
  363.     #+lcl3.0
  364.     (progn
  365.       (unless (member :pqc *features*)
  366.     (cerror
  367.       "Go ahead anyway."
  368.       "Lucid's production mode compiler must be loaded to compile CLX."))
  369.       (proclaim '(optimize (speed 3)
  370.                (safety 1)
  371.                (space 0)
  372.                (compilation-speed 0))))
  373.  
  374.     (labels ((compile-lisp (filename)
  375.            (let ((source (merge-pathnames filename source-path))
  376.              (binary (merge-pathnames filename binary-path)))
  377.          ;; If the source and binary pathnames are the same,
  378.          ;; then don't supply an output file just to be sure
  379.          ;; compile-file defaults correctly.
  380.          #+(or kcl ibcl) (load source)
  381.          (if (equal source binary)
  382.              (compile-file source)
  383.            (compile-file source :output-file binary  
  384.                  #+CMU :error-file #+CMU nil))
  385.          binary))
  386.          (compile-and-load (filename)
  387.            (load (compile-lisp filename)))
  388.          #+(or lucid kcl ibcl)
  389.          (compile-c (filename)
  390.            (let* ((c-filename (concatenate 'string filename ".c"))
  391.               (o-filename (concatenate 'string filename ".o"))
  392.               (src (merge-pathnames c-filename source-path))
  393.               (obj  (merge-pathnames o-filename binary-path))
  394.               (args (list "-c" (namestring src)
  395.                   "-o" (namestring obj)
  396.                   #+mips "-G 0"
  397.                   #+(or hp sysv) "-DSYSV"
  398.                   #+(and mips (not dec)) "-I/usr/include/bsd"
  399.                   #-(and mips (not dec)) "-DUNIXCONN"
  400.                   #+(and lucid pa) "-DHPUX -DHPUX7.0"
  401.                   )))
  402.          (format t ";;; cc~{ ~A~}~%" args)
  403.          (unless
  404.            (zerop 
  405.              #+lucid
  406.              (multiple-value-bind (iostream estream exitstatus pid)
  407.              ;; in 2.0, run-program is exported from system:
  408.              ;; in 3.0, run-program is exported from lcl:
  409.              ;; system inheirits lcl
  410.              (system::run-program "cc" :arguments args)
  411.                (declare (ignore iostream estream pid))
  412.                exitstatus)
  413.              #+(or kcl ibcl)
  414.              (system (format nil "cc~{ ~A~}" args)))
  415.            (error "Compile of ~A failed." src)))))
  416.  
  417.       ;; Now compile and load all the files.
  418.       ;; Defer compiler warnings until everything's compiled, if possible.
  419.       (#+clx-ansi-common-lisp with-compilation-unit
  420.        #+lcl3.0 lucid::with-deferred-warnings
  421.        #-(or lcl3.0 clx-ansi-common-lisp) progn
  422.        ()
  423.        
  424.        (compile-and-load "package")
  425.        #+akcl (compile-and-load "kcl-patches")
  426.        #+(or lucid kcl ibcl) (when compile-c (compile-c "socket"))
  427.        #+(or kcl ibcl) (compile-lisp "sockcl")
  428.        #+(or lucid kcl ibcl) (clx-foreign-files binary-path)
  429.        #+excl (compile-and-load "excldep")
  430.        (compile-and-load "depdefs")
  431.        (compile-and-load "clx")
  432.        (compile-and-load "dependent")
  433.        #+excl (compile-and-load "exclcmac")    ; these are just macros
  434.        (compile-and-load "macros")        ; these are just macros
  435.        (compile-and-load "bufmac")        ; these are just macros
  436.        (compile-and-load "buffer")
  437.        (compile-and-load "display")
  438.        (compile-and-load "gcontext")
  439.        (compile-and-load "input")
  440.        (compile-and-load "requests")
  441.        (compile-and-load "fonts")
  442.        (compile-and-load "graphics")
  443.        (compile-and-load "text")
  444.        (compile-and-load "attributes")
  445.        (compile-and-load "translate")
  446.        (compile-and-load "keysyms")
  447.        (compile-and-load "manager")
  448.        (compile-and-load "image")
  449.        (compile-and-load "resource")
  450.        (compile-and-load "describe")
  451.        (compile-and-load "trace")
  452.        ))))
  453.  
  454.  
  455. ;;;; Load CLX
  456.  
  457. ;;; This procedure loads the binaries for CLX.  All of the binaries
  458. ;;; should be in the same directory, so setting the default pathname
  459. ;;; should point load to the right place.
  460.  
  461. ;;; You should have a module definition somewhere so the require/provide
  462. ;;; mechanism can avoid reloading CLX.  In an ideal world, somebody would
  463. ;;; just put
  464. ;;;        (REQUIRE 'CLX)
  465. ;;; in their file (some implementations don't have a central registry for
  466. ;;; modules, so a pathname needs to be supplied).
  467.  
  468. ;;; The REQUIRE should find a file that does
  469. ;;;        (IN-PACKAGE 'XLIB :USE '(LISP))
  470. ;;;        (PROVIDE 'CLX)
  471. ;;;        (LOAD <clx-defsystem-file>)
  472. ;;;        (LOAD-CLX <binary-specific-clx-directory>)
  473.  
  474. #-(or lispm allegro)
  475. (defun load-clx (&optional (binary-pathname-defaults "")
  476.          &key (macrosp nil))
  477.  
  478.   (let* ((source-path (pathname ""))
  479.      (path        (make-pathname
  480.             :host      (pathname-host      source-path)
  481.             :device    (pathname-device    source-path)
  482.             :directory (pathname-directory source-path)
  483.             :name      (pathname-name      source-path)
  484.             :type      nil
  485.             :version   (pathname-version   source-path)))
  486.      (binary-path (merge-pathnames binary-pathname-defaults
  487.                        path))
  488.      (*load-verbose* t))
  489.  
  490.     (flet ((load-binary (filename)
  491.          (let ((binary (merge-pathnames filename binary-path)))
  492.            (load binary))))
  493.  
  494.       (load-binary "package")
  495.       #+akcl (load-binary "kcl-patches")
  496.       #+(or lucid kcl ibcl) (clx-foreign-files binary-path)
  497.       #+excl (load-binary "excldep")
  498.       (load-binary "depdefs")
  499.       (load-binary "clx")
  500.       (load-binary "dependent")
  501.       (when macrosp
  502.     #+excl (load-binary "exclcmac")
  503.     (load-binary "macros")
  504.     (load-binary "bufmac"))
  505.       (load-binary "buffer")
  506.       (load-binary "display")
  507.       (load-binary "gcontext")
  508.       (load-binary "input")
  509.       (load-binary "requests")
  510.       (load-binary "fonts")
  511.       (load-binary "graphics")
  512.       (load-binary "text")
  513.       (load-binary "attributes")
  514.       (load-binary "translate")
  515.       (load-binary "keysyms")
  516.       (load-binary "manager")
  517.       (load-binary "image")
  518.       (load-binary "resource")
  519.       (load-binary "describe")
  520.       (load-binary "trace")
  521.       )))
  522.