home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / encorsrc.lha / encore_sources / sys / zsystem.t < prev   
Encoding:
Text File  |  1988-05-02  |  3.9 KB  |  98 lines
  1. (herald zsystem
  2.         (env tsys
  3.              (osys kernel)
  4.              (osys list)
  5.              (osys vector)
  6.              (osys vm_port)))
  7.  
  8. ;;; Copyright (c) 1985 Yale University
  9. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  10. ;;; This material was developed by the T Project at the Yale University Computer 
  11. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  12. ;;; and to use it for any purpose is granted, subject to the following restric-
  13. ;;; tions and understandings.
  14. ;;; 1. Any copy made of this software must include this copyright notice in full.
  15. ;;; 2. Users of this software agree to make their best efforts (a) to return
  16. ;;;    to the T Project at Yale any improvements or extensions that they make,
  17. ;;;    so that these may be included in future releases; and (b) to inform
  18. ;;;    the T Project of noteworthy uses of this software.
  19. ;;; 3. All materials developed as a consequence of the use of this software
  20. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  21. ;;;    of acknowledging credit in academic research.
  22. ;;; 4. Yale has made no warrantee or representation that the operation of
  23. ;;;    this software will be error-free, and Yale is under no obligation to
  24. ;;;    provide any services, by way of maintenance, update, or otherwise.
  25. ;;; 5. In conjunction with products arising from the use of this material,
  26. ;;;    there shall be no use of the name of the Yale University nor of any
  27. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  28. ;;;    without prior written consent from Yale in each case.
  29. ;;;
  30.  
  31. ;;; Z system object, read-eval-print loop, etc.
  32.  
  33. ;;; We herein explicitly avoid any dependence on entities, operations,
  34. ;;; or format.  we must not throw away the scaffolding!  at some
  35. ;;; point the "real" printer will take over and we can just stop
  36. ;;; loading this one, and let it lie dormant until the next
  37. ;;; transportation effort.  Ha!
  38.  
  39. ;;; *z-repl-env* is set to a real environment later in the bootstrap.
  40.  
  41. (lset *z-repl-env* bootstrap-env)
  42.  
  43. (define (z-read-eval-print-loop)
  44.   (iterate loop ()
  45.     (let ((out standard-output)
  46.           (fmt (if (fx= *break-level* 0) "~&> " "~&~s(Z): ")))
  47.       (z-prompt (out) fmt *break-level*)
  48.       (let ((form (z-read (standard-input))))
  49.         (cond ((eof? form) form)
  50.               (else
  51.                (receive vals 
  52.                         (z-eval form *z-repl-env*)
  53.                  (cond ((null? vals)
  54.                         (format (out) "~&;no values.")
  55.                         (loop))
  56.                        ((not (null? (cdr vals)))
  57.                         (format (out) ";multiple values:")
  58.                         (do ((l vals (cdr l))
  59.                              (i 0 (fx+ i 1)))
  60.                             ((null? l) (loop))
  61.                           (format (out) "~% [~s] ~s" i (car l))))
  62.                        (else
  63.                         ;; single value
  64.                         (z-print (car vals) (out))
  65.                         (loop))))))))))
  66.  
  67. (define (z-top-level)
  68.   (z-breakpoint "~&Z top level"))
  69.  
  70. (define (z-reset)
  71.   (set *top-level* z-top-level)
  72.   (**reset** nil))
  73.                                       
  74. ;;; We assume that catch works.
  75.  
  76. (define (z-breakpoint . args)
  77.   (let* ((z     *z?*)
  78.          (cont  **ret**)
  79.          (level *break-level*))
  80.     (receive vals (catch ret
  81.                     (set *z?*          '#t)
  82.                     (set **ret**       ret)
  83.                     (set *break-level* (fx+ *break-level* 1))
  84.                     (if args (apply z-prompt (standard-output) args))
  85.                     (z-read-eval-print-loop)
  86.                     (cont))
  87.       (set *z?*          z)
  88.       (set **ret**       cont)
  89.       (set *break-level* level)
  90.       (apply return vals))))
  91.  
  92. (define z-system
  93.   (create-system 'Z-system 1 0 3 true true true t-copyright-notice '()))
  94.  
  95. (set *top-level* z-top-level)
  96. (set (z-system-present?) '#t)
  97. (set *z-repl-env* tvm-env)
  98.