Ensure that newspace is the space in front when dumping an image the

prevent relocation on startup.
This commit is contained in:
mainzelm 2002-08-15 16:35:26 +00:00
parent 671f2c0181
commit 8f1dfb6935
5 changed files with 23 additions and 7 deletions

View File

@ -59,6 +59,9 @@
(swap! *newspace-begin* *oldspace-begin*)
(swap! *newspace-end* *oldspace-end*))
(define (s48-newspace<oldspace?)
(address< s48-*limit* *oldspace-limit*))
;----------------
(define (s48-available? cells)

View File

@ -135,6 +135,7 @@
(define-interface heap-interface
(export s48-available
s48-heap-size
s48-newspace<oldspace?
s48-find-all
s48-find-all-records

View File

@ -19,6 +19,8 @@
(define-structure heap heap-interface
(open prescheme)
(begin
(define s48-newspace<oldspace?
(external "s48_newspaceLoldspaceP" (=> () boolean)))
(define s48-available
(external "s48_available" (=> () integer)))
(define s48-heap-size

View File

@ -83,7 +83,7 @@
interpreter-internal
channel-io vmio
memory data struct
images interpreter-gc
images interpreter-gc heap
symbols external-opcodes
stack ;pop
stob) ;immutable

View File

@ -414,6 +414,16 @@
(let ((status (write-string (extract-string comment-string) port)))
(if (error? status)
(port-lose (enum exception os-error) status port)
;; little hack for faster startup:
;; trigger a GC to ensure newspace is behind oldspace
;; write-image will also GC and thereby move newspace
;; to the front.
;; We can't do this in s48-write-image because it doesn't
;; know collect-saving-temp.
(let ((resume-proc
(if (s48-newspace<oldspace?)
(collect-saving-temp resume-proc)
resume-proc)))
(let ((status (s48-write-image resume-proc port)))
(if (error? status)
(port-lose (enum exception os-error) status port)
@ -430,7 +440,7 @@
resume-proc
comment-string
undumpables
(enter-fixnum undumpable-count))))))))))))))))
(enter-fixnum undumpable-count)))))))))))))))))
; READ-IMAGE needs to protect some values against GCs (this can't be with
; READ-IMAGE as that is compiled separately.)