.TITLE	ADS - ALLOCATE DUMP SPACE
	.IDENT	/02.00/
	.LIST	MEB
	.PSECT	ADS
;
; AUTHOR:	H. L. COLEMAN
;		MILLIKEN AND COMPANY
;		P. O. BOX 1926
;		MAIL STOP M-103
;		SPARTANBURG, S. C. 29304
;		(803)573-2556
;
; VERSION:	02.00
;
; DATE:		9-FEB-78
;
; MODIFICATIONS:
;
; FUNCTION:	ALLOCATE A FILE ON DISK TO BE USED FOR CRASH DUMPS AND
;		POINT THE CRASH DUMP ROUTINE TO IT. THE FIRST BLOCK IN
;		THE FILE IS WRITTEN AS ALL ZEROES.
;
; INPUT:	MCR COMMAND LINE OF THE FORM:
;
;		ADS DDUU:[GROUP,OWNER]NAME.TYP;VER
;
;		DEFAULTS:
;
;		DDUU:	SY0:
;		GROUP	1
;		OWNER	4
;		NAME	CRASH
;		TYP	DMP
;		VER	0
;
	.PAGE
; MACRO CALLS AND SYSTEM DEFINITIONS
;
	.MCALL	GMCR$,DIR$,QIOW$S,EXIT$S,MSGN$S,CKDSW$S
	.MCALL	DCBDF$,UCBDF$,SCBDF$,TCBDF$,FDOF$L,FCSBT$,QIOSY$
	.MCALL	HDRDF$
	DCBDF$			;DEFINE DCB OFFSETS
	UCBDF$			;DEFINE UCB OFFSETS
	SCBDF$			;DEFINE SCB OFFSETS
	TCBDF$			;DEFINE TCB OFFSETS
	HDRDF$			;DEFINE TASK HEADER OFFSETS
	FDOF$L			;DEFINE FCS OFFSETS
	FCSBT$			;DEFINE FCS BITS
	QIOSY$			;DEFINE QIO FUNCTION AND ERROR CODES
	.PSECT	ADS
	.PAGE
; MESSAGES
;
PFX:	.BYTE	PRMT-PFX-1
	.ASCII	/ADS -/
PRMT:	.BYTE	M001-PRMT-1
	.ASCII	/ADS>/
M001:	.BYTE	M002-M001-1
	.ASCII	/NOT A PRIVLEDGED TERMINAL/
M002:	.BYTE	M003-M002-1
	.ASCII	/SYNTAX ERROR/
M003:	.BYTE	M004-M003-1
	.ASCII	/WILD CARDS NOT ALLOWED/
M004:	.BYTE	M005-M004-1
	.ASCII	/INVALID DEVICE/
M005:	.BYTE	M006-M006-1
	.ASCII	/DEVICE NOT MOUNTED/
M006:	.BYTE	M007-M006-1
	.ASCII	/DIRECTORY DOES NOT EXIST/
M007:	.BYTE	M008-M007-1
	.ASCII	/I-O ERROR FINDING DIRECTORY /
M007A:	.ASCII	/         /
M008:	.BYTE	M009-M008-1
	.ASCII	/DEVICE TOO SMALL/
M009:	.BYTE	M010-M009-1
	.ASCII	/INSUFFICIENT FREE SPACE/
M010:	.BYTE	M011-M010-1
	.ASCII	/DEVICE FULL/
M011:	.BYTE	M012-M011-1
	.ASCII	/INDEX FILE FULL/
M012:	.BYTE	M013-M012-1
	.ASCII	/I-O ERROR ON CREATE /
M012A:	.ASCII	/         /
M013:	.BYTE	M014-M013-1
	.ASCII	/DUMP FILE ALLOCATED - NOT AT END OF PACK/
M014:	.BYTE	M015-M014-1
	.ASCII	/DUMP FILE ALLOCATED/
M015:	.BYTE	M016-M015-1
	.ASCII	/I-O ERROR FORMATTING FILE /
M015A:	.ASCII	/         /
M016:	.BYTE	M017-M016-1
	.ASCII	/DEVICE NOT SUPPORTED/
M017:	.BYTE	0
	.EVEN
	.PAGE
; CONSTANTS AND WORK AREAS
;
MCRLIN:	GMCR$			;MCR COMMAND BUFFER
PARBUF:				;PARSE BUFFER
PARDEV:	.ASCII	/  /		;DEVICE NAME
PARUN:	.WORD	0		;UNIT NUMBER
PARUIC:	.BYTE	0,0		;UIC - GROUP,OWNER
PARFNM:	.RAD50	/         /	;FILE NAME
PARTYP:	.RAD50	/   /		;FILE TYPE
PARVER:	.WORD	0		;FILE VERSION NUMBER
PARFLG:	.WORD	0		;FLAGS
DEFBUF:	.ASCII	/SY/		;DEFAULTS
	.WORD	0
	.BYTE	4,1
	.RAD50	/CRASH    DMP/
	.WORD	0,0
CRPARM:	.WORD	PARBUF		;A(PARSE BUFFER)
	.WORD	DUMFDB		;A(DUMMY FDB)
	.WORD	2		;LUN 2
CRPFSI:	.BLKW	2		;FILE SIZE
CRPSLB:	.BLKW	2		;STARTING LBN
	.WORD	7		;FLAGS - CONTIGUOUS
				;	 PLACEMENT
				;	 ANY IF PLACEMENT FAILS
CRPALB:	.BLKW	2		;ACTUAL STARTING LBN
DUMFDB:	.BYTE	R.FIX,0		;F.RTYP,F.RATT
	.WORD	512.		;F.RSIZ
	.BLKW	2		;F.HIBK
	.BLKW	2		;F.EFBK
	.WORD	512.		;F.FFBY
CREMT1:	.WORD	0,M003,M006,M007,M009,M010,M011,M012
CREMT2:	.WORD	0,0,0,M007A,0,0,0,M012A
PCFLG:	.WORD	0
IOSB:	.BLKW	2
DMPUCB:	.WORD	0
DNTAB:	.ASCII	/DKDMDB/
	.WORD	0
DRTAB:	.WORD	DKRTN,DMRTN,DBRTN
DATAB:	.WORD	DKARTN,DMARTN,DBARTN
DEVRTN:	.WORD	0
DARTN:	.WORD	0
ZERO:	.BLKW	256.
	.PAGE
ADS:	MOV	$TKTCB,R1	;R1 = A(MY TCB)
	MOV	T.UCB(R1),R0	;R0 = A(TI: UCB)
	BIT	#U2.PRV,U.CW2(R0) ;IS THE USER PRIVLEDGED?
	BNE	1100$		  ;IF NE, YES - CONTINUE
	MSGN$S	PFX,3,M001,,,ABORT ;NOT A PRIVLEDGED TERMINAL
1000$:	EXIT$S
1100$:	MOV	$SYSIZ,R1	;R1 = PHYSICAL MEMORY SIZE(32W BLOCKS)
	ASR	R1		;64W BLOCKS
	ASR	R1		;128W BLOCKS
	ASR	R1		;256W BLOCKS
	ADD	#22,R1		;R1 = FILE SIZE
				;22 ACCOUNTS FOR A POSSIBLE 4 K WORDS WHICH
				;ARE NOT ADDRESSABLE (NOT SYSGENED) ON AN
				;11/70 IN 18 BIT MODE.  (I.E. A 128K CPU
				;WHICH WAS SYSGENED 124K TO KEEP 18 BIT
				;ADDRESSING MODE.)
	MOV	R1,CRPFSI+2	;SET FILE SIZE
	MOV	R1,DUMFDB+F.EFBK+2 ;SET EOF VBN
	MOV	R1,DUMFDB+F.HIBK+2 ;SET HIGH VBN
	MOV	#MCRLIN+2,R0	;R0 = A(MCR COMMAND)
	DIR$	#MCRLIN		;GET MCR COMMAND LINE
	BCC	1300$		;IF CC, WE GOT ONE - GO PROCESS IT
1200$:	MSGN$S	PRMT,0,,MCRLIN+2,79.,ABORT ;PROMPT FOR COMMAND
	CMPB	#IE.EOF,$TIOSB	;CTRL/Z?
	BEQ	1000$		;IF EQ, YES - EXIT
	MOV	#MCRLIN+2,R0	;R0 = A(COMMAND LINE)
	BR	1400$		;GO PARSE COMMAND
1300$:	TSTB	(R0)		;EOL?
	BEQ	1400$		;IF EQ, YES - NOTHING TO SKIP
	CMPB	#' ,(R0)+	;BLANK?
	BNE	1300$		;IF NE, NO - KEEP LOOKING
1400$:	MOV	#PARBUF,R1	;R1 = A(PARSE BUFFER)
	MOV	#DEFBUF,R2	;R2 = A(DEFAULTS)
	MOV	#8.,R3		;R3 = COUNT
1500$:	MOV	(R2)+,(R1)+	;SET UP DEFAULTS
	SOB	R3,1500$	;LOOP UNTIL DONE
	MOV	#PARBUF,R1	;R1 = A(PARSE BUFFER)
	TSTB	(R0)		;ANYTHING TO PARSE?
	BEQ	1600$		;IF EQ, NO - USE ALL DEFAULTS
	CALL	$PARFL		;PARSE THE COMMAND
	BCC	1600$		;IF CC, NO ERRORS - CONTINUE
	MSGN$S	PFX,3,M002,,,ABORT ;SYNTAX ERROR
	BR	1200$		;FORCE PROMPT
1600$:	MOV	#PARDEV,R3	;R3 = A(DEVICE NAME)
	MOV	PARUN,R1	;R1 = UNIT NUMBER
	MOVB	#':,R2		;R2 = COLON
	CALL	$FDLGG		;LOCATE THE UCB OR LCB
	BCC	1900$		;IF CC, WE FOUND IT - CONTINUE
1800$:	MSGN$S	PFX,3,M004,,,ABORT ;INVALID DEVICE
	BR	1200$		;FORCE PROMPT
1900$:	CALL	$SWSTK,2100$	;SWITCH TO SYSTEM STACK
2000$:	MOV	U.RED(R1),R1	;;;FOLLOW REDIRECT CHAIN
	CMP	U.RED(R1),R1	;;;END OF CHAIN?
	BNE	2000$		;;;IF NE, NO - KEEP LOOKING
	MOV	R1,DMPUCB	;;;SAVE A(DUMP DEVICE UCB)
	MOV	$HEADR,R0	;;;R0 = A(MY TASK HEADER)
	MOV	R1,H.LUN+4(R0)	;;;ASSIGN LUN 2 TO DEVICE
	RETURN			;;;RETURN TO USER STACK
2100$:	MOV	DMPUCB,R1	;R1 = A(DUMP DEVICE UCB)
	BIT	#DV.F11,U.CW1(R1) ;FILES 11 DEVICE?
	BEQ	1800$		  ;IF EQ, NO - INVALID DEVICE
	BITB	#US.MNT,U.STS(R1) ;IS DEVICE MOUNTED?
	BEQ	2300$		  ;IF EQ, YES - CONTINUE
2200$:	MSGN$S	PFX,3,M005,,,ABORT ;DEVICE NOT MOUNTED
	BR	1200$		;FORCE PROMPT
2300$:	MOV	#DNTAB,R0	;R0 = A(DEVICE NAME TABLE)
	MOV	U.DCB(R1),R2	;R2 = A(DCB)
2220$:	CMP	D.NAM(R2),(R0)+	;MATCH?
	BEQ	2230$		;IF EQ, YES
	TST	(R0)		;END OF TABLE?
	BNE	2220$		;IF NE, NO - LOOP UNTIL DONE
	MSGN$S	PFX,3,M016,,,ABORT ;DEVICE NOT SUPPORTED
	BR	1200$		;FORCE PROMPT
2230$:	SUB	#DNTAB+2,R0	;R0 = TABLE OFFSET
	MOV	DRTAB(R0),DEVRTN ;SET A(DEVICE DEPENDANT ROUTINE)
	MOV	DATAB(R0),DARTN	;SET A(DEVICE DEPENDANT ALLOCATION RTN)
	CALL	$SWSTK,2500$	;SWITCH TO SYSTEM STACK
	BITB	#US.MNT,U.STS(R1) ;;;DEVICE MOUNTED?
	BEQ	2400$		  ;;;IF EQ, YES - CONTINUE
	CLR	4(SP)		;;;CLEAR R1 ON STACK
	RETURN			;;;RETURN TO USER STACK
2400$:	INC	@U.VCB(R1)	;;;INCREMENT TRANSACTION COUNT
	RETURN			;;;RETURN TO USER STACK
2500$:	TST	R1		;DEVICE STILL MOUNTED?
	BEQ	2200$		;IF EQ, NO - ERROR
	MOV	DMPUCB,R2	;R2 = A(DUMP DEVICE UCB)
	CLR	R0		;GET R0,R1 = DEVICE SIZE
	BISB	U.CW2(R2),R0
	MOV	U.CW3(R2),R1
	SUB	CRPFSI+2,R1	;GET R0,R1 = STARTING LBN
	SBC	R0
	CALL	@DARTN		;CALL DEVICE DEPENDANT ALLOCATION
	BCC	2600$		;IF CC, DEVICE BIG ENOUGH
	MSGN$S	PFX,3,M008,,,ABORT ;DEVICE TOO SMALL
	JMP	1200$		;FORCE PROMPT
2600$:	MOV	R0,CRPSLB	;SET STARTING LBN
	MOV	R1,CRPSLB+2
	MOV	#CRPARM,R0	;R0 = A(PARM LIST)
	CLR	PCFLG		;CLEAR FLAG
	CALL	$CRFIL		;CREATE THE FILE
	BCC	2800$		;IF CC, FILE WAS CREATED
	MOV	CREMT1(R0),2700$+10 ;INSERT A(MESSAGE) IN PARM LIST
	MOV	CREMT2(R0),R0	;R0 = A(ERROR CODE AREA)
	BEQ	2700$		;IF EQ, NO CODE IN MESSAGE
	CLR	R2		;SUPRESS LEADING ZEROES
	CALL	$CBDSG		;INSERT ERROR CODE
2700$:	MSGN$S	PFX,3,0,,,ABORT	;CREATE ERROR
	MOV	DMPUCB,R0	;R0 = A(DEVICE UCB)
	CALL	RELDEV		;RELEASE THE DEVICE
	JMP	1200$		;FORCE PROMPT
2800$:	BVC	2900$		;IF VC, PLACEMENT OK
	DEC	PCFLG		;SET PLACEMENT FLAG
2900$:	CALL	FORMAT		;FORMAT THE FILE
	MOV	$CRUCB,R0	;R0 = A(OLD DUMP DEVICE)
	CLR	$CRUCB		;DISABLE CRASH DUMP
	CALL	RELDEV		;RELEASE THE DEVICE
	MOV	DMPUCB,R5	;R5 = A(NEW DUMP DEVICE UCB)
	MOV	U.DCB(R5),R4	;R4 = A(DCB)
	MOV	D.NAM(R4),$CRSDV ;PUT DEVICE NAME IN MESSAGE TEXT
	MOV	R5,R0		;R0 = A(UCB)
	SUB	D.UCB(R4),R0	;R0 = UCB OFFSET
	MOV	D.UCBL(R4),R1	;R1 = UCB LENGTH
	CALL	$DIV		;R0 = RELATIVE DEVICE NUMBER
	MOVB	D.UNIT(R4),R1	;R1 = LOWEST UNIT NUMBER
	ADD	R1,R0		;R0 = UNIT NUMBER
	ADD	#60,R0		;ASCII UNIT NUMBER
	MOVB	R0,$CRUNA	;PUT UNIT NUMBER IN MESSAGE TEXT
	MOV	U.SCB(R5),R3	;R3 = A(SCB)
	MOV	S.CSR(R3),R3	;R3 = A(CSR)
	MOV	#$CRDAP,R2	;R2 = A(PROCEDURE TABLE)
	MOV	R3,(R2)+	;A(CSR) TO TABLE
	MOV	CRPALB,R0	;R0 = STARTING LBN (HIGH PART)
	MOV	CRPALB+2,R1	;R1 = STARTING LBN (LOW PART)
	CALL	@DEVRTN		;CALL DEVICE DEPENDANT ROUTINE
	MOV	R5,$CRUCB	;ENABLE CRASH DUMP
	TST	PCFLG		;PLACEMENT OK?
	BEQ	3000$		;IF EQ, YES - GO TELL OPERATOR
	MSGN$S	PFX,1,M013,,,ABORT ;ALLOCATED - NOT AT END
	EXIT$S			;EXIT
3000$:	MSGN$S	PFX,0,M014,,,ABORT ;ALLOCATED
	EXIT$S			;EXIT
	.PAGE
; FORMAT
;
; FUNCTION:	FORMAT THE DUMP FILE. THIS CURRENTLY CONSISTS OF
;		WRITEING A BLOCK OF ALL ZEROES AS THE FIRST BLOCK
;		OF THE FILE.
;
; INPUT:
;
;	CRPALB = LBN OF THE FIRST BLOCK OF THE FILE
;	LUN 2 ASSIGNED TO DEVICE
;
FORMAT:	QIOW$S	#IO.WLB,#2,#24.,,#IOSB,,<#ZERO,#512.,,CRPALB,CRPALB+2>
	CKDSW$S	FORMAT,ABORT	;CHECK DSW STATUS
	CMPB	#IS.SUC,IOSB	;WRITE SUCESSFULL?
	BNE	1000$		;IF NE, NO - I/O ERROR
	RETURN			;RETURN TO CALLER
1000$:	MOV	#M015A,R0	;R0 = A(ERROR CODE AREA)
	MOV	IOSB,R1		;R1 = ERROR CODE
	CLR	R2		;SUPRESS LEADING ZEROES
	CALL	$CBDSG		;INSERT ERROR CODE
	MSGN$S	PFX,1,M015,,,ABORT ;I/O ERROR FORMATTING FILE
	RETURN			;RETURN TO CALLER
	.PAGE
; RELDEV
;
; FUNCTION:	RELEASE A DEVICE AND IF IT IS MARKED FOR DISMOUNT,
;		AND NO ONE ELSE IS USING IT, DISMOUNT IT.
;
; INPUT:
;
;	R0 = A(UCB OF DEVICE TO RELEASE)
;
RELDEV:	TST	R0		;DO WE HAVE A DEVICE?
	BEQ	1000$		;IF EQ, NO - EXIT
	CALL	$SWSTK,1000$	;SWITCH TO SYSTEM STACK
	DEC	@U.VCB(R0)	;;;DECREMENT TRANSACTION COUNT
	BNE	1000$		;;;IF NE, SOMEONE STILL USING IT
	BITB	#US.MDM,U.STS(R0) ;;;IS IT MARKED FOR DISMOUNT
	BEQ	1000$		  ;;;IF EQ, NO - WE'RE THROUGH
	BICB	#US.MDM,U.STS(R0) ;;;RESET MARK FOR DISMOUNT
	MOV	R0,-(SP)	;;;SAVE REGISTERS
	MOV	R1,-(SP)	;;;
	MOV	#84.,R1		;;;R1 = LENGTH OF MCR BUFFER
	CALL	$ALOCB		;;;ALLOCATE A BUFFER
	BCS	1000$		;;;IF CS, BUFFER NOT ALLOCATED
	MOV	R0,-(SP)	;;;SAVE A(BUFFER)
	CLR	(R0)+		;;;CLEAR LINK WORD
	MOV	$TKTCB,R1	;;;R1 = A(MY TCB)
	MOV	T.UCB(R1),(R0)+	;;;INSERT A(TI: UCB)
	MOV	#"DM,(R0)+	;;;FORMAT DMO COMMAND
	MOV	#"O ,(R0)+	;;;
	MOV	R2,-(SP)	;;;SAVE R2
	MOV	6(SP),R1	;;;R1 = A(UCB)
	MOV	U.DCB(R1),R2	;;;R2 = A(DCB)
	MOV	D.NAM(R2),(R0)+	;;;INSERT DEVICE NAME
	SUB	D.UCB(R2),R1	;;;R1 = UCB OFFSET
	MOV	R0,-(SP)	;;;SAVE BUFFER ADDRESS
	MOV	R1,R0		;;;R0 = UCB OFFSET
	MOV	D.UCBL(R2),R1	;;;R1 = UCB LENGTH
	CALL	$DIV		;;;R0 = UNIT NUMBER
	MOV	R0,R1		;;;R1 = UNIT NUMBER
	MOV	(SP)+,R0	;;;R0 = BUFFER POSITION
	CLR	R2		;;;SUPRESS LEADING ZEROES
	CALL	$CBOMG		;;;INSERT UNIT NUMBER
	MOVB	#':,(R0)+	;;;INSERT COLON
	MOVB	#33,(R0)+	;;;INSERT ESC
	MOV	(SP)+,R2	;;;RESTORE R2
	MOV	(SP)+,R1	;;;R1 = A(BUFFER)
	CALL	$QMCRL		;;;INSERT IN MCR QUEUE
	MOV	(SP)+,R1	;;;RESTORE R1
	MOV	(SP)+,R0	;;;RESTORE R0
1000$:	RETURN			;;;RETURN TO CALLER
ABORT:	HALT			;ABORT THE TASK
	.PAGE
; FUNCTION:	SETUP CRASH DUMP FOR DUMP TO AN RK05
;
; INPUT:
;
;	R0 = STARTING LBN (HIGH PART)
;	R1 = STARTING LBN (LOW PART)
;	R2 = A($CRDAP)
;	R3 = A(DUMP DEVICE CSR)
;	R4 = A(DUMP DEVICE DCB)
;	R5 = A(DUMP DEVICE UCB)
;
; OUTPUT:
;
;	CRASH DUMP ROUTINE IS SET UP.
;
DKRTN:	MOV	R3,(R2)+	;A(CSR)
	MOV	#401,(R2)+	;RESET COMMAND
	MOV	R3,(R2)		;A(CSR)
	ADD	#6,(R2)+	;A(DISK ADDRESS REGISTER)
	MOV	R1,R0		;R0 = STARTING LBN
	MOV	#12.,R1		;R1 = DEVISOR
	CALL	$DIV		;GET R0 = SECTOR, R1 = CYL + SURFACE
	ASR	R0		;WHICH SURFACE?
	BCC	1000$		;IF CC, SURFACE 0
	BIS	#20,R1		;SET SURFACE 1
1000$:	SWAB	R0		;PUT CYLINDER IN HIGH BYTE
	MOV	R2,-(SP)	;SAVE R2
	MOVB	U.UNIT(R5),R2	;R2 = PHYSICAL UNIT NUMBER
	ASR	R2		;SHIFT UNIT IN WITH CYLINDER
	ROR 	R0
	ASR	R2
	ROR	R0
	ASR	R2
	ROR	R0
	BIS	R1,R0		;MERGE IN SECTOR AND SURFACE
	MOV	(SP)+,R2	;RESTORE R2
	MOV	R0,(R2)+	;DISK ADDRESS
	CLR	(R2)+		;END OF INITILIZATION PROCEDURE
	MOV	R3,(R2)		;A(CSR)
	ADD	#4,(R2)+	;A(BUS ADDRESS REGISTER)
	MOV	R3,(R2)		;A(CSR)
	ADD	#2,(R2)+	;A(WORD COUNT REGISTER)
	MOV	R3,(R2)		;A(CSR)
	SUB	#2,(R2)+	;A(ERROR REGISTER)
	MOV	#403,(R2)+	;WRITE COMMAND
	MOV	#100200,(R2)+	;ERROR AND READY BITS
	MOV	#100000,(R2)+	;ERROR BITS
	MOV	#2000,(R2)	;NON-EXISTANT MEMORY BIT
	RETURN			;RETURN TO CALLER
	.PAGE
; FUNCTION:	SETUP CRASH DUMP ROUTINE FOR DUMP TO AN RK611
;
; INPUT:
;
;	R0 = STARTING LBN (HIGH PART)
;	R1 = STARTING LBN (LOW PART)
;	R2 = A($CRDAP)
;	R3 = A(DUMP DEVICE CSR)
;	R4 = A(DUMP DEVICE DCB)
;	R5 = A(DUMP DEVICE UCB)
;
; OUTPUT:
;	CRASH DUMP ROUTINE IS SET UP.
;
DMRTN:	MOV	R3,(R2)+	;A(CSR)
	MOV	#100000,(R2)+	;CLEAR COMMAND
	MOV	R3,(R2)		;A(CSR)
	ADD	#10,(R2)+	;A(CSR2)
	MOV	#40,(R2)+	;CLEAR COMMAND
	MOV	R3,(R2)		;A(CSR)
	ADD	#10,(R2)+	;A(CSR2)
	MOVB	U.UNIT(R5),R0	;R0 = PHYSICAL UNIT NUMBER
	MOV	R0,(R2)+	;DRIVE SELECT
	MOV	R3,(R2)		;A(CSR)
	ADD	#20,(R2)+	;A(DESIRED CYLINDER REGISTER)
	MOV	R1,R0		;R0 = STARTING LBN
	MOV	#66.,R1		;R1 = BLOCKS/CYLINDER
	CALL	$DIV		;R0 = CYLINDER
	MOV	R0,(R2)+	;CYLINDER
	MOV	R3,(R2)		;A(CSR)
	ADD	#6,(R2)+	;A(DISK ADDRESS REGISTER)
	MOV	R1,R0		;R0 = TRACKS*SECTORS
	MOV	#22.,R1		;R1 = SECTORS/TRACK
	CALL	$DIV		;GET R0 = TRACK, R1 = SECTOR
	SWAB	R0		;PUT TRACK IN HIGH BYTE
	BIS	R1,R0		;MERGE IN SECTOR
	MOV	R0,(R2)+	;TRACK + SECTOR
	CLR	(R2)+		;END OF INITILIZATION PROCEDURE
	MOV	R3,(R2)		;A(CSR)
	ADD	#4,(R2)+	;A(BUS ADDRESS REGISTER)
	MOV	R3,(R2)		;A(CSR)
	ADD	#2,(R2)+	;A(WORD COUNT REGISTER)
	MOV	R3,(R2)		;A(CSR)
	ADD	#10,(R2)+	;A(ERROR STATUS REGISTER)
	MOV	#23,(R2)+	;WRITE COMMAND
	MOV	#100200,(R2)+	;ERROR AND READY BITS
	MOV	#100000,(R2)+	;ERROR BITS
	MOV	#4000,(R2)+	;NON-EXISTANT MEMORY BIT
	RETURN			;RETURN TO CALLER
	.PAGE
; FUNCTION:	SETUP CRASH DUMP ROUTINE FOR DUMP TO AN RP04
;
; INPUT:
;
;	R0 = STARTING LBN (HIGH PART)
;	R1 = STARTING LBN (LOW PART)
;	R2 = A($CRDAP)
;	R3 = A(DUMP DEVICE CSR)
;	R4 = A(DUMP DEVICE DCB)
;	R5 = A(DUMP DEVICE UCB)
;
; OUTPUT:
;
;	CRASH DUMP ROUTINE IS SET UP.
;
DBRTN:	MOV	R3,(R2)		;A(CSR)
	ADD	#10,(R2)+	;A(CSR2)
	MOV	#40,(R2)+	;CLEAR COMMAND
	MOV	R3,(R2)		;A(CSR)
	ADD	#32,(R2)+	;A(OFFSET REGISTER)
	MOV	#10000,(R2)+	;SELECT FORMAT 22
	MOV	R3,(R2)		;A(CSR)
	ADD	#10,(R2)+	;A(CSR2)
	MOV	R0,-(SP)	;SAVE R0
	MOVB	U.UNIT(R5),R0	;R0 = PHYSICAL UNIT NUMBER
	MOV	R0,(R2)+	;SELECT UNIT
	MOV	(SP)+,R0	;RESTORE R0
	MOV	R3,(R2)		;A(CSR)
	ADD	#34,(R2)+	;A(DESIRED CYLINDER REGISTER)
	MOV	#16.,-(SP)	;LOOP COUNTER
1000$:	ASL	R1		;CALCULATE CYLINDER
	ROL	R0
	CMP	R0,#19.*22.
	BLO	1100$
	SUB	#19.*22.,R0
	INC	R1
1100$:	DEC	(SP)		;FINISHED?
	BGT	1000$		;IF GT, NO - LOOP UNTIL DONE
	TST	(SP)+		;POP STACK
	MOV	R1,(R2)+	;CYLINDER
	MOV	R3,(R2)		;A(CSR)
	ADD	#6,(R2)+	;A(DESIRED TRACK/SECTOR REGISTER)
	MOV	#22.,R1		;R1 = SECTORS / TRACK
	CALL	$DIV		;CALCULATE TRACK AND SECTOR
	SWAB	R0		;TRACK TO HIGH BYTE
	BIS	R1,R0		;MERGE IN SECTOR
	MOV	R0,(R2)+	;TRACK AND SECTOR
	CLR	(R2)+		;END OF INITILIZATION PROCEDURE
	MOV	R3,(R2)		;A(CSR)
	ADD	#4,(R2)+	;A(BUS ADDRESS REGISTER)
	MOV	R3,(R2)		;A(CSR)
	ADD	#2,(R2)+	;A(WORD COUNT REGISTER)
	MOV	R3,(R2)		;A(CSR)
	ADD	#10,(R2)+	;A(ERROR REGISTER)
	MOV	#61,(R2)+	;WRITE COMMAND
	MOV	#060200,(R2)+	;ERROR OR READY BITS
	MOV	#060000,(R2)+	;ERROR BITS
	MOV	#4000,(R2)	;NON-EXISTANT MEMORY BIT
	RETURN			;RETURN TO CALLER
	.PAGE
; FUNCTION:	ADJUST ALLOCATION PARAMETERS FOR RK05, AND RP04.
;
; INPUT:
;
;	R0,R1 = DEVICE SIZE - FILE SIZE
;
; OUTPUT:
;
;	IF CC - DEVICE BIG ENOUGH
;		R0,R1 = STARTING LBN
;
;	IF CS - DEVICE TOO SMALL
;
DBARTN:
DKARTN:	SUB	#1,R1		;ADJUST STARTING LBN
	SBC	R0
	BPL	1000$		;IF PL, DEVICE BIG ENOUGH
	SEC			;INDICATE DEVICE TOO SMALL
	RETURN			;RETURN TO CALLER
1000$:	CLC			;INDICATE DEVICE BIG ENOUGH
	RETURN			;RETURN TO CALLER
	.PAGE
; FUNCTION:	DEVICE DEPENDANT ALLOCATION FOR RK06
;
; INPUT:
;
;	R0,R1 = DEVICE SIZE - FILE SIZE
;
; OUTPUT:
;
;	IF CC - DEVICE BIG ENOUGH
;		R0,R1 = STARTING LBN
;
;	IF CS - DEVICE TOO SMALL
;
DMARTN:	SUB	#26,R1		;ADJUST FOR BAD BLOCK FILE
	SBC	R0
	BPL	1000$		;IF PL, DEVICE BIG ENOUGH
	SEC			;INDICATE DEVICE TOO SMALL
	RETURN			;RETURN TO CALLER
1000$:	CLC			;INDICATE DEVICE BIG ENOUGH
	RETURN			;RETURN TO CALLER
	.END	ADS