.TITLE	CQR
	.IDENT	/V1.3/

;*******************************************************************
;
; CQR.TSK	CRASH QUEUE RESTORE PROGRAM
;
;		THIS PROGRAM IS RUN AFTER A SYSTEM CRASH TO RESTORE
;		THE STATE OF THE BATCH SYSTEM QUEUE FROM THE DUMP
;		ON THE CRASH DUMP DEVICE.
;		IT CAN ONLY BE USED IF SUPPORT FOR CRASH DUMPS WAS
;		INCLUDED AT SYSGEN.
;		THIS PROGRAM CANNOT BE USED IF A SYSGEN HAS BEEN
;		PERFORMED BETWEEN THE TIME THAT THE CRASH DUMP WAS
;		TAKEN AND WHEN THIS PROGRAM IS RUN.
;	*** IF THE CRASH WAS TAKEN FROM ONE SYSTEM AND YOU WISH TO
;	RESTORE THE QUEUE USING CQR ON A DIFFERENT SYSTEM, YOU CAN
;	DO THIS BY MAKING CERTAIN CHANGES IN THE TASK BUILDER COMMAND
;	FILE FOR CQR AND THEN REBUILDING THE TASK. SEE THE TASK
;	BUILDER COMMAND FILE FOR INSTRUCTIONS.
;
;	S.M. THOMPSON, FEBRUARY 1980
;
;*******************************************************************

	.MCALL	SPWN$,DIR$,EXST$,QIOW$,QUEDF$,QIOW$S,EXST$S
	.MCALL	STSE$S

	QUEDF$		; DEFINE JOB PACKET OFFSETS

CR	=	15	; CARRIAGE RETURN
SPA	=	40	; SPACE

BATEFN	=	3	; EVENT FLAG FOR SPAWN WAIT
TIOEFN	=	1	; EVENT FLAG FOR TI: I/O
TAPEFN	=	2	; EVENT FLAG FOR TAPE READS
TIOLUN	=	1	; TI: LOGICAL UNIT NUMBER
TAPLUN	=	2	; CRASH DUMP DEVICE LUN

TKPS	=	60.	; TICKS PER SECOND

;
; MACROS
;

	.MACRO	PRINT$	MSG,MSGSZ
	MOV	MSG,TERMIO+Q.IOPL
	MOV	MSGSZ,TERMIO+Q.IOPL+2
	DIR$	#TERMIO
	.ENDM

;
; FORMAT OF THE FOLLOWING STORAGE ALLOCATIONS MUST BE THE SAME
; AS DEFINED BY THE QUEDF$ MACRO
;

LNK:	.BLKW	1		; STORAGE FOR LINK WORD
UCB:	.BLKW	1		; UCB ADDRESS OF BATCH STREAM
JOBN:	.BLKW	1		; JOB NUMBER
LUIC:	.BLKW	1		; LOGON UIC
DUIC:	.BLKW	1		; COMMAND FILE DIRECTORY
MASK:	.BLKW	1		; JOB MASK WORD
DEVN:	.BLKW	1		; ASCII JOB FILE DEVICE NAME
DEVU:	.BLKW	1		; BINARY JOB FILE DEVICE NUMBER
FNAM:	.BLKW	3		; RADIX 50 JOB FILE NAME
FTYP:	.BLKW	1		; RADIX 50 JOB FILE TYPE
FVER:	.BLKW	1		; BINARY JOB FILE VERSION NUMBER
PSWD:	.BLKW	3		; ASCII PASSWORD
TIME:	.BLKW	2		; TIME LIMIT (FORMAT DEPENDS ON JOB
				; STATUS)
HOLD:	.BLKW	2		; HOLD TIME
PARM:	.BLKW	2		; PARAMETER PACKETS LISTHEAD
LINE:	.BLKW	1		; CURRENT OUTPUT COUNT
MXLN:	.BLKW	1		; MAXIMUM ALLOWED OUTPUT COUNT

;
; THE FOLLOWING BIT DEFINITIONS MUST BE THE SAME AS THOSE IN THE
; SOURCE LISTING FOR BAT.TSK
;

EXMASK	=	20	; /EX
TRMASK	=	40	; /TR
DEMASK	=	100	; /DE
HFMASK	=	200	; /HF
HUMASK	=	400	; /HU
LNMASK	=	1000	; /LN
RSMASK	=	2000	; /RS
KEMASK	=	4000	; /KE
NOMASK	=	10000	; /NO

MRKEXE	=	40000	; JOB IN EXECUTION
MRKABO	=	100000	; JOB MARKED FOR ABORT

SPWN:	SPWN$	MCR...,,,1,54,BATEFN,,,CMD0,3,0

TERMIO:	QIOW$	IO.WVB,TIOLUN,TIOEFN,,,,<0,0,40>
RDTAPE:	QIOW$	IO.RLB,TAPLUN,TAPEFN,,IOSB,,<$BLK,512.>
SPTAPE:	QIOW$	IO.SPB,TAPLUN,TAPEFN,,IOSB,,<0>
BLOCK:	.WORD	0		; CURRENT TAPE POSITION
SKIPJ:	.WORD	0		; NO. EXECUTING JOBS NOT RESUBMITTED
IOSB:	.BLKW	2		; I/O STATUS BLOCK
$BLK:	.BLKB	512.		; TAPE INPUT BUFFER

;
; TEXT MESSAGES
;

	.NLIST	BEX
	.ENABL	LC

SPE:	.ASCII	/CQR -- Spawn error/
SPESZ=.-SPE

CURJ:	.ASCII	/CQR -- Scanning executing jobs.../
CURJSZ=.-CURJ
EXPR:	.ASCII	/CQR -- Scanning express queue.../
EXPRSZ=.-EXPR
NORM:	.ASCII	/CQR -- Scanning normal queue.../
NORMSZ=.-NORM
HLDQ:	.ASCII	/CQR -- Scanning hold queue.../
HLDQSZ=.-HLDQ
IOERR:	.ASCII	%CQR -- I/O error on crash dump device - IOSB = %
IOERR1:	.BLKB	30.
ATT:	.ASCII	/CQR -- Attach failure/
ATTSZ=.-ATT
RWD:	.ASCII	/CQR -- Can't rewind tape - /
RWDSZ=.-RWD
NUMBR:	.ASCII	/CQR -- Number of jobs in queue at time of crash = /
NUMBR1:	.ASCII	/0000/
NSKIP:	.ASCII	/CQR -- Number of executing jobs not resubmitted = /
NSKIP1:	.ASCII	/0000/
NXJX:	.ASCII	/CQR -- /
CQRSZ=.-NXJX
NXJ:	.ASCII	%BAT /NEXTJOB:%
NXJ1:	.ASCII	/0000000/
SETX:	.ASCII	/CQR -- /
SET0:	.ASCII	%SET /UIC=%
SET1:	.ASCII	/[GGG,MMM]/
CMDX:	.ASCII	/CQR -- /
CMD0:	.ASCII	/BAT /
CMD1:	.BLKB	<80.+CMD0-.>

	.EVEN

EXST:	EXST$	EX$SUC	; EXIT WITH STATUS DPB

$CQREP:	QIOW$S	#IO.ATT,#TAPLUN,#TAPEFN	; ATTACH CRASH DUMP DEVICE
	BCC	10$		; OK
	PRINT$	#ATT,#ATTSZ	; ATTACH FAILURE
	EXST$S	#EX$SEV		; EXIT WITH SEVERE ERROR
10$:	QIOW$S	#IO.RWD,#TAPLUN,#TAPEFN ; MAKE SURE IT'S REWOUND
	BCC	11$		; OK
	PRINT$	#RWD,#RWDSZ	; REWIND FAILED
	JMP	$IOERR		; BLEW IT
11$:	MOV	#$NUMQ,R0	; GET ADDRESS OF QUEUE SIZE WORD
	CALL	$GWORD		; FIND OUT HOW BIG THE QUEUE WAS
	MOV	R5,R1		; COPY QUEUE SIZE TO R1
	MOV	#NUMBR1,R0	; GET BUFFER ADDRESS OF MESSAGE
	CALL	$DECML		; FORMAT AS DECIMAL
	SUB	#NUMBR,R0	; CALCULATE MESSAGE SIZE
	PRINT$	#NUMBR,R0	; AND TYPE IT OUT
	TST	R5		; WERE THERE ANY JOBS IN THE QUEUE?
	BNE	20$		; IF NE YES
	DIR$	#EXST		; NO JOBS, EXIT WITH SUCCESS
20$:	MOV	#$JOBN,R0	; GET ADDRESS OF LOCATION FOR JOB NUMBER
	CALL	$GWORD		; GET ITS CONTENTS
	ADD	#100,R5		; BUMP IT UP A BIT
	MOV	#NXJ1,R0	; GET BUFFER ADDRESS FOR THIS MESSAGE
	MOV	R5,R1		; GET NEW JOB NUMBER
	CALL	$OCTAL		; FORMAT AS OCTAL
	SUB	#NXJ,R0		; CALCULATE COMMAND LENGTH
	MOV	#SPWN,R4	; GET SPAWN DPB ADDRESS
	MOV	R0,S.PWCL(R4)	; SET COMMAND LENGTH
	MOV	#NXJ,S.PWCA(R4)	; AND ADDRESS
	ADD	#CQRSZ,R0	; INCLUDE LEADING CHARACTER COUNT
	PRINT$	#NXJX,R0	; TYPE IT ALL OUT
	DIR$	R4		; SPAWN IT
	BCC	21$		; OK
	PRINT$	#SPE,#SPESZ	; SPAWN ERROR
	BR	22$		; KEEP GOING
21$:	STSE$S	#BATEFN		; WAIT FOR IT
22$:	MOV	#$CURJ,R0	; GET ADDRESS OF EXECUTING JOBS LISTHEAD
	PRINT$	#CURJ,#CURJSZ	; TELL USER WHAT WE ARE DOING
	CALL	$RQUE		; RESUBMIT THOSE JOBS
	MOV	SKIPJ,R1	; GET NUMBER OF JOBS NOT RESUBMITTED
	BEQ	30$		; IF EQ DON'T SEND A MESSAGE
	MOV	#NSKIP1,R0	; GET BUFFER ADDRESS
	CALL	$DECML		; FORMAT AS DECIMAL
	SUB	#NSKIP,R0	; CALCULATE MESSAGE LENGTH
	PRINT$	#NSKIP,R0	; TYPE IT OUT
30$:	MOV	#$EXPRQ,R0	; REPEAT FOR EXPRESS QUEUE
	PRINT$	#EXPR,#EXPRSZ	;
	CALL	$RQUE		;
	MOV	#$QUEHD,R0	; REPEAT FOR NORMAL JOBS
	PRINT$	#NORM,#NORMSZ	;
	CALL	$RQUE		;
	MOV	#$HOLDQ,R0	; REPEAT FOR HOLD QUEUE
	PRINT$	#HLDQ,#HLDQSZ	;
	CALL	$RQUE		;
	DIR$	#EXST		; OK, EXIT WITH SUCCESS

	.SBTTL	JOB RESUBMISSION ROUTINE
;+
; *** $RSJOB
;
;	THIS ROUTINE IS CALLED TO CONSTRUCT A BAT COMMAND
;	TO RESUBMIT A JOB TO THE BATCH SYSTEM.
;
;	INPUTS:
;		R0	ADDRESS OF JOB DESCRIPTION PACKET
;
;	OUTPUTS:
;		ALL REGISTERS CHANGED
;
;-
$RSJOB:	CALL	$GWORD		; GET CONTENTS OF LINK WORD
	MOV	R5,LNK		; SAVE IT
	ADD	#2,R0		; POINT R0 TO UCB ADDRESS
	CALL	$GWORD		; GET CONTENTS OF THIS WORD
	MOV	R5,UCB		; SAVE THE RESULT
	ADD	#2,R0		; REPEAT FOR JOB NUMBER...
	CALL	$GWORD		;
	MOV	R5,JOBN		;
	ADD	#2,R0		; REPEAT FOR LOGON UIC
	CALL	$GWORD		;
	MOV	R5,LUIC		;
	ADD	#2,R0		; REPEAT FOR DIRECTORY
	CALL	$GWORD		;
	MOV	R5,DUIC		;
	ADD	#2,R0		; REPEAT FOR MASK WORD
	CALL	$GWORD		;
	MOV	R5,MASK		;
	ADD	#2,R0		; REPEAT FOR DEVICE NAME
	CALL	$GWORD		;
	MOV	R5,DEVN		;
	ADD	#2,R0		; REPEAT FOR UNIT NUMBER
	CALL	$GWORD		;
	MOV	R5,DEVU		;
	ADD	#2,R0		; FILENAME, PART 1
	CALL	$GWORD		;
	MOV	R5,FNAM		;
	ADD	#2,R0		; FILENAME, PART 2
	CALL	$GWORD		;
	MOV	R5,FNAM+2	;
	ADD	#2,R0		; FILENAME, PART 3
	CALL	$GWORD		;
	MOV	R5,FNAM+4	;
	ADD	#2,R0		; FILETYPE
	CALL	$GWORD		;
	MOV	R5,FTYP		;
	ADD	#2,R0		; VERSION NUMBER
	CALL	$GWORD		;
	MOV	R5,FVER		;
	ADD	#2,R0		; PASSWORD, CHARS. 1 AND 2
	CALL	$GWORD		;
	MOV	R5,PSWD		;
	ADD	#2,R0		; PASSWORD, CHARS. 3 AND 4
	CALL	$GWORD		;
	MOV	R5,PSWD+2	;
	ADD	#2,R0		; PASSWORD, CHARS. 5 AND 6
	CALL	$GWORD		;
	MOV	R5,PSWD+4	;
	ADD	#2,R0		; JOB TIME, HIGH ORDER
	CALL	$GWORD		;
	MOV	R5,TIME		;
	ADD	#2,R0		; JOB TIME, LOW ORDER
	CALL	$GWORD		;
	MOV	R5,TIME+2	;
	ADD	#2,R0		; HOLD TIME, HIGH ORDER
	CALL	$GWORD		;
	MOV	R5,HOLD		;
	ADD	#2,R0		; HOLD TIME, LOW ORDER
	CALL	$GWORD		;
	MOV	R5,HOLD+2	;
	ADD	#2,R0		; PARAMETER LISTHEAD, WORD 1
	CALL	$GWORD		;
	MOV	R5,PARM		;
	ADD	#2,R0		; PARAMETER LISTHEAD, WORD 2
	CALL	$GWORD		;
	MOV	R5,PARM+2	;
	ADD	#2,R0		; LINE COUNT
	CALL	$GWORD		;
	MOV	R5,LINE		;
	ADD	#2,R0		; MAXIMUM LINE COUNT
	CALL	$GWORD		;
	MOV	R5,MXLN		;
	INC	SKIPJ		; ASSUME WE WON'T RESUBMIT THIS JOB
	BIT	#MRKABO,MASK	; WAS JOB MARKED FOR ABORT?
	BEQ	5$		; NO
4$:	JMP	RSJOBR		; YES, FORGET IT
5$:	BIT	#MRKEXE,MASK	; WAS IT EXECUTING?
	BEQ	10$		; NO, ALWAYS RESTORE IT
	BIT	#RSMASK,MASK	; YES, WAS IT RESTARTABLE?
	BEQ	4$		; NO
	TST	TIME		; YES, TIME TO GO LESS THAN 18.2 MINS?
	BLE	4$		; YES, DON'T RESUBMIT IT
	DEC	SKIPJ		; OK, THIS ONE GOES BACK IN
	BIS	#EXMASK,MASK	; SET IT EXPRESS IF NOT ALREADY
10$:	MOV	#SET1,R0	; GET BUFFER ADDRESS FOR UIC
	MOV	LUIC,R3		; GET UIC TO SET
	CALL	$FUIC		; FORMAT IT
	SUB	#SET0,R0	; CALCULATE COMMAND LENGTH
	MOV	#SPWN,R4	; GET SPAWN DPB ADDRESS
	MOV	R0,S.PWCL(R4)	; SET UP COMMAND PARAMETERS
	MOV	#SET0,S.PWCA(R4) ;
	ADD	#CQRSZ,R0	; UPDATE BYTE COUNT
	PRINT$	#SETX,R0	; TYPE OUT COMMAND
	MOV	#454,S.PWUM(R4) ; SET SYSTEM UIC
	DIR$	R4		; SET THE UIC
	BCC	15$		; OK
	PRINT$	#SPE,#SPESZ	; SPAWN ERROR
	BR	16$		;
15$:	STSE$S	#BATEFN		; WAIT FOR SET
16$:	MOV	#CMD1,R0	; GET COMMAND BUFFER ADDRESS
;
; INSERT DEVICE NAME
;
	MOVB	DEVN,(R0)+	; INSERT FIRST BYTE OF DEVICE NAME
	MOVB	DEVN+1,(R0)+	; AND SECOND BYTE
	MOV	DEVU,R1		; GET UNIT NUMBER
	CALL	$OCTAL		; FORMAT AS OCTAL
	MOVB	#':,(R0)+	; INSERT DEVICE/UFD SEPARATOR
;
; INSERT DIRECTORY
;
	MOV	DUIC,R3		; GET DIRECTORY UIC
	CALL	$FUIC		; FORMAT IT AS [G,M]
;
; INSERT FILENAME, FILETYPE AND VERSION NUMBER
;
	MOV	#FNAM,R5	; POINT R5 TO FILENAME STRING
	CALL	$RAD50		; CONVERT TO ASCII, CHARS. 1-3
	CALL	$RAD50		; CHARS. 4-6
	CALL	$RAD50		; CHARS. 7-9
	MOVB	#'.,(R0)+	; NAME/TYPE SEPARATOR
	CALL	$RAD50		; CONVERT FILETYPE TO ASCII
	MOVB	#';,(R0)+	; TYPE/VERSION SEPARATOR
	MOV	(R5),R1		; GET VERSION NUMBER
	CALL	$OCTAL		; FORMAT IT AS OCTAL
;
; INSERT PASSWORD SWITCH
;
	MOVB	#'/,(R0)+	; INSERT /PA:
	MOVB	#'P,(R0)+	;
	MOVB	#'A,(R0)+	;
	MOVB	#':,(R0)+	;
	MOV	#PSWD,R1	; POINT R1 TO PASSWORD
	MOV	#6,R2		; SET MAXIMUM BYTES TO MOVE
40$:	MOVB	(R1)+,(R0)+	; MOVE A BYTE
	BEQ	45$		; IF EQ, END OF PASSWORD
	DEC	R2		; ANY MORE BYTES TO MOVE?
	BNE	40$		; YES, DO IT
	BR	50$		; GO INSERT TIME LIMIT
45$:	DEC	R0		; REMOVE NULL BYTE
50$:				; REF. LABEL
;
; INSERT TIME LIMIT
;
	MOVB	#'/,(R0)+	; INSERT /TL SWITCH
	MOVB	#'T,(R0)+	;
	MOVB	#'L,(R0)+	;
	MOVB	#':,(R0)+	;
	BIT	#MRKEXE,MASK	; WAS JOB EXECUTING?
	BEQ	60$		; NO
	MOV	#TIME,R1	; YES, POINT R1 TO TIME
	CALL	$TFRMT		; AND FORMAT IT (MINUTES)
	BR	70$		; CONTINUE
60$:	MOV	TIME+2,R1	; GET TIME LIMIT IN MINUTES
	CALL	$DECML		; FORMAT AS DECIMAL
70$:				; REF. LABEL
;
; INSERT HOLD TIME
;
	BIT	#HFMASK!HUMASK,MASK ; WAS JOB IN HOLD?
	BEQ	80$		; NO
	MOVB	#'/,(R0)+	; INSERT /HF:
	MOVB	#'H,(R0)+	;
	MOVB	#'F,(R0)+	;
	MOVB	#':,(R0)+	;
	MOV	#HOLD,R1	; POINT R1 TO HOLD TIME
	CALL	$TFRMT		; FORMAT IT IN MINUTES
80$:				; REF. LABEL
;
; EXPRESS JOB
;
	BIT	#EXMASK,MASK	; EXPRESS JOB?
	BEQ	90$		; IF EQ NO
	MOVB	#'/,(R0)+	; INSERT /EX
	MOVB	#'E,(R0)+	;
	MOVB	#'X,(R0)+	;
90$:				; REF. LABEL
;
; DELETE COMMAND FILE AT END OF JOB
;
	BIT	#DEMASK,MASK	; WAS /DE SPECIFIED?
	BEQ	100$		; NO
	MOVB	#'/,(R0)+	; YES, INSERT /DE
	MOVB	#'D,(R0)+	;
	MOVB	#'E,(R0)+	;
100$:				; REF. LABEL
;
; TRACE COMMAND FILE EXECUTION
;
	BIT	#TRMASK,MASK	; WAS /TR SPECIFIED?
	BEQ	110$		; NO
	MOVB	#'/,(R0)+	; YES, INSERT /TR
	MOVB	#'T,(R0)+	;
	MOVB	#'R,(R0)+	;
110$:				; REF. LABEL
;
; RESTARTABLE JOBS
;
	BIT	#RSMASK,MASK	; WAS JOB RESTARTABLE?
	BEQ	120$		; IF EQ NO
	MOVB	#'/,(R0)+	; IF YES, INSERT /RS
	MOVB	#'R,(R0)+	;
	MOVB	#'S,(R0)+	;
120$:				; REF. LABEL
;
; LOG FILE DISPOSITION
;
	BIT	#KEMASK,MASK	; WAS /KE SPECIFIED?
	BEQ	130$		; IF EQ NO
	MOVB	#'/,(R0)+	; INSERT /KE
	MOVB	#'K,(R0)+	;
	MOVB	#'E,(R0)+	;
130$:	BIT	#NOMASK,MASK	; HOW ABOUT /NO
	BEQ	140$		; NO (/NO?)
	MOVB	#'/,(R0)+	; THIS IS GETTING BORING
	MOVB	#'N,(R0)+	;
	MOVB	#'O,(R0)+	;
140$:				; YAWN
;
; NOW THE DIFFICULT BIT (PARAMETER LISTS)
;
	TST	PARM		; ANY PARAMETERS?
	BEQ	180$		; NO IF EQ
	MOVB	#'/,(R0)+	; INSERT /PM:
	MOVB	#'P,(R0)+	;
	MOVB	#'M,(R0)+	;
	MOVB	#':,(R0)+	;
	MOV	R0,R4		; COPY BUFFER POINTER TO R4
	MOV	PARM,R0		; ADDRESS OF FIRST PARAMETER GOES IN R0
150$:	CALL	$GWORD		; GET LINK WORD CONTENTS
	MOV	R5,R3		; SAVE IT
	ADD	#4,R0		; POINT TO ACTUAL PARAMETER STRING
160$:	CALL	$GBYTE		; GET THE FIRST BYTE
	MOVB	R5,(R4)+	; PUT IT IN THE BUFFER
	BEQ	170$		; IF EQ END OF PARAMETER
	INC	R0		; INCREMENT NEXT BYTE ADDRESS
	BR	160$		; AND GET IT
170$:	DEC	R4		; REMOVE NULL BYTE FROM BUFFER
	MOVB	#':,(R4)+	; ASSUME MORE PARAMETERS TO COME
	MOV	R3,R0		; GET ADDRESS OF NEXT PARAMETER
	BNE	150$		; IF NE THERE IS ONE
	DEC	R4		; NO MORE, SO REMOVE LAST COLON
	MOV	R4,R0		; COPY POINTER BACK TO R0
180$:				;
;
; OUTPUT LIMITS
;
	BIT	#LNMASK,MASK	; /LN SPECIFIED?
	BEQ	190$		; NO
	MOVB	#'/,(R0)+	; YES, INSERT /LN:
	MOVB	#'L,(R0)+	;
	MOVB	#'N,(R0)+	;
	MOVB	#':,(R0)+	;
	MOV	MXLN,R1		; GET LINE COUNT
	CALL	$DECML		; FORMAT AS DECIMAL
190$:	MOVB	#33,(R0)+	; FINISH WITH A ESCAPE
;
; SPAWN BAT TO SUBMIT THE JOB
;
	SUB	#CMD0,R0	; CALCULATE COMMAND LINE LENGTH
	MOV	#SPWN,R4	; GET SPAWN DPB ADDRESS
	MOV	R0,S.PWCL(R4)	; SET UP COMMAND LINE LENGTH
	MOV	#CMD0,S.PWCA(R4) ; AND ADDRESS
	MOVB	LUIC+1,S.PWUG(R4) ; SET GROUP CODE FOR SPAWN
	MOVB	LUIC,S.PWUM(R4)	; AND MEMBER CODE
	ADD	#CQRSZ,R0	; UPDATE COMMAND LENGTH
	PRINT$	#CMDX,R0	; AND TYPE IT OUT
	DIR$	R4		; RESUBMIT THIS JOB
	BCC	200$		; OK
	PRINT$	#SPE,#SPESZ	;
	BR	RSJOBR		;
200$:	STSE$S	#BATEFN		;
RSJOBR:	RETURN			; AND RETURN TO CALLER

	.SBTTL	BLOCK READ ROUTINE
;+
; *** $GTBLK
;
;	THIS ROUTINE READS A SPECIFIED LOGICAL BLOCK FROM THE
;	CRASH DUMP DEVICE. IF IT IS ALREADY IN CORE, NO ACTION
;	IS PERFORMED.
;
;	** THIS ROUTINE USES REWIND WITH MULTIPLE READS WHICH IS PROBABLY
;	THE WORST POSSIBLE WAY OF DOING THIS. YOU SHOULD REWRITE THIS
;	ROUTINE TO USE THE IO.SPB FUNCTION.
;
;	INPUT:
;		R1	LOGICAL BLOCK NUMBER
;			THIS IS THE LOW ORDER PART; SINCE WE ARE
;			INTERESTED IN THE EXEC. ONLY, THE HIGH
;			ORDER IS ALWAYS ZERO.
;
;	OUTPUT:
;		ALL REGISTERS PRESERVED
;		IF AN I/O ERROR OCCURS, AN IMMEDIATE JUMP IS MADE
;		TO THE ERROR REPORTING ROUTINE, WHICH TERMINATES
;		THE PROGRAM
;
;-
$GTBLK:	CMP	R1,BLOCK	; BLOCK ALREADY IN CORE?
	BEQ	GTBLKR		; YES, JUST RETURN
	MOV	R1,BLOCK	; SET UP NEW POSITION
	QIOW$S	#IO.RWD,#TAPLUN,#TAPEFN ; REWIND THE TAPE
	BCS	10$		; ERROR
5$:	DIR$	#RDTAPE		; READ IN THE BLOCK
	BCC	15$		; OK
10$:	JMP	$IOERR		; JUMP STRAIGHT TO ERROR ROUTINE
15$:	DEC	R1		; THIS BLOCK?
	BNE	5$		; NO, READ ANOTHER
	MOV	BLOCK,R1	; RESTORE BLOCK NUMBER
GTBLKR:	RETURN			; RETURN TO CALLER

	.SBTTL	QUEUE RESTORE ROUTINE
;+
; *** $RQUE
;
;	THIS ROUTINE SCANS THE IMAGE OF A JOB QUEUE ON THE
;	CRASH DUMP DEVICE AND CALLS ROUTINES NECESSARY TO
;	RESTORE THE QUEUE TO THE CURRENT SYSTEM IMAGE IN CORE.
;
;	INPUTS:
;		R0	ADDRESS OF QUEUE LISTHEAD
;
;	OUTPUTS:
;		ALL REGISTERS PRESERVED
;
;-
$RQUE:	CALL	$SAVAL		; CALL CO-ROUTINE TO PRESERVE ALL REGISTERS
	CALL	$GWORD		; GET CONTENTS OF FIRST LISTHEAD WORD
	TST	R5		; ANY JOBS IN THIS QUEUE?
	BEQ	RQUER		; NO, JUST RETURN
	MOV	R5,R0		; COPY ADDRESS OF NEXT JOB PACKET TO R0
10$:	CALL	$RSJOB		; RESUBMIT THE JOB
	MOV	LNK,R0		; GET LINK TO NEXT JOB IN LIST
	BNE	10$		; IF NE THERE ARE MORE
RQUER:	RETURN			; RETURN TO CALLER

	.SBTTL	ROUTINE TO GET A WORD FROM CRASH DEVICE
;+
; *** $GWORD
;
;	THIS ROUTINE RETURNS THE CONTENTS OF A SPECIFIED WORD FROM
;	THE EXECUTIVE REGION ON THE CRASH DUMP DEVICE
;
;	INPUT:
;		R0	ADDRESS OF DESIRED WORD (EVEN)
;
;	OUTPUT:
;		R5	CONTENTS OF WORD
;		ALL OTHER REGISTERS PRESERVED
;
;-
$GWORD:	MOV	R0,-(SP)	; SAVE R0
	CALL	$BLOCK		; CALCULATE OFFSET AND GET THE RIGHT BLOCK
				; INTO CORE
	MOV	$BLK(R0),R5	; GET CONTENTS OF WORD
	MOV	(SP)+,R0	; RESTORE R0
	RETURN			; AND RETURN

	.SBTTL	ROUTINE TO GET A BYTE FROM THE CRASH DEVICE
;+
; *** $GBYTE
;
;	THIS ROUTINE RETURNS THE CONTENTS OF A SPECIFIED BYTE FROM
;	THE EXECUTIVE REGION ON THE CRASH DUMP DEVICE
;
;	INPUT:
;		R0	ADDRESS OF DESIRED BYTE (ODD OR EVEN)
;
;	OUTPUT:
;		R5	CONTENTS OF BYTE IN LOW 8 BITS
;		ALL OTHER REGISTERS PRESERVED
;
;-
$GBYTE:	MOV	R0,-(SP)	; SAVE R0
	CALL	$BLOCK		; CALCULATE OFFSET AND GET THE RIGHT BLOCK
				; INTO CORE
	MOVB	$BLK(R0),R5	; GET CONTENTS OF BYTE
	MOV	(SP)+,R0	; RESTORE R0
	RETURN			; RETURN TO CALLER

	.SBTTL	BLOCK OFFSET/READ ROUTINE
;+
; *** $BLOCK
;
;	THIS ROUTINE CALCULATES WHICH BLOCK ON THE CRASH DUMP
;	DEVICE CONTAINS THE WORD OR BYTE DESIRED. THE BLOCK
;	IS READ INTO CORE (IF NOT THERE ALREADY) AND RETURNS
;	THE OFFSET WITHIN THIS BLOCK WHERE THE DESIRED LOCATION
;	LIES.
;
;	INPUT:
;		R0	ADDRESS OF LOCATION
;
;	OUTPUT:
;		R0	OFFSET WITHIN CORE BLOCK AT WHICH LOCATION
;			NOW LIES
;		OTHER REGISTERS PRESERVED
;
;-
$BLOCK:	MOV	R1,-(SP)	; SAVE R1
	MOV	R2,-(SP)	; SAVE R2
	MOV	R0,R1		; COPY ADDRESS TO R1
	CLRB	R1		; DIVIDE BY...
	SWAB	R1		;	...256.
	ASR	R1		; MAKE IT LOCATION/512.
	MOV	R1,R2		; COPY RESULT (RELATIVE BLOCK NUMBER) TO R2
	SWAB	R2		; MULTIPLY BY...
	ASL	R2		;	...512.
	SUB	R2,R0		; CALCULATE OFFSET WITHIN BLOCK
	INC	R1		; CALCULATE LOGICAL BLOCK NUMBER
	CALL	$GTBLK		; LOAD THIS BLOCK INTO CORE
	MOV	(SP)+,R2	; RESTORE R2
	MOV	(SP)+,R1	; RESTORE R1
	RETURN			; AND RETURN TO CALLER

	.SBTTL	I/O ERROR ROUTINE
;+
; *** $IOERR
;
;	THIS ROUTINE IS CALLED WHEN AN I/O ERROR OCCURS.
;	IT TYPES OUT THE I/O STATUS BLOCK AND CAUSES THE
;	PROGRAM TO TERMINATE.
;
;-
$IOERR:	MOV	#IOERR1,R0	; GET BUFFER ADDRESS FOR STATUS
	MOV	IOSB,R1		; GET FIRST STATUS WORD
	CALL	$OCTAL		; FORMAT IT
	MOVB	#SPA,(R0)+	; INSERT A SPACE
	MOVB	#'(,(R0)+	; AND (
	MOVB	IOSB,R1		; GET FCS CODE
	CLR	R2		; NO LEADING ZEROES
	CALL	$CBDSG		; CONVERT TO SIGNED DECIMAL
	MOVB	#'.,(R0)+	; INSERT ".) "
	MOVB	#'),(R0)+	;
	MOVB	#SPA,(R0)+	;
	MOV	IOSB+2,R1	; GET SECOND STATUS WORD
	CALL	$OCTAL		; FORMAT IT
	SUB	#IOERR,R0	; CALCULATE MESSAGE LENGTH
	PRINT$	#IOERR,R0	; TYPE IT OUT
	EXST$S	#EX$SEV		; THEN EXIT

	.SBTTL	TIME FORMAT ROUTINE
;+
; *** $TFRMT
;
;	THIS ROUTINE CONVERTS A TIME IN BINARY TICKS TO
;	ASCII MINUTES FOR JOB RESUBMISSION.
;
;	INPUTS:
;		R0	BUFFER POINTER
;		R1	POINTER TO BINARY TIME
;
;	OUTPUTS:
;		R0	UPDATED
;		R1,R2	USED
;
;-
$TFRMT:	MOV	R0,-(SP)	; SAVE R0
	MOV	2(R1),R2	; GET LOW ORDER TIME
	MOV	(R1),R1		; AND HIGH ORDER
	MOV	#<60.*TKPS>,R0	; GET NUMBER OF TICKS PER MINUTE
	CALL	$DDIV		; FIND TIME IN MINUTES
	TST	R2		; WAS IT ZERO?
	BNE	10$		; NO
	INC	R2		; YES, MAKE IT ONE
10$:	MOV	(SP)+,R0	; RESTORE BUFFER POINTER
	MOV	R2,R1		; COPY RESULT TO R1
	BNE	15$		; IF NON-ZERO OK
	INC	R1		; ELSE MAKE SURE ITS AL LEAST 1
15$:	CALLR	$DECML		; AND FORMAT IT

	.END	$CQREP