.TITLE	DUMP	   
	.IDENT	-05-
;	  
; MCR TASK THAT	PROVIDES OCTAL DUMPS OF SPECIFIED AREAS OF CORE.  
; WHEN DUMPING A SPECIFIED TASK, DUMP 'FREEZES' THE TASK IN CORE
; (SUSPENDS IT AND DISABLES CHECKPOINTING), MAPS TO THE AREA TO
; BE DUMPED, GENERATES THE OCTAL DUMP AND SPOOLS IT TO THE LINE
; PRINTER.  IT THEN RESTORES THE ORIGINAL STATUS OF THE TASK.
; WHEN DUMPING BY MEMORY ADDRESS, THE SAME PROCEDURE IS FOLLOWED
; EXCEPT THAT ACTIVITY IN THE AREA BEING DUMPED IS NOT INHIBITED.
;	  
; WRITTEN   APR	1976   R B FRENCH   THE	BOEING COMPANY  
;
; MODIFIED  JUN 1977   R B FRENCH   +01 BUG FIX - FW GREATER THAN 100000
;				        OCTAL WAS TREATED AS A NEGATIVE VALUE
;				        AND SET TO ZERO.
;
; MODIFIED  OCT 1977   R B FRENCH   +02 CAPABILITY ADDED TO DUMP BY
;				        ABSOLUTE MEMORY ADDRESS.
;
; MODIFIED  NOV 1977   R B FRENCH   +03 KERNEL SWITCH (/KN) ADDED.  VALID
;					FOR SCOMM ADDRESSES (100000 - 1577776)
;					ONLY.
; MODIFIED  SEP 1978   R B FRENCH   +04 ADDED EXTERNAL PAGE ADDRESS TO /KN
;					SWITCH.  NON-EXISTANT UNIBUS ADDRESSES
;					WILL APPEAR AS ASTERICKS.
; MODIFIED  JAN 1979   B C WRIGHT   +05	VARIOUS CLEANUPS.
;	  
; CALLING SEQUENCE:	    
;	  
; MCR>DUM[P] [TASKNAME][/SWITCHES]   
;	  
;   TASKNAME = NAME OF TASK TO BE DUMPED (OMIT FOR MEMORY DUMP)    
;	  
;   SWITCHES:	 
;    ALL NUMERIC ARGUMENTS ARE IN OCTAL.  THE DELIMITER    
;    CAN EITHER BE A COLON, AS SHOWN, OR AN EQUAL SIGN.   
;    NOTE: FOR MEMORY DUMPS EITHER FW OR LW (OR BOTH)
;    MUST BE INPUT.
;	  
;    /FW:ADR   ADR IS THE FIRST	WORD TO BE DUMPED.  IT  
;	       WILL BE ROUNDED DOWN TO THE NEAREST 100    
;              BYTE BOUNDARY.  DEFAULT IS ZERO.
;    /LW:ADR   ADR IS THE LAST WORD TO BE DUMPED.  IT   
;	       WILL BE ROUNDED UP TO THE NEAREST 100  
;	       BYTE BOUNDARY. DEFAULT IS THE PHYSICAL
;	       UPPER LIMIT OF MEMORY.
;    /NW:NUM   NUM IS THE NUMBER OF BYTES TO DUMP.  
;    /KN       DUMP ADR'S WILL BE INTREPRETED AS KERNEL
;	       VIRTUAL SPACE.  VALID ONLY FOR MEMORY DUMPS 
;	       (NO TASKNAME INPUT) - IGNORED 0THERWISE.
;	       OUTPUT FOR THIS SWITCH IS VALID ONLY FOR
;	       SCOMM AND THE EXTERNAL PAGE (KERNAL VIRTUAL
;	       100000 TO 177776).
;    /AS       DUMP ASCII TRANSLATION OF DATA AS WELL AS DATA.
;	       VALID ONLY FOR NON-TASK DUMPS.
;    /TI:TTNN  THE TI ADDRESS FOR THE TASK. VALID ONLY FOR
;	       TASK-STYLE DUMPS.
;	  
;    IF A TASK TYPE DUMP IS TAKEN, THE DUMP WILL BE WRITTEN
;    TO A STANDARD TASK DUMP FILE WHICH CAN BE ANALYSED WITH
;    THE TASK DUMP ANALYSIS PROGRAM, ...COR. NO SWITCHES
;    OTHER THAN /TI: CAN BE SPECIFIED FOR A TASK DUMP;  ANY
;    RELEVANT SWITCHES MUST BE SPECIFIED TO ...COR.
;
;    IF A NON-TASK TYPE DUMP IS TAKEN, A LISTING IS WRITTEN
;    TO "CL:DUMP.LST", WHICH NORMALLY GOES TO LP:. ALL
;    SWITCHES (WITH THE EXCEPTION OF /TI:) ARE VALID UNDER
;    A NON-TASK TYPE DUMP.
;	  
; IF ALL ARGUMENTS ARE OMITTED,	DUMP WILL REQUEST INPUT 
; WITH THE PROMPT 'DUMP>'.  ONCE A DUMP	REQUEST FOR A TASK  
; IS MADE IN THIS MANNER, IT WILL REMAIN 'FROZEN' UNTIL  
; A CONTROL Z OR ANOTHER TASKNAME (OR MEMORY DUMP REQUEST) 
; IS ENTERED.  MULTIPLE DUMPS OF A TASK CAN BE MADE IN THIS   
; MANNER.
;	  
; TASK BUILD FILE	  
;	  
;   DUMP/PR/-FP/-CP/MU=DUMP,DMPCOR,DIRDL,PRFCS,[1,1]EXEC.STB/SS  
;   /	  
;   TASK=...DUM	    
;   ASG=TI:1	   
;   PRI=100	 
;   LIBR=SYSRES:RO	 
;   STACK=32	   
;   /	  
;	  
	.MCALL	DIR$,GMCR$,QIOW$,OPEN$,CLOSE$,DELET$,PUT$,EXIT$S   
	.MCALL	FSRSZ$,FDBDF$,FDAT$A,FDRC$A,FDOP$A,NMBLK$,SVDB$S   
	.MACRO	ERROR	ARG
	MOV	ARG,-(SP)
	MOV	#ARG+2,-(SP)
	JSR	PC,ERROR
	.ENDM
	.MACRO	MSG	ARG
	.NCHR	$$$LEN,<ARG>
	.WORD	$$$LEN
	.ASCII	"ARG"
	.EVEN
	.ENDM
	.MACRO	PRINT	ARG,LEN
	MOV	ARG,-(SP)
	MOV	LEN,-(SP)
	JSR	PC,PRINT
	.ENDM
;
; CONDITIONAL ASSEMBLY PARAMETERS
;
R$$11D	=	0	;ASSEMBLE FOR RSX-11D
;I$$AS	=	0	;ASSEMBLE FOR IAS
;
APR2OF	=	40000		;+05 OFFSET FOR APR2 MAPPING.
APR3OF	=	60000		;+05 OFFSET FOR APR3 MAPPING.
UISAR2	=	177644		;+05 APR2 ADDRESS REGISTER
UISAR3	=	177646		;+05 APR3 ADDRESS REGISTER
UISDR2	=	177604		;+05 APR2 DESCRIPTOR REGISTER
UISDR3	=	177606		;+05 APR3 DESCRIPTOR REGISTER
;
APREXT	=	177600		;+05 EXTERNAL PAGE APR ADDRESS
BR3	=	140		;+05 BUS PRIORITY 3.
SCOMBO	=	1000		;+05 SCOM BASE APR ADDRESS
SCOMTO	=	1600		;+05 SCOM TOP APR ADDRESS
EXTTO	=	2000		;+05 EXTERNAL PAGE TOP APR ADDRESS
;	  
; MAP APR2 TO THE 1ST 100 BYTES	OF OUR HEADER.  ALL APR 
; CHANGES MUST BE MADE IN THE HEADER ALSO OR EXEC ACTIVITY  
; WILL RESTORE THE APR'S TO THEIR ORIGINAL VALUES.  
;+04 ALSO SPECIFY THE SST VECTOR TABLE HERE, WHICH TRAPS 
;+04 REFERENCES TO NON-EXISTANT UNIBUS ADDRESSES WHEN DUMPING
;+04 THE EXTERNAL PAGE.
; THIS CODE IS EXECUTED	ONLY ONCE AND THEN WILL BE USED 
; AS STACK SPACE.	  
START:	MOV	.CRTSK,R0	;GET OUR ATL NODE  
	MOV	A.TI(R0),R1	;+05 GET OUR PUD BLOCK.
	MOV	R1,OURTI	;+05 SET OUR TI ADDRESS.
	CLR	PRIV		;+05 ASSUME USER ISN'T PRIVILEGED.
	.IF DF	R$$11D!I$$AS	;+05
	BITB	#UT.PR,U.TF(R1)	;+05 IS THIS CLOWN PRIVILEGED?
	BEQ	1$		;+05 NO, ASSUMPTION CORRECT.
	INC	PRIV		;+05 YOU CAN'T BE RIGHT ALL THE TIME.
1$:
	.ENDC	;R$$11D!I$$AS	;+05
	MOV	A.HA(R0),R0	;GET OUR LOAD ADDRESS  
	MOV	#1006,R1	;+05 PDR FOR 200 BYTES    
	MOV	@#PS.EXP,-(SP)	;+05 PSW TO STACK   
	BIS	#BR3,@#PS.EXP	;;+05 INHIBIT TASK SWITCHING 
	MOV	R0,@#UISAR2	;;MAP APR2 TO FIRST 100    
	MOV	R1,@#UISDR2	;;BYTES	OF OUR HEADER  
	MOV	R0,@#APR2OF+H.PA0+4 ;;+05 PUT APR2 IN OUR HEADER    
	MOV	R1,@#APR2OF+H.PD0+4 ;;+05
	JSR	PC,..ENB0	;ENABLE	TASK SWITCHING   
	SVDB$S	#EXPG,#1	;+04 - SPECIFY THE VECTOR TABLE
	JSR	SP,GETMCR	;MAKE PREVIOUS CODE STACK SPACE  
;	  
; GET THE MCR COMMAND LINE AND LOCATE THE START AND 
; LENGTH OF THE	REQUEST.  THIS CODE IS EXECUTED ONLY    
; ONCE AND WILL	BE USED	LATER AS THE USER RECORD BUFFER 
; FOR PUT$ OPERATIONS.	 
GMCR:	GMCR$	    
GETMCR:	MOV	SP,SPSAVE	;+05 REMEMBER SP.
	DIR$	#GMCR		;GET COMMAND LINE   
	CMP	@#$DSW,#4	;+05 ANY ARGUMENTS?  
	BLE	GETCMD		;IF NOT, GO GET COMMAND    
	INC	MCRFLG	    
	MOV	#GMCR+G.MCRB,R0	;GET MCR LINE ADDRESS  
	MOV	@#$DSW,R1	;+05 GET NUMBER OF CHARACTERS    
10$:	CMPB	#' ,(R0)+	;SCAN FOR BLANK 
	BEQ	20$	   
	SOB	R1,10$	    
	BR	GETCMD		;IF NONE, GO READ COMMAND   
20$:	DEC	R1	    
	BEQ	GETCMD	    
30$:	CMPB	#' ,(R0)+	;SCAN FOR NON-BLANK 
	BNE	40$	   
	SOB	R1,30$	    
	BR	GETCMD	 
40$:	DEC	R0	    
	MOV	R0,R3	 
	MOV	R1,IOST+2	;SAVE CHARACTER COUNT    
	BR	RDNAME	 
;	  
PUDERR:	ERROR	PUDMSG		;+05 WRITE ILLEGAL DEVICE MSG
	BR	DONE		;+05
SWTERR:	ERROR	SWTMSG		;+05 WRITE ILLEGAL SWITCH
	BR	DONE		;+05
PRVERR:	ERROR	PRVMSG		;+05 WRITE PRIVILEGE MESSAGE
	BR	DONE		;+05 AND DONE.
SYNERR:	ERROR	SYNMSG		;WRITE SYNTAX ERROR MESSAGE 
;	  
DONE:	TST	MCRFLG		;COMMAND FROM MCR LINE?   
	BEQ	GETCMD		;NO - GET ANOTHER COMMAND  
EXIT:	TST	SAVNAM		;IS A TASK SUSPENDED? 
	BEQ	10$	   
	JSR	PC,RESUME	;RESUME	IT BEFORE EXITING    
10$:	EXIT$S
;	  
; COME HERE TO WRITE 'DUMP>' PROMPT AND	TO READ REQUEST 
; IF NONE WAS GIVEN IN MCR LINE.    
GETCMD:	MOV	#READ,-(SP)	;+05 READ COMMAND TO STACK
	CALL	.DIRDL		;+05 DO I/O
	MOV	#GMCR,R3   
	CMP	#-10.,IOST	;CONTROL Z? 
	BNE	RDNAME	    
	BR	EXIT	   
;	  
; READ TASKNAME	AND CONVERT IT TO RAD50.    
RDNAME:	CLRB	SWMASK		;CLEAR SWITCH MASK 
	MOV	IOST+2,R4	;GET NUMBER OF CHARACTERS    
	BEQ	GETCMD		;+05 LOOP IF NOTHING INPUT.
	MOV	OURTI,DEFTI	;+05 SET THE DEFAULT TI:
	MOV	R3,R5		;ADD ZERO BYTE  
	ADD	R4,R5	 
	CLRB	(R5)	 
	CLR	TSKNAM		;+05 CLEAR TASKNAME.
	CLR	TSKNAM+2	;+05 AND SECOND PART.
	MOV	R3,R0		;+05 RE-POINT TO TASKNAME.
	MOV	#TSKNAM,R5	;+05 POINT TO THE TASKNAME BLOCK.
	MOV	#1,R1		;SET PERIOD ACCEPT  
	JSR	PC,$CAT5	;CONVERT 1ST WORD OF TASKNAME 
	MOV	R1,(R5)+	;SAVE IT  
	BCC	50$		;ANY ERRORS?
	CLR	(R5)		;IF SO - CLEAR 2ND WORD
	DEC	R0		;+05 DEC TO CHAR WHICH FAILED.
	BR	60$		;AND ASSUME WE'RE DONE
50$:	JSR	PC,$CAT5	;CONVERT 2ND WORD OF TASKNAME 
	MOV	R1,(R5)		;SAVE IT  
	BCC	60$		;+05 SKIP IF OK
	DEC	R0		;+05 POINT TO CHAR WHICH FAILED.
60$:	TST	TSKNAM		;+02 TASKNAME INPUT?
	BNE	70$		;+02 BRANCH IF SO
	TST	PRIV		;+05 THIS GUY PRIVILEGED?
	BEQ	PRVERR		;+05 NO -- ERROR.
	MOV	#NAME,R1	;+02 PUT 'MEMORY' IN TITLE BLOCK
	MOV	#"ME,(R1)+	;+02
	MOV	#"MO,(R1)+	;+02
	MOV	#"RY,(R1)	;+02
70$:				;+02
	CMP	TSKNAM+2,#^R...	;+05 IS IT A DRIVER???
	BNE	75$		;+05 NO, LET HIM BE.
	TST	PRIV		;+05 THIS CLOWN PRIVILEGED?
	BEQ	PRVERR		;+05 YOU ASKED FOR IT, YOU GOT IT.
75$:
	MOV	R0,R3		;+05
;	  
; READ SWITCHES	AND SET	PARAMETERS ACCORDINGLY  
RDSW:	CMPB	(R3),#'/	;+05 ANY SWITCHES?
	BEQ	2$		;+05 YES.
	TSTB	(R3)		;+05 IS IT THE END-OF-STRING?
	BEQ	1$		;+05 YES -- THEN GO.
	CMPB	#' ,(R3)+	;+05 OTHERWISE SKIP BLANKS.
	BEQ	RDSW		;+05 OK -- GO ON.
	BR	SYNERR		;+05 OTHERWISE, SYNTAX ERROR.
1$:	JMP	GO		;+05 AND GO.
2$:	INC	R3		;STEP R3 PAST /    
	TST	PRIV		;+05 THIS GUY PRIVILEGED?
	BEQ	PRVERR		;+05 NO -- THE DUMMY.
;
	MOVB	(R3)+,SW	;GET SWITCH NAME    
	BEQ	SWTERR		;ERROR?
	MOVB	(R3)+,SW+1	   
	BEQ	SWTERR		;ERROR?
	MOV	SW,R0		;AND PUT IN R0  
	MOVB	NSWTCH,R5	;NUMBER	OF POSSIBLE SWITCHES    
	MOV	#SWTYP,R1	;SWITCH	TABLE ADR IN R1  
10$:	CMP	R0,(R1)+	;CHECK FOR SWITCH TYPE    
	BEQ	20$	   
	SOB	R5,10$	    
	JMP	SWTERR		;ERROR IF NO MATCH  
20$:	DEC	R5		;USE SWITCH POINTER    
	MOV	#1,R0		;TO SET	MASK    
	ASH	R5,R0	 
	BISB	R0,SWMASK	    
	CMP	#TISN,R5	;+05 TI= OR /AS OR /KN?
	BGE	40$		;+03 BRANCH IF SO
	CMPB	#':,(R3)+	;CHECK FOR SEMI-COLON   
	BEQ	25$		;BRANCH	IF THERE  
	CMPB	#'=,-1(R3)	;HOW ABOUT EQUAL SIGN? 
	BEQ	25$		;+05 OK IF AN =
	JMP	SYNERR		;+05 SYNTAX ERROR IF NEITHER.
25$:	MOV	R3,-(SP)	;+02 SAVE R3
26$:	CMPB	#'0,(R3)+	;+02 SCAN FOR END OF SWITCH VALUE
	BGT	27$		;+02
	CMPB	#'7,-1(R3)	;+05 WELL?
	BGE	26$		;+05 NOT YET.
27$:	CLR	R4		;+05 CLEAR R4 FOR FLAG OF ROUNDUP.
	CMPB	-3(R3),#'0	;+05 IS FIRST CHAR A 0?
	BNE	28$		;+05 NO, SIGNAL ROUNDUP.
	CMPB	-2(R3),#'0	;+05 HOW ABOUT SECOND TO LAST CHAR?
	BEQ	29$		;+05 NO, SKIP ROUNDUP FLAG.
28$:	INC	R4		;+05 SET ROUNDUP FLAG.
29$:	MOV	R3,R0		;+05 REMEMBER BUFFER POINTER.
	SUB	#3,R3		;+02 BACK UP AND CLEAR DIGIT
	CLRB	(R3)		;+02 TO STOP $COTB
	SUB	(SP),R3		;+05 IS IT > 3 DIGITS?
	BGT	30$		;+05 YES
	CLR	R1		;+05 NO, FIX UP VALUES.
	TST	(SP)+		;+05 POP OFF USELESS WORD.
	MOV	R0,R3		;+05 REMEMBER BUFFER POINTER.
	DEC	R3		;+05 POINT TO BYTE WHICH FAILED.
	BR	35$		;+05 AND CONTINUE.
30$:	MOV	(SP)+,R3	;+02 RESTORE R3
	MOV	R3,R0	  
	JSR	PC,$COTB	;CONVERT SWITCH PARAMETER 
	MOV	R0,R3		;+05 POINT TO BUFFER AGAIN.
	INC	R3		;+02 SKIP OVER IGNORED CHARACTERS
35$:	CMP	R5,#LWSN	;+05 IS IT THE /LW OR /NW SWITCH?
	BLT	36$		;+05 NO, IT'S THE /FW: SWITCH.
	TST	R4		;+05 YES - IS ROUNDUP NEEDED?
	BEQ	36$		;+05 NO, /SW:NN00 SPECIFIED.
	INC	R1		;+05 YES, ROUND UP THE ADDRESS.
36$:	ASL	R5	    
	MOV	R1,FW-<TISN*2>-2(R5) ;+03 AND SAVE IT
	BR	RDSW		;+05 AND CONTINUE.
40$:	CMP	#TISN,R5	;+05 /TI= SWITCH?
	BNE	RDSW		;+05 NO, WAS THE /KN OR /AS SWITCH.
	TST	TSKNAM		;+05 WAS A TASK NAME SPECIFIED?
	BEQ	44$		;+05 NO -- SYNTAX ERROR.
	CMPB	(R3)+,#':	;+05 WAS A : SPECIFIED?
	BEQ	45$		;+05 YES
	CMPB	-1(R3),#'=	;+05 HOW ABOUT AN =?
	BEQ	45$		;+05 YES
44$:	JMP	SYNERR		;+05 NO -- ERROR.
45$:	MOVB	(R3)+,SW	;+05 GET FIRST PART OF TI NAME.
	BEQ	44$		;+05 ERROR?
	MOVB	(R3)+,SW+1	;+05 GET SECOND PART OF TI NAME.
	BEQ	44$		;+05 ERROR?
	MOV	R3,R0		;+05 REMEMBER THE POSITION.
	CALL	$COTB		;+05 GET THE TI NUMBER.
	MOV	R0,R3		;+05 GET STRING POINTER BACK AGAIN.
	DEC	R3		;+05 POINT TO FAILED CHARACTER.
	CMPB	(R3),#':	;+05 IS IT A :?
	BNE	50$		;+05 NO
	INC	R3		;+05 YES -- SKIP OVER IT.
50$:	MOV	.PUDBA,R0	;+05 POINT TO PUD BEGINNING ADDRESS.
55$:	CMP	U.DN(R0),SW	;+05 DOES DEVICE MATCH?
	BNE	60$		;+05 NO
	CMPB	U.UN(R0),R1	;+05 HOW ABOUT DEVICE NAME?
	BEQ	70$		;+05 YES, A MATCH!
60$:	ADD	#U.SZ,R0	;+05 NEXT PUD ENTRY
	CMP	R0,.PUDEA	;+05 AT END OF PUD?
	BLO	55$		;+05 NO, KEEP GOING.
	JMP	PUDERR		;+05 SYNTAX ERROR.
70$:	MOV	R0,DEFTI	;+05 CHANGE THE TI ADDRESS.
	JMP	RDSW		;+05 AND READ THE NEXT SWITCH.
;	  
; CHECK	FOR NEW	TASKNAME.  IF NEW, RESUME PREVIOUS TASK 
; (IF ANY) BEFORE SUSPENDING NEW ONE. 
;
GO:	CMP	TSKNAM,SAVNAM	;COMPARE 1ST WORD OF OLD AND NEW TASKNAMES    
	BNE	10$		;BRANCH	IF DIFFERENT  
	CMP	TSKNAM+2,SAVNAM+2 ;COMPARE 2ND WORD    
	BEQ	SETUP		;IF THE	SAME - GO DUMP SOME MORE    
10$:	TST	SAVNAM		;IS A TASK SUSPENDED   
	BEQ	SUSPND		;BRANCH	IF NOT 
	JSR	PC,RESUME	;RESUME	THE OLD TASK 
SUSPND:	TST	TSKNAM		;+02 IS THIS A MEMORY DUMP?
	BEQ	SETUP		;+02 IF SO, BRANCH
	MOV	#.ATLLH,R0	;GET ATL LISTHEAD    
	MOV	R0,R3		;AND SAVE IT    
	MOV	#TSKSIZ,R2	;START OF PARAMETERS IN R2  
	MOV	@#PS.EXP,-(SP)	;+05 PUSH PSW TO STACK  
	BIS	#BR3,@#PS.EXP	;;+05 INHIBIT TASK SWITCHING 
ATLSCN:	MOV	(R0),R0		;;GET NEXT ATL NODE    
	CMP	R0,R3		;;END OF ATL?   
	BEQ	ERRTS		;;GO WRITE NOT ACTIVE MESSAGE   
	MOV	A.TD(R0),R1	;;STD ADDRESS IN R1    
	CMP	(R1),TSKNAM	;;CHECK	1ST WORD OF TASKNAME   
	BNE	ATLSCN	    
	CMP	2(R1),TSKNAM+2	;;CHECK	2ND WORD OF TASKNAME    
	BNE	ATLSCN	    
	CMP	R0,.CRTSK	;;+05 CANNOT BE US!
	BEQ	ATLSCN		;;+05 YES! IGNORE THIS
	CMP	A.TI(R0),DEFTI	;;+05 ALSO MUST BE RIGHT TI:!
	BNE	ATLSCN		;;+05 NO! IGNORE THIS
	MOV	S.TZ(R1),(R2)+	;;MATCH	FOUND - SAVE MAX TASK SIZE  
	MOV	A.TS(R0),(R2)+	;;SAVE TASK STATUS  
	MOV	A.TF(R0),(R2)+	;;SAVE TASK FLAGS   
	MOVB	#TS.SUS,A.TS(R0) ;;SUSPEND TASK   
	BIS	#AF.CD,A.TF(R0)	;;DISABLE CHECKPOINTING    
	MOV	A.HA(R0),R1	;;GET TASK LOAD ADDRESS    
	MOV	R1,(R2)+	;;AND SAVE IT 
	MOV	R1,@#UISAR3	;;MAP APR3 TO FIRST 200    
	MOV	#1002,@#UISDR3	;;BYTES	OF HEADER   
	MOV	R1,@#APR2OF+H.PA0+6 ;;+05
	MOV	#1002,@#APR2OF+H.PD0+6 ;;+05
	MOV	@#APR3OF+H.HSZ,(R2)+ ;;SAVE HEADER SIZE 
	DECB	@#UISDR3+1	;;CHANGE MAPPING TO 100 BYTES    
	DECB	@#APR2OF+H.PD0+7 ;;+05
	JSR	PC,..ENB0	;ENABLE	TASK SWITCHING   
	MOV	R0,(R2)+	;SAVE THE ATL NODE ADDRESS    
	MOV	TSKNAM,(R2)+	;SAVE THE NEW TASKNAME    
	MOV	TSKNAM+2,(R2)+	    
	BR	SETUP	  
ERRTS:	JSR	PC,..ENB0	;ENABLE	TASK SWITCHING 
	ERROR	ACTMSG		;+05 WRITE NOT ACTIVE MESSAGE.
	JMP	DONE	  
;	  
; DO A TASK DUMP WITH THE DMPCOR SUBROUTINE.
; DO EXECUTIVE DUMPS OURSELVES.
;
SETUP:	TST	TSKNAM		;IS IT A TASK NAME DUMP?
	BEQ	5$		;NO
	MOV	ATLNOD,R0	;YES, GET ATL NODE.
	CALL	DMPCOR		;DUMP THE TASK'S CORE.
	JMP	DONE		;AND DONE.
5$:	OPEN$	#FDB		;OPEN THE PRINT FILE   
	BCC	TSKDMP		;+05 SKIP IF OK
	JMP	PRFCS		;+05 OTHERWISE, ERROR.
;	  
; CHECK	FOR SWITCH PARAMETERS AND SET POINTERS ACCORDINGLY  
TSKDMP:	BITB	#FWSW,SWMASK	;FW INPUT?    
	BNE	10$		;BRANCH IF SO	   
	CLR	FW		;DEFAULT IS ZERO   
10$:	BITB	#LWSW,SWMASK	;LW INPUT?   
	BNE	20$		;BRANCH IF SO	   
	MOV	.MSIZE,LW	;+02 SET LW TO UPPER MEMORY LIMIT
20$:	BITB	#NWSW,SWMASK	;NW INPUT?   
	BEQ	30$		;BRANCH IF NOT	   
	MOVB	SWMASK,R4	;+05 GET MASK WORD.
	BIC	#^C<FWSW!LWSW>,R4 ;+05 CLEAR OFF ALL BUT /FW AND /LW
	CMP	#FWSW!LWSW,R4	;+05 ARE FW AND LW BOTH INPUT?
	BNE	21$		;BRANCH IF NOT
	ERROR	AMBMSG		;+05 HE'S GOT TO MAKE UP HIS MIND!!
	JMP	DONE		;+05
21$:	BITB	#LWSW,SWMASK	;FW OR LW INPUT?  
	BNE	25$		;BRANCH	IF LW 
	MOV	FW,LW		;RECOMPUTE LW AS LW=FW+NW   
	ADD	NW,LW	 
	BR	30$	    
25$:	MOV	LW,FW		;RECOMPUTE FW AS FW=LW-NW   
	SUB	NW,FW	 
	BCC	30$		;+01 BRANCH ON NO CARRY
	CLR	FW		;+01 OTHERWISE SET FW=0
;+01 FOLLOWING CODE DELETED
;30$:	TST	FW		;CHECK IF FW IS NEGATIVE
;	BGE	35$		;BRANCH IF NOT
;	CLR	FW		;CLEAR IT IF IT IS
;35$:
;+01 END OF CODE DELETION	  
30$:	MOV	#40.,R4		;+04 ASSUME 40. BYTES IN HEADER
	CMP	LW,.MSIZE	;+02 CHECK IF LW EXCEEDS MEMORY SIZE
	BLOS	5$		;+02 BRANCH IF NOT
	MOV	.MSIZE,LW	;+02 OTHERWISE SET LW TO MEMORY SIZE
5$:	MOV	FW,PADR		;+02 SET UP DUMP LIMITS
	MOV	LW,LPADR	;+02
	MOV	FW,VADR		;+02
;
	BITB	#KNSW,SWMASK	;+03 KERNEL SWITCH INPUT?
	BEQ	45$		;+03 BRANCH IF NOT
	CMP	#SCOMTO,FW	;+04 ADDRESS IN EXTERNAL PAGE?
	BHI	32$		;+04 BRANCH IF NOT
	CMP	#EXTTO,LW	;+04 ADDRESS IN RANGE?
	BHIS	31$		;+04
40$:	ERROR	ADRMSG		;+05 SYNTAX ERROR IF NOT.
	JMP	DONE		;+05
31$:	ADD	#APREXT,PADR	;+04 SET PADR FOR EXTERNAL PAGE
	ADD	#APREXT,LPADR	;+04 LPADR ALSO
	MOV	#80.,R4		;+05 80. BYTES IN UNIBUS HEADER
	BR	34$		;+04
;
32$:	CMP	#SCOMBO,FW	;+03 CHECK ADDRESS LIMITS
	BHI	40$		;+05 ADDRESS OUT OF BOUNDS
	CMP	#SCOMTO,LW	;+05 IS LAST ADDRESS IN EXTERNAL PAGE?
	BHI	33$		;+05 NO
	MOV	#80.,R4		;+05 GET LINE LENGTH.
33$:	CMP	#EXTTO,LW	;+05 OUT OF KERNEL RANGE?
	BLO	40$		;+05 YES, ERROR.
	MOV	#1400,R0	;+03 CALCULATE VIRTUAL-PHYSICAL 
	SUB	@#KP.AR6,R0	;+03 OFFSET FOR KERNAL PAR 6
	SUB	R0,PADR		;+03 ADJUST PADR ACCORDINGLY
	SUB	R0,LPADR	;+03 LPADR ALSO
;
34$:	MOV	#NAME,R0	;+03 PUT KERNEL IN TITLE BLOCK
	MOV	#"KE,(R0)+	;+03
	MOV	#"RN,(R0)+	;+03
	MOV	#"EL,(R0)	;+03
45$:	CMP	PADR,LPADR	;IS PADR LT LPADR?
	BHIS	40$		;+05 ADDRESS OUT OF RANGE IF NOT.
;	CLRB	SWMASK	   	;+05
;	  
; PRINT TITLE
	MOV	#1,R2		;SET ZERO FILL FLAG
	MOV	#FROM,R0	;PUT START OF DUMP IN TITLE
	MOV	FW,R1
	JSR	PC,$CBOMG
	MOV	#"00,(R0)+	;+02 ADD FILLER ZEROS
	MOV	#" T,(R0)+
	MOV	#"O ,(R0)+
	MOV	LW,R1		;PUT END OF DUMP IN TITLE
	JSR	PC,$CBOMG
	MOV	#"00,(R0)+	;+02 ADD FILLER ZEROS
	CLR	SKPFLG		;+05 CLEAR SKIP FLAG
	CLR	LINENO		;+05 AND LINE #
	PRINT	#TITLE,R4	;+05 PRINT THE TITLE.
	INC	SKPFLG		;+05 INCREMENT SKIP FLAG.
;
; DUMP THE MEMORY PER REQUEST
DUMP:	INC	FLAG		;INCREMENT THE PRINT FLAG
	MOV	@#PS.EXP,-(SP)	;+05 PSW TO STACK   
	BIS	#BR3,@#PS.EXP	;;+05 INHIBIT TASK SWITCHING 
	MOV	PADR,@#UISAR3	;;MAP TO START OF DUMP   
	MOV	PADR,@#APR2OF+H.PA0+6 ;;+05
	MOV	#402,@#UISDR3	;;+05 SET UP PDR3
	MOV	#402,@#APR2OF+H.PD0+6 ;;+05
10$:	JSR	PC,..ENB0	;ENABLE	TASK SWITCHING   
	DEC	LPADR
	MOV	#1,R2		;ZERO FILL FLAG FOR $CBOMG
CNVRT:	MOV	#APR3OF,R5	;APR3 OFFFSET IN R5  
	MOV	#GMCR,R0	;OUTPUT	STRING ADDRESS    
	MOV	VADR,R1		;CONVERT VIRTUAL ADDRESS  
	JSR	PC,$CBOMG	 
	MOV	#"00,(R0)+	;+02 ADD FILLER ZEROS
;	MOV	#"  ,(R0)+	;ADD TWO BLANKS 
;LOOP1:	CLR	R4		;CLEAR COUNTER 
LOOP1:	MOV	LINLEN,R3	;+05 SET UP WORDS PER LINE.
LOOP2:	MOVB	#' ,(R0)+	;ADD A BLANK    
;	CMP	#4,R4		;FOUR WORDS CONVERTED?  
;	BNE	10$	   
;	MOVB	#' ,(R0)+	;THEN ADD A BLANK   
;	CLR	R4		;AND CLEAR THE COUNTER 
10$:	MOV	(R5)+,R1   
	JSR	PC,$CBOMG	;CONVERT A WORD  
;CONT:	INC	R4		;INCREMENT COUNTER
CONT:	SOB	R3,LOOP2
	BITB	#ASSW,SWMASK	;+05 ASCII TO BE PRINTED?
	BEQ	20$		;+05 NO, JUST PRINT THE LINE.
	SUB	LINLEN,R5	;+05 SUBTRACT TWICE THE LINE LENGTH.
	SUB	LINLEN,R5	;+05
;	MOVB	#' ,(R0)+	;+05 ADD A BLANK.
	MOV	#SST1,EXPG	;+05 SET UP A NEW SST ADDRESS.
	MOV	LINLEN,R3	;+05 GET LINE LENGTH.
	ASL	R3		;+05 TIMES 2.
10$:	MOVB	(R5)+,R1	;+05 GET A CHARACTER.
	CMPB	R1,#' 		;+05 IS IT LESS THAN A BLANK??
	BLO	12$		;+05 YES, CHANGE IT TO A .
	CMPB	R1,#177		;+05 IS IT >= RUBOUT??
	BLO	14$		;+05 NO, WE CAN PRINT IT.
12$:	MOV	#'.,R1		;+05 GET A . FOR PRINTING.
14$:	MOVB	R1,(R0)+	;+05 OUTPUT THE CHARACTER.
	SOB	R3,10$		;+05 AND LOOP.
	MOV	#SST,EXPG	;+05 RESTORE OLD SST ADDRESS.
20$:	MOV	R0,R3		;+05 GET THE # OF BYTES
	SUB	#GMCR,R3	;+05 COMPUTE LENGTH OF BUFFER.
	PRINT	#GMCR,R3	;+05 PRINT THE LINE.
	MOV	LINLEN,R4	;+05 GET LINE LENGTH.
	ASR	R4		;+05 COMPUTE ...
	ASR	R4		;+05 ... NEXT LINE OFFSET.
	MOVB	GMCR+6,R3	;+05 GET THE SECOND BYTE OUT.
	ADD	R4,R3		;+05 INC AS APPROPRIATE.
	CMP	R3,#'7		;+05 IS IT TOO BIG?
	BHI	30$		;+05 YES -- NEXT BATCH.
	MOVB	R3,GMCR+6	;+05 AND RESET THE CHARACTER.
	MOV	#GMCR+10,R0	;AND RESET POINTER
	BR	LOOP1	
30$:	INC	VADR		;INCREMENT ADR POINTER
	DEC	LPADR	 
	CMP	PADR,LPADR	;ARE WE	DONE?   
	BHI	40$		;BRANCH	IF SO 
	MOV	@#PS.EXP,-(SP)	;+05 OTHERWISE - PSW TO STACK   
	BIS	#BR3,@#PS.EXP	;;+05 INHIBIT TASK SWITCHING 
	INC	@#UISAR3	;;INCREMENT PAR2  
	INC	@#APR2OF+H.PA0+6 ;;+05
	BIT	#KNSW,SWMASK	;;+05 /KN SWITCH SPECIFIED?
	BEQ	35$		;;+05 NO
	CMP	VADR,#SCOMTO	;;+05 ARE WE TO THE EXTERNAL PAGE?
	BNE	35$		;;+05 NO
	MOV	#APREXT,@#UISAR3 ;;+05 YES, ADJUST POINTERS.
	MOV	#APREXT,@#APR2OF+H.PA0+6 ;;
35$:	JSR	PC,..ENB0	;ENABLE	TASK SWITCHING   
	BR	CNVRT		;AND GO	DUMP SOME MORE 
40$:	CALL	SPOOL		;+05 SPOOL ANY OUTPUT.
	JMP	DONE	  
;
EXPG:	.WORD	SST		;+04 SST VECTOR TABLE
SST1:	MOV	#'.,R1		;+05 SET R1 TO A . FOR NXM.
	RTI			;+05 AND RETURN.
SST:	MOV	#6,R1		;+04 6 BYTES PER ENTRY
10$:	MOVB	#'*,(R0)+	;+04 PUT IN ASTERICKS
	SOB	R1,10$		;+04
	CMP	(SP)+,(SP)+	;+04 CLEAN UP STACK
	BR	CONT		;+04 RESUME NORMAL CODE
;	  
; SUBROUTINE THE RESTORE THE STATUS OF AND RESUME THE   
; SUSPENDED TASK.	  
RESUME:	MOV	ATLNOD,R0	;GET ATL NODE 
	MOV	@#PS.EXP,-(SP)	;+05 PUSH PSW TO STACK  
	BIS	#BR3,@#PS.EXP	;;+05 INHIBIT TASK SWITCHING 
	MOVB	STATUS,A.TS(R0)	;;RESTORE ORIGINAL TASK STATUS    
	BIC	#AF.CD,A.TF(R0)	;;+05 CLEAR CHECKPOINTING FLAG.
	BIS	FLAGS,A.TF(R0)	;;RESTORE ORIGINAL TASK FLAGS   
	JSR	PC,..ENB0	;ENABLE	TASK SWITCHING   
SPOOL:	TST	FLAG		;ANYTHING TO PRINT?
	BNE	10$		;IF SO, GO PRINT IT
	DELET$	#FDB		;OTHERWISE DELETE THE FILE
	BR	20$		;AND RETURN
10$:	CLOSE$	#FDB		;CLOSE THE PRINT FILE 
	CLR	FLAG		;CLEAR THE PRINT FLAG
20$:	RTS	PC	    
;
; SUBROUTINE TO PRINT ERROR MESSAGES.
;
; SP+2 = ADDRESS OF MESSAGE.
; SP+4 = LENGTH OF MESSAGE.
;
ERROR:	MOV	2(SP),QIOW+Q.IOPL+0 ;+05
	MOV	4(SP),QIOW+Q.IOPL+2 ;+05
	MOV	#QIOW,-(SP)	;+05
	CALL	.DIRDL		;+05
	MOV	(SP),4(SP)	;+05
	CMP	(SP)+,(SP)+	;+05
	CALL	SPOOL		;+05 CLOSE OUT ANY FILES.
	RTS	PC		;+05
;
; SUBROUTINE TO PRINT LINES ON THE OUTPUT FILE.
; NOTE THAT IT MUST BE RE-ENTRANT.
;
; CALLING SEQUENCE:
;
;	MOV	#LINE,-(SP)
;	MOV	#LENGTH,-(SP)
;	JSR	PC,PRINT
;
PRINT:	CMP	LINENO,PAGESZ	;+05 OVER PAGE SIZE?
	BLOS	10$		;+05 NO
	CLR	SKPFLG		;+05 CLEAR SKIP FLAG.
	CLR	LINENO		;+05 AND LINE NUMBER.
	PRINT	#PAGEMS,#PAGELN	;+05 YES, PRINT THE FORM FEED.
	PRINT	#TITLE,#TITLEE	;+05 AND PRINT THE TITLE.
	INC	SKPFLG		;+05 INC THE SKIP FLAG.
10$:	TST	SKPFLG		;+05 SKIP A LINE?
	BEQ	20$		;+05 NO, SKIP
	CLR	SKPFLG		;+05 YES, SHOW WE'VE DONE IT.
	PRINT	#GMCR,#0	;+05 SKIP A LINE.
20$:	PUT$	#FDB,4(SP),2(SP) ;+05 PRINT A LINE.
	BCS	PRFCS		;+05 ERRORS?
	INC	LINENO		;+05 INC THE LINE #.
	MOV	(SP),4(SP)	;+05 POP OFF RETURN ADDRESS.
	CMP	(SP)+,(SP)+	;+05 POP OFF STACK
	RTS	PC		;+05 AND RETURN TO CALLER.
;
; SUBROUTINE TO PRINT FCS MESSAGES.
;
PRFCS:	MOV	SPSAVE,SP	;+05 RECOVER SP.
	MOV	#DUMPMS,R1	;+05 GET DUMP MESSAGE
	MOV	#DUMPLN,R2	;+05 AND LENGTH.
	CALL	.PRFCS		;+05 GET MESSAGE OUT.
	CALL	SPOOL		;+05 SPOOL ANY FILES PRODUCED.
	JMP	DONE		;+05 AND DONE.
;	  
PAGEMS:	.ASCII	<14>
PAGELN	=	.-PAGEMS
	.EVEN
TITLE:	.ASCII	<12>/ DUMP OF /
NAME:	.ASCII	/          /
FROM:	.ASCII	/          /
TO:	.ASCII	/          /
TITLEE	=	.-TITLE
	.ASCII	/  (****** = NON-EXISTANT UNIBUS ADDRESS)/
	.EVEN
DUMPMS:	.ASCII	/DUMP/
DUMPLN	=	.-DUMPMS
	.EVEN
FLAG:	.WORD	0		;PRINT FLAG
;
MCRFLG:	.WORD	0	    
OURTI:	.WORD	0		;+05 OUR OWN TI: ADDRESS.
DEFTI:	.WORD	0		;+05 DEFAULT TI: ADDRESS.
PRIV:	.WORD	0		;+05 1=> PRIVILEGED, 0=> NOT.
LINLEN:	.WORD	10		;+05 LINE LENGTH OF OUTPUT.
LINENO:	.WORD	0		;+05 CURRENT LINE #
PAGESZ:	.WORD	58.		;+05 NUMBER OF LINES/PAGE
SPSAVE:	.WORD	0.		;+05 SP SAVE AREA.
SKPFLG:	.WORD	0		;+05 SKIP NEXT LINE.
PADR:	.WORD	0	  
LPADR:	.WORD	0	 
VADR:	.WORD	0	  
TSKNAM:	.WORD	0,0,0	    
;	  
SWMASK:	.BYTE	0	    
NSWTCH:	.BYTE	6	    
;
; SWITCH MASK DEFINITIONS
;
KNSW=1
ASSW=2
TISW=4	 
FWSW=10	 
LWSW=20	 
NWSW=40	    
;
; SWITCH NUMBER DEFINITIONS
;
KNSN=0
ASSN=1
TISN=2
FWSN=3
LWSN=4
NWSN=5
SWTYP:	.ASCII	/NWLWFWTIASKN/	   
; THE REMAINING	PARAMETERS ARE ORDER DEPENDENT - DO NOT ALTER   
FW:	.WORD	0	    
LW:	.WORD	0	    
NW:	.WORD	0	    
SW:	.WORD	0	    
;	  
TSKSIZ:	.WORD	0	    
STATUS:	.WORD	0	    
FLAGS:	.WORD	0	 
HDADR:	.WORD	0	 
HEADSZ:	.WORD	0	    
ATLNOD:	.WORD	0	    
SAVNAM:	.WORD	0,0	  
;
; END OF ORDER DEPENDENT STUFF.
;	  
;	FSRSZ$	1	  	;+05
FDB:	FDBDF$	    
	FDAT$A	R.VAR,FD.CR,123.    
	FDOP$A	2,,NMBLK,FO.WRT	    
NMBLK:	NMBLK$	DUMP,LST,,CL,0
;	  
QIOW:	QIOW$	IO.WVB,1,1,,,,<0,0,40>  
SYNMSG:	MSG	<DUMP -- SYNTAX ERROR>
ACTMSG:	MSG	<DUMP -- TASK NOT ACTIVE>
PUDMSG:	MSG	<DUMP -- ILLEGAL DEVICE>
SWTMSG:	MSG	<DUMP -- ILLEGAL SWITCH>
PRVMSG:	MSG	<DUMP -- ILLEGAL FUNCTION FOR NON-PRIVILEGED USER>
AMBMSG:	MSG	<DUMP -- TOO MANY SWITCHES - COMMAND AMBIGUOUS>
ADRMSG:	MSG	<DUMP -- ILLEGAL MEMORY ADDRESS>
PRMT:	.ASCII	<12>/DUMP>/	   
	.EVEN
READ:	QIOW$	IO.RPR,1,1,,IOST,,<GMCR,80.,0,PRMT,6>  
IOST:	.BLKW	2	  
;	  
	.END	START