;;; Inertly recovered online-help source contexts.
;;; Original System 46 file: lmcons/cc.516
;;; Exact source bytes follow each generated provenance comment.

;;; Source bytes 62721:65176; lines 1884-1940; sha256 541e5abdd0cb9be59b5f0f703630c412ac820164a24d4716db2ab9b943a7bd1c
(DEFUN CC-DESCRIBE-AREAS (IGNORE)
  (TERPRI)
  (LET ((A-N (QF-INITIAL-AREA-ORIGIN 'AREA-NAME))
	(A-RL (QF-INITIAL-AREA-ORIGIN 'AREA-REGION-LIST))
	(A-RS (QF-INITIAL-AREA-ORIGIN 'AREA-REGION-SIZE))
	(A-MS (QF-INITIAL-AREA-ORIGIN 'AREA-MAXIMUM-SIZE))

	(R-O (QF-INITIAL-AREA-ORIGIN 'REGION-ORIGIN))
	(R-L (QF-INITIAL-AREA-ORIGIN 'REGION-LENGTH))
	(R-B (QF-INITIAL-AREA-ORIGIN 'REGION-BITS))
	(R-FP (QF-INITIAL-AREA-ORIGIN 'REGION-FREE-POINTER))
	(R-GCP (QF-INITIAL-AREA-ORIGIN 'REGION-GC-POINTER))
	(R-LT  (QF-INITIAL-AREA-ORIGIN 'REGION-LIST-THREAD)))
   (DO ((AREA 0 (1+ AREA))
	(NAREAS 0) (BITS) (A-NAME))
       ((= AREA SIZE-OF-AREA-ARRAYS) (PRINC '|/
Number of active areas = |) (PRINC NAREAS) (TERPRI) )
       (SETQ A-NAME (QF-MEM-READ (+ A-N AREA)))
       (COND ((AND (= (LOGLDB %%Q-DATA-TYPE A-NAME) DTP-SYMBOL)
		   (NOT (ZEROP (LOGLDB %%Q-POINTER A-NAME))))
		(AND (SIGNP GE (- (CAR (CURSORPOS)) CC-FIRST-STATUS-LINE))
		     (PROGN (PRINC '**MORE**) (TYI)
			    (CURSORPOS 0 0) (CURSORPOS 'L)))
		(SETQ NAREAS (1+ NAREAS))
		(PRIN1 AREA)		;AREA NUMBER
		(TYO #M 11 #Q 211)
		(CC-Q-PRINT-TOPLEV A-NAME)  ;AREA-NAME
		(TYO #M 11 #Q 211)
		(PRINC '|Region-size |)
		(CC-Q-PRINT-TOPLEV (QF-MEM-READ (+ A-RS AREA)))
		(PRINC '| Maximum-size |)
		(CC-Q-PRINT-TOPLEV (QF-MEM-READ (+ A-MS AREA)))
		(DO ((RN (LOGLDB %%Q-POINTER (QF-MEM-READ (+ A-RL AREA)))
			 (LOGLDB %%Q-POINTER (QF-MEM-READ (+ R-LT RN)))))
		     ((NOT (ZEROP (LOGAND 1_23. RN)))
		      (COND ((NOT (= AREA (LOGAND RN 777777)))
			     (PRINC '|Region thread not linked back to AREA!!|))))
		   (TERPRI)
                   (PRINC '|   R |)
		   (PRINC RN) 
		   (PRINC '|: Origin |)
		   (PRINC (LOGLDB %%Q-POINTER (QF-MEM-READ (+ R-O RN))))
		   (PRINC '| Length |)
		   (PRINC (LOGLDB %%Q-POINTER (QF-MEM-READ (+ R-L RN))))
		   (PRINC '| Free-Ptr |)
		   (PRINC (LOGLDB %%Q-POINTER (QF-MEM-READ (+ R-FP RN))))
		   (PRINC '| GC-Ptr |)
		   (PRINC (LOGLDB %%Q-POINTER (QF-MEM-READ (+ R-GCP RN))))
                   (PRINC '| |)
                   (SETQ BITS (QF-MEM-READ (+ R-B RN)))
                   (PRINC (NTH (LOGLDB %%REGION-REPRESENTATION-TYPE BITS)
                               '(LIST STRUC 2 3)))
                   (PRINC '| |)
                   (PRINC (NTH (LOGLDB %%REGION-SPACE-TYPE BITS)
                               '(FREE OLD NEW STATIC FIXED EXITED EXIT EXTRA-PDL
                                 WIRED USER-PAGED COPY 13 14 15 16 17))))
		(TERPRI))))))

;;; Source bytes 65226:65530; lines 1945-1955; sha256 ee1022dfe4016e332ed1beef1e117ac4efd7645dd4a183a0bedbdc0e321367ad
(DEFUN CC-DESCRIBE-ATOM (TEM)
  (SETQ CC-GETSYL-UNRCH NIL CC-GETSYL-UNRCH-TOKEN NIL) ;FLUSH DELIMITER
  (SETQ TEM (READ))	;GET NAME OF ATOM USING LISP SYNTAX
  (TERPRI)
  (SETQ TEM (QF-SYMBOL TEM))
  (COND ((< TEM 0)
	 (PRINC '|Not found.|)
	 (TERPRI))
	(T (CC-DESCRIBE-THIS-ATOM TEM)))
  (TERPRI)
  NIL)

;;; Source bytes 65532:65892; lines 1957-1968; sha256 45fba24b0cbff269282817803f8dff67a4a478972ed1784403634d4beb1aa9cd
(DEFUN CC-DESCRIBE-THIS-ATOM (ADR)
  (PRINT 'LOCATION)
  (PRIN1 (SETQ ADR (QF-POINTER ADR)))
  (PRINT 'VALUE)
  (CC-Q-PRINT-TOPLEV (CC-MEM-READ (1+ ADR)))
  (PRINT 'FUNCTION)
  (CC-Q-PRINT-TOPLEV (CC-MEM-READ (+ ADR 2)))
  (PRINT 'PLIST)
  (CC-Q-PRINT-TOPLEV (CC-MEM-READ (+ ADR 3)))
  (PRINT 'PACKAGE)
  (CC-Q-PRINT-TOPLEV (CC-MEM-READ (+ ADR 4)))
  (TERPRI))

;;; Source bytes 82106:83365; lines 2421-2447; sha256 188d165aad2d7f27fb9ce2076e01ae8702d4d0a0dc8b3322832b81d78c01b1a1
(DEFUN CC-DESCRIBE-MEMORY (TEM)
  ;GET LIST OF REVERSE LISTS (FOR CONTIG AREAS) OF LISTS
  ;EACH 3RD LEVEL LIST IS VIRTUAL ADDR, AREA NUMBER, SWAP STATUS, PHYS ADDR,
  ; META BITS, MAP STATUS, ACCESS CODE 
  (DO L (CC-DESCRIBE-MEMORY-COLLECT-CONTIG (CC-DESCRIBE-MEMORY-COPY-OUT-PHT) NIL)
      (CDR L) (NULL L)					;PROCESS EACH CONTIG AREA
    (DO LL (CC-DESCRIBE-MEMORY-CONTIG-SPLITUP (NREVERSE (CAR L)) NIL)
	   (CDR LL) (NULL LL)
      (PRINT (CAAAR LL))				;FIRST VIRTUAL ADDRESS
      (TYO 11)
      (COND ((< (CADAAR LL) (LENGTH AREA-LIST))		;PRINT AREA NAME, TRYING TO BE
	     (PRIN1-THEN-SPACE (NTH (CADAAR LL) AREA-LIST)))	;QUICK ABOUT IT
	    (T (CC-Q-PRINT-TOPLEV (QF-MEM-READ (+ (CADAAR LL)
						  (QF-INITIAL-AREA-ORIGIN 'AREA-NAME))))
	       (TYO 40)))
      (PRIN1 (// (- (CAAAR LL)
		     (SETQ TEM (QF-POINTER		;AREA NUMBER TO AREA ORIGIN
				 (QF-MEM-READ (+ (CADAAR LL)
						 (QF-INITIAL-AREA-ORIGIN 'AREA-ORIGIN))))))
		  PAGE-SIZE))				;FIRST RELATIVE PAGE NUM
      (COND ((> (LENGTH (CAR LL)) 1)			;IF MULTI PAGES CONTIG
	     (PRINC '-)
	     (PRIN1 (// (- (CAAR (LAST (CAR LL))) TEM) PAGE-SIZE))))
      (PRINC '|  -->  |)				;MAPS ONTO
      (CC-DESCRIBE-MEMORY-PRINT-ATTRIB (CAAR LL))))	;SAY WHAT IT MAPS ONTO
  (TERPRI)
  NIL)

;;; Source bytes 83367:83764; lines 2449-2457; sha256 474ab2d1b68667f7357816e99ec5ab952c92de63348c8ac275dd496e006f3070
(DEFUN CC-DESCRIBE-MEMORY-PRINT-ATTRIB (X)
  (PRIN1-THEN-SPACE (CADDDR X))				;PHYSICAL ADDRESS
  (AND (CADDR X) (PRIN1-THEN-SPACE (CADDR X)))		;SWAP STATUS IF ABNORMAL
  (PRIN1-THEN-SPACE (CADR (CDDDDR X)))			;MAP STATUS
  (AND (CADDR (CDDDDR X))
       (PRIN1-THEN-SPACE (CADDR (CDDDDR X))))		;ACCESS IF ANY
  (OR (= 0 (CAR (CDDDDR X)))
      (PRIN1 'META-BITS=)
      (PRIN1 (CAR (CDDDDR X)))))

;;; Source bytes 84027:84680; lines 2463-2475; sha256 5143a53f8c98d257ec4666dd0aa32727c72cc18f42e596c9d9cbfb14a41c7fe3
(DEFUN CC-DESCRIBE-MEMORY-CONTIG-SPLITUP (LL PREV-CONTIG)
  (COND ((NULL PREV-CONTIG)
	 (CC-DESCRIBE-MEMORY-CONTIG-SPLITUP (CDR LL) (LIST (CAR LL))))
	((NULL LL)
	 (LIST (NREVERSE PREV-CONTIG)))
	((AND (= (- (CADDDR (CAR LL)) PAGE-SIZE)
		 (CADDDR (CAR PREV-CONTIG)))	;PHYS ADDRS AGREE
	      (EQ (CADDR (CAR LL)) (CADDR (CAR PREV-CONTIG)))	;SWAP STATUS AGREE
	      (EQUAL (CDDDDR (CAR LL)) (CDDDDR (CAR PREV-CONTIG)))) ;OTHER STUFF AGREES
	 (CC-DESCRIBE-MEMORY-CONTIG-SPLITUP (CDR LL) (CONS (CAR LL) PREV-CONTIG)))
	(T							;START NEW CONTIG FROB
	 (CONS (NREVERSE PREV-CONTIG)
	       (CC-DESCRIBE-MEMORY-CONTIG-SPLITUP (CDR LL) (LIST (CAR LL)))))))

;;; Source bytes 84682:85370; lines 2477-2490; sha256 a8482007e397323dedc8b6b7186d7160397865e44330f49dcbf3f4c3d0217075
(DEFUN CC-DESCRIBE-MEMORY-COLLECT-CONTIG (SORTED-PHT-LIST PREVIOUS-CONTIG-LIST)
  (COND ((NULL SORTED-PHT-LIST)
	 (AND PREVIOUS-CONTIG-LIST (LIST PREVIOUS-CONTIG-LIST)))
	((NULL PREVIOUS-CONTIG-LIST)
	 (CC-DESCRIBE-MEMORY-COLLECT-CONTIG (CDR SORTED-PHT-LIST)
					    (LIST (CAR SORTED-PHT-LIST))))
	((AND (= (CADAR SORTED-PHT-LIST) (CADAR PREVIOUS-CONTIG-LIST)) ;SAME AREA
	      (= (CAAR SORTED-PHT-LIST)
		 (+ PAGE-SIZE (CAAR PREVIOUS-CONTIG-LIST)))) ;NEXT VIR ADR
	 (CC-DESCRIBE-MEMORY-COLLECT-CONTIG (CDR SORTED-PHT-LIST)
					    (CONS (CAR SORTED-PHT-LIST) PREVIOUS-CONTIG-LIST)))
	(T
	 (CONS PREVIOUS-CONTIG-LIST
	       (CC-DESCRIBE-MEMORY-COLLECT-CONTIG SORTED-PHT-LIST NIL)))))

;;; Source bytes 85447:86839; lines 2494-2529; sha256 a792ecbfbb74d8cf8f47f74da1e76e6023daf3196381d9042cb76bed06fe1465
(DEFUN CC-DESCRIBE-MEMORY-COPY-OUT-PHT NIL 
  (SORTCAR
    (DO ((PHTP (QF-POINTER (PHYS-MEM-READ (+ PAGE-SIZE %SYS-COM-PAGE-TABLE-PNTR))) (+ PHTP 2))
	 (COUNT (// (QF-POINTER (PHYS-MEM-READ (+ PAGE-SIZE %SYS-COM-PAGE-TABLE-SIZE))) 2)
		(1- COUNT))
	 (PHT1)
	 (PHT2)
	 (VIRAD)
	 (LST NIL))
	((= 0 COUNT) LST)
      (DECLARE (FIXNUM PHTP COUNT PHT1 PHT2 VIRAD))
      (COND ((AND (NOT (= 0 (LOGAND 100 (SETQ PHT1 (PHYS-MEM-READ PHTP)))))
		  (NOT (= %PHT-DUMMY-VIRTUAL-ADDRESS (LOGLDB %%PHT1-VIRTUAL-PAGE-NUMBER PHT1))))
	     (SETQ LST (CONS (LIST (SETQ VIRAD (* PAGE-SIZE		;VIRTUAL ADDRESS
						  (LOGLDB %%PHT1-VIRTUAL-PAGE-NUMBER PHT1)))

				   (QF-AREA-NUMBER-OF-POINTER VIRAD)	;AREA NUMBER
				   (NTH (LOGLDB %%PHT1-SWAP-STATUS-CODE PHT1)
					'(SWAP-STATUS-ZERO?
					  NIL FLUSHABLE SWAP-STATUS-PDL-BUFFER
					  AGE-TRAP WIRED SWAP-STATUS-6?
					  SWAP-STATUS-7?))
				   (* PAGE-SIZE		;PHYSICAL ADDRESS
				      (LOGLDB %%PHT2-PHYSICAL-PAGE-NUMBER
					      (SETQ PHT2 (PHYS-MEM-READ (1+ PHTP)))))
				   (LOGLDB %%PHT2-META-BITS PHT2)
				   (NTH (LOGLDB %%PHT2-MAP-STATUS-CODE PHT2)
					'(LEVEL-1-MAP-NOT-VALID?
					  LEVEL-2-MAP-NOT-VALID?
					  READ-ONLY READ-WRITE-FIRST READ-WRITE
					  MAP-STATUS-PDL-BUFFER
					  MAP-STATUS-6? MAP-STATUS-7?))
				   (NTH (LOGLDB %%PHT2-MAP-ACCESS-CODE PHT2)
					'(NIL NIL R-ACCESS R-W-ACCESS)))
			     LST)))))
    (FUNCTION <)))

;;; Source bytes 96215:97138; lines 2790-2812; sha256 f7a4d044c848d1205f0d4803ffa322d6a517cc86e041a6eb0ee8610b5b5a7f20
(DEFUN CC-DESCRIBE-STACK-GROUP (SG)
  (PROG (PNTR)
	(SETQ PNTR (QF-POINTER SG))
	(FORMAT T "~%Stack group: " )
	(CC-Q-PRINT-TOPLEV (CC-MEM-READ (- PNTR 2 SG-NAME)))
	(LET ((STATE (CC-MEM-READ (- PNTR 2 SG-STATE))))
	   (COND ((NOT (ZEROP (LOGLDB %%SG-ST-IN-SWAPPED-STATE STATE)))
		  (FORMAT T "~% Variables currently swapped out")))
	   (COND ((NOT (ZEROP (LOGLDB %%SG-ST-FOOTHOLD-EXECUTING STATE)))
		  (FORMAT T "~% Foothold currently executing")))
	   (COND ((NOT (ZEROP (LOGLDB %%SG-ST-PROCESSING-ERROR STATE)))
		  (FORMAT T "~% Currently processing an error")))
	   (FORMAT T ", State ~S" (NTH (LOGLDB %%SG-ST-CURRENT-STATE STATE) SG-STATES)))
	(DO ((L STACK-GROUP-HEAD-LEADER-QS (CDR L))
	     (A (- PNTR 2) (1- A))
	     (WD))
	    ((NULL L))
	  (FORMAT T "~%~O~10T~A:~30T" A (CAR L))
	  (SETQ WD (CC-MEM-READ A))
	  (CC-TYPE-OUT WD CC-Q-DESC NIL NIL)
	  (TYO #\TAB)
	  (ERRSET (CC-Q-PRINT-TOPLEV WD)))
	(TERPRI)))

;;; Source bytes 97140:97497; lines 2814-2822; sha256 cccae35ac01803a10b5d7521887bc983cbdf3fd1d976a8f6ca4fa153062ea5f3
(DEFUN CC-DESCRIBE-CLOSURE (CLOS)
    (FORMAT T "~%CLOSED-FUNCTION ")
    (CC-Q-PRINT-TOPLEV (QF-CAR CLOS))
    (DO ((L (QF-CDR CLOS) (QF-CDR (QF-CDR L))))
	((CC-Q-NULL L))
      (FORMAT T "~%SYM: ")
      (CC-Q-PRINT-TOPLEV (1- (QF-SMASH-DATA-TYPE (QF-CAR L) DTP-SYMBOL)))
      (FORMAT T " VALUE:")
      (CC-Q-PRINT-TOPLEV (QF-CAR (QF-CAR (QF-CDR L))))))

;;; Source bytes 97685:99557; lines 2830-2874; sha256 ece99cd40e1a6447b2c363f78f695923d843f0b0a91ce085f40b68c0111ab9c6
(DEFUN CC-DESCRIBE-FEF (FEF &AUX HEADER NAME FAST-ARG SV MISC LENGTH DBI)
  (SETQ HEADER (CC-P-LDB-OFFSET %%HEADER-REST-FIELD FEF %FEFHI-IPC))
  (SETQ LENGTH (CC-P-CONTENTS-OFFSET FEF %FEFHI-STORAGE-LENGTH))
  (SETQ NAME (CC-P-CONTENTS-OFFSET FEF %FEFHI-FCTN-NAME))
  (SETQ FAST-ARG (CC-P-CONTENTS-OFFSET FEF %FEFHI-FAST-ARG-OPT))
  (SETQ SV (CC-P-CONTENTS-OFFSET FEF %FEFHI-SV-BITMAP))
  (SETQ MISC (CC-P-CONTENTS-OFFSET FEF %FEFHI-MISC))
  (FORMAT T "~%FEF for function ") (CC-Q-PRINT-TOPLEV NAME) (TERPRI)
  (FORMAT T "Initial relative PC: ~S halfwords.~%" (LOGLDB %%FEFH-PC HEADER))
; -- Print out the fast arg option
  (FORMAT T "The Fast Argument Option is ~A"
	  (IF (ZEROP (LOGLDB %%FEFH-FAST-ARG HEADER))
	      "not active, but here it is anyway:"
	      "active:"))
  (SI:DESCRIBE-NUMERIC-DESCRIPTOR-WORD FAST-ARG)
; -- Randomness.
  (FORMAT T "~%The length of the local block is ~S~%"
	  (LOGLDB %%FEFHI-MS-LOCAL-BLOCK-LENGTH MISC))
  (FORMAT T "The total storage length of the FEF is ~S~%"
	  LENGTH)
; -- Special variables
  (COND ((ZEROP (LOGLDB %%FEFH-SV-BIND HEADER))
	 (PRINC "There are no special variables present."))
	(T (PRINC "There are special variables, ")
	   (TERPRI)
	   (COND ((ZEROP (LOGLDB %%FEFHI-SVM-ACTIVE SV))
		  (PRINC "but the S-V bit map is not active. "))
		 (T (FORMAT T "and the S-V bit map is active and contains: ~O"
			    (LOGLDB %%FEFHI-SVM-BITS SV))))))
  (TERPRI)
; -- ADL.
  (COND ((ZEROP (LOGLDB %%FEFH-NO-ADL HEADER))
	 (FORMAT T "There is an ADL:  It is ~S long, and starts at ~S"
		 (LOGLDB %%FEFHI-MS-BIND-DESC-LENGTH MISC)
			   (LDB %%FEFHI-MS-ARG-DESC-ORG MISC))
	 (CC-DESCRIBE-ADL (CC-GET-MACRO-ARG-DESC-POINTER FEF))
	 )
	(T (PRINC "There is no ADL.")))
  (TERPRI)
  DBI
; (COND ((SETQ DBI (FUNCTION-DEBUGGING-INFO FEF))
;	 (FORMAT T "Debugging info:~%")
;	 (DOLIST (ITEM DBI)
;		 (FORMAT T "  ~S~%" ITEM))))
  )

;;; Source bytes 99990:100924; lines 2888-2913; sha256 6a71d44cfae595bbbebb25d10a314edc7d49ba2e568f4dea7ecb34584f5b4fb7
(DEFUN CC-DESCRIBE-ADL (ADL)
  (PROG (OPT-Q INIT-OPTION)
    L	(COND ((CC-Q-NULL ADL) (RETURN NIL)))
    	(SETQ OPT-Q (QF-CAR ADL) ADL (QF-CDR ADL))
	(TERPRI)
	(COND ((NOT (ZEROP (LOGAND OPT-Q %FEF-NAME-PRESENT)))
	       (PRINC "NAME ")
	       (CC-Q-PRINT-TOPLEV (QF-CAR ADL))
	       (SETQ ADL (QF-CDR ADL))))
	(PRIN1-THEN-SPACE (NTH (LDB %%FEF-SPECIALNESS OPT-Q)
			       FEF-SPECIALNESS))
	(PRIN1-THEN-SPACE (NTH (LDB %%FEF-DES-DT OPT-Q)
			       FEF-DES-DT))
	(PRIN1-THEN-SPACE (NTH (LDB %%FEF-QUOTE-STATUS OPT-Q)
			       FEF-QUOTE-STATUS))
	(PRIN1-THEN-SPACE (NTH (LDB %%FEF-ARG-SYNTAX OPT-Q)
			       FEF-ARG-SYNTAX))
	(PRIN1-THEN-SPACE (SETQ INIT-OPTION (NTH (LDB %%FEF-INIT-OPTION OPT-Q)
						 FEF-INIT-OPTION)))
	(COND ((MEMQ INIT-OPTION '(FEF-INI-PNTR FEF-INI-C-PNTR 
				   FEF-INI-OPT-SA FEF-INI-EFF-ADR))
	       (PRINC "ARG ")
	       (CC-Q-PRINT-TOPLEV (QF-CAR ADL))
	       (SETQ ADL (QF-CDR ADL))))
	(GO L)
))