/[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.11 by wlott, Thu Sep 6 19:42:41 1990 UTC revision 1.12 by wlott, Sun Sep 23 17:44:13 1990 UTC
# Line 67  Line 67 
67  (proclaim '(special *gc-inhibit* *already-maybe-gcing*  (proclaim '(special *gc-inhibit* *already-maybe-gcing*
68                      *need-to-collect-garbage* *gc-verbose*                      *need-to-collect-garbage* *gc-verbose*
69                      *before-gc-hooks* *after-gc-hooks*                      *before-gc-hooks* *after-gc-hooks*
70                        mach::*interrupts-enabled*
71                        mach::*interrupt-pending*
72                      c::*type-system-initialized*))                      c::*type-system-initialized*))
73    
74    
# Line 75  Line 77 
77    
78  ;;; These are filled in by Genesis.  ;;; These are filled in by Genesis.
79    
 (defvar *the-undefined-function*)  
80  (defvar *current-catch-block*)  (defvar *current-catch-block*)
81  (defvar *current-unwind-block*)  (defvar *current-unwind-block*)
82  (defvar *free-interrupt-context-index*)  (defvar *free-interrupt-context-index*)
83    
84    
 ;;;  
   
 (defvar %sp-interrupts-inhibited nil)  
   
   
85    
86  ;;;; Global ports:  ;;;; Global ports:
87    
# Line 129  Line 125 
125  ;;; things initialize right at OS-Init time.  ;;; things initialize right at OS-Init time.
126  ;;;  ;;;
127  (defun reset-reply-port-stack ()  (defun reset-reply-port-stack ()
128    (setq *reply-port-pointer* 0  *reply-port-depth* 0)    (setf *reply-port-pointer* 0  *reply-port-depth* 0)
129    (fill (the simple-vector *reply-port-stack*) nil)    (fill (the simple-vector *reply-port-stack*) nil)
130    (setq *allocate-reply-port* (mach:mach-task_data)))    (setf *allocate-reply-port* (mach:mach-task_data)))
131  (pushnew 'reset-reply-port-stack *before-save-initializations*)  (pushnew 'reset-reply-port-stack *before-save-initializations*)
132    
133  ;;; Allocate-New-Reply-Ports  --  Internal  ;;; Allocate-New-Reply-Ports  --  Internal
# Line 147  Line 143 
143      (when (eql pointer (1- len))      (when (eql pointer (1- len))
144        (let ((new (make-array (* len 2))))        (let ((new (make-array (* len 2))))
145          (replace new stack :end1 len :end2 len)          (replace new stack :end1 len :end2 len)
146          (setq stack new  *reply-port-stack* new)))          (setf stack new  *reply-port-stack* new)))
147      (setf (svref stack pointer) *allocate-reply-port*)      (setf (svref stack pointer) *allocate-reply-port*)
148      (let ((port (gr-call* mach:port_allocate (mach:mach-task_self))))      (let ((port (gr-call* mach:port_allocate (mach:mach-task_self))))
149        (gr-call mach:port_disable (mach:mach-task_self) port)        (gr-call mach:port_disable (mach:mach-task_self) port)
# Line 490  Line 486 
486    
487  (defun %initial-function ()  (defun %initial-function ()
488    "Gives the world a shove and hopes it spins."    "Gives the world a shove and hopes it spins."
489    (setq *already-maybe-gcing* t)    (setf *already-maybe-gcing* t)
490    (setf *gc-inhibit* t)    (setf *gc-inhibit* t)
491    (setf *need-to-collect-garbage* nil)    (setf *need-to-collect-garbage* nil)
492    (setq *gc-verbose* t)    (setf *gc-verbose* t)
493    (setq *before-gc-hooks* ())    (setf *before-gc-hooks* nil)
494    (setq *after-gc-hooks* ())    (setf *after-gc-hooks* nil)
495    (setq %sp-interrupts-inhibited nil)    (setf mach::*interrupts-enabled* t)
496    (setq c::*type-system-initialized* nil)    (setf mach::*interrupt-pending* nil)
497      (setf c::*type-system-initialized* nil)
498    (%primitive print "In initial-function, and running.")    (%primitive print "In initial-function, and running.")
499    
500    ;; Many top-level forms call INFO, (SETF INFO).    ;; Many top-level forms call INFO, (SETF INFO).
# Line 506  Line 503 
503    ;; 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...
504    (print-and-call type-init)    (print-and-call type-init)
505    
506    (setq *lisp-initialization-functions*    (setf *lisp-initialization-functions*
507          (nreverse *lisp-initialization-functions*))          (nreverse *lisp-initialization-functions*))
508    (%primitive print "Calling top-level forms.")    (%primitive print "Calling top-level forms.")
509    (dolist (fun *lisp-initialization-functions*)    (dolist (fun *lisp-initialization-functions*)
# Line 515  Line 512 
512    
513    ;; Only do this after top level forms have run, 'cause thats where    ;; Only do this after top level forms have run, 'cause thats where
514    ;; deftypes are.    ;; deftypes are.
515    (setq c::*type-system-initialized* t)    (setf c::*type-system-initialized* t)
516    
517    (print-and-call os-init)    (print-and-call os-init)
518    (print-and-call filesys-init)    (print-and-call filesys-init)
# Line 527  Line 524 
524    (print-and-call sharp-init)    (print-and-call sharp-init)
525    ;; After the various reader subsystems have done their thing to the standard    ;; After the various reader subsystems have done their thing to the standard
526    ;; readtable, copy it to *readtable*.    ;; readtable, copy it to *readtable*.
527    (setq *readtable* (copy-readtable std-lisp-readtable))    (setf *readtable* (copy-readtable std-lisp-readtable))
528    
529    (print-and-call stream-init)    (print-and-call stream-init)
530    (print-and-call loader-init)    (print-and-call loader-init)
# Line 540  Line 537 
537    
538    (%primitive print "Done initializing.")    (%primitive print "Done initializing.")
539    
540    (setq *already-maybe-gcing* nil)    (setf *already-maybe-gcing* nil)
541    (terpri)    (terpri)
542    (princ "CMU Common Lisp kernel core image ")    (princ "CMU Common Lisp kernel core image ")
543    (princ (lisp-implementation-version))    (princ (lisp-implementation-version))
# Line 564  Line 561 
561  (defun reinit ()  (defun reinit ()
562    (%primitive print "In REINIT.")    (%primitive print "In REINIT.")
563    (without-interrupts    (without-interrupts
564     (setq *already-maybe-gcing* t)     (setf *already-maybe-gcing* t)
565     (print-and-call os-init)     (print-and-call os-init)
566     (print-and-call kernel::signal-init)     (print-and-call kernel::signal-init)
567     (print-and-call stream-reinit)     (print-and-call stream-reinit)
568     (setq *already-maybe-gcing* nil))     (setf *already-maybe-gcing* nil))
569    #+nil    #+nil
570    (mach:port_enable (mach:mach-task_self) *task-notify*)    (mach:port_enable (mach:mach-task_self) *task-notify*)
571    #+nil    #+nil
# Line 579  Line 576 
576  ;;; that set up the argument blocks for the server interfaces.  ;;; that set up the argument blocks for the server interfaces.
577    
578  (defun os-init ()  (defun os-init ()
579    (setq *task-self* (mach:mach-task_self))    (setf *task-self* (mach:mach-task_self))
580    (setq *task-data* (mach:mach-task_data))    (setf *task-data* (mach:mach-task_data))
581    (setq *task-notify* (mach:mach-task_notify)))    (setf *task-notify* (mach:mach-task_notify)))
582    
583    
584  ;;; Setup-path-search-list returns a list of the directories that are  ;;; Setup-path-search-list returns a list of the directories that are

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

  ViewVC Help
Powered by ViewVC 1.1.5