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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees, Mike Sperber
; System entry and exit
; Entry point from OS executive. Procedures returned by USUAL-RESUMER
; are suitable for use as the second argument to WRITE-IMAGE.
;
; The placement of INITIALIZE-RECORDS! is questionable. Important parts
; of the system are not in place when it is run.
(define (make-usual-resumer warn-about-undefined-imported-bindings?
entry-point)
;; The argument list needs to be in sync with
;; S48-CALL-STARTUP-PROCEDURE in vm/interp/resume.scm, and
;; MAKE-STARTUP-PROCEDURE in bcomp/comp.scm.
(lambda (resume-arg
in in-encoding out out-encoding error error-encoding
records)
(initialize-rts in in-encoding out out-encoding error error-encoding
(lambda ()
(initialize-os-string-text-codec!)
(run-initialization-thunks)
(initialize-records! records)
(if warn-about-undefined-imported-bindings?
(warn-about-undefined-imported-bindings))
(entry-point
(map byte-vector->os-string
(vector->list resume-arg)))))))
(define (usual-resumer entry-point)
(make-usual-resumer #t entry-point))
(define (warn-about-undefined-imported-bindings)
(let ((undefined-bindings (find-undefined-imported-bindings)))
(do ((size (vector-length undefined-bindings))
(i 0 (+ 1 i)))
((= i size))
(debug-message "undefined imported binding "
(shared-binding-name (vector-ref undefined-bindings i))))))
(define (initialize-rts in in-encoding out out-encoding error error-encoding
thunk)
(initialize-session-data!)
(initialize-dynamic-state!)
(initialize-exceptions!
(lambda ()
(initialize-interrupts!
spawn-on-root
(lambda ()
(initialize-external-events!)
(let ((in-port (input-channel->port in))
(out-port (output-channel->port out))
(error-port (output-channel->port error 0))) ; zero-length buffer
(set-encoding! in-port in-encoding)
(set-encoding! out-port out-encoding)
(set-encoding! error-port error-encoding)
(initialize-i/o
in-port out-port error-port
(lambda ()
(with-threads
(lambda ()
(root-scheduler thunk
200 ; thread quantum, in msec
300))))))))))) ; port-flushing quantum
; Leave the default if we can't find a suitable codec
(define (set-encoding! port encoding)
(cond
((find-text-codec encoding) =>
(lambda (codec)
(set-port-text-codec! port codec)))))
; This is primarily for LOAD-DYNAMIC-EXTERNALS; we don't want to
; refer to it directly here, because that would increase the size of
; the image by 100k.
; Use this with care: no efforts are being made to remove duplicates.
(define *initialization-thunks* '())
(define (add-initialization-thunk! thunk)
(set! *initialization-thunks*
(cons thunk *initialization-thunks*)))
(define (run-initialization-thunks)
(for-each (lambda (thunk) (thunk))
*initialization-thunks*))
; Add the full/empty buffer handlers.
(initialize-i/o-handlers! define-vm-exception-handler signal-vm-exception)
|
