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
|
; -*- Mode: Scheme; Syntax: Scheme; Package: Scheme; -*-
; This is file resume.scm.
; All sizes are in cells
(define (required-init-space startup-vector startup-vector-length)
(+ (+ (do ((i 0 (+ i 1))
(s 0 (+ s (vm-string-size
(string-length
(vector-ref startup-vector i))))))
((>= i startup-vector-length)
s))
(code-vector-size 2))
(+ initial-interpreter-heap-space
(+ initial-stack-heap-space
initial-i/o-heap-space))))
(define (initialize-vm memory-begin memory-size stack-begin stack-size)
(initialize-heap memory-begin memory-size)
(initialize-i/o-system)
(initialize-stack stack-begin stack-size)
(initialize-interpreter))
(define (call-startup-procedure startup-proc
startup-vector
startup-vector-length)
(let ((vector (vm-make-vector startup-vector-length universal-key)))
(do ((i 0 (+ i 1)))
((>= i startup-vector-length))
(vm-vector-set! vector i (enter-string (vector-ref startup-vector i))))
(clear-registers)
(push vector)
(push (initial-input-port))
(push (initial-output-port))
(let ((code (make-code-vector 2 universal-key)))
(code-vector-set! code 0 (enum op call))
(code-vector-set! code 1 3) ; nargs
(set! *code-pointer* (address-after-header code)))
(restart startup-proc)))
(define (restart value)
(set! *val* value)
(let loop ()
(let ((option (interpret)))
(cond ((= option (enum return-option exit))
*val*)
((= option (enum return-option external-call))
(set! *val* (call-external-value ; type inference hack
(fetch (address-after-header (external-value *val*)))
*nargs*
(pointer-to-stack-arguments)))
(remove-stack-arguments (+ *nargs* 1)) ; remove proc and args
(loop))
(else
(error "unkown VM return option" option)
-1)))))
(define-enumeration return-option
(exit
external-call
native-call
native-return
))
|
