.MCALL	.MODULE
.MODULE	GTJB,VERSION=04,COMMENT=<GTJB/SYSLIB>,IDENT=NO,LIB=YES

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
	.SBTTL	Module Declaration

	.NLIST
	.ENABL	LC
	.DSABL	GBL
	.NLIST	CND
	.LIST
; ++
; FACILITY:
;
;    RT-11 System Subroutine Library
;
;	GTJB
;
; ENVIRONMENT:
;
;    This routine can be used by any job running in a single-job
;    or multi-job environment. It uses "TRAP" to provide error processing.
;
; INCLUDE FILES:
;

	; SYSMAC.SML		; RT-11 system macro library.

;
; MACRO REFERENCES:
;
	.MCALL	.GTJB

;
; EQUATED SYMBOLS:
;

;
; EXTERNAL REFERENCES:
;

	.GLOBL	$SYSLB		; Include system library work area.
	.GLOBL	$NXADR		; Entry point to next address routine
	.GLOBL	$NXVAL		; Entry point to next value routine
	.WEAK	$MSARG		; Trap code for missing argument
	.GLOBL	$ERRM0		; Error processor
	.SBTTL	GTJB - Fortran-callable routine

; ++
; FUNCTIONAL DESCRIPTION:
;
;	GTJB  -	returns information about a job in the system.
;		There are two styles of calling sequence; one
;		(the 'old' style) returns eight words of information.
;		The 'new' style returns twelve words; the original
;		eight plus an ASCII logical job name.  The new
;		style is requested implicitly by the specification
;		of more than one argument, unless the second argument
;		has a value of -3.
;        
; CALLING SEQUENCE:
;
;	CALL GTJB ( area [, jobblk [,i]])
;  or	I = IGTJB ( area [, jobblk])
;
; INPUT PARAMETERS:
;
;    R5	    -  address of GTJB argument block
;    0(R5)  -  argument count 
;    2(R5)  -  address of the array to receive job information
;    4(R5)  -  address of a job specification or style code
;    6(R5)  -  address of an optional returned function value
;
; RETURNED ARGUMENT VALUES:
;
;    area - integer array containing job information
; 	
; RETURNED FUNCTION VALUE:
;
;    i    =  0 indicates normal return
;	  = -1 indicates no such job
;
;
; CALLS TO GIVE 8 PARAMETER RETURN ONLY: (OLD STYLE)
;
;	CALL GTJB (IJPARM)
;	CALL GTJB (IJPARM , -3)
;	I = IGTJB (IJPARM)    ETC.....
;
; THE FOLLOWING WILL RETURN 12 PARAMETERS: (NEW STYLE)
;
;	CALL GTJB (IJPARM ,)
;	CALL GTJB (IJPARM , ,)
;	CALL GTJB (IJPARM , ,I)
;	CALL GTJB (IJPARM , -1)
;	CALL GTJB (IJPARM , 'ME')
;	CALL GTJB (IJPARM , IADDR( JNAME))
;	I = GTJB (IJPARM ,)		ETC.....	
;
;	JOBBLK	  = 0-16: Job number for which information is desired
;		  = -1 or "ME": information is passed about issuing job
;		  = -3: 8-word parameter block
;	 	  = address of 3-word ASCII job name for which data is desired
;
;
; ON RETURN,
;	IJPARM(1) = job number (0 = background, 2 = foreground)
;	IJPARM(2) = high memory limit
;	IJPARM(3) = low  memory limit
;	IJPARM(4) = start of channel area
;	IJPARM(5) = pointer to impure area
;	IJPARM(6) = logical unit number (multi-terminal only, 1 byte)
;	IJPARM(7) = virtual high limit (XM only)
;	IJPARM(8)...IJPARM(9) are reserved for future use.
;	IJPARM(10)...IJPARM(12) logical job name (system job monitor only)
;
;-
	.PSECT	SYS$I
	.ENABL	LSB

IGTJB::
GTJB::	MOV	#-3,-(SP)	;SET FOR OLD STYLE BLOCK (8 WORDS LONG)
	CLR	R3		;Assume no 3rd argument
	MOV	(R5)+,R4	;Get arg count
	CALL	$NXADR		;Get 1st arg
	BCS	ERR		;No arguments?  That's very bad.
	MOV	R0,R1		;put it here

	CMPB	-4(R5),#1	;Was a comma (non argument) supplied?
	BEQ	40$		;Use old style if not.
	CALL	$NXADR		;Get second argument
	BCS	20$		;If none, do new style
	MOV	R0,R2
	CALL	$NXADR		;Third arg?
	BCS	10$
	MOV	R0,R3
10$:	CMPB	@R2,#'M		;user passed "ME"?
	BNE	30$
	CMPB	1(R2),#'E
	BNE	30$
20$:	MOV	#-1,@SP		;yes...set up proper code for .GTJB
	BR	40$

30$:	MOV	@R2,@SP		;pass user's thing to .GTJB
40$:	MOV	R1,-(SP)	;addr of IJPARM
	MOV	#20*400+1,-(SP)	;.GTJB code
	MOV	SP,R0
	EMT	375		; Do .GTJB...

	CALL	$ERRM0		;Get error code

50$:	TST	R3		;Was a 3rd arg passed?
	BEQ	60$		;Branch if not
	MOV	R0,@R3		;return code if so
60$:	ADD	#6,SP		;pop arg block (3 words = 6 bytes)
	RETURN

ERR:	TRAP	$MSARG
	RETURN

	.DSABL	LSB

	.END