/[cmucl]/src/code/lispinit.lisp
ViewVC logotype

Diff of /src/code/lispinit.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.1.1 by wlott, Mon Mar 12 19:06:39 1990 UTC revision 1.1.1.2 by wlott, Wed Apr 11 17:16:14 1990 UTC
# Line 7  Line 7 
7  ;;; Scott Fahlman (FAHLMAN@CMUC).  ;;; Scott Fahlman (FAHLMAN@CMUC).
8  ;;; **********************************************************************  ;;; **********************************************************************
9  ;;;  ;;;
10    ;;; $Header$
11    ;;;
12  ;;; Initialization and low-level interrupt support for the Spice Lisp system.  ;;; Initialization and low-level interrupt support for the Spice Lisp system.
13  ;;; Written by Skef Wholey and Rob MacLachlan.  ;;; Written by Skef Wholey and Rob MacLachlan.
14  ;;;  ;;;
# Line 32  Line 34 
34            coerce-to-motion-event coerce-to-expose-event            coerce-to-motion-event coerce-to-expose-event
35            coerece-to-exposecopy-event coerce-to-focuschange-event server            coerece-to-exposecopy-event coerce-to-focuschange-event server
36            *nameserverport* *usertypescript* *userwindow* *typescriptport*            *nameserverport* *usertypescript* *userwindow* *typescriptport*
37            *task-self* *task-data* *task-notify* *file-input-handlers*            *task-self* *task-data* *task-notify*
38            with-interrupts with-enabled-interrupts enable-interrupt            with-interrupts with-enabled-interrupts enable-interrupt
39            ignore-interrupt default-interrupt))            ignore-interrupt default-interrupt))
40    
# Line 67  Line 69 
69  ;;; Random information:  ;;; Random information:
70    
71  (defvar compiler-version "???")  (defvar compiler-version "???")
72  (defvar *lisp-implementation-version* "3.0(?)")  (defvar *lisp-implementation-version* "4.0(?)")
73    
74  (defvar *in-the-compiler* nil  (defvar *in-the-compiler* nil
75    "Bound to T while running code inside the compiler.  Macros may test this to    "Bound to T while running code inside the compiler.  Macros may test this to
76    see where they are being expanded.")    see where they are being expanded.")
77    
78  (defparameter %fasl-code-format vm:target-fasl-code-format)  (defparameter %fasl-code-format #.vm:target-fasl-code-format)
79    
80    
81  ;;;; Global ports:  ;;;; Global ports:
# Line 91  Line 93 
93    
94  ;;; GC stuff.  ;;; GC stuff.
95    
 #| Again, will be different.  
   
96  (defvar *gc-inhibit* nil)       ; Inhibits GC's.  (defvar *gc-inhibit* nil)       ; Inhibits GC's.
97    
98  (defvar *already-maybe-gcing* nil) ; Inhibits recursive GC's.  (defvar *already-maybe-gcing* nil) ; Inhibits recursive GC's.
# Line 101  Line 101 
101    "*Need-to-collect-garbage* is set to T when GC is disabled, but the system    "*Need-to-collect-garbage* is set to T when GC is disabled, but the system
102    needs to do a GC.  When GC is enabled again, the GC is done then.")    needs to do a GC.  When GC is enabled again, the GC is done then.")
103    
 |#  
   
104    
105    
106  ;;;; Reply port allocation.  ;;;; Reply port allocation.
# Line 189  Line 187 
187    
188    
189  ;;;; Server stuff:  ;;;; Server stuff:
190    #|
191  ;;;  ;;;
192  ;;;    There is a fair amount of stuff to support Matchmaker RPC servers  ;;;    There is a fair amount of stuff to support Matchmaker RPC servers
193  ;;; and asynchonous message service.  RPC message service needs to be  ;;; and asynchonous message service.  RPC message service needs to be
# Line 311  Line 310 
310  ;;;  ;;;
311  (defsetf object-set-operation %set-object-set-operation  (defsetf object-set-operation %set-object-set-operation
312    "Sets the handler function for an object set operation.")    "Sets the handler function for an object set operation.")
313    |#
314    
315    
316    
# Line 491  Line 491 
491    (print-and-call c::globaldb-init)    (print-and-call c::globaldb-init)
492    
493    ;; Some of the random top-level forms call Make-Array, which calls Subtypep...    ;; Some of the random top-level forms call Make-Array, which calls Subtypep...
494    (print-and-call subtypep-init)    (print-and-call type-init)
495    
496    (setq *lisp-initialization-functions*    (setq *lisp-initialization-functions*
497          (nreverse *lisp-initialization-functions*))          (nreverse *lisp-initialization-functions*))
# Line 501  Line 501 
501    (makunbound '*lisp-initialization-functions*) ; So it gets GC'ed.    (makunbound '*lisp-initialization-functions*) ; So it gets GC'ed.
502    
503    (print-and-call os-init)    (print-and-call os-init)
504      #+nil
505    (print-and-call filesys-init)    (print-and-call filesys-init)
506      #+nil
507    (print-and-call conditions::error-init)    (print-and-call conditions::error-init)
508    
509      #+nil
510    (print-and-call reader-init)    (print-and-call reader-init)
511      #+nil
512    (print-and-call backq-init)    (print-and-call backq-init)
513      #+nil
514    (print-and-call sharp-init)    (print-and-call sharp-init)
515    ;; After the various reader subsystems have done their thing to the standard    ;; After the various reader subsystems have done their thing to the standard
516    ;; readtable, copy it to *readtable*.    ;; readtable, copy it to *readtable*.
517      #+nil
518    (setq *readtable* (copy-readtable std-lisp-readtable))    (setq *readtable* (copy-readtable std-lisp-readtable))
519    
520      #+nil
521    (print-and-call stream-init)    (print-and-call stream-init)
522      #+nil
523    (print-and-call random-init)    (print-and-call random-init)
524      #+nil
525    (print-and-call format-init)    (print-and-call format-init)
526      #+nil
527    (print-and-call package-init)    (print-and-call package-init)
528      #+nil
529    (print-and-call pprint-init)    (print-and-call pprint-init)
530    
531    (setq *already-maybe-gcing* nil)    (setq *already-maybe-gcing* nil)
# Line 529  Line 540 
540      (loop      (loop
541       (%top-level)       (%top-level)
542       (write-line "You're certainly a clever child.")))       (write-line "You're certainly a clever child.")))
543      #+nil
544    (mach:unix-exit 0))    (mach:unix-exit 0))
545    
546    
# Line 542  Line 554 
554    (without-interrupts    (without-interrupts
555     (setq *already-maybe-gcing* t)     (setq *already-maybe-gcing* t)
556     (os-init)     (os-init)
557       #+nil
558     (stream-reinit)     (stream-reinit)
559     (setq *already-maybe-gcing* nil))     (setq *already-maybe-gcing* nil))
560      #+nil
561    (setq *task-notify* (mach:mach-task_notify))    (setq *task-notify* (mach:mach-task_notify))
562      #+nil
563    (mach:port_enable (mach:mach-task_self) *task-notify*)    (mach:port_enable (mach:mach-task_self) *task-notify*)
564      #+nil
565    (add-port-object *task-notify* nil *kernel-messages*)    (add-port-object *task-notify* nil *kernel-messages*)
566      #+nil
567    (init-mach-signals))    (init-mach-signals))
568    
569    
# Line 555  Line 572 
572  ;;; that set up the argument blocks for the server interfaces.  ;;; that set up the argument blocks for the server interfaces.
573    
574  (defun os-init ()  (defun os-init ()
575      #+nil
576    (setq *task-self* (mach:mach-task_self))    (setq *task-self* (mach:mach-task_self))
577      #+nil
578    (setq *task-data* (mach:mach-task_data)))    (setq *task-data* (mach:mach-task_data)))
579    
580    
# Line 670  Line 689 
689  (defun quit (&optional recklessly-p)  (defun quit (&optional recklessly-p)
690    "Terminates the current Lisp.  Things are cleaned up unless Recklessly-P is    "Terminates the current Lisp.  Things are cleaned up unless Recklessly-P is
691    non-Nil."    non-Nil."
 ;  (reset-keyboard 0)  
   (dolist (x (if (boundp 'extensions::temporary-foreign-files)  
                  extensions::temporary-foreign-files))  
     (mach:unix-unlink x))  
692    (if recklessly-p    (if recklessly-p
693        (mach:unix-exit 0)        (mach:unix-exit 0)
694        (throw '%end-of-the-world nil)))        (throw '%end-of-the-world nil)))

Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.1.1.2

  ViewVC Help
Powered by ViewVC 1.1.5