scsh-0.5/link/lucid-script.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)