;;; -*- Mode:LISP; Package:LISP-INTERNALS; Readtable:CL; Base:10 -*-



;;; Even though we are not running the call stack dumper we must still set up
;;; GR:*SPECIAL-PDL-POINTER* used by interpreter in PROGV type forms
;;; GR:*STACK-POINTER* used by APPLY-INTERNAL to shuffle args around

;;; Weird behavior results if GR:*STACK-POINTER* is not initialized properly.
;;; I have seen the print name for T get bashed.  SETQ apparently didnot catch this.


(defun boot-stack-groups ()
  ;; this should not be neccessary, these initial areas
  ;; should have constant area numbers
  (setq gr::*special-pdl-area*
	(area-data:make-area 5.
			     (region-bits:encode-region-bits
			       region-bits:$$region-fixed
			       region-bits:$$region-new-space
			       region-bits:$$region-space-unboxed
			       region-bits:$$region-read-write
			       region-bits:$$scavenge-enabled
			       region-bits:$$region-internal-memory
			       0.
			       )
			     1.))
  (let ((initial-sg (make-stack-group "Initial Stack Group")))
    (setq gr:*special-pdl-ptr* (sg-special-pdl-ptr initial-sg))
    (setq gr:*special-pdl-limit* (sg-special-pdl-limit initial-sg))
    (setq gr:*stack-pointer* (sg-extraneous-pdl-ptr initial-sg))
    (setq gr:*stack-limit*   (sg-extraneous-pdl-limit initial-sg))
;   (setq gr:*current-stack-group* initial-sg)
    nil
    (make-control-pdl-area)
    (setq gr:*control-pdl* (make-control-pdl initial-sg))
    (load-control-pdl-state)
    ))