63 lines
		
	
	
		
			1.6 KiB
		
	
	
	
		
			Common Lisp
		
	
	
	
			
		
		
	
	
			63 lines
		
	
	
		
			1.6 KiB
		
	
	
	
		
			Common Lisp
		
	
	
	
| 
 | |
| ; Script to load the Scheme48 linker into Lucid Common Lisp.
 | |
| ; Not tested recently.
 | |
| 
 | |
| (defvar pseudoscheme-directory "../pseudo/")
 | |
| (load (string-append pseudoscheme-directory "loadit"))
 | |
| (setq *use-scheme-read* t)
 | |
| (load-pseudoscheme pseudoscheme-directory)
 | |
| 
 | |
| (progn (revised^4-scheme::define-sharp-macro #\.
 | |
| 	 #'(lambda (c port)
 | |
| 	     (read-char port)
 | |
| 	     (eval (let ((*readtable* ps::scheme-readtable))
 | |
| 		     (read port)))))
 | |
|        (values))
 | |
| 
 | |
| (defun enable-lisp-packages ()
 | |
|   (setq *readtable* ps:scheme-readtable)
 | |
|   (values))
 | |
| 
 | |
| (defun disable-lisp-packages ()
 | |
|   (setq *readtable* ps::roadblock-readtable)
 | |
|   (values))
 | |
| 
 | |
| (ps:scheme)
 | |
| 
 | |
| (benchmark-mode)
 | |
| 
 | |
| (load "alt/config.scm")
 | |
| (load "alt/flatload.scm")
 | |
| (load "bcomp/defpackage.scm")
 | |
| (load-configuration "packages.scm")
 | |
| 
 | |
| (flatload linker-structures)
 | |
| 
 | |
| ; Make no more bootstrap structures - clobber its definition as syntax.
 | |
| (define (make-structure . rest) (error "make-structure" rest))
 | |
| 
 | |
| (let ((#.'clever-load:*compile-if-necessary-p* #t))
 | |
|   (let ((#.'ps:*scheme-read* #.'#'ps::scheme-read-using-commonlisp-reader))
 | |
|     (load "alt/pseudoscheme-record")
 | |
|     (load "alt/pseudoscheme-features"))
 | |
|   (flatload link-config))
 | |
| 
 | |
| (load "alt/init-defpackage.scm")
 | |
| 
 | |
| (define-syntax struct-list    ;not in link.sbin
 | |
|   (syntax-rules ()
 | |
|     ((struct-list name ...) (list (cons 'name name) ...))))
 | |
| 
 | |
| (quit)
 | |
| 
 | |
| (defun disksave-restart-function ()
 | |
|   (format t "~&Scheme48 linker.~2%")
 | |
|   ;; (hax:init-interrupt-delivery)
 | |
|   (ps:scheme)
 | |
|   (terpri))
 | |
| (defun dump-linker ()
 | |
|   (lcl:disksave "link/linker-in-lucid" :gc t :full-gc t :verbose t
 | |
| 		:restart-function #'disksave-restart-function))
 | |
| ;(dump-linker)
 | |
| ;(lcl:quit)
 |