.TITLE	COREANL -- ANALYSE DUMPS
	.SBTTL	TITLE PAGE
	.IDENT	-000500-
;
;+
; ABSTRACT: COREANL
;
;	THIS PROGRAM IS USED TO ANALYSE CORE DUMPS FROM THE
; DMPCOR SUBROUTINE TO .TKTN.
; THE TASK TERMINATOR PRODUCES AN INTERNAL FORMAT TO ALLOW
; SMALL SIZE AND FAST ACTION IN THE TASK TERMINATOR, AND THIS
; PROGRAM WILL FORMAT THE INTERNAL FORMAT FILE INTO A READABLE
; CORE DUMP.
;
; OPERATING PROCEDURES:
;
; THIS PROGRAM CAN BE INVOKED EITHER BY A
;
;	MCR>RUN COREANL$
;	----
;	COR>
;	----
;
; COMMAND OR DIRECTLY AS
;
;	MCR>COR
;	----
;	COR>
;	----
;
; IT TAKES A COMMAND STRING OF THE FORM:
;
;	FILESPEC=FILESPEC
;
; WHERE THE FIRST FILESPEC IS THE OUTPUT FILE AND THE
; SECOND IS THE INPUT FILE.
; THE INPUT FILE DEFAULTS TO SY:[CURRENT UIC]CORE.DMP.
; THIS IS THE USUAL FORM PRODUCED BY THE TASK TERMINATION
; ROUTINE.
; THE OUTPUT FILE DEFAULTS TO SY:[CURRENT UIC]CORE.LST.
; IT WILL NORMALLY BE SPOOLED AUTOMATICALLY UNLESS /-SP IS
; SPECIFIED IN THE COMMAND STRING.
;
; TWELVE SWITCHES ARE PERMITTED:
;
;	/R5	DUMP TASK READ/WRITE AND READ-ONLY AREA
;		IN RADIX 50. DEFAULT IS /-R5;  REGARDLESS OF
;		THIS SWITCH THE CONTROL INFORMATION WILL BE
;		DUMPED IN RADIX 50. A RADIX-50 DUMP
;		REQUIRES ABOUT TWICE AS MUCH PAPER AS
;		ONE WITHOUT.
;
;	/BY	DUMP ALL OUTPUT IN BYTE MODE OCTAL. IF
;		THIS IS NOT SPECIFIED ALL OUTPUT WILL BE
;		IN WORD MODE OCTAL. REGISTERS AND ADDRESSES
;		WILL NOT BE AFFECTED. DEFAULT IS /-BY.
;
;	/AS	DUMP ASCII EQUIVALENT ON THE TASK AND
;		SYSTEM TABLES CORE. DEFAULT IS /AS.
;
;	/N5	DUMP NO RADIX-50, EVEN IN THE SYSTEM
;		TABLES. DEFAULT IS /-N5.
;
;	/RO	PRINT THE TASK READ-ONLY AREA IF ANY AND
;		IF IT WAS DUMPED. THIS FACILITY IS NOT
;		NORMALLY INTERESTING EXCEPT TO CATCH
;		STRANGE HARDWARE ERRORS (E. G., ODD ADDRESS
;		TRAPS ON GOOD PROGRAMS AND OTHER THINGS
;		WHICH MIGHT NOT GET LOGGED AS A MEMORY ERROR),
;		SO THE DEFAULT IS /-RO.
;
;	/SY	DUMP THE SYSTEM TABLES (ATL NODE, ETC).
;		THE TERMINATION CODE WILL BE PRINTED
;		REGARDLESS OF THE SETTING OF THIS SWITCH.
;		DEFAULT IS /SY.
;
;	/HD	DUMP THE HEADER. THE REGISTERS WILL BE
;		DUMPED IN ANY CASE. DEFAULT IS /HD.
;
;	/RW	DUMP TASK READ/WRITE AREA. DEFAULT
;		IS /RW.
;
;	/CM	DUMP LIBRARIES AND COMMON AREAS. DEFAULT IS /-CM.
;		LIBRARIES WILL NOT BE DUMPED UNLESS /RO IS
;		SPECIFIED AS WELL.
;
;	/SP	SPOOL THE LISTING FILE AND DELETE WHEN DONE.
;		THE DEFAULT IS /SP.
;
;	/MD:X:Y	ONLY MEMORY IN THE TASK IMAGE BETWEEN X AND
;		Y IS TO BE DUMPED. DEFAULT IS 0:177777
;
;	/PS:X	DEFAULT PAGE SIZE IS X. DEFAULT IS 59.
;		THIS PARAMETER DEFAULTS TO DECIMAL MODE.
;
; WRITTEN: BRUCE C. WRIGHT, -0.0.0-, 18-JUN-77
; MODIFIED: BRUCE C. WRIGHT, -0.4.0-, 25-OCT-77
;	ADDED LIBRARY/COMMON AREA CODE.
; MODIFIED: BRUCE C. WRIGHT, -0.4.1-, 01-NOV-77
;	CHANGED DUMP OF SINGLE USER TASK TO LABEL RO AREA.
; MODIFIED: BRUCE C. WRIGHT, -0.5.0-, 28-AUG-78
;	CHANGED LOGIC TO DISPLAY TASK NAME BETTER.
; VERIFIED:
;-

	.SBTTL	MACRO CALLS
;
	.MCALL	FDBDF$,FSRSZ$,NMBLK$,BDOFF$,FHDOF$
	.MCALL	FDAT$A,FDRC$A,FDOP$A,FDBF$A
	.MCALL	OPEN$R,OPEN$W,PUT$,GET$,CLOSE$,PRINT$
	.MCALL	DIR$,QIOW$,EXIT$S,GTIM$,ALUN$S
	.MCALL	GCMLB$,GCML$
	.MCALL	CSI$,CSI$1,CSI$2,CSI$SW,CSI$ND,CSI$SV
	FHDOF$	DEF$L		;DEFINE FILE HEADER OFFSETS
;
	.MACRO	PRINT	MSG,LEN
	MOV	MSG,-(SP)
	MOV	LEN,-(SP)
	CALL	$PRINT
	.ENDM
;
	.MACRO	TYPE	MSG,LEN
	MOV	MSG,-(SP)
	MOV	LEN,-(SP)
	CALL	$TYPE
	.ENDM
;
	.MACRO	SAVE
	MOV	R5,-(SP)
	MOV	R4,-(SP)
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	MOV	R1,-(SP)
	MOV	R0,-(SP)
	.ENDM
;
	.MACRO	UNSAVE
	MOV	(SP)+,R0
	MOV	(SP)+,R1
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	MOV	(SP)+,R5
	.ENDM
;
	.MACRO	CALL	SUBR
	JSR	PC,SUBR
	.ENDM
;
	.MACRO	RETURN
	RTS	PC
	.ENDM
;
	.SBTTL	EQUATES FOR THE PROGRAM.
;
CMDLUN	=	1
INPLUN	=	2
INPEVF	=	2
OUTLUN	=	3
OUTEVF	=	3
TTYLUN	=	4
TTYEVF	=	4
DIRLUN	=	5
DIREVF	=	5
;
LF	=	12
FF	=	14
CR	=	15
;
PAGSIZ	=	59.		;NUMBER OF LINES PER PAGE.

	.SBTTL	READ THE COMMAND LINE.
;
;
RESTRT:	MOV	SPSAVE,SP	;RECOVER STACK.
	CLOSE$	#INFDB
	BIT	#SW.SPL,SWORD	;SPOOL LISTING FILE?
	BNE	10$		;YES
	CLOSE$	#OUTFDB		;CLOSE THE FILE.
	JMP	CORDMP		;AND CONTINUE.
10$:	PRINT$	#OUTFDB
CORDMP::MOV	SP,SPSAVE	;SAVE STACK
	GCML$	#CMLBLK		;GET COMMAND LINE.
	BCC	GETOK		;SKIP IF NO ERRORS.
	CMPB	CMLBLK+G.ERR,#GE.IOR ;I/O ERROR?
	BEQ	CMDERR
	CMPB	CMLBLK+G.ERR,#GE.OPR ;OPEN ERROR?
	BEQ	CMDOPE
	CMPB	CMLBLK+G.ERR,#GE.BIF ;SYNTAX ERROR?
	BEQ	CMDSYN
	CMPB	CMLBLK+G.ERR,#GE.MDE ;MAX @ FILE DEPTH?
	BEQ	CMDMAX
	CMPB	CMLBLK+G.ERR,#GE.EOF ;END-OF-FILE?
	BEQ	CMDEOF
	TYPE	#M.UNK,#L.UNK
	BR	LEAVE
CMDERR:	TYPE	#M.ERR,#L.ERR
	BR	LEAVE		;THIS IS FATAL.
CMDOPE:	TYPE	#M.OPE,#L.OPE
	BR	CORDMP		;THIS IS NOT FATAL
CMDSYN:	TYPE	#M.SYN,#L.SYN
	BR	CORDMP
CMDMAX:	TYPE	#M.MAF,#L.MAF
	BR	CORDMP
CMDEOF:
LEAVE:	EXIT$S			;AND LEAVE.

	.SBTTL	INITIALISATION OF THE DATA FILES
;
;	OPEN THE INPUT FILE AND THE OUTPUT FILE AND
; CHECK FOR ANY ERRORS. IF ANY, THEN EXIT; ELSE BEGIN
; TO FORMAT THE DUMP.
;
GETOK:	TST	CMLBLK+G.CMLD	;ANY INPUT?
	BEQ	CORDMP		;NO
	CSI$1	#CSIBLK,CMLBLK+G.CMLD+2,CMLBLK+G.CMLD
	BCC	10$		;SKIP IF OK
	TYPE	#M.PS1,#L.PS1	;SYNTAX ERROR MESSAGE.
	BR	CORDMP
10$:	CSI$2	#CSIBLK,INPUT,#SWTAB ;GET INPUT FILE # 1
	BCC	20$		;ERROR?
	TYPE	#M.PS2,#L.PS2	;SYNTAX ERROR MESSAGE.
	BR	CORDMP
20$:	BITB	CSIBLK+C.STAT,#CS.MOR
	BEQ	25$		;SKIP IF NO MORE
	TYPE	#M.INM,#L.INM
	BR	CORDMP
25$:	BITB	CSIBLK+C.STAT,#CS.WLD ;WILD CARDS?
	BEQ	27$		;NO
	TYPE	#M.WLD,#L.WLD
	JMP	CORDMP
27$:	OPEN$R	#INFDB,,#CSIBLK+C.DSDS
	BCC	30$		;SKIP IF OK
	TYPE	#M.OPI,#L.OPI
	CALL	PRFCS		;PRINT FCS MESSAGE FOR THIS FILE.
	JMP	CORDMP
30$:	CSI$2	#CSIBLK,OUTPUT,#SWTAB
	BCC	40$
	CLOSE$	#INFDB
	TYPE	#M.PS2,#L.PS2
	JMP	CORDMP
40$:	BITB	CSIBLK+C.STAT,#CS.MOR ;IS THIS THE END OF OUTPUT?
	BEQ	41$		;YES
	TYPE	#M.OUM,#L.OUM
	CLOSE$	#INFDB
	JMP	CORDMP
41$:	BITB	CSIBLK+C.STAT,#CS.WLD ;WILD CARDS?
	BEQ	45$		;NO
	TYPE	#M.WLD,#L.WLD
	CLOSE$	#INFDB
	JMP	CORDMP
45$:	TST	PGSIZE		;IS THERE A PAGE SIZE?
	BGT	46$		;YES
	CLOSE$	#INFDB		;CLOSE DUMP FILE.
	TYPE	#M.IPS,#L.IPS	;TYPE ILLEGAL PAGE SIZE MSG.
	JMP	CORDMP		;AND LOOP.
46$:	OPEN$W	#OUTFDB,,#CSIBLK+C.DSDS
	BCC	50$
	TYPE	#M.OPO,#L.OPO
	CALL	PRFCS
	CLOSE$	#INFDB		;CLOSE THE INPUT FDB
	JMP	CORDMP		;AND EXIT.

	.SBTTL	SET UP THE PAGE HEADER
;
; THE FOLLOWING CODE SETS UP THE PAGE HEADER WITH THE TIME AND THE
; FILE NAME.
;
50$:	MOVB	#'1,PGNOHD	;SET PAGE NO TO 1
	MOVB	#' ,PGNOHD+1
	MOVB	#' ,PGNOHD+2
	MOV	#FILOFF,R0	;GET THE FILE NAME OFFSET.
51$:	MOVB	#' ,(R0)+	;BLANK OUT THE FILE NAME.
	CMP	R0,#FILEND	;AT END YET?
	BLO	51$		;NO
	MOV	#HDRMSG,R2
	CALL	PRTIME
	CLR	SKPFLG		;NO SKIP LINE.
	MOV	INFDB+F.FNB+N.DID,DIRFDB+F.FNB+N.FID
	MOV	INFDB+F.FNB+N.DID+2,DIRFDB+F.FNB+N.FID+2
	MOV	INFDB+F.FNB+N.DID+4,DIRFDB+F.FNB+N.FID+4
	MOV	INFDB+F.FNB+N.DVNM,DIRFDB+F.FNB+N.DVNM
	MOV	INFDB+F.FNB+N.UNIT,DIRFDB+F.FNB+N.UNIT
	ALUN$S	#DIRLUN,DIRFDB+F.FNB+N.DVNM,DIRFDB+F.FNB+N.UNIT
	MOV	#$REDDR,-(SP)
	CALL	.DIRDL
	BCC	60$
	MOV	#DIRFDB,R0
	CLR	F.ERR(R0)
	MOVB	IOST,F.ERR(R0)
	BLT	55$
	MOV	@#$DSW,F.ERR(R0)
55$:	TYPE	#M.DIRE,#L.DIRE
	CALL	PRFCS
	CLOSE$	#INFDB
	CLOSE$	#OUTFDB
	JMP	RESTRT
60$:	MOV	#FILOFF,R0	;POINT TO FILE OFFSET.
	MOVB	INFDB+F.FNB+N.DVNM,(R0)+
	MOVB	INFDB+F.FNB+N.DVNM+1,(R0)+
	MOV	INFDB+F.FNB+N.UNIT,R1 ;GET THE NUMBER
	CLR	R2		;
	CALL	$CBOMG		;CONVERT TO OCTAL MAGNITUDE.
	MOVB	#':,(R0)+	;AND A :
	MOVB	#'[,(R0)+
	MOVB	HEADER+H.IDOF,R3 ;GET ID OFFSET
	ASL	R3
	MOV	HEADER+I.FNAM(R3),R1
	CALL	$C5TA
	CALL	UICPRT		;PRETTY UP THE UIC.
	MOVB	#',,(R0)+
	MOV	HEADER+I.FNAM+2(R3),R1
	CALL	$C5TA
	CALL	UICPRT		;PRETTY UP THE UIC.
	MOVB	#'],(R0)+
	MOV	INFDB+F.FNB+N.FNAM,R1
	CALL	$C5TA
	MOV	INFDB+F.FNB+N.FNAM+2,R1
	CALL	$C5TA
	MOV	INFDB+F.FNB+N.FNAM+4,R1
	CALL	$C5TA
100$:	CMPB	#' ,-(R0)	;SKIP BACK OVER BLANKS.
	BEQ	100$		;LOOP UNTIL NON-BLANK
	INC	R0		;
	MOVB	#'.,(R0)+	;MOVE IN A .
	MOV	INFDB+F.FNB+N.FTYP,R1
	CALL	$C5TA
101$:	CMPB	#' ,-(R0)	;SKIP BACK OVER BLANKS.
	BEQ	101$
	INC	R0
	MOVB	#';,(R0)+	;AND A ;
	MOV	INFDB+F.FNB+N.FVER,R1
	CLR	R2
	CALL	$CBOMG		;CONVERT TO OCTAL.
	MOV	#PGNOHD+1,R2
	SUB	#HDRMSG,R2
	PRINT	#HDRMSG,R2	;PRINT HEADER
	INC	SKPFLG
	MOV	#1,PAGENO	;CLEAR CURRENT PAGE NUMBER.
	CLR	LINENO		;AND LINE NUMBER.
	CLR	FIRSTL
	MOV	#-1,ADDR
	BIC	#SW.TMP,SWORD	;CLEAR TMP. IND.
	BIT	#SW.N50,SWORD	;WAS NO RADIX 50 ASKED?
	BEQ	110$		;NO
	BIC	#SW.R50,SWORD	;CLEAR TASK RADIX-50 IF SO.
110$:	PRINT	#CMDMSG,#CMDLEN	;PRINT MESSAGE ABOUT COMMAND LINE.
	PRINT	CMLBLK+G.CMLD+2,CMLBLK+G.CMLD ;PRINT THE COMMAND LINE.
	INC	SKPFLG		;AND SKIP A LINE.

	.SBTTL	PROCESS THE FILE.
;
; FIRST READ THE ATL NODE. THIS SHOULD BE THE FIRST RECORD IN
; THE FILE.
;
PROCES:	MOV	#$READ,-(SP)	;READ THE FILE HEADER.
	CALL	.DIRDL		;
	BCC	SKIP1		;CHECK FOR ERRORS.
	MOV	#INFDB,R0	;POINT TO THE INPUT FDB.
	CLR	F.ERR(R0)	;CLEAN OUT F.ERR
	MOVB	IOST,F.ERR(R0)
	BLT	1$
	MOVB	@#$DSW,F.ERR(R0)
1$:	TYPE	#M.INPE,#L.INPE	;NOTE ERROR.
	CALL	PRFCS		;PRINT FCS ERROR CODE.
	CLOSE$	#INFDB
	CLOSE$	#OUTFDB
	JMP	RESTRT
SKIP1:	MOVB	HEADER+H.IDOF,R0 ;GET ID OFFSET.
	ASL	R0		;ACCOUNT FOR WORDS.
	ADD	#I.CRDT,R0	;POINT TO CREATION OFFSET.
	ADD	#HEADER,R0	;POINT TO THE OFFSET DIRECTLY.
	MOV	#TIMOFF,R1	;POINT TO TIME MESSGAGE POS.
	MOVB	(R0)+,(R1)+	;MOVE IN DATE 1
	MOVB	(R0)+,(R1)+	;DATE 2
	MOVB	#'-,(R1)+
	MOVB	(R0)+,(R1)+
	MOVB	(R0)+,(R1)+	;MONTH.
	MOVB	(R0)+,(R1)+
	MOVB	#'-,(R1)+
	MOVB	(R0)+,(R1)+	;YEAR
	MOVB	(R0)+,(R1)+
	MOVB	#' ,(R1)+	;SKIP A SPACE.
	MOVB	HEADER+H.IDOF,R0 ;GET ID OFFSET.
	ASL	R0		;ADJUST.
	ADD	#I.CRTI,R0	;GET TO TIME.
	ADD	#HEADER,R0	;GET TO THE ABSOLUTE ADDR.
	MOVB	(R0)+,(R1)+	;MOVE IN HOUR.
	MOVB	(R0)+,(R1)+
	MOVB	#':,(R1)+
	MOVB	(R0)+,(R1)+	;MINUTE.
	MOVB	(R0)+,(R1)+
	MOVB	#':,(R1)+
	MOVB	(R0)+,(R1)+	;SECOND
	MOVB	(R0)+,(R1)+
	CALL	GET		;GET THE FIRST RECORD IN THE FILE.
				;THIS WILL BE THE ATL NODE.
	MOV	#TMPBUF,R0	;GET THE TEMP. BUFFER.
	MOV	#40,R1		;AND LENGTH OF BUFFER.
	MOV	#INPBUF,R2	;AND THE INPUT BUFFER.
SAVIT:	MOV	(R2)+,(R0)+	;SAVE THE ATL NODE.
	SOB	R1,SAVIT	;SAVE WHOLE BUFFER.
	CALL	GET		;GET SECOND RECORD IN FILE.
				;THIS WILL BE THE STD NODE.
	MOV	#TSNOFF,R0	;GET THE TASK NAME OFFSET.
	MOV	INPBUF+S.TN,R1	;GET THE FIRST PART OF THE TASK NAME.
	CALL	$C5TA		;CONVERT TO ASCII.
	MOV	INPBUF+S.TN+2,R1 ;GET SECOND PART OF THE TASK NAME.
	CALL	$C5TA		;CONVERT TO ASCII.
	PRINT	#TIMMSG,#TIMLEN	;PRINT TIME OF ABORT MESSAGE.
	INC	SKPFLG
	MOV	TMPBUF+A.HA,VADDR
	PRINT	#TRMMSG,#TRMLEN
	MOVB	TMPBUF+A.FM,R0	;GET THE REASON FOR TERMINATION.
	CMP	R0,#ENDMT	;TOO HIGH?
	BHI	1$		;YES
	BIT	#1,R0		;IS THE CODE ODD?
	BNE	1$		;YES -- CAN'T PRINT CODE.
	MOV	BEGMT+2(R0),R1
	SUB	BEGMT(R0),R1
	PRINT	BEGMT(R0),R1
	BR	2$
1$:	PRINT	#ILCMSG,#ILCLEN
2$:	BIT	#1000,TMPBUF+A.FM ;PENDING I/O?
	BEQ	3$		;NO
	PRINT	#IORMSG,#IORLEN	;NOTE IT.
3$:	BIT	#SW.SYS,SWORD	;PRINT SYSTEM TABLES?
	BEQ	NOATL		;SKIP IF NOT.
	INC	SKPFLG
	PRINT	#ATLMSG,#ATLLEN	;NOTE THAT THIS IS THE ATL
	INC	SKPFLG
	MOV	#TMPBUF,R5	;POINT TO INPUT BUFFER.
	MOV	#A.SIZ,R4	;INDICATE BYTE COUNT.
	CLR	R3		;CLEAR ADDR REG.
	CALL	DUMP50		;DUMP THE ATL NODE DIRECTLY.
	CALL	PRSAME
NOATL:	MOV	INPBUF+S.TZ,TSKSIZ ;GET TASK SIZE.
	BIT	#SW.SYS,SWORD
	BEQ	NOSTD
	INC	SKPFLG
	PRINT	#STDMSG,#STDLEN
	INC	SKPFLG
	MOV	#INPBUF,R5
	MOV	#S.SIZ,R4
	CLR	R3
	CLR	FIRSTL
	CALL	DUMP50		;DUMP TASK'S STD.
	CALL	PRSAME
NOSTD:	CALL	GET		;GET THE NEXT BLOCK (REQUESTOR'S STD)
	BIT	#SW.SYS,SWORD	;PRINT SYS TABLES?
	BEQ	NOREQ
	INC	SKPFLG
	PRINT	#REQMSG,#REQLEN
	INC	SKPFLG
	MOV	#INPBUF,R5
	MOV	#S.SIZ,R4
	CLR	R3
	CLR	FIRSTL
	CALL	DUMP50		;DUMP REQUESTOR'S STD.
	CALL	PRSAME
NOREQ:	CALL	GET		;GET NEXT BLOCK (PARTITION BLOCK)
	BIT	#SW.SYS,SWORD	;SYS TABLES?
	BEQ	NOTPD
	INC	SKPFLG
	PRINT	#TPDMSG,#TPDLEN
	INC	SKPFLG
	MOV	#INPBUF,R5
	MOV	#T.SZ,R4
	CLR	R3
	CLR	FIRSTL
	CALL	DUMP50		;AND DUMP TPD ENTRY.
	CALL	PRSAME
NOTPD:	CALL	GET		;GET NEXT BLOCK (PUD BLOCK)
	BIT	#SW.SYS,SWORD
	BEQ	NOPUD		;PUD?
	INC	SKPFLG
	PRINT	#PUDMSG,#PUDLEN
	INC	SKPFLG
	MOV	#INPBUF,R5
	MOV	#U.SZ,R4
	CLR	R3
	CLR	FIRSTL
	CALL	DUMP50		;DUMP IT.
	CALL	PRSAME
NOPUD:	CALL	GET		;GET THE NEXT BLOCK (HEADER)
	DEC	TSKSIZ
	INC	VADDR
	MOV	#INPBUF+H.PD0,R0 ;POINT TO PDR 0
	MOV	#PDRBUF,R1	;GET ADDR OF PDR STORAGE AREA.
	MOV	#8.,R2		;WILL LOOK AT 8. PDR'S
PDRLP:	MOV	(R0)+,(R1)+	;GET A PDR
	SOB	R2,PDRLP	;LOOP UNTIL SOMETHING FOUND
	MOV	#INPBUF+H.PA0,R0 ;GET PAR 0
	MOV	#PARBUF,R1	;GET PAR STORAGE AREA.
	MOV	#8.,R2
PARLP:	MOV	(R0)+,(R1)+	;GET A PAR
	SOB	R2,PARLP	;AND LOOP OVER PARS
	INC	SKPFLG
	PRINT	#THDMSG,#THDLEN	;NOTE IT AS SUCH
	INC	SKPFLG
	MOV	#REGPS,R0	;POINT TO PS
	MOV	#1,R2
	MOV	INPBUF+H.TPS,R1
	CALL	$CBOMG
	MOV	#REGPC,R0	;POINT TO PC
	MOV	INPBUF+H.TPC,R1	;GET PC
	CALL	$CBOMG		;GET THE MESSAGE OUT.
	PRINT	#STSMSG,#STSLEN
	MOV	#REG0,R0	;POINT TO R0
	MOV	INPBUF+H.TPC+2,R1
	CALL	$CBOMG
	MOV	#REG1,R0
	MOV	INPBUF+H.TPC+4,R1
	CALL	$CBOMG
	MOV	#REG2,R0
	MOV	INPBUF+H.TPC+6,R1
	CALL	$CBOMG
	MOV	#REG3,R0
	MOV	INPBUF+H.TPC+10,R1
	CALL	$CBOMG
	MOV	#REG4,R0
	MOV	INPBUF+H.TPC+12,R1
	CALL	$CBOMG
	MOV	#TMPBUF,R0
	MOV	#40,R1
	MOV	#INPBUF,R2	;SET UP TO MOVE DATA BLOCK.
5$:	MOV	(R2)+,(R0)+
	DEC	R1		;DEC COUNT
	BGT	5$		;AND LOOP.
	CALL	GET
	DEC	TSKSIZ
	INC	VADDR
	MOV	#REG5,R0
	MOV	INPBUF+H.TPC+14-100,R1
	CALL	$CBOMG
	MOV	#REGSP,R0
	MOV	INPBUF+H.TPC+16-100,R1
	CALL	$CBOMG
	PRINT	#REGMSG,#REGLEN
	MOV	#REGIPS,R0
	MOV	INPBUF+H.IPS-100,R1
	CALL	$CBOMG
	MOV	#REGIPC,R0
	MOV	INPBUF+H.IPC-100,R1
	CALL	$CBOMG
	MOV	#REGISP,R0
	MOV	INPBUF+H.ISP-100,R1
	CALL	$CBOMG
	PRINT	#IRGMSG,#IRGLEN
	INC	SKPFLG
	MOV	#TMPBUF,R5	;POINT TO FIRST PART OF BUFFER.
	MOV	#200,R4		;DUMP 200 BYTES.
	CLR	R3
	CLR	FIRSTL
	BIT	#SW.HDR,SWORD	;DUMP HEADER AREA?
	BEQ	1$		;NO
	CALL	DUMP50
1$:	MOV	INPBUF+H.HSZ-100,R1 ;GET SIZE OF HEADER.
	SUB	#2,R1		;WE JUST USED 2 BLOCKS.
	BLE	30$		;SKIP IF DONE.
	CMP	R1,#100		;IS THE HEADER 2K WORD OR LARGER?
	BLO	10$		;NO
	PRINT	#HDCMSG,#HDCLEN	;PRINT HEADER CORRUPTED MESSAGE.
	JMP	RESTRT		;AND BEGIN AGAIN.
10$:	ADD	#100,R3		;BUMP ADDRESS.
6$:	CALL	GET		;GET NEXT REC.
	DEC	TSKSIZ
	INC	VADDR
	MOV	#INPBUF,R5
	MOV	#100,R4		;GET LENGTH.
	ADD	R4,R3		;COMPUTE NEW ADDR
	BIT	#SW.HDR,SWORD	;PRINT HEADER?
	BEQ	2$		;NO
	CALL	DUMP50
2$:	DEC	R1
	BGT	6$		;AND LOOP.
30$:	CALL	PRSAME
	CLR	R3		;CLEAR ADDRESS.
	BIT	#SW.RWA,SWORD	;PRINT READ/WRITE AREA?
	BEQ	40$
	INC	SKPFLG
	PRINT	#RWAMSG,#RWALEN
	INC	SKPFLG
40$:	CLR	FIRSTL
	BIS	#SW.TMP,SWORD
	CALL	GETPDR		;GET THE PDR. R1 WILL HAVE LENGTH.
	BCC	50$
	JMP	BADPDR
50$:	CMP	R0,R3
	BEQ	60$
	JMP	BADPD2
60$:	MOV	ACF,OLDACF	; 0.4.1 SAVE ACF FIELD.
TKLOOP:	CALL	GET		;GET THE NEXT BLOCK.
	MOV	#INPBUF,R5	;GET THE BUFFER ADDRESS.
	MOV	#100,R4		;AND LENGTH OF BUFFER.
	CMP	ACF,#6		; 0.4.1 IS THE AREA R/W?
	BEQ	900$		; 0.4.1 NO
	BIT	#SW.ROA,SWORD	; 0.4.1 DUMP R-O AREA?
	BEQ	11$		; 0.4.1 NO
	BR	901$		; 0.4.1
900$:	BIT	#SW.RWA,SWORD	;DUMP READ/WRITE AREA?
	BEQ	11$		;NO
901$:	CMP	R3,MEMADR+2	;IS ADDR > LARGEST ADDR?
	BHI	11$		;YES
	ADD	R4,R3		;R3 -> LAST ADDRESS
	CMP	R3,MEMADR	;IS ADDR < SMALLEST ADDR?
	BLOS	1$		;YES.
	SUB	R4,R3		;FIXUP R3
	BR	2$		;AND SKIP.
1$:	SUB	R4,R3		;FIXUP R3
	BR	11$		;AND SKIP.
2$:	BIT	#SW.R50!SW.BYT,SWORD
	BEQ	10$		;SKIP IF NO RAD 50
	CALL	DUMP50
	BR	11$
10$:	CALL	DUMP		;DUMP NON RAD 50
11$:	DEC	R1		;DECREMENT NUMBER OF TIMES THIS FIELD.
	BPL	20$		;SKIP IF OK.
	INC	VADDR
	CALL	GETPDR		;GET PDR. R1=LENGTH,R0=ADDR
	BCC	18$		;SKIP IF FOUND.
	DEC	TSKSIZ		;IS TASK SIZE 0 TOO?
	BEQ	25$		;YES -- OK
	JMP	BADPD1
18$:	DEC	VADDR
	SUB	R4,R0		;FIXUP R0
	CMP	R0,R3		;IS IT THE PLACE WE EXPECTED IT?
	BEQ	19$		;YES
	CALL	PRSAME		;PRINT LINES SAME MESSAGE
	CLR	FIRSTL		;AND FAKE FIRST LINE.
	MOV	R0,R3		;NO -- SKIP A LINE TO DELIMIT
	INC	SKPFLG
19$:	CMP	TSKSIZ,#1	; 0.4.1 IS THIS THE LAST OF THE TASK?
	BLE	20$		; 0.4.1 YES -- DON'T FIDDLE.
	CMP	ACF,OLDACF	; 0.4.1 IS THE ACF THE SAME?
	BEQ	20$		; 0.4.1 YES -- SKIP
	CALL	PRSAME		; 0.4.1 PRINT LINES SAME MSG
	CLR	FIRSTL		; 0.4.1 SIGNAL FIRST LINE.
	INC	SKPFLG		; 0.4.1 FORCE SKIP ON LABEL.
	CMP	ACF,#6		; 0.4.1 IS ACF R/W?
	BEQ	194$		; 0.4.1 YES
	BIT	#SW.ROA,SWORD	; 0.4.1 PRINT R-O AREA?
	BEQ	198$		; 0.4.1 NO
	PRINT	#ROAMSG,#ROALEN	; 0.4.1 PRINT R-O AREA MESSAGE
	BR	197$		; 0.4.1 AND LEAVE.
194$:	BIT	#SW.RWA,SWORD	; 0.4.1 PRINT R/W AREA?
	BEQ	198$		; 0.4.1 NO
	PRINT	#RWAMSG,#RWALEN	; 0.4.1 PRINT R/W AREA MESSAGE
197$:	MOV	ACF,OLDACF	; 0.4.1 SAVE ACF
198$:	INC	SKPFLG		; 0.4.1 AND SKIP.
20$:	ADD	R4,R3		;BUMP POINTER.
	INC	VADDR
	DEC	TSKSIZ		;DECREMENT SIZE OF R/W AREA
	BLE	25$		;AND LOOP IF STILL THERE.
	JMP	TKLOOP		;AND LOOP IF STILL THERE.
25$:	CALL	PRSAME
	BIT	#SW.ROA!SW.GCD,SWORD ;DUMP READ-ONLY AREA?
	BNE	GCDDMP		;YES
	INC	SKPFLG
	PRINT	#ENDMSG,#ENDLEN	;PRINT END OF DUMP MESSAGE
	JMP	RESTRT		;AND START AGAIN.
GCDDMP:	CALL	GET		;GET THE NEXT REC.
	BIT	#SW.SYS,SWORD	;SYS TABLES?
	BEQ	70$		;NO
	INC	SKPFLG
	TST	INPBUF		;IS THIS THE READ-ONLY AREA?
	BNE	50$		;NO
	MOV	#1,ROAFLG	;SIGNAL THAT THIS IS R-O CODE.
	BIT	#SW.ROA,SWORD	;DUMP TASK READ-ONLY CODE?
	BEQ	90$		;NO
	PRINT	#GCDMSG,#GCDLEN	;NOTE GCD NODE
	BR	60$
50$:	CLR	ROAFLG		;SIGNAL THAT THIS IS LIB CODE.
	BIT	#SW.GCD,SWORD	;DUMP LIBRARIES?
	BEQ	90$		;NO
	BITB	#GF.LI,INPBUF+G.FB ;IS IT A LIBRARY?
	BEQ	55$		;NO -- COMMON AREA.
	MOV	#1,ROAFLG	;SIGNAL AS RO CODE.
	BIT	#SW.ROA,SWORD	;DO WE DUMP RO CODE?
	BEQ	90$		;NO
	MOV	#LIBMSG,R5
	MOV	#LIBPTR,R0
	BR	56$
55$:	MOV	#COMMSG,R5
	MOV	#COMPTR,R0
56$:	MOV	INPBUF+G.BN,R1	;GET COMMON AREA NAME.
	CALL	$C5TA
	MOV	INPBUF+G.BN+2,R1 ;GET SECOND HALF.
	CALL	$C5TA
	MOVB	#':,(R0)+	;SET TRAILING :
	SUB	R5,R0
	PRINT	R5,R0
60$:	INC	SKPFLG
	CLR	R3		;CLEAR ADDR REG
	CLR	FIRSTL		;NOTE FIRST LINE.
	MOV	#INPBUF,R5	;POINT TO BUFFER
	MOV	#G.SZ,R4	;NOTE SIZE
	BIC	#SW.TMP,SWORD
	CALL	DUMP50		;DUMP IT
	CALL	PRSAME		;PRINT LINES SAME AS ABOVE IF ANY
70$:	INC	SKPFLG		;SKIP A LINE ON NEXT LINE.
	TST	INPBUF		;IS IT THE R-O AREA?
	BNE	80$		;NO
	PRINT	#ROAMSG,#ROALEN
	BR	90$
80$:	BITB	#GF.LI,INPBUF+G.FB ;IS IT A LIBRARY?
	BEQ	85$		;NO
	MOV	#LBCPTR,R0
	MOV	#LBCMSG,R5
	BR	86$		;CONTINUE ...
85$:	MOV	#CMCPTR,R0
	MOV	#CMCMSG,R5
86$:	MOV	INPBUF+G.BN,R1	;GET FIRST HALF OF NAME.
	CALL	$C5TA
	MOV	INPBUF+G.BN+2,R1 ;GET SECOND HALF OF NAME.
	CALL	$C5TA
	MOVB	#':,(R0)+	;MOVE IN A :
	SUB	R5,R0		;COMPUTE LENGTH OF LINE.
	PRINT	R5,R0		;AND PRINT IT.
90$:	INC	SKPFLG
	MOV	INPBUF+G.CZ,TSKSIZ ;GET THE LENGTH OF AREA.
	MOV	INPBUF+G.BA,VADDR
	CLR	FIRSTL
	BIS	#SW.TMP,SWORD
	CALL	GETPDR		;GET THE NEXT PDR.
	BCC	100$		;SKIP IF OK.
	JMP	BADPDR
100$:	MOV	R0,R3		;SET NEW BEGINNING ADDR
ROLOOP:	CALL	GET		;GET THE NEXT REC.
	MOV	#INPBUF,R5	;POINT TO INPUT BUF.
	MOV	#100,R4		;GET LENGTH
	BIT	#SW.ROA,SWORD	;DUMP R-O CODE?
	BNE	900$		;YES
	TST	ROAFLG		;NO -- IS THIS RO AREA?
	BNE	11$		;YES -- DON'T DUMP.
900$:	BIT	#SW.GCD,SWORD	;DUMP GCD AREAS?
	BNE	910$		;YES
	TST	ROAFLG		;IS THIS A GCD AREA?
	BEQ	11$		;YES -- DON'T DUMP.
910$:	CMP	R3,MEMADR+2	;IS ADDR > LARGEST ADDR?
	BHI	11$		;YES
	ADD	R4,R3		;R3 -> LAST ADDRESS
	CMP	R3,MEMADR	;IS ADDR < SMALLEST ADDR?
	BLOS	1$		;YES.
	SUB	R4,R3		;FIXUP R3
	BR	2$		;AND SKIP.
1$:	SUB	R4,R3		;FIXUP R3
	BR	11$		;AND SKIP.
2$:	BIT	#SW.R50!SW.BYT,SWORD
	BEQ	10$
	CALL	DUMP50
	BR	11$
10$:	CALL	DUMP
11$:	DEC	R1		;DECREMENT NUMBER OF TIMES THIS FIELD.
	BPL	20$		;SKIP IF OK.
	INC	VADDR
	CALL	GETPDR
	BCC	15$
	DEC	TSKSIZ
	BEQ	25$
	JMP	BADPD1
15$:	DEC	VADDR
	SUB	R4,R0
	CMP	R0,R3		;DOES IT MATCH NORMAL ADDRESS?
	BEQ	20$		;YES
	CALL	PRSAME		;PRINT LINES SAME MESSAGE
	CLR	FIRSTL		;AND FAKE FIRST LINE.
	MOV	R0,R3		;NO -- SKIP A LINE TO DELIMIT
	INC	SKPFLG
20$:	ADD	R4,R3
	INC	VADDR
	DEC	TSKSIZ		;DECREMENT SIZE OF GCA
	BGT	ROLOOP		;LOOP IF STILL THERE.
25$:	CALL	PRSAME
	CLR	FIRSTL
	JMP	GCDDMP		;AND LOOP.
BADPDR:	PRINT	#PD0MSG,#PD0LEN
	JMP	RESTRT
BADPD1:	PRINT	#PD1MSG,#PD1LEN
	JMP	RESTRT
BADPD2:	PRINT	#PD2MSG,#PD2LEN
	JMP	RESTRT
BADPD3:	PRINT	#PD3MSG,#PD3LEN
	JMP	RESTRT

	.SBTTL	GETPDR -- GET NEXT PDR
;
; THIS SUBROUTINE SCANS THE PAR LIST LOOKING FOR
; 'VADDR'. IF FOUND, IT RETURNS THE LENGTH AND THE
; VIRTUAL ADDRESS IN R1 AND R0 RESPECTIVELY. IF NOT
; FOUND, IT SETS CARRY.
;
GETPDR:	CLR	R0		;GET PAR BUFFER.
	MOV	#8.,R1		;GET LENGTH OF PARS
5$:	CMP	PARBUF(R0),VADDR ;FOUND VADDR?
	BEQ	10$		;YES
	ADD	#2,R0		;GET TO NEXT PAR.
	SOB	R1,5$		;AND LOOP.
	SEC			;SET ERROR.
	RETURN			;AND RETURN.
10$:	MOV	PDRBUF(R0),R1	;GET PDR
	BIC	#177770,R1	;KEEP ACF
	MOV	R1,ACF		; 0.4.1 SAVE ACF
	BEQ	30$		;ERROR?
	CMP	R1,#3
	BEQ	30$
	CMP	R1,#7
	BEQ	30$
	MOV	PDRBUF(R0),R1	;GET PDR
	BIC	#100377,R1	;CLEAN GARBAGE.
	ASH	#-8.,R1		;MOVE TO CORRECT LOCATION.
	ASH	#12.,R0		;FIXUP RETURN ADDRESS.
	CLC			;CLEAR ERROR RETURN.
	RETURN			;AND RETURN.
30$:	JMP	BADPD3

	.SBTTL	DUMP50 -- DUMP CORE INCLUDING RAD50
;
; R5 -> THE SEGMENT OF CORE TO BE DUMPED.
; R4 = THE NUMBER OF WORDS TO BE DUMPED.
; R3 = THE CURRENT ADDRESS TO PRINT.
;
DUMP50:	SAVE			;SAVE ALL REGISTERS.
DLINE:	TST	FIRSTL		;FIRST LINE OF DUMP?
	BEQ	100$		;YES -- DON'T CHECK FOR MATCHING LINES.
	MOV	#LINBUF,R2	;GET OLD LINE.
	MOV	R5,R0		;AND NEW LINE
	MOV	#4,R1		;GET COUNT.
20$:	CMP	(R2)+,(R0)+	;COMPARE
	BNE	100$
	SOB	R1,20$		;AND LOOP
	CMP	ADDR,#-1	;WAS ADDR SET?
	BNE	80$		;YES
	MOV	R3,ADDR
80$:	MOV	R3,LADDR	;SET LAST ADDRESS.
	ADD	#10,R5		;BUMP POINTER.
	JMP	LEND		;AND LOOP.
100$:	CALL	PRSAME		;PRINT LINES SAME IF ANY
	MOV	#LINBUF,R2	;GET OLD LINE.
	MOV	R5,R0		;AND NEW LINE
	MOV	#4,R1		;GET COUNT.
120$:	MOV	(R0)+,(R2)+	;MOVE DATA
	SOB	R1,120$		;AND LOOP
	INC	FIRSTL		;INCREMENT FIRST LINE.
	MOV	#DMPBUF,R0	;POINT TO ADDR AREA OF BUFFER.
	MOV	R3,R1		;GET THE CURRENT ADDR.
	MOV	#4,R2		;DON'T SUPPRESS 0'S
	CALL	$CBOMG		;CONVERT IT.
	MOVB	#' ,(R0)+	;MOVE IN A BLANK.
	MOVB	#' ,(R0)+	;AND ANOTHER.
	BIT	#SW.BYT,SWORD	;BYTE MODE?
	BEQ	DLOOP		;NO
	MOV	#10,R2		;FIXUP R2
DLOOP:	BIT	#SW.BYT,SWORD	;BYTE MODE?
	BEQ	5$		;NO
	MOVB	(R5)+,R1	;GET BYTE
	BIC	#177400,R1
	MOVB	R1,2(R0)
	ASH	#-3,R1		;GET SECOND DIGIT
	MOVB	R1,1(R0)
	ASH	#-3,R1		;GET THIRD DIGIT
	MOVB	R1,(R0)
	BICB	#370,2(R0)
	BICB	#370,1(R0)
	BISB	#'0,(R0)+	;CONVERT TO ASCII
	BISB	#'0,(R0)+
	BISB	#'0,(R0)+
	BR	6$		;AND CONTINUE
5$:	MOV	(R5)+,R1	;GET THE CORE TO DUMP.
	CALL	$CBOMG		;DUMP IT
6$:	MOVB	#' ,(R0)+	;PUT IN A SPACE.
	SOB	R2,DLOOP	;AND LOOP.
	BIT	#SW.ASC,SWORD	;ASCII TO BE PRINTED?
	BEQ	20$		;NO
	SUB	#10,R5		;RESET TO BEGINNING OF LINE.
	MOVB	#' ,(R0)+	;MOVE IN ' '
	MOVB	#' ,(R0)+
	MOV	#10,R2		;GET NEW COUNT.
10$:	MOVB	(R5)+,R1
	CMPB	R1,#40		;LESS THAN ' '?
	BLO	11$		;YES
	CMPB	R1,#177		;TOO LARGE TO PRINT?
	BLO	12$		;NO
11$:	MOVB	#'.,R1		;MOVE IN A '.'
12$:	MOVB	R1,(R0)+	;MOVE IT IN.
	SOB	R2,10$		;MOVE IN THE ASCII.
20$:	BIT	#SW.N50,SWORD	;ANY RAD 50 TO BE PRINTED?
	BNE	30$		;NO
	BIT	#SW.R50,SWORD	;CORE DUMPS TO DUMP R50?
	BNE	21$		;YES
	BIT	#SW.TMP,SWORD	;THIS A CORE OR TABLE DUMP?
	BNE	30$		;CORE
21$:	SUB	#10,R5		;RESET AGAIN.
	MOVB	#' ,(R0)+	;SKIP A SPACE
	MOVB	#' ,(R0)+
	MOV	(R5)+,R1	;GET WRD 1
	CALL	$C5TA		;CONVERT IT.
	MOV	(R5)+,R1
	CALL	$C5TA
	MOV	(R5)+,R1
	CALL	$C5TA
	MOV	(R5)+,R1
	CALL	$C5TA		;CONVERT THE RAD50.
30$:	SUB	#DMPBUF,R0	;COMPUTE LENGTH OF BUFFER.
	PRINT	#DMPBUF,R0	;PRINT IT.
LEND:	ADD	#10,R3		;INCREMENT THE REG.
	SUB	#10,R4		;DECREMENT COUNT.
	BLE	10$		;AND LOOP
	JMP	DLINE
10$:	UNSAVE			;RESTORE REGS.
	RETURN			;AND LEAVE.

	.SBTTL	DUMP -- DUMP CORE WITHOUT RAD50
;
; R5 -> THE SEGMENT OF CORE TO BE DUMPED.
; R4 = THE NUMBER OF WORDS TO BE DUMPED.
; R3 = THE CURRENT ADDRESS TO PRINT.
;
DUMP:	SAVE			;SAVE ALL REGISTERS.
DLINE1:	TST	FIRSTL		;THIS THE FIRST LINE OF DUMP?
	BEQ	100$		;YES
	MOV	#LINBUF,R2	;GET THE OLD LINE.
	MOV	R5,R0		;AND NEW LINE.
	MOV	#10,R1		;GET COUNT INTO R1.
20$:	CMP	(R2)+,(R0)+	;COMPARE/
	BNE	100$		;SKIP OUT ON NOT EQUAL.
	SOB	R1,20$		;AND LOOP.
	CMP	ADDR,#-1	;WAS ADDR SET?
	BNE	80$		;YES
	MOV	R3,ADDR		;SET IT.
80$:	MOV	R3,LADDR	;SAVE END ADDR
	ADD	#20,R5		;BUMP CORE POINTER.
	BR	LEND1		;END THE LOOP.
100$:	CALL	PRSAME		;PRINT SAME MESSAGE.
	MOV	#DMPBUF,R0	;POINT TO ADDR AREA OF BUFFER.
	INC	FIRSTL
	MOV	R3,R1		;GET THE CURRENT ADDR.
	MOV	#10,R2		;DON'T SUPPRESS 0'S
	CALL	$CBOMG		;CONVERT IT.
	MOVB	#' ,(R0)+	;MOVE IN A BLANK.
	MOVB	#' ,(R0)+	;AND ANOTHER.
DLOOP1:	MOV	(R5)+,R1	;GET THE CORE TO DUMP.
	CALL	$CBOMG		;DUMP IT
	MOVB	#' ,(R0)+	;PUT IN A SPACE.
	SOB	R2,DLOOP1	;AND LOOP.
	SUB	#20,R5		;RESET TO BEGINNING OF LINE.
	MOV	#20,R2		;GET NEW COUNT.
	MOV	#LINBUF,R1
10$:	BIT	#SW.ASC,SWORD	;PRINT ASCII?
	BEQ	13$		;NO
	CMPB	(R5),#40	;LESS THAN ' '?
	BLO	11$		;YES
	CMPB	(R5),#177	;TOO LARGE TO PRINT?
	BLO	12$		;NO
11$:	MOVB	#'.,(R0)+	;MOVE IN A '.'
	BR	13$
12$:	MOVB	(R5),(R0)+	;MOVE IT IN.
13$:	MOVB	(R5)+,(R1)+	;MOVE INTO TMP AREA.
	SOB	R2,10$		;MOVE IN THE ASCII.
	SUB	#DMPBUF,R0	;COMPUTE LENGTH OF BUFFER.
	PRINT	#DMPBUF,R0	;PRINT IT.
LEND1:	ADD	#20,R3		;INCREMENT THE REG.
	SUB	#20,R4		;DECREMENT COUNT.
	BGT	DLINE1		;AND LOOP
	UNSAVE			;RESTORE REGS.
	RETURN			;AND LEAVE.

	.SBTTL	PRSAME -- PRINT LINES SAME MESSAGE
;
; THIS SUBROUTINE PRINTS THE "LINES SAME AS ABOVE" MESSAGE.
;
PRSAME:	CMP	ADDR,#-1	;WAS ADDR SET?
	BEQ	999$		;NO
	SAVE
	CMP	ADDR,LADDR	;AT FIRST LINE?
	BEQ	150$		;YES
	MOV	#SAMFRV,R0
	MOV	ADDR,R1
	MOV	#1,R2
	CALL	$CBOMG		;CONVERT TO OCTAL.
	MOV	#SAMLSV,R0
	MOV	LADDR,R1
	CALL	$CBOMG		;CONVERT AGAIN.
	PRINT	#SAMMSG,#SAMLEN
	BR	200$		;AND LEAVE.
150$:	MOV	#SAMVAL,R0
	MOV	ADDR,R1
	MOV	#1,R2
	CALL	$CBOMG
	PRINT	#SM1MSG,#SM1LEN
200$:	MOV	#-1,ADDR
	UNSAVE
999$:	RETURN

	.SBTTL	UTILITY SUBROUTINES
;
; THESE SUBROUTINES ARE USED FOR VARIOUS UTILITY FUNCTIONS.
;
$TYPE:	MOV	4(SP),$MSG+Q.IOPL ;MOVE IN THE ADDRESS
	MOV	2(SP),$MSG+Q.IOPL+2 ;MOVE IN THE LENGTH
	MOV	(SP),4(SP)	;MOVE IN THE RETURN ADDRESS
	CMP	(SP)+,(SP)+	;POP THE STACK
	MOV	#$MSG,-(SP)	;WRITE THE MESSAGE TO THE TERMINAL.
	CALL	.DIRDL
	RETURN			;AND RETURN.
;
GET:	MOV	R0,-(SP)	;SAVE R0
	GET$	#INFDB,#INPBUF,#INPLEN ;GET THE BUFFER.
	BCS	10$		;SKIP ON ERROR.
	MOV	(SP)+,R0	;RECOVER R0
	RETURN			;AND RETURN.
10$:	CMPB	INFDB+F.ERR,#IE.EOF ;WAS IT END-OF-FILE?
	BEQ	20$		;YES
	TYPE	#M.INPE,#L.INPE
	CALL	PRFCS		;PRINT FCS ERROR CODE.
	JMP	RESTRT
20$:	CALL	PRSAME		;PRINT LINES SAME MESSAGE.
	INC	SKPFLG
	PRINT	#ENDMSG,#ENDLEN
	JMP	RESTRT		;AND RE-START PROGRAM.
;
$PRINT:	MOV	R0,-(SP)	;SAVE R0
3$:	CMP	LINENO,PGSIZE	;PAST END OF PAGE?
	BLOS	5$		;NO
	MOV	R1,-(SP)	;SAVE R1
	MOV	R2,-(SP)	;AND R2
	INC	PAGENO
	MOV	#PGNOHD,R0
	MOV	PAGENO,R1
	CLR	R2
	CALL	$CBDMG
	MOV	R0,R1
	PUT$	#OUTFDB,#FFMSG,#FFLEN
	BCS	10$		;ERROR?
	SUB	#HDRMSG,R1
	PUT$	#OUTFDB,#HDRMSG,R1
	BCS	10$		;ERROR?
	INC	SKPFLG
	CLR	LINENO
	MOV	(SP)+,R2
	MOV	(SP)+,R1
5$:	TST	SKPFLG		;SKIP A LINE?
	BEQ	6$		;NO
	CLR	SKPFLG		;FORCE SKIP FLAG TO 0.
	PUT$	#OUTFDB,#SKPMSG,#SKPLEN
	INC	LINENO		;INCREMENT LINE NUMBER.
	BCS	10$		;TEST ERROR.
	BR	3$		;AND PRINT ANOTHER IF NECESSARY.
6$:	PUT$	#OUTFDB,6(SP),4(SP)
	BCS	10$		;ERROR?
	INC	LINENO
	MOV	(SP)+,R0	;RECOVER R0
	MOV	(SP),4(SP)	;RESTORE RETN ADDR
	CMP	(SP)+,(SP)+	;CLEAN STACK
	RETURN			;AND LEAVE.
10$:	TYPE	#M.OUTE,#L.OUTE
	CALL	PRFCS		;PRINT FCS ERROR.
	JMP	RESTRT
;
; THIS SUBROUTINE PRINTS THE FCS ERROR CODE AND THE DIRECTIVE
; CODE FOR THE FDB POINTED TO BY R0.
;
PRFCS:	MOV	R1,-(SP)	;SAVE R1
	MOV	R2,-(SP)	;SAVE R2
	MOV	#M.FCS,R1	;GET FCS BUFFER.
	MOV	#L.FCS,R2	;AND LENGTH.
	CALL	.PRFCS		;FETCH THE CODE NAME.
	MOV	(SP)+,R2	;RECOVER R2
	MOV	(SP)+,R1	;RECOVER R1
	RETURN
;
; THIS SUBROUTINE PLACES THE TIME AT THE LOC. SPEC. BY R2.
;
PRTIME:	DIR$	#$GTIM		;GET THE TIME.
	MOV	R0,-(SP)	;SAVE R0
	MOV	R1,-(SP)	;SAVE R1
	MOV	BUFIN+G.TIDA,R1	;GET THE DAY.
	CLR	R0		;CLEAR TMP. REG.
	DIV	#10.,R0		;COMPUTE DAY.
	ADD	#'0,R1
	ADD	#'0,R0
	MOVB	R0,(R2)+
	MOVB	R1,(R2)+
	MOVB	#'-,(R2)+	;MOVE IN A -
	MOV	BUFIN+G.TIMO,R1	;GET THE MONTH.
	DEC	R1		;GET IT TO 0 ORIGIN.
	MUL	#3.,R1		;MULTIPLY BY 3 FOR NAME.
	ADD	#MONTHS,R1	;POINT TO MONTHS LIST.
	MOVB	(R1)+,(R2)+	;MOVE IT IN
	MOVB	(R1)+,(R2)+
	MOVB	(R1)+,(R2)+
	MOVB	#'-,(R2)+
	MOV	BUFIN+G.TIYR,R1	;GET YEAR.
	CLR	R0
	DIV	#10.,R0		;GET IN DEC.
	ADD	#'0,R1
	ADD	#'0,R0
	MOVB	R0,(R2)+	;MOVE IT IN.
	MOVB	R1,(R2)+
	MOVB	#' ,(R2)+	;SKIP A SPACE.
	MOV	BUFIN+G.TIHR,R1	;GET HOUR.
	CLR	R0
	DIV	#10.,R0
	ADD	#'0,R0
	ADD	#'0,R1		;CONVERT TO ASCII
	MOVB	R0,(R2)+	;MOVE IT IN.
	MOVB	R1,(R2)+
	MOVB	#':,(R2)+	;MOVE IN A :
	MOV	BUFIN+G.TIMI,R1	;GET MINUTE.
	CLR	R0
	DIV	#10.,R0		;CONVERT TO 10
	ADD	#'0,R0		;CONVERT TO ASCII
	ADD	#'0,R1
	MOVB	R0,(R2)+
	MOVB	R1,(R2)+	;MOVE IT IN.
	MOVB	#':,(R2)+	;MOVE IN A :
	MOV	BUFIN+G.TISC,R1	;GET SECOND
	CLR	R0
	DIV	#10.,R0		;CONVERT TO 10
	ADD	#'0,R0
	ADD	#'0,R1
	MOVB	R0,(R2)+
	MOVB	R1,(R2)+
	MOV	(SP)+,R1	;R1
	MOV	(SP)+,R0	;R0
	RETURN			;AND LEAVE.

	.SBTTL	UICPRT -- PRETTY UP THE UIC LISTING
;
; THIS SUBROUTINE PRETTYS UP THE UIC LISTING. IT TAKES ONE
; PARAMETER, AT R0, AND EXPECTS R0 TO POINT ONE BYTE BEYOND
; A THREE DIGIT UIC PORTION. THE SUBROUTINE WILL STRIP ANY
; LEADING ZERO'S IN THE UIC AND ADJUST R0 APPROPRIATELY.
;
UICPRT:	MOV	R1,-(SP)	;SAVE R1
	MOV	R2,-(SP)	;AND R2
	MOV	R0,R2		;SAVE R0
	CLRB	(R0)		;MARK END OF STRING.
	SUB	#3,R0		;BACK UP OVER UIC.
10$:	CMPB	#'0,(R0)	;IS (R0) A '0'?
	BNE	50$		;NO
	MOV	R0,R1		;REMEMBER OUR PLACE.
20$:	MOVB	1(R0),(R0)+	;MOVE A CHARACTER IN.
	BNE	20$		;AND GO BACK.
	MOV	R1,R0		;RECOVER PLACE.
	DEC	R2		;ADJUST OUTPUT PLACE.
	BR	10$		;AND LOOP.
50$:	MOV	R2,R0		;RETURN ADJUSTED POSITION.
	MOV	(SP)+,R2	;RECOVER R2
	MOV	(SP)+,R1
	RETURN

	.SBTTL	MESSAGES AND STRINGS
;
	.NLIST	BIN
M.ERR:	.ASCII	'COR -- I/O ERROR ON @ FILE'
L.ERR	=	.-M.ERR
	.EVEN
;
M.UNK:	.ASCII	/COR -- UNKNOWN @ FILE ERROR/
L.UNK	=	.-M.UNK
	.EVEN
;
M.OPE:	.ASCII	/COR -- OPEN FAILURE FOR @ FILE/
L.OPE	=	.-M.OPE
	.EVEN
;
M.SYN:	.ASCII	/COR -- SYNTAX ERROR FOR @ FILE/
L.SYN	=	.-M.SYN
	.EVEN
;
M.MAF:	.ASCII	/COR -- MAX @ FILE DEPTH EXCEEDED/
L.MAF	=	.-M.MAF
	.EVEN
;
M.PS1:	.ASCII	/COR -- SYNTAX ERROR/
L.PS1	=	.-M.PS1
	.EVEN
;
M.PS2:	.ASCII	/COR -- ILLEGAL SWITCH/
L.PS2	=	.-M.PS2
	.EVEN
;
M.INM:	.ASCII	/COR -- MORE THAN 1 INPUT FILE/
L.INM	=	.-M.INM
	.EVEN
;
M.OUM:	.ASCII	/COR -- MORE THAN 1 OUTPUT FILE/
L.OUM	=	.-M.OUM
	.EVEN
;
M.WLD:	.ASCII	/COR -- WILDCARDS NOT ALLOWED/
L.WLD	=	.-M.WLD
	.EVEN
;
M.OPI:	.ASCII	/COR -- CANNOT OPEN DUMP FILE/
L.OPI	=	.-M.OPI
	.EVEN
M.IPS:	.ASCII	/COR -- ILLEGAL PAGE SIZE/
L.IPS	=	.-M.IPS
	.EVEN
;
M.OPO:	.ASCII	/COR -- CANNOT CREATE LIST FILE/
L.OPO	=	.-M.OPO
	.EVEN
;
M.INPE:	.ASCII	/COR -- ERROR ON INPUT FILE/
L.INPE	=	.-M.INPE
	.EVEN
;
M.DIRE:	.ASCII	"COR -- ERROR DURING DIRECTORY I/O"
L.DIRE	=	.-M.DIRE
	.EVEN
;
M.OUTE:	.ASCII	/COR -- ERROR ON OUTPUT FILE/
L.OUTE	=	.-M.OUTE
	.EVEN
;
M.FCS:	.ASCII	/COR/
L.FCS	=	.-M.FCS
	.EVEN
;
TIMMSG:	.ASCII	/TASK "/
TSNOFF:	.ASCII	/123456" ABORTED ON /
TIMOFF:	.ASCII	/00-XXX-00 00:00:00/
TIMLEN	=	.-TIMMSG
	.EVEN
;
TRMMSG:	.ASCII	/REASON FOR TERMINATION:/
TRMLEN	=	.-TRMMSG
	.EVEN
;
ILCMSG:	.ASCII	/TERMINATION CODE NOT AVAILABLE/
ILCLEN	=	.-ILCMSG
	.EVEN
;
IORMSG:	.ASCII	'AND WITH PENDING I/O REQUESTS'
IORLEN	=	.-IORMSG
	.EVEN
;
SKPMSG:
SKPLEN	=	.-SKPMSG
	.EVEN
;
CMDMSG:	.ASCII	/COMMAND LINE USED:/
CMDLEN	=	.-CMDMSG
	.EVEN
;
HDRMSG:
	.ASCII	/                     /
	.ASCII	+TASK DUMP ANALYSER+
	.ASCII	/   /
;		/SY0:[000,000]123456.123;123/
FILOFF:	.ASCII	/                           /
FILEND:
	.ASCII	/ PAGE /
PGNOHD:	.ASCII	/1  /
HDRLEN	=	.-HDRMSG
	.EVEN
;
ATLMSG:	.ASCII	/ATL NODE OF ABORTING TASK:/
ATLLEN	=	.-ATLMSG
	.EVEN
;
STDMSG:	.ASCII	/STD NODE OF ABORTING TASK:/
STDLEN	=	.-STDMSG
	.EVEN
;
REQMSG:	.ASCII	/STD NODE OF REQUESTING TASK:/
REQLEN	=	.-REQMSG
	.EVEN
;
TPDMSG:	.ASCII	/TPD BLOCK FOR ABORTING TASK:/
TPDLEN	=	.-TPDMSG
	.EVEN
;
PUDMSG:	.ASCII	/PUD BLOCK FOR ABORTING TASK:/
PUDLEN	=	.-PUDMSG
	.EVEN
;
THDMSG:	.ASCII	/TASK HEADER:/
THDLEN	=	.-THDMSG
	.EVEN
;
STSMSG:	.ASCII	/PS=/
REGPS:	.ASCII	/       /
	.ASCII	/PC=/
REGPC:	.ASCII	/       /
STSLEN	=	.-STSMSG
	.EVEN
;
REGMSG:	.ASCII	/R0=/
REG0:	.ASCII	/       /
	.ASCII	/R1=/
REG1:	.ASCII	/       /
	.ASCII	/R2=/
REG2:	.ASCII	/       /
	.ASCII	/R3=/
REG3:	.ASCII	/       /
	.ASCII	/R4=/
REG4:	.ASCII	/       /
	.ASCII	/R5=/
REG5:	.ASCII	/       /
	.ASCII	/SP=/
REGSP:	.ASCII	/       /
REGLEN	=	.-REGMSG
	.EVEN
;
IRGMSG:	.ASCII	/INITIAL PS=/
REGIPS:	.ASCII	/       /
	.ASCII	/INITIAL PC=/
REGIPC:	.ASCII	/       /
	.ASCII	/INITIAL SP=/
REGISP:	.ASCII	/       /
IRGLEN	=	.-IRGMSG
	.EVEN
;
HDCMSG:	.ASCII	/HEADER FATALLY CORRUPTED, DUMP TERMINATED./
HDCLEN	=	.-HDCMSG
	.EVEN
;
PD0MSG:	.ASCII	/PAGE DESCRIPTOR REGISTER UNEXPECTEDLY MISSING, /
	.ASCII	/DUMP TERMINATED./
PD0LEN	=	.-PD0MSG
	.EVEN
;
PD1MSG:	.ASCII	/PAGE DESCRIPTOR REGISTER MISMATCH, DUMP TERMINATED./
PD1LEN	=	.-PD1MSG
	.EVEN
;
PD2MSG:	.ASCII	/PAGE DESCRIPTOR REGISTER UNEXPECTEDLY CHANGED, /
	.ASCII	/DUMP TERMINATED./
PD2LEN	=	.-PD2MSG
	.EVEN
;
PD3MSG:	.ASCII	/PAGE DESCRIPTOR HAS ILLEGAL ACCESS CONTROL FIELD, /
	.ASCII	/DUMP TERMINATED./
PD3LEN	=	.-PD3MSG
	.EVEN
;
RWAMSG:	.ASCII	'TASK READ/WRITE AREA:'
RWALEN	=	.-RWAMSG
	.EVEN
;
GCDMSG:	.ASCII	/GCD NODE FOR TASK READ-ONLY AREA:/
GCDLEN	=	.-GCDMSG
	.EVEN
;
ROAMSG:	.ASCII	/TASK READ-ONLY AREA:/
ROALEN	=	.-ROAMSG
	.EVEN
;
LIBMSG:	.ASCII	/GCD NODE FOR LIBRARY /
LIBPTR:	.ASCII	/       /
	.EVEN
;
COMMSG:	.ASCII	/GCD NODE FOR COMMON AREA /
COMPTR:	.ASCII	/       /
	.EVEN
;
LBCMSG:	.ASCII	/MEMORY FOR LIBRARY /
LBCPTR:	.ASCII	/       /
	.EVEN
;
CMCMSG:	.ASCII	/MEMORY FOR COMMON AREA /
CMCPTR:	.ASCII	/       /
	.EVEN
;
SAMMSG:	.ASCII	/LINES /
SAMFRV:	.ASCII	/       THROUGH /
SAMLSV:	.ASCII	/       SAME AS ABOVE./
SAMLEN	=	.-SAMMSG
	.EVEN
;
SM1MSG:	.ASCII	/LINE /
SAMVAL:	.ASCII	/       SAME AS ABOVE./
SM1LEN	=	.-SM1MSG
	.EVEN
;
ENDMSG:	.ASCII	/END OF DUMP./
ENDLEN	=	.-ENDMSG
	.EVEN
;
FFMSG:	.ASCII	<FF>
FFLEN	=	.-FFMSG
	.EVEN
;
MONTHS:	.ASCII	/JANFEBMARAPRMAYJUN/
	.ASCII	/JULAUGSEPOCTNOVDEC/

	.SBTTL	TERMINATION NOTICE STRINGS.
;
BEGMT:	.WORD	MESS00		;TERMINATION MESSAGE TABLE
	.WORD	MESS02
	.WORD	MESS04
	.WORD	MESS06
	.WORD	MESS10
	.WORD	MESS12
	.WORD	MESS14
	.WORD	MESS16
	.WORD	MESS20
	.WORD	MESS22
	.WORD	MESS24
	.WORD	MESS26
	.WORD	MESS30
	.WORD	MESS32
	.WORD	MESS34
	.WORD	MESS36
	.WORD	MESS40
	.WORD	MESS42
	.WORD	MESS44
	.WORD	MESS46
ENDMT=44
;
;
MESS00:	.ASCII	'ODD ADDRESS OR OTHER TRAP FOUR'
MESS02:	.ASCII	'MEMORY PROTECT VIOLATION'
MESS04:	.ASCII	'T-BIT TRAP OR "BPT" EXECUTION'
MESS06:	.ASCII	'"IOT" EXECUTION'
MESS10:	.ASCII	'"RESERVED INST" EXECUTION'
MESS12:	.ASCII	'"NON-RSX EMT" EXECUTION'
MESS14:	.ASCII	'"TRAP" EXECUTION'
MESS16:	.ASCII	'11/40 F.P. EXCEPTION'
MESS20:	.ASCII	'MEMORY PARITY ERROR' ;RSX-11D V6.2 CODE
MESS22:	.ASCII	"F014"
MESS24:	.ASCII	"F013"
MESS26:	.ASCII	"F012"
MESS30:	.ASCII	'SST ABORT (BAD STACK)'
MESS32:	.ASCII	'AST ABORT (BAD STACK)'
MESS34:	.ASCII	'ABORTED VIA DIRECTIVE (OR MCR)'
MESS36:	.ASCII	'TIME LIMIT EXCEEDED'
MESS40:	.ASCII	'LOAD FAILURE (DSK READ ERR)'
MESS42:	.ASCII	'CHECKPOINT FAILURE (DSK WRITE ERR)'
MESS44:	.ASCII	'MEMORY PARITY ERROR' ;RSX-11D V6B CODE
MESS46:
;
.EVEN
;

	.SBTTL	FILE TABLES
	.LIST	BIN
;
$GTIM:	GTIM$	BUFIN
PDRBUF:	.BLKW	8.		;PDR BUFFER AREA.
PARBUF:	.BLKW	8.		;PAR BUFFER AREA.
ACF:	.WORD	0		;ACF AREA
OLDACF:	.WORD	0		;OLD ACF AREA.
TSKSIZ:	.WORD	0		;TASK SIZE INDICATOR SAVE AREA.
VADDR:	.WORD	0		;TASK VIRTUAL ADDRESS COUNTER.
BUFIN:	.BLKW	14.
SPSAVE:	.WORD	0
ADDR:	.WORD	0
LADDR:	.WORD	0
FIRSTL:	.WORD	0
LINENO:	.WORD	0		;CURRENT LINE NUMBER OF LISTING.
PAGENO:	.WORD	0		;CURRENT PAGE NUMBER OF LISTING.
SKPFLG:	.WORD	0		;SKIP LINE FLAG
ROAFLG:	.WORD	0		;TYPE OF GCD AREA BEING DUMPED
TMPBUF:	.BLKB	100		;TEMPORARY BUFFER AREA.
INPBUF:	.BLKB	100		;NORMAL BUFFER AREA.
LINBUF:	.BLKB	100		;LINE BUFFER FOR "LINES SAME" MESSAGE.
INPLEN	=	.-INPBUF
DMPBUF:	.BLKB	120.
$MSG:	QIOW$	IO.WVB,TTYLUN,TTYEVF,,,,<0,0,40>
$READ:	QIOW$	IO.RAT,INPLUN,INPEVF,,,,<INFDB+F.FNB,RDHDR>
$REDDR:	QIOW$	IO.RAT,DIRLUN,DIREVF,,,,<DIRFDB+F.FNB,RDHDR>
RDHDR:	.BYTE	-12,0		;BLOCK TO READ FILE HEADER
	.WORD	HEADER
	.WORD	0
HEADER:	.BLKB	1000
IOST:	.BLKW	2
CMLBLK:	GCMLB$	2,COR,USRBUF,CMDLUN
USRBUF:	.BLKB	82.
	.EVEN
	CSI$
	.EVEN
CSIBLK:	.BLKB	C.SIZE
	.EVEN
SWTAB:	CSI$SW	R5,SW.R50,SWORD,SET,NEG
	CSI$SW	BY,SW.BYT,SWORD,SET,NEG
	CSI$SW	N5,SW.N50,SWORD,SET,NEG
	CSI$SW	AS,SW.ASC,SWORD,SET,NEG
	CSI$SW	RO,SW.ROA,SWORD,SET,NEG
	CSI$SW	SY,SW.SYS,SWORD,SET,NEG
	CSI$SW	HD,SW.HDR,SWORD,SET,NEG
	CSI$SW	RW,SW.RWA,SWORD,SET,NEG
	CSI$SW	SP,SW.SPL,SWORD,SET,NEG
	CSI$SW	MD,SW.DMP,SWORD,SET,,MEMDSC
	CSI$SW	PS,SW.SIZ,SWORD,SET,,PAGDSC
	CSI$SW	CM,SW.GCD,SWORD,SET,NEG
	CSI$ND
MEMDSC:	CSI$SV	OCTAL,MEMADR,2
	CSI$SV	OCTAL,MEMADR+2,2
	CSI$ND
PAGDSC:	CSI$SV	DECIMAL,PGSIZE,2
	CSI$ND
MEMADR:	.WORD	0,-1.
PGSIZE:	.WORD	PAGSIZ		;DEFAULT PAGE SIZE.
SWORD:	.WORD	SW.ASC!SW.SYS!SW.HDR!SW.RWA!SW.SPL
SW.R50	=	000001	;PRINT RAD50 ON TASK CORE INDICATOR
SW.BYT	=	000002	;PRINT BYTE MODE INDICATOR
SW.N50	=	000004	;PRINT NO RAD 50 INDICATOR
SW.ASC	=	000010	;PRINT ASCII INDICATOR
SW.ROA	=	000020	;PRINT READ-ONLY AREA IF ANY.
SW.SYS	=	000040	;PRINT SYSTEM TABLES.
SW.HDR	=	000100	;PRINT TASK HEADER
SW.RWA	=	000200	;PRINT READ/WRITE AREA
SW.SPL	=	000400	;SPOOL LISTING FILE WHEN DONE.
SW.DMP	=	001000	;MEMORY DUMP LIMITS ARE SPECIFIED.
SW.SIZ	=	002000	;PAGE SIZE SPECIFIED.
SW.GCD	=	004000	;DUMP GCD AND LIBRARY AREAS.
SW.TMP	=	100000	;TEMP BIT -- DON'T PRINT RAD50 UNLESS SW.R50 SET
INFDB:	FDBDF$
	FDRC$A
	FDOP$A	INPLUN,,INDFNB
	FDBF$A	INPEVF
INDFNB:	NMBLK$	CORE,DMP,,SY,0
OUTFDB:	FDBDF$
	FDAT$A	R.VAR,FD.CR
	FDRC$A
	FDOP$A	OUTLUN,,OUDFNB
	FDBF$A	OUTEVF
OUDFNB:	NMBLK$	CORE,LST,,SY,0
DIRFDB:	FDBDF$
	FDOP$A	DIRLUN
	FDBF$A	DIREVF
;
	BDOFF$	DEF$L
	FSRSZ$	3,3*<S.BFHD+512.>
	.END	CORDMP