/[gcl]/gcl/cmpnew/gcl_cmpmain.lsp
ViewVC logotype

Diff of /gcl/cmpnew/gcl_cmpmain.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.36 by camm, Wed Oct 12 03:12:57 2005 UTC revision 1.37 by camm, Thu Oct 13 21:20:05 2005 UTC
# Line 163  Line 163 
163     (if (consp *split-files*)     (if (consp *split-files*)
164         (setf (car *split-files*) (+ (third *split-files*) section-length)))))         (setf (car *split-files*) (+ (third *split-files*) section-length)))))
165    
166    (defvar *init-name*)
167    
168  (defun compile-file1 (input-pathname  (defun compile-file1 (input-pathname
169                        &key (output-file (merge-pathnames *o-ext* input-pathname))                        &key (output-file (merge-pathnames *o-ext* input-pathname))
# Line 190  Line 191 
191                                           nil ;inits                                           nil ;inits
192                                           nil                                           nil
193                                           ))                                           ))
                            *init-name*    
194                             (*fasd-data* *fasd-data*)                             (*fasd-data* *fasd-data*)
195                             (*error-count* 0))                             (*error-count* 0))
196    (declare (special *c-debug* *init-name* system-p))    (declare (special *c-debug* system-p))
197    (when input-pathname    (when input-pathname
198      (setq input-pathname (si:search-local-pathname input-pathname)))      (setq input-pathname (si:search-local-pathname input-pathname)))
199    (when output-file    (when output-file
# Line 408  Cannot compile ~a.~%" Line 408  Cannot compile ~a.~%"
408            (values)            (values)
409            )))))            )))))
410    
411  (defun gazonk-name ( &aux tem)  (defun gazonk-name ()
412    (dotimes (i 1000)    (dotimes (i 1000)
413      (let ((tem (merge-pathnames (format nil "gazonk~d.lsp" i))))      (let ((tem (merge-pathnames (format nil "gazonk~d.lsp" i))))
414        (unless (probe-file tem)        (unless (probe-file tem)
# Line 476  Cannot compile ~a.~%" Line 476  Cannot compile ~a.~%"
476           (setf (macro-function name) (macro-function name))           (setf (macro-function name) (macro-function name))
477           nil)           nil)
478          ((and (setq tem (symbol-function name))          ((and (setq tem (symbol-function name))
479                (or (consp tem) (when (typep tem 'interpreted-function) (setq tem (si::interpreted-function-lambda tem))))                (or (consp tem) (when (typep tem 'interpreted-function)
480                                    (setq tem (si::interpreted-function-lambda tem))))
481                (eq (car tem) 'lambda-block))                (eq (car tem) 'lambda-block))
482           (let ((gaz (gazonk-name)))           (let ((gaz (gazonk-name)))
483             (with-open-file             (with-open-file
# Line 494  Cannot compile ~a.~%" Line 495  Cannot compile ~a.~%"
495                   (on (get-output-pathname gaz "o" gaz )))                   (on (get-output-pathname gaz "o" gaz )))
496               (with-open-file (st cn)               (with-open-file (st cn)
497                               (do () ((let ((a (read-line st)))                               (do () ((let ((a (read-line st)))
498                                         (when (>= (si::string-match "gazonk[0-9]*.h" a) 0)                                         (when (>= (si::string-match
499                                                      (load-time-value
500                                                       (si::compile-regexp
501                                                        #u"gazonk[0-9]*.h")) a) 0)
502                                           (format t "~%~d~%" a)                                           (format t "~%~d~%" a)
503                                           a))))                                           a))))
504                               (si::copy-stream st *standard-output*))                               (si::copy-stream st *standard-output*))
# Line 745  SYSTEM_SPECIAL_INIT Line 749  SYSTEM_SPECIAL_INIT
749  ;  the loading of binary objects on systems relocating with dlopen.  ;  the loading of binary objects on systems relocating with dlopen.
750  ;  ;
751    
752  (defun make-user-init (files outn &aux tem)  (defun make-user-init (files outn)
753    
754    (let* ((c (pathname outn))    (let* ((c (pathname outn))
755           (c (merge-pathnames c (make-pathname :directory '(:current))))           (c (merge-pathnames c (make-pathname :directory '(:current))))
# Line 826  SYSTEM_SPECIAL_INIT Line 830  SYSTEM_SPECIAL_INIT
830                     new                     new
831                     (mysub (subseq str y) it new)))))                     (mysub (subseq str y) it new)))))
832    
833  (defun link (files image &optional post extra-libs (run-user-init t) &aux raw init)  (defun link (files image &optional post extra-libs (run-user-init t))
834    
835    (let* ((ui (make-user-init files "user-init"))    (let* ((ui (make-user-init files "user-init"))
836           (raw (pathname image))           (raw (pathname image))

Legend:
Removed from v.1.36  
changed lines
  Added in v.1.37

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26