home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-385-Vol-1of3.iso / s / s48.zip / VM / RESUME.SCM < prev    next >
Text File  |  1992-06-17  |  2KB  |  56 lines
  1. ; -*- Mode: Scheme; Syntax: Scheme; Package: Scheme; -*-
  2. ; Copyright (c) 1992 by Richard Kelsey and Jonathan Rees.  See file COPYING.
  3.  
  4.  
  5. ; This is file resume.scm.
  6.  
  7. ;;;; Top level entry into Scheme48 system
  8.  
  9. ; RESUME is the main entry point to the entire system, and the only
  10. ; routine that calls RUN-MACHINE other than for debugging purposes.
  11.  
  12. (define (resume filename startup-string)
  13.   (let* ((string-space (vm-string-size (string-length startup-string)))
  14.      (startup-proc (read-image filename string-space)))
  15.     (call-startup-procedure startup-proc startup-string)))
  16.  
  17. (define (call-startup-procedure startup-proc startup-string)
  18.   (clear-registers)
  19.   (push (enter-string startup-string))    ; get it in the heap so suspend will
  20.                     ; save it
  21.   (push (initial-input-port))
  22.   (push (initial-output-port))
  23.   (set! *nargs* 3)
  24.   (set! *val* startup-proc)
  25.   (run-machine (label perform-application)))
  26.  
  27. ; Restartable version that the PreScheme compiler cannot deal with yet.
  28. ;(define (call-startup-procedure startup-proc startup-string)
  29. ;  (clear-registers)
  30. ;  (push (enter-string startup-string))    ; get it in the heap so suspend will
  31. ;                    ; save it
  32. ;  (push (initial-input-port))
  33. ;  (push (initial-output-port))
  34. ;  (set! *code-pointer* (make-byte-vector 2))
  35. ;  (byte-vector-set! *code-pointer* 0 op/call)
  36. ;  (byte-vector-set! *code-pointer* 1 3)       ; nargs
  37. ;  (set! *val* startup-proc)
  38. ;  (run-machine (label interpret)))
  39.  
  40. ;(define (restart value)
  41. ;  (set! *val* value)
  42. ;  (run-machine (label interpret)))
  43.  
  44. ; Used by RUN
  45.  
  46. (define (start-vm thunk)
  47.   (set! *val* thunk)
  48.   (set! *nargs* 0)
  49.   (set! *pending-interrupts* 0)
  50.   (run-machine perform-application)
  51.   *val*)
  52.  
  53. ; (define (run x) (start-vm (make-closure (compile-form `(halt ,x) e) 'run)))
  54. ; (define write-instruction (access-scheme48 'write-instruction))
  55.  
  56.