.TITLE DMP/DMPS/DMPREG	    
;	  
; DUMPS	REGISTERS OR SPECIFIED CORE LOCATIONS IN OCTAL WORDS	   
;	  
; WRITTEN   NOVEMBER 1975   R B	FRENCH	 THE BOEING COMPANY	 
;	  
; CALLING SEQUENCES	    
;	  
; FROM FORTRAN	 
;    CALL DMP(LOC,NLOC,[LUN])	  
;      LOC = STARTING LOCATION FOR DUMP	    
;     NLOC = NUMBER OF WORDS TO	DUMP	   
;      LUN = LUN NUMBER	TO DUMP	TO (OPTIONAL)	  
;	     NOTE : LUN	WILL NOT BE RESET	    
;	  
; FROM MACRO	   
;	  
;   TO DUMP CORE LOCATIONS	 
;	MOV	#LOC,-(SP)	   
;	MOV	#NLOC,-(SP)	  
;	JSR	PC,DMPS	  
;     OR    
;	MOV	#LOC,-(SP)	   
;	MOV	#NLOC,-(SP)	  
;	MOV	#LUN,-(SP)	   
;	JSR	PC,DMPSL  
;	  NOTE : DMPS AND DMPSL	WILL CLEAN UP STACK	  
;	  
;   TO DUMP REGISTERS	  
;	JSR	PC,DMPREG	    
;	  
	.MCALL	DIR$,QIOW$	 
DMPSL::	MOV	(SP)+,RETPC	;SAVE RETURN PC	    
	MOV	(SP)+,QIO+Q.IOLU ;PUT LUN IN DPB   
	DECB	FLAG	 
	BR	GO	 
DMPS::	MOV	(SP)+,RETPC	;SAVE RETURN PC	 
	DECB	FLAG		;SET FLAG NEGATIVE FOR STACK ARGUMENTS	 
	BR	GO	 
DMPREG::INCB	FLAG		;SET FLAG POSITIVE FOR REQISTERS ONLY	   
	MOV	SP,NWORD   
	MOV	NWORD,-(SP)	;ADD SP	TO STACK   
	ADD	#2,(SP)		;AND ADJUST TO ORIG VALUE	    
	MOV	R5,-(SP)   
	BR	GO	 
DMP::	CMPB	#3,(R5)		;THREE ARGUMENTS?	  
	BNE	GO		;BRANCH	IF NOT	    
	MOV	@6(R5),QIO+Q.IOLU ;PUT LUN IN QIO DPB	 
GO:	MOV	R4,-(SP)	;SAVE REGISTERS	   
	MOV	R3,-(SP)   
	MOV	R2,-(SP)   
	MOV	R1,-(SP)   
	MOV	R0,-(SP)   
	MOV	#1,R2		;SET FLAG FOR ZERO FILL	    
	TSTB	FLAG	 
	BLE	20$	   
;	  
; COME HERE TO DUMP REGISTERS ONLY	 
5$:	MOV	16(SP),-(SP)	;ADD PC	TO LIST	   
	MOV	SP,R3		;R3 POINTS TO START OF NUMBERS (STACK)	 
	MOV	#ARR,R0		;PUT 'REGS' IN OUTPUT STRING	 
	MOV	#REGS,R4   
	MOV	#6,R1	 
10$:	MOVB	(R4)+,(R0)+	  
	SOB	R1,10$	    
	BR	50$	    
;	  
20$:	BLT	25$		;BRANCH	IF ARGUMENTS ON	STACK	    
	MOV	2(R5),R3	;STARTING ADDRESS IN R3	  
	MOV	@4(R5),NWORD	;GET NUMBER OF WORDS	 
	BR	30$	    
25$:	MOV	14(SP),R3	;STARTING ADDRESS IN R3	 
	MOV	12(SP),NWORD	;GET NUMBER OF WORDS	 
30$:	MOV	#ARR,R0		;ADDRESS OF OUTPUT STRING	    
	MOV	R3,R1		;ADDRESS IN R1	 
	JSR	PC,$CBOMG	;CONVERT ADDRESS 
40$:	CMP	#10,NWORD	;CHECK IF LESS THAN FULL LINE LEFT	  
	BLT	50$		;AND SET COUNTER ACCORDINGLY	 
	MOVB	NWORD,COUNT	  
	BR	55$	    
50$:	MOVB	#10,COUNT	    
55$:	MOVB	#' ,(R0)+	;PUT IN	2 BLANKS    
	MOVB	#' ,(R0)+	    
60$:	MOV	(R3)+,R1	;GET A NUMBER	    
	JSR	PC,$CBOMG	;CONVERT IT	 
	MOVB	#' ,(R0)+	;ADD A BLANK	   
	DECB	COUNT		;DECREMENT THE COUNTER	    
	BGT	60$		;IF STILL GT ZERO, GET ANOTHER NUMBER	    
	MOVB	#15,(R0)+	;PUT IN	CARRAIGE RETURN	    
	MOV	R0,R1		;CALCULATE NUMBER OF BYTES	 
	SUB	#BLK,R1	   
	MOV	R1,QIO+Q.IOPL+2	;AND PUT IN QIO	DPB	   
	DIR$	#QIO		;AND PRINT IT	  
	TSTB	FLAG		;CHECK FLAG FOR	TYPE OF	ENTRY	  
	BGT	70$		;IF REGISTERS ONLY, WE'RE DONE	   
	SUB	#10,NWORD	;DECREMENT WORD	COUNT BY 10	 
	BGT	30$		;IF STILL GT ZERO, GET ANOTHER LINE	  
	BR	80$		;OTHERWISE WE'RE DONE	 
70$:	TST	(SP)+		;CLEAN UP STACK	    
80$:	MOV	(SP)+,R0	;RESTORE REGISTERS	   
	MOV	(SP)+,R1   
	MOV	(SP)+,R2   
	MOV	(SP)+,R3   
	MOV	(SP)+,R4   
	TSTB	FLAG		;CHECK FLAG FOR	TYPE OF	RETURN	 
	BEQ	RETURN	    
	BGT	90$	   
	CLRB	FLAG	 
	ADD	#4,SP		;CLEAN UP STACK	    
	MOV	RETPC,PC	;RETURN	BY CHANGING PC	   
;	  
90$:	CMP	(SP)+,(SP)+	;CLEAN UP STACK	   
RETURN:	CLRB	FLAG	  
	RTS	PC	    
NWORD:	.WORD	0	 
COUNT:	.BYTE	0	 
FLAG:	.BYTE	0	  
RETPC:	.WORD	0	 
REGS:	.ASCII	/ REGS /   
BLK:	.BYTE	12	  
ARR:	.BLKB	70.	 
	.EVEN	 
QIO:	QIOW$	IO.WLB,5,10,,,,<BLK,0,0> 
	.END