/[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.17 by camm, Mon Aug 23 23:31:13 2004 UTC revision 1.18 by camm, Fri Nov 19 21:38:44 2004 UTC
# Line 35  Line 35 
35    
36    
37  (defvar *compiler-in-use* nil)  (defvar *compiler-in-use* nil)
38    (defvar *compiler-compile* nil)
39  (defvar *compiler-input*)  (defvar *compiler-input*)
40  (defvar *compiler-output1*)  (defvar *compiler-output1*)
41  (defvar *compiler-output2*)  (defvar *compiler-output2*)
# Line 426  Cannot compile ~a.~%" Line 427  Cannot compile ~a.~%"
427      (wt-data1 form)  ;; this binds all the print stuff      (wt-data1 form)  ;; this binds all the print stuff
428      ))      ))
429    
   
430  (defun compile (name &optional def &aux tem gaz (*default-pathname-defaults* #"."))  (defun compile (name &optional def &aux tem gaz (*default-pathname-defaults* #"."))
431    
432    (cond ((not(symbolp name)) (error "Must be a name"))    (cond ((not(symbolp name)) (error "Must be a name"))
# Line 441  Cannot compile ~a.~%" Line 441  Cannot compile ~a.~%"
441           (setf (symbol-function 'cmp-anon) tem)           (setf (symbol-function 'cmp-anon) tem)
442           (compile 'cmp-anon)           (compile 'cmp-anon)
443           (setf (macro-function name) (macro-function name))           (setf (macro-function name) (macro-function name))
444           name)           ;; FIXME -- support warnings-p and failures-p.  CM 20041119
445             (values name nil nil))
446          ((and (setq tem (symbol-function name))          ((and (setq tem (symbol-function name))
447                (consp tem))                (consp tem))
448           (let ((na (if (symbol-package name) name 'cmp-anon)))           (let ((na (if (symbol-package name) name 'cmp-anon))
449                   (tem (wrap-literals tem)))
450             (unless (and (fboundp 'si::init-cmp-anon) (or (si::init-cmp-anon) (fmakunbound 'si::init-cmp-anon)))             (unless (and (fboundp 'si::init-cmp-anon) (or (si::init-cmp-anon) (fmakunbound 'si::init-cmp-anon)))
451               (with-open-file               (with-open-file
452                (st (setq gaz (gazonk-name)) :direction :output)                (st (setq gaz (gazonk-name)) :direction :output)
# Line 452  Cannot compile ~a.~%" Line 454  Cannot compile ~a.~%"
454                                                 (lambda (cdr tem))                                                 (lambda (cdr tem))
455                                                 (lambda-block (cddr tem))                                                 (lambda-block (cddr tem))
456                                                 ))       st))                                                 ))       st))
457               (let ((fi (compile-file gaz)))               (let ((fi (let ((*compiler-compile* t))
458                             (compile-file gaz))))
459                 (load fi)                 (load fi)
460                 (delete-file fi))                 (delete-file fi))
461               (unless *keep-gaz* (delete-file gaz)))               (unless *keep-gaz* (delete-file gaz)))
462             (or (eq na name) (setf (symbol-function name) (symbol-function na)))             (or (eq na name) (setf (symbol-function name) (symbol-function na)))
463             (symbol-function name)           ;; FIXME -- support warnings-p and failures-p.  CM 20041119
464               (values (symbol-function name) nil nil)
465             ))             ))
466          (t (error "can't compile ~a" name))))          (t (error "can't compile ~a" name))))
467    

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18

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