.TITLE	SHRFIL.MAC	81F16A		23-SEP-80/16-JUN-81.


;	AUTHOR: N. A. BOURGEOIS, JR.
;		SYSTEMS ENGINEERING DIVISION 1738
;		SANDIA NATIONAL LABORATORIES
;		PO BOX 5800
;		ALBUQUERQUE, NM 87185
;		505-844-8088
;		AV  244-8088
;
;	THIS SOFTWARE IS ISSUED BY SANDIA NATIONAL  LABORATORIES,
;	OPERATED FOR  THE  UNITED  STATES DEPARTMENT OF ENERGY BY
;	SANDIA CORPORATION.
;
;				NOTICE
;
;	THIS  SOFTWARE  WAS  SPONSORED  BY  THE  UNITED   STATES
;	GOVERNMENT.   NEITHER  THE  UNITED STATES GOVERNMENT NOR
;	THE UNITED STATES DEPARTMENT OF ENERGY, NOR ANY OF THEIR
;	EMPLOYEES, NOR ANY OF THEIR CONTRACTORS, SUBCONTRACTORS,
;	OR  THEIR  EMPLOYEES  MAKES  ANY  WARRANTY,  EXPRESS  OR
;	IMPLIED,    OR    ASSUMES   ANY   LEGAL   LIABILITY   OR
;	RESPONSIBILITY  FOR  THE   ACCURACY,   COMPLETENESS   OR
;	USEFULNESS  OF  ANY  INFORMATION,  APPARATUS, PRODUCT OR
;	PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD  NOT
;	INFRINGE PRIVATELY OWNED RIGHTS.
;
;	THIS WORK WAS SPONSORED AND FUNDED BY:
;
;		    HEADQUARTERS, ESD / OCB / STOP 36
;		    HANSCOM AIR FORCE BASE, MA 01731
;
;
.SBTTL                      ****************
.SBTTL                      *              *
.SBTTL                      * UNCLASSIFIED *
.SBTTL                      *              *
.SBTTL                      ****************
.SBTTL	DESCRIPTION			23-SEP-80/16-JUN-81.

;THIS MODULE CONTAINS SEVEN SHARED FILE SUPPORT ROUTINES THAT ARE CALLABLE
;SUBROUTINES.  SIX OF THEM ARE ALSO CALLABLE AS FUNCTIONS.  THIS MODULE IS
;A PART OF THE LIBRARY OF FORTRAN CALLABLE TSX/TSX-PLUS EMT ROUTINES.  THE
;CODE IS REENTRANT.

;DECALARE AN OPEN FILE TO BE SHARED.
;
;CALLING SEQUENCES:
;
;	CALL IDCLSF ( ICHAN ,IACES [ ,IERR ] )
;			OR
;	IERR = IDCLSF ( ICHAN ,IACES )
;
;WHERE:	IACES IS ONE OF THE FOLLOWING CODES:
;
;		CODE	PROTECTION	ACCESS
;		0	EXCLUSIVE	INPUT
;		1	EXCLUSIVE	UPDATE
;		2	PROTECTED	INPUT
;		3	PROTECTED	UPDATE
;		4	SHARED		INPUT
;		5	SHARED		UPDATE
;
;	IERR IS ONE OF THE FOLLOWING:
;
;		0	NO ERROR.
;		1	CHANNEL HAS NOT BEEN OPENED AS A FILE.
;		2	TOO MANY CHANNELS OPENED TO SHARED FILES.
;		3	TOO MANY SHARED FILES OPENED.
;		4	FILE PROTECTION/ACCESS CONFLICT.

;LOCK A BLOCK, WAIT IF ALREADY LOCKED.
;
;CALLING SEQUENCES:
;
;	CALL LKBLKW ( ICHAN ,IBLOCK [ ,IERR ] )
;			OR
;	IERR = LKBLKW ( ICHAN ,IBLOCK )
;
;WHERE:	IERR IS ONE OF THE FOLLOWING:
;
;		0	NO ERROR.
;		1	CHANNEL IS NOT OPEN TO A SHARED FILE.
;		2	REQUEST TO LOCK TOO MANY BLOCKS IN FILE.
;LOCK A BLOCK, RETURN IF ALREADY LOCKED.
;
;CALLING SEQUENCES:
;
;	CALL LKBLK ( ICHAN ,IBLOCK [ ,IERR ] )
;			OR
;	IERR = LKBLK ( ICHAN ,IBLOCK )
;
;WHERE:	IERR IS ONE OF THE FOLLOWING:
;
;		0	NO ERROR.
;		1	CHANNEL IS NOT OPENED TO A SHARED FILE.
;		2	REQUEST TO LOCK TOO MANY BLOCKS IN FILE.
;		3	REQUESTED BLOCK IS LOCKED BY ANOTHER JOB.

;UNLOCK A SPECIFIC BLOCK.
;
;CALLING SEQUENCES:
;
;	CALL IUSPBK ( ICHAN ,IBLOCK [ ,IERR ] )
;			OR
;	IERR = IUSPBK ( ICHAN ,IBLOCK )
;
;WHERE:	IERR IS ONE OF THE FOLLOWING:
;
;		0	NO ERROR.
;		1	CHANNEL IS NOT OPENED TO A SHARED FILE.

;UNLOCK ALL LOCKED BLOCKS.
;
;CALLING SEQUENCES:
;
;	CALL IUALBK ( ICHAN [ ,IERR ] )
;		OR
;	IERR = IUALBK ( ICHAN )
;
;WHERE:	IERR IS ONE OF THE FOLLOWING:
;
;		0	NO ERROR.
;		1	CHANNEL IS NOT OPENED TO A SHARED FILE.
;CHECK FOR WRITES TO A SHARED FILE.
;
;CALLING SEQUENCES:
;
;	CALL ICKWTS ( ICHAN [ ,IERR ] )
;		OR
;	IERR = ICKWTS ( ICHAN )
;
;WHERE:	IERR IS ONE OF THE FOLLOWING:
;
;		0	NO WRITES HAVE BEEN PERFORMED.
;		2	WRITES HAVE BEEN PERFORMED.

;SAVE THE STATUS OF A SHARED FILE CHANNEL.
;
;CALLING SEQUENCE:
;
;	CALL ISVST ( ICHAN )


.SBTTL	DIRECTIVES			23-SEP-80/16-JUN-81.

	.IDENT	\81F16A\	;TELL LINKER OUR VERSION
	.PSECT	TSXLIB,I


.SBTTL	ASSIGNMENTS			23-SEP-80/14-APR-81.

	ERRBYT	=52		;ERROR CODE LOCATION
.SBTTL	ENTRY POINTS			23-SEP-80/08-APR-81.

;DECLARE A FILE TO BE SHARED.
;
IDCLSF::MOV	#125	,R1		;EMT CODE
	JSR	PC	,DOIT		;MAKE THE DECLARATION
	RTS	PC

;LOCK A BLOCK, WAIT IF ALREADY LOCKED.
;
LKBLKW::MOV	#102	,R1		;EMT CODE
	JSR	PC	,DOIT		;LOCK THE BLOCK
	RTS	PC

;LOCK A BLOCK, RETURN IF ALREADY LOCKED.
;
LKBLK::	MOV	#103	,R1		;EMT CODE
	JSR	PC	,DOIT		;TRY TO LOCK THE BLOCK
	RTS	PC

;UNLOCK A SPECIFIC BLOCK.
;
IUSPBK::MOV	#113	,R1		;EMT CODE
	JSR	PC	,DOIT		;UNLOCK THE BLOCK
	RTS	PC

;UNLOCK ALL LOCKED BLOCKS.
;
IUALBK::MOV	#101	,R1		;EMT CODE
	JSR	PC	,DOIT1		;UNLOCK ALL BLOCKS
	RTS	PC

;CHECK FOR WRITES TO A SHARED FILE.
;
ICKWTS::MOV	#121	,R1		;EMT CODE
	JSR	PC	,DOIT1		;CHECK FOR WRITES
	RTS	PC

;SAVE THE STATUS OF A SHARED FILE CHANNEL.
;
ISVST::	MOV	#122	,R1		;EMT CODE
	JSR	PC	,DOIT1		;SAVE THE STATUS
RTS	PC
.SBTTL	SUPPORTING SUBROUTINES		23-SEP-80/08-APR-81.

DOIT:	MOV	@4(R5)	,-(SP)		;PASS ARGUMENT 2
	MOV	@2(R5)	,-(SP)		;PASS ARGUMENT 1 TO LO BYTE
	MOV	SP	,R0		;SET UP THE POINTER
	MOVB	R1	,1(R0)		;HI BYTE = EMT CODE
	EMT	375			;LET TSX DO IT
	CLR	R0			;GET THE
	MOVB	@#ERRBYT,R0		; ERROR CODE
	CMP	#3	,(R5)		;SUBROUTINE ERROR RETURN?
	BNE	1$			; NO
	MOV	R0	,@6(R5)		; YES
1$:	CMP	(SP)+	,(SP)+		;FIX THE STACK POINTER
	RTS	PC

DOIT1:	MOV	@2(R5)	,-(SP)		;PASS ARGUMENT 1 TO LO BYTE
	MOV	SP	,R0		;SET UP THE POINTER
	MOVB	R1	,1(R0)		;LO BYTE = EMT CODE
	EMT	375			;LET TSX DO IT
	CLR	R0			;GET THE
	MOVB	@#ERRBYT,R0		; ERROR CODE
	CMP	#2	,(R5)		;SUBROUTINE ERROR RETURN?
	BNE	1$			; NO
	MOV	R0	,@4(R5)		; YES
1$:	TST	(SP)+			;FIX THE STACK POINTER
	RTS	PC


.SBTTL	EDIT RECORD			23-SEP-80/16-JUN-81.

;23-SEP-80	ORIGINAL CREATION.
;08-OCT-80	REVISED.
;25-MAR-81	CORRECTED ADDRESSING ERROR.
;09-APR-81	CHANGED THE FOLLOWING MODULE AND ROUTINE NAMES; "RCDLOK"
;		TO "SHRFIL", "DCLRSF" TO "IDCLSF" AND "UNLBLK" TO "IUALBK".
;		ADDED THE FOLLOWING NEW ROUTINES; "IULSPBK", "ICKWTS" AND
;		"ISVST".  MADE CODE REENTRANT.
;14-APR-81	"ERRBYT" WAS 53.
;16-JUN-81	CORRECTED COMMENT ON THE ICKWTS ROUTINE.


.SBTTL	END				23-SEP-80/.

	.END
                                                                                                    