;;; -*- Mode:LISP; Package:SYSTEM-INTERNALS; Base:8 -*- ;;; This is file of definitions of the format of stack groups. dlw 10/15/77 ;;; It will be used by error handlers. ; ** (c) Copyright 1980 Massachusetts Institute of Technology ** ;If this file is changed, it goes without saying that you need to make a new cold load. ;(Comments below may not be correct!) ; Also SYS:SYS; QCOM and SYS:SYS2;GLOBAL must be changed to agree. ;----------------------------------------------------------------------------------------- ; SYS:SYS2;SYSTEM has a list of the symbols defined here which belong in the SYSTEM package ;----------------------------------------------------------------------------------------- ;The microcode must be reassembled, and at least the following must be recompiled: ; SYS:SYS2;EH >, SYS:SYS2;EHR >, SYS:SYS;SGFCTN >, SYS:SYS; QMISC > (for DESCRIBE) ; SYS:SYS2;PROCES >, LMIO;KBD > (for PROCESS-WAIT), SYS:SYS2;QTRACE (for FUNCTION-ACTIVE-P) ; ;also LMCONS;CC > (DEFSTRUCT (STACK-GROUP :ARRAY-LEADER (:CONSTRUCTOR NIL) (:ALTERANT NIL)) SG-NAME ;String with the name of the stack group SG-REGULAR-PDL ;Regular PDL array, 0=base of stack SG-REGULAR-PDL-LIMIT ;Max depth before trap SG-SPECIAL-PDL ;Special PDL array, 0=base of stack SG-SPECIAL-PDL-LIMIT ;Max depth before trap SG-INITIAL-FUNCTION-INDEX ;Index into PDL of initial M-AP ; (3 unless initial call has adi) SG-PLIST SG-TRAP-TAG ;Symbolic tag corresponding to SG-TRAP-MICRO-PC. ; gotten via MICROCODE-ERROR-TABLE, etc. Properties ; off this symbol drive error recovery. SG-RECOVERY-HISTORY ;Available for hairy SG munging routines to attempt to ; leave tracks. SG-FOOTHOLD-DATA ;During error recovery, contains pointer to a stack frame ; which contains saved status of the main stack group. ; (Preventing it from being lost when the foothold is ; running.) ((SG-STATE) (SG-CURRENT-STATE 0006) ;state of this stack group (SG-FOOTHOLD-EXECUTING-FLAG 0601) ;not used (SG-PROCESSING-ERROR-FLAG 0701) ;taking error trap (detect recursive errors) (SG-PROCESSING-INTERRUPT-FLAG 1001) ;not used (SG-SAFE 1101) (SG-INST-DISP 1202) ;the instruction dispatch we are using (SG-IN-SWAPPED-STATE 2601) ;we are in the swapped state (SG-SWAP-SV-ON-CALL-OUT 2501) ;if this is on in the caller, or (SG-SWAP-SV-OF-SG-THAT-CALLS-ME 2401)) ; this in the callee, then swap SG-PREVIOUS-STACK-GROUP ;Stack group who just ran SG-CALLING-ARGS-POINTER ;Pointer into previous stack group's REGPDL to SG-CALLING-ARGS-NUMBER ; the args passed to us. SG-TRAP-AP-LEVEL ;Locative to a location in PDL Buffer, below which ;traps occur SG-REGULAR-PDL-POINTER ;Saved pdl pointer (as index into regular-pdl array) SG-SPECIAL-PDL-POINTER ;Saved A-QLBNDP (as index into special-pdl array) SG-AP ;Saved M-AP SG-IPMARK ;Saved A-IPMARK SG-TRAP-MICRO-PC ;Address of last call to TRAP ; SG-ERROR-HANDLING-SG ;Having these part of the SG would be nice, but ; SG-INTERRUPT-HANDLING-SG ; it doesnt buy anything for the time being, and costs ; a couple microinstructions. SG-SAVED-QLARYH ;Saved A-QLARYH SG-SAVED-QLARYL ;Saved A-QLARYL ((SG-SAVED-M-FLAGS) ;Saved M-FLAGS (SG-FLAGS-QBBFL %%M-FLAGS-QBBFL) ; Binding-block-pushed flag (SG-FLAGS-CAR-SYM-MODE %%M-FLAGS-CAR-SYM-MODE) ;UPDATE PRINT-ERROR-MODE IN QMISC (SG-FLAGS-CAR-NUM-MODE %%M-FLAGS-CAR-NUM-MODE) ; IF ADD ANY.. (SG-FLAGS-CDR-SYM-MODE %%M-FLAGS-CDR-SYM-MODE) (SG-FLAGS-CDR-NUM-MODE %%M-FLAGS-CDR-NUM-MODE) (SG-FLAGS-DONT-SWAP-IN %%M-FLAGS-DONT-SWAP-IN) (SG-FLAGS-TRAP-ENABLE %%M-FLAGS-TRAP-ENABLE) (SG-FLAGS-MAR-MODE %%M-FLAGS-MAR-MODE) (SG-FLAGS-PGF-WRITE %%M-FLAGS-PGF-WRITE) (SG-FLAGS-METER-ENABLE %%M-FLAGS-METER-ENABLE) (SG-FLAGS-TRAP-ON-CALL %%M-FLAGS-TRAP-ON-CALL) ) SG-AC-K SG-AC-S SG-AC-J SG-AC-I SG-AC-Q SG-AC-R SG-AC-T SG-AC-E SG-AC-D SG-AC-C SG-AC-B SG-AC-A SG-AC-ZR SG-AC-2 ;Pointer field of M-2 as fixnum SG-AC-1 ;Pointer field of M-1 as fixnum SG-VMA-M1-M2-TAGS ;Tag fields of VMA, M-1, M-2 packed into a fixnum SG-SAVED-VMA ;Pointer field of VMA as a locative SG-PDL-PHASE ;If you mung the sg's stack pointer, do same to this ;This is the actual value of PDL-BUFFER-POINTER reg. ) (DEFSTRUCT (REGULAR-PDL :ARRAY-LEADER (:CONSTRUCTOR NIL) (:ALTERANT NIL)) REGULAR-PDL-SG) (DEFSTRUCT (SPECIAL-PDL :ARRAY-LEADER (:CONSTRUCTOR NIL) (:ALTERANT NIL)) SPECIAL-PDL-SG) ;; Defsubsts for accessing the Regular Pdl. (DEFSUBST RP-CALL-WORD (RP AP) (AR-1 RP (+ AP %LP-CALL-STATE))) (DEFSUBST RP-EXIT-WORD (RP AP) (AR-1 RP (+ AP %LP-EXIT-STATE))) (DEFSUBST RP-ENTRY-WORD (RP AP) (AR-1 RP (+ AP %LP-ENTRY-STATE))) (DEFSUBST RP-FUNCTION-WORD (RP AP) (AR-1 RP (+ AP %LP-FEF))) ; (DEFINE-RP-MACROS ((RP-FOO %%FOO) (RP-BAR %%BAR)) RP-CALL-WORD) ; ; produces ; ; (PROGN 'COMPILE ; (DEFSUBST RP-FOO (RP AP) ; (LDB %%FOO (RP-CALL-WORD RP AP))) ; (DEFSUBST RP-BAR (RP AP) ; (LDB %%BAR (RP-CALL-WORD RP AP)))) (DEFMACRO DEFINE-RP-MACROS (SPEC-LIST WORD-MACRO) (DO ((L SPEC-LIST (CDR L)) (BYTE) (NAME) (ACCUM)) ((NULL L) `(PROGN 'COMPILE . ,ACCUM)) (SETQ NAME (CAAR L) BYTE (CADAR L)) ;; Use %LOGLDB (%LOGDPB) so we can set the sign bit without bignum coercion. (PUSH `(DEFSUBST ,NAME (RP AP) (%LOGLDB ,BYTE (,WORD-MACRO RP AP))) ACCUM))) (DEFINE-RP-MACROS ((RP-ATTENTION %%LP-CLS-ATTENTION) (RP-ADI-PRESENT %%LP-CLS-ADI-PRESENT) (RP-DESTINATION %%LP-CLS-DESTINATION) (RP-DELTA-TO-OPEN-BLOCK %%LP-CLS-DELTA-TO-OPEN-BLOCK) (RP-DELTA-TO-ACTIVE-BLOCK %%LP-CLS-DELTA-TO-ACTIVE-BLOCK) (RP-TRAP-ON-EXIT %%LP-CLS-TRAP-ON-EXIT)) RP-CALL-WORD) (DEFINE-RP-MACROS ((RP-MICRO-STACK-SAVED %%LP-EXS-MICRO-STACK-SAVED) (RP-PC-STATUS %%LP-EXS-PC-STATUS) (RP-BINDING-BLOCK-PUSHED %%LP-EXS-BINDING-BLOCK-PUSHED) ;Same as above (RP-EXIT-PC %%LP-EXS-EXIT-PC)) RP-EXIT-WORD) (DEFINE-RP-MACROS ((RP-NUMBER-ARGS-SUPPLIED %%LP-ENS-NUM-ARGS-SUPPLIED) ;Only for macro frames (RP-LOCAL-BLOCK-ORIGIN ;can this be extended? %%LP-ENS-MACRO-LOCAL-BLOCK-ORIGIN)) ;Only for macro frames RP-ENTRY-WORD) ;; Defsubsts for accessing fields of the headers of Function Entry Frames. (DEFMACRO DEFINE-OFFSET-BYTE-MACROS (PTR . WORDS) (DO ((LL WORDS (CDR LL)) (ACCUM) (INDEX 0 (1+ INDEX))) ((NULL LL) `(PROGN 'COMPILE . ,ACCUM)) (DO ((L (CAR LL) (CDR L)) (NAME) (BYTE)) ((NULL L)) (SETQ NAME (CAAR L) BYTE (CADAR L)) (PUSH `(DEFSUBST ,NAME (,PTR) (%P-LDB-OFFSET ,BYTE ,PTR ,INDEX)) ACCUM)))) (DEFINE-OFFSET-BYTE-MACROS FEF ((FEF-INITIAL-PC %%FEFH-PC) (FEF-NO-ADL-P %%FEFH-NO-ADL) (FEF-FAST-ARGUMENT-OPTION-P %%FEFH-FAST-ARG) (FEF-SPECIALS-BOUND-P %%FEFH-SV-BIND)) ((FEF-LENGTH %%Q-POINTER)) () ((FEF-FAST-ARGUMENT-OPTION-WORD %%Q-POINTER)) ((FEF-BIT-MAP-P %%FEFHI-SVM-ACTIVE) (FEF-BIT-MAP %%FEFHI-SVM-BITS)) ((FEF-NUMBER-OF-REAL-LOCALS %%FEFHI-MS-LOCAL-BLOCK-LENGTH) (FEF-ADL-ORIGIN %%FEFHI-ARG-DESC-ORG) (FEF-ADL-LENGTH %%FEFHI-BIND-DESC-LENGTH))) (DEFSUBST FEF-NAME (FEF) (%P-CONTENTS-OFFSET FEF %FEFHI-FCTN-NAME)) ;; Randomness. ; %%US-RPC ;RETURN PC ; %%US-PPBMIA ;ADI ON MICRO-TO-MICRO-CALL ; %%US-PPBMAA ;ADI ON MACRO-TO-MICRO-CALL ; %%US-PPBSPC ;BINDING BLOCK PUSHED ;%%ADI-TYPE ;ADI-KINDS ; ADI-RETURN-INFO ; %%ADI-RET-STORING-OPTION ;ADI-STORING-OPTIONS ; ADI-ST-BLOCK ADI-ST-LIST ; ADI-ST-MAKE-LIST ; ADI-ST-INDIRECT ; %%ADI-RET-SWAP-SV ; %%ADI-RET-NUM-VALS-EXPECTING ; ADI-RESTART-PC ; %%ADI-RPC-MICRO-STACK-LEVEL ; ADI-FEXPR-CALL ; ADI-LEXPR-CALL ; ADI-BIND-STACK-LEVEL ; ADI-USED-UP-RETURN-INFO (DEFCONST SG-ACCUMULATORS '( SG-AC-K SG-AC-S SG-AC-J SG-AC-I SG-AC-Q SG-AC-R SG-AC-T SG-AC-E SG-AC-D SG-AC-C SG-AC-B SG-AC-A SG-AC-ZR ))