;;; -*- Mode:LISP; Package:LISP-INTERNALS; Base:10; Readtable:CL -*- ;;; The control pdl object. Control pdls are arrays of type ART-CONTROL-PDL. ;;; At the base of each control pdl are several words used for bookkeeping. Immediately after ;;; these words the call hardware dump starts. These words include ;;; - pointer to the stack group it belongs to ;;; - the allocation pointer where dumping continues ;;; The limit after which the control pdl structure must be grown to accomodate more call records ;;; can be calculated from the control pdl's size. ;;; Each frame of the control pdl consists of CONTROL-PDL-FRAME-SIZE words. ;;; The first word contains: ;;; - the type code: OPEN, OPEN-CALL, TOPEN (2 bits), PROTECTED-OPEN-CALL, ;;; - the return-destination (7 bits), ;;; - the global return destination (4 bits) and ;;; - 16 box bits for the saved registers ;;; The second word contains the typed RPC ;;; The third through eighteenth words contain the saved registers. (defconstant %%cpdl0-type-code (byte 2 0)) (defconstant %%cpdl0-rdest (byte 7 2)) (defconstant %%cpdl0-global-frame (byte 4 9)) (defconstant %%cpdl0-box-bits (byte 16 16)) ;register zero's box bit is LSB of this field (defconstant $$cpdl0-type-open 0) ;for type code field (defconstant $$cpdl0-type-open-call 1) (defconstant $$cpdl0-type-topen 2) (defconstant $$cpdl0-type-protected-open-call 3) (defconstant control-pdl-frame-size 18) (defconstant control-pdl-frame-offset-to-registers 2) ;;; The control pdl could be full of OPEN-CALL TOPEN frames (defconstant max-call-hardware-dump (* 2 control-pdl-frame-size 256) "The largest possible size that a call hardware dump can be") (defvar control-pdl-area nil "This is the area in which control pdls live") (defun make-control-pdl-area () (when (or (not (boundp 'control-pdl-area)) (null control-pdl-area)) (setq control-pdl-area (area-data:make-area 7 (vinc:dpb-multiple-boxed (ceiling max-call-hardware-dump vinc:*qs-in-cluster*) region-bits:%%region-bits-swapin-quantum region-bits:$$scavenge-enabled region-bits:%%region-bits-scavenge-bit region-bits:$$region-read-write region-bits:%%region-bits-read-only region-bits:$$region-space-structure region-bits:%%region-bits-space-type region-bits:$$region-new-space region-bits:%%region-bits-new-space ;;; what should this really be: region-bits:$$region-fixed region-bits:%%region-bits-flippable region-bits:$$region-internal-memory region-bits:%%region-bits-external-bus 0) 10)))) (defconstant control-pdl-allocation-quantum (* 2 max-call-hardware-dump) "amount by which a control pdl is grown when it fills up") ;at least enough for one full call hardware dump ;;; The zeroth slot of the control pdl contains a pointer ;;; back to the stack group to which the control pdl belongs. (defmacro CONTROL-PDL-STACK-GROUP (control-pdl) "Return the stack group associated with the CONTROL-PDL" `(array:%vm-read (hw:24+ 1 ,control-pdl))) (defmacro SET-CONTROL-PDL-STACK-GROUP (control-pdl stack-group) "Set the stack group associated with CONTROL-PDL to STACK-GROUP" `(array:%vm-write (hw:24+ 1 ,control-pdl) ,stack-group)) ;;; The first slot of the control pdl contains the saved value of the control pdl pointer ;;; when the control pdl is not the current one. (defmacro CONTROL-PDL-POINTER (control-pdl) "Return the saved value of CONTROL-PDL's top of stack pointer" `(array:%vm-read (hw:24+ 2 ,control-pdl))) (defmacro SET-CONTROL-PDL-POINTER (control-pdl new-pointer) "Changes the saved value of CONTROL-PDL's top of stack pointer to NEW-POINTER" `(array:%vm-write (hw:24+ 2 ,control-pdl) ,new-pointer)) (defconstant control-pdl-base 3 "Add to a control-pdl objects pointer to find the base for call hardware dumps") (defun make-control-pdl (stack-group &optional (total-size control-pdl-allocation-quantum)) (setq total-size (* (ceiling (max total-size control-pdl-allocation-quantum) vinc:*qs-in-cluster*) vinc:*qs-in-cluster*)) ;must fall on cluster boundary (for ease in wiring). (let ((control-pdl (cons:allocate-structure-in-area control-pdl-base ;3 words including header (- total-size 3) vinc:$$dtp-array (vinc:dpb-multiple-boxed (1- total-size) array::%%bounds ;don't count header word array:art-control-pdl array::%%sv-art vinc:$$dtp-array-header-single vinc:%%data-type 0) control-pdl-area))) ;;; touch each page (do ((i 3 (1+ i))) ((>= i (1- total-size))) (array:%vm-write32 control-pdl i (hw:unboxed-constant 0))) (set-control-pdl-pointer control-pdl control-pdl-base) (set-control-pdl-stack-group control-pdl stack-group) control-pdl)) (defun control-pdl-p (object) (and (array:arrayp object) (= array:art-control-pdl (hw:ldb object array::%%sv-art 0)))) (defsubst control-pdl-empty-p (control-pdl) (progn (when (< (control-pdl-pointer control-pdl) control-pdl-base) (error "control-pdl-pointer below control-pdl-base")) (<= (control-pdl-pointer control-pdl) control-pdl-base))) (defsubst control-pdl-limit (control-pdl) "if control-pdl-pointer reaches here we are out of room" (hw:ldb (array:%vm-read32 control-pdl 0) array::%%bounds 0)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The state of the current control pdl is stored in global registers rather than ;;; in the object itself. These are used to maintain consistency and for context switching. (defsubst save-control-pdl-state () (set-control-pdl-pointer gr:*control-pdl* (hw:ldb (hw:24- gr:*control-pdl-pointer* gr:*control-pdl*) (byte 24 0) 0))) (defsubst load-control-pdl-state () (macrolet ((index-to-address (index) `(cons:make-pointer vinc:$$dtp-unboxed-locative (hw:24+ gr:*control-pdl* ,index)))) (setq gr:*control-pdl-limit* (index-to-address (control-pdl-limit gr:*control-pdl*)) gr:*control-pdl-pointer* (index-to-address (control-pdl-pointer gr:*control-pdl*))))) (defun select-control-pdl (control-pdl) "Set up the global registers associated with the call hardware dump/restore code to use CONTROL-PDL. The previous values are stored in the outgoing control pdl" ;;; make sure it is a control pdl (unless (control-pdl-p control-pdl) (trap:illop "is not a control pdl")) (save-control-pdl-state) (setq gr:*control-pdl* control-pdl) (load-control-pdl-state)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; interlock to avoid recursive invcation of dumper and catcher ;;; we should maybe use a vanilla global variable for the interlock (defmacro DUMPING-OR-RESTORING-CALL-HARDWARE (doing-it) (let ((interlock 'gr:*ch-dumper-return-pc*)) (if doing-it `(progn (unless (null ,interlock) (trap:illop "call hardware dump/restore entered recursively")) (setq ,interlock t)) `(setq ,interlock nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; when the control pdl and call hardware are scrolled the base of the call hardware ;;; must be an open-call frame so that the underflow catcher can be reached via a return operation. ;;; Since the call hardware dumper and restorer play with traps and can only be invoked while ;;; traps are enabled, this boundary can not fall on an open-call across which traps are disabled. ;;; To prevent the restorer from putting the underflow handler boundary at an open-call across which ;;; traps are disabled, we make the rule that only the trap handler is allowed to disable traps. ;;; We also have the rule that it must reenable traps by the time is goes TRAP-CALL-PROTECTION-COUNT ;;; deep in calls. When the call hardware dumper sees a return pc that is a trap entry (pc < 64) ;;; it protects the next TRAP-CALL-PROTECTION-COUNT open-calls that is sees by recording them ;;; as being control pdl frame type $$CPDL0-TYPE-PROTECTED-OPEN-CALL rather than $$CPDL0-TYPE-OPEN-CALL. ;;; The restorer only looks for $$CPDL0-TYPE-OPEN-CALL when deciding how much to restore but when ;;; it does restore, it treats both type codes the same. (defconstant trap-call-protection-count 2)