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
|
; Script to load the Scheme 48 linker into Common Lisp.
; Requires Pseudoscheme 2.11.
(defvar pseudoscheme-directory "../pseudo/")
(load (concatenate 'string pseudoscheme-directory "loadit.lisp"))
; or perhaps (load (merge-pathnames "loadit.lisp" pseudoscheme-directory))
(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))
(ps:scheme)
;--------------------
; Scheme forms
(benchmark-mode)
(define config-env ; (interaction-environment) would also work here.
(#.'scheme-translator:make-program-env
'%config
(list #.'scheme-translator:revised^4-scheme-structure)))
(load "bcomp/module-language" config-env)
(load "alt/config" config-env)
(load "env/flatload" config-env)
(eval '(set! *load-file-type* #f) config-env)
(define load-config
(let ((load-config (eval 'load-configuration config-env)))
(lambda (filename)
(load-config filename config-env))))
(load-config "packages")
(define flatload-package (eval 'flatload config-env))
(flatload-package (eval 'linker-structures config-env) config-env)
(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")))
(let ((#.'clever-load:*compile-if-necessary-p* #t))
(flatload-package (eval 'link-config config-env)))
(load "alt/init-defpackage.scm")
(define-syntax struct-list ;not in link.sbin
(syntax-rules ()
((struct-list ?name ...) (list (cons '?name ?name) ...))))
;--------------------
(quit)
#+Lucid
(defun disksave-restart-function ()
(format t "~&Scheme 48 linker.~2%")
;; (hax:init-interrupt-delivery) - for threads
(ps:scheme)
(terpri))
#+Lucid
(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)
; Debugging hacks
;(defun enable-lisp-packages ()
; (setq *readtable* ps:scheme-readtable)
; (values))
;(defun disable-lisp-packages ()
; (setq *readtable* ps::roadblock-readtable)
; (values))
|
