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

;;; Go backwards through the special pdl.  For each entry, swap the symbol's value for the
;;; value associated with the symbol in the special pdl.
(defun unwind-special-pdl ()
  "do this when a stack group stops running"
  (do ((pointer (hw:24+ -2 gr:*special-pdl-ptr*)
		(hw:24+ -2 pointer))
       (bottom (cons:make-pointer vinc:$$dtp-unboxed-locative	;this is what gr:*special-pdl-pointer* is
				  (sg-special-pdl initial-sg))))
      ((hw:32<= pointer bottom))
    (special-pdl-binding-swap pointer)))

(defun rewind-special-pdl ()
  "do this when a stack group gets to run again"
  (do ((pointer (cons:make-pointer vinc:$$dtp-unboxed-locative
				   (hw:24+ 2 (sg-special-pdl initial-sg)))
		(hw:24+ 2 pointer)))
      ((hw:32>= pointer gr:*special-pdl-ptr*))
    (special-pdl-binding-swap pointer)))

;;; swap current symbol value and symbol value from special pdl
(defun special-pdl-binding-swap (pointer)
  (let (symbol
	value-from-special-pdl
	value-from-value-cell
	sp-symbol-loc
	value-cell-loc)
    (hw:vma-start-read-visible-evcp-vma-unboxed-md-boxed pointer)
    (setq sp-symbol-loc (hw:24+ 1 pointer))
    (setq value-from-special-pdl (hw:read-md))
    (hw:vma-start-read-visible-evcp-vma-unboxed-md-boxed sp-symbol-loc)
    (setq symbol (hw:read-md))
    (setq value-cell-loc (hw:32-1+ symbol))
    (hw:vma-start-read-visible-evcp-vma-unboxed-md-boxed value-cell-loc)
    (setq value-from-value-cell (hw:read-md))
    (hw:write-md value-from-value-cell)
    (hw:vma-start-write pointer)
    (hw:write-md value-from-special-pdl)
    (hw:vma-start-write value-cell-loc)
    nil))