summaryrefslogtreecommitdiff
path: root/gcl/xgcl-2/sysdef.lisp
blob: edded8f0d8d25fa86f2c96ff885be001d56e7b46 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
; Copyright (c) 1994 William F. Schelter

; See the files gnu.license and dec.copyright .

; 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 1, 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., 675 Mass Ave, Cambridge, MA 02139, USA.

; Some of the files that interface to the Xlib are adapted from DEC/MIT files.
; See the file dec.copyright for details.

(make-package :XLIB :use '(:lisp :si))
(in-package :XLIB)

(defvar *files* '( "gcl_Xlib"
      "gcl_Xutil"
      "gcl_X"
      "gcl_XAtom"
      "gcl_defentry_events"
      "gcl_Xstruct"
      "gcl_XStruct_l_3"
      "gcl_general"
      "gcl_keysymdef"
      "gcl_X10"
      "gcl_Xinit"
      "gcl_dwtrans"
      "gcl_tohtml"
      "gcl_index"
;      "gcl_sysinit"
      ))


(defun compile-xgcl()
  (mapc (lambda (x) 
	  (let ((x (concatenate 'string compiler::*cc* " -I../h " (namestring x))))
	    (unless (zerop (system x))
	      (error "compile failure: ~s~%" x))))
	(directory "*.c"))
  (let ((compiler::*default-c-file* t)
	(compiler::*default-h-file* t)
	(compiler::*default-data-file* t)
	(compiler::*default-system-p* t))
    (mapc (lambda (x)
	    (compile-file (format nil "~a.lsp" x) :system-p t)) *files*)))


(defun load-xgcl()
  (mapcar (lambda (x) (load (format nil "~a.o" x))) *files*))

(defun load-interp-xgcl()
  (mapcar (lambda (x) (load (format nil "~a.lsp" x))) *files*))

(defun load-xgcl-interp()
  (mapcar (lambda (x) (load (format nil "~a.lsp" x))) *files*))

(defun save-xgcl (pn)
  (let* ((x (mapcar (lambda (x) (probe-file (concatenate 'string x ".o"))) *files*))
	 (y (directory "*.o"))
	 (z (set-difference y x :test 'equal)))
    (compiler::link x 
		    (namestring pn) 
		    (format nil "(load ~s)
                                 (mapc 'load '~s)
                                 (let ((si::*disable-recompile* nil))
                                    (si::do-recompile ~s))" 
			    "sysdef.lisp" x (let ((q "gcl_xrecompile.lsp")) (when (probe-file q) (delete-file q)) q))
		    (reduce (lambda (&rest xy) (when xy (concatenate 'string (namestring (car xy)) " " (cadr xy)))) z
			    :initial-value " -lXmu -lXt -lXext -lXaw -lX11" :from-end t) nil)
    (let ((x (append x (list "gcl_xrecompile.o"))))
      (compiler::link x 
		      (namestring pn) 
		      (format nil "(load ~s)
                                   (mapc 'load '~s)
                                   (setq si::*optimize-maximum-pages* t si::*disable-recompile* nil)" 
			      "sysdef.lisp" x (let ((q "gcl_xrecompile.lsp")) (when (probe-file q) (delete-file q)) q))
		    (reduce (lambda (&rest xy) (when xy (concatenate 'string (namestring (car xy)) " " (cadr xy)))) z
			    :initial-value " -lXmu -lXt -lXext -lXaw -lX11" :from-end t) nil))))