.TITLE	CLISUB
	.IDENT	/V3.00/
	.NLIST	BEX
	.ENABL	LC

;***********************************************************************
;
;	CLISUB.PAT
;
;	This patch file implements processing specific to the Cornell
;	University/Chemical Engineering Batch System (version 3) for
;	RSX-11M V4.0 or V4.1.
;
;	This patch is applied to object module CLISUB.OBJ extracted from
;	the library file QMGCLI.OLB on the distribution disk.
;	Its function is to send a MODIFY command to the Queue Manager
;	immediately after a job has been submitted, to correctly
;	set its scheduling priority. It has to be done this way since
;	the priority field has already been sent to QMG... before we
;	have had a chance to analyze the *JOB card(s). Sneaky!!! It
;	works too! However, there is a snag... if we just sent a
;	modify function immediately after submitting the job, there
;	may have been a stream free and the job might have got started
;	immediately before the modify could be done. Hence we submit
;	the job on hold, send the modify function, and then send a
;	release function (unless the user wanted the job to be on
;	hold). For this to work, the value 004 MUST be ORed
;	into $SUBDF in the build file.
;
;----------------------------------------------------------------------
;
;	Steve Thompson
;	School of Chemical Engineering
;	Cornell University
;	Ithaca NY 14853
;
;***********************************************************************

	.MCALL	QIOW$S

;
; Specify location of patch in module CLISUB. This is different in
; the RSX-11M V4.0 and V4.1 versions.
;

	.PSECT	PURE$I

	.IF 	EQ,<V$$RSN-41>	;
$$$=.				; RSX-11M V4.1
.=.+362				;
	CALL	SETPRI		; Call new routine
.=$$$+416			;
	CALL	SETPRI		; Maybe twice
	.ENDC	; EQ,<V$$RSN-41>

	.IF 	EQ,<V$$RSN-40>	;
$$$=.				; RSX-11M V4.0
.=.+356				;
	CALL	SETPRI		; Call new routine
.=$$$+412			;
	CALL	SETPRI		; Maybe twice
	.ENDC	; EQ,<V$$RSN-40>

;
; New stuff, all in P-sections BAPDAT (data) and  BAPCOD (code).
;

	.PSECT	BAPDAT,D

CJNU:	.WORD	0		; Job ID

	.IF	DF,B3$PQP

QPRMSG:	.ASCII	/SUB - Priority of Job is /
QPRMS1:	.ASCIZ	/000./

	.ENDC	; DF,B3$PQP

	.PSECT	BAPCOD,I

SETPRI:	CALL	SEND			;* Interecpted instruction

	.IF	DF,B3$TIM ! B3$MEM

	BCC	10$			; If CC it work
	RTS	PC			; else go back to normal code
10$:	MOV	QMGRET+4+Q.CJNU,CJNU	; Save job ID

;
; Calculate scheduling priority. This is calculated from the formula:
;
;			$DFPRI * $DFTIM * $DFMEM
;	Priority =	--------------------
;			     TIMMEM
;
;	where TIMMEM is the accumulated sum of time*memory for each
;	of the sub-jobs comprising this job.
;	The scheduling priority is never greater than 250 or less
;	than 1.
;

	.IF	DF,B3$TIM & B3$MEM

	MOV	#$DFTIM,R0		; Calculate $DFPRI*DEFTIME*DEFMEM
	MOV	#$DFMEM,R1		;
	CALL	$MUL			;
	MOV	R1,R3			; Shift registers for $DMUL
	MOV	R0,R2			;

	.IFF

	CLR	R2			; High order always zero

	.IF	DF,B3$TIM

	MOV	#$DFTIM,R3		; Lower order = default time limit

	.ENDC	; DF,B3$TIM

	.IF	DF,B3$MEM

	MOV	#$DFMEM,R3		; Low order = default memory limit

	.ENDC	; DF,B3$MEM

	.ENDC	; DF,B3$TIM & B3$MEM

	MOV	#$DFPRI,R0		; Get default queueing priority
	CALL	$DMUL			;
	MOV	R1,R2			; Shift registers for divide by TIMMEM
	MOV	R0,R1			;
	MOV	TIMMEM,-(SP)		; High order divisor on stack
	MOV	TIMMEM+2,R0		; Low order divisor in R0
20$:	TST	(SP)			; Is the high order divisor zero?
	BNE	30$			; No, continue to shift
	TST	R0			; Yes, is the low order still signed?
	BPL	40$			; If PL no, do D.P. by S.P. divide
30$:	ASR	R1			; Divide dividend by 2
	ROR	R2			;
	ASR	(SP)			; And also the divisor
	ROR	R0			;
	BR	20$			;
40$:	TST	(SP)+			; Clean the stack
	CALL	$DDIV			; Do remaining divide
50$:					; Result is in R2

;
; Perform some checks on the result.
;

	TST	R2			; Too small?
	BGT	60$			; If GT no
	MOV	#1,R2			; If yes, use priority of 1
	BR	70$			;
60$:	CMP	R2,#250.		; Too big?
	BLE	70$			; If LE no
	MOV	#250.,R2		; If yes, use priority of 250.
70$:					; Ref. label

;
; Construct the SEND packet to do the modify function.
;

	CALL	SETPKT			; Set up packet for modify
	MOVB	#QM.MDJ,Q.MFUN(R5)	; Show modify function
	MOV	#QM.PRI,Q.MMSK(R5)	; Show modifying priority
	MOVB	R2,Q.MPRI(R5)		; Insert new priority
	CALL	SEND			; Send it to QMG...
					; No point in checking for errors
					; here because there's nothing
					; we could do about it anyway
;
; Print queueing priority.
;

	.IF	DF,B3$PQP

	MOV	R2,R1			; Copy priority to R1
	MOV	#QPRMS1,R0		; Get message address
	CLR	R2			; Set no leading zeroes
	CALL	$CBDMG			; Convert to decimal
	MOVB	#'.,(R0)+		; Add a decimal point
	SUB	#QPRMSG,R0		; Calculate message length
	QIOW$S	#IO.WVB,#2,#2,,,,<#QPRMSG,R0,#40> ; Print it

	.ENDC	; DF,B3$PQP

	.IFTF

	BIT	#1000,SWMASK		; Was job to be on hold?
	BNE	80$			; If NE yes, don't release now
	CALL	SETPKT			; Fill in job information
	MOV	#QM.REJ,Q.MFUN(R5)	; Set release function
	CALL	SEND			; Tell QMG...
	CLC				; Show normal return
80$:	RTS	PC			;

	.ENDC	; DF,B3$TIM ! B3$MEM

;+
; **-SETPKT-Set up send packet to QMG for modify/release.
;-

SETPKT:	MOV	#QMGRET+4,R4		; Get address of stuff from QMG...
	MOV	#PACKET+32,R5		; Get address of SEND packet+26.
	MOV	#13.,R3			; Get its length
10$:	CLR	-(R5)			; Zero it
	DEC	R3			; Done yet?
	BGT	10$			; If GT no, loop
	MOV	JOBUIC,Q.MUIC(R5)	; Insert UIC of job
	MOV	CJNU,Q.MQID(R5)		; Insert job ID (returned by QMG...)
	RTS	PC			;

	.END