1; Part of Scheme 48 1.9.  See file COPYING for notices and license.
2
3; Authors: Richard Kelsey, Jonathan Rees, Mike Sperber
4
5; System entry and exit
6
7; Entry point from OS executive.  Procedures returned by USUAL-RESUMER
8; are suitable for use as the second argument to WRITE-IMAGE.
9;
10; The placement of INITIALIZE-RECORDS! is questionable.  Important parts
11; of the system are not in place when it is run.
12
13(define (make-usual-resumer warn-about-undefined-imported-bindings?
14			    entry-point)
15  ;; The argument list needs to be in sync with
16  ;; S48-CALL-STARTUP-PROCEDURE in vm/interp/resume.scm, and
17  ;; MAKE-STARTUP-PROCEDURE in bcomp/comp.scm.
18  (lambda (resume-arg
19	   in in-encoding out out-encoding error error-encoding
20	   records)
21    (initialize-rts in in-encoding out out-encoding error error-encoding
22		    (lambda ()
23		      (initialize-os-string-text-codec!)
24		      (run-initialization-thunks)
25		      (initialize-records! records)
26		      (if warn-about-undefined-imported-bindings?
27			  (warn-about-undefined-imported-bindings))
28		      (entry-point
29		       (map byte-vector->os-string
30			    (vector->list resume-arg)))))))
31
32(define (usual-resumer entry-point)
33  (make-usual-resumer #t entry-point))
34
35(define (warn-about-undefined-imported-bindings)
36  (let ((undefined-bindings (find-undefined-imported-bindings)))
37    (do ((size (vector-length undefined-bindings))
38	 (i 0 (+ 1 i)))
39	((= i size))
40      (debug-message "undefined imported binding "
41		     (shared-binding-name (vector-ref undefined-bindings i))))))
42
43(define (initialize-rts in in-encoding out out-encoding error error-encoding
44			thunk)
45  (initialize-session-data!)
46  (initialize-dynamic-state!)
47  (initialize-exceptions!
48   (lambda ()
49     (initialize-interrupts!
50      spawn-on-root
51      (lambda ()
52	(initialize-external-events!)
53
54	(let ((in-port (input-channel->port in))
55	      (out-port (output-channel->port out))
56	      (error-port (output-channel->port error 0))) ; zero-length buffer
57
58	  (set-encoding! in-port in-encoding)
59	  (set-encoding! out-port out-encoding)
60	  (set-encoding! error-port error-encoding)
61
62	  (initialize-i/o
63	   in-port out-port error-port
64	   (lambda ()
65	     (with-threads
66	      (lambda ()
67		(root-scheduler thunk
68				200	; thread quantum, in msec
69				300))))))))))) ; port-flushing quantum
70
71; Leave the default if we can't find a suitable codec
72(define (set-encoding! port encoding)
73  (cond
74   ((find-text-codec encoding) =>
75    (lambda (codec)
76      (set-port-text-codec! port codec)))))
77
78; This is primarily for LOAD-DYNAMIC-EXTERNALS; we don't want to
79; refer to it directly here, because that would increase the size of
80; the image by 100k.
81
82; Use this with care: no efforts are being made to remove duplicates.
83
84(define *initialization-thunks* '())
85
86(define (add-initialization-thunk! thunk)
87  (set! *initialization-thunks*
88	(cons thunk *initialization-thunks*)))
89
90(define (run-initialization-thunks)
91  (for-each (lambda (thunk) (thunk))
92	    *initialization-thunks*))
93
94; Add the full/empty buffer handlers.
95
96(initialize-i/o-handlers! define-vm-exception-handler signal-vm-exception)
97