.TITLE	TSXMSC.MAC	84a28a		17-SEP-80/28-Jan-84.
	.ENABL	LC


;	AUTHOR: N. A. BOURGEOIS, JR.
;			of
;		NAB Software Services, Inc.
;		PO Box 20009
;		Albuquerque, NM 87154
;			and
;		SANDIA NATIONAL LABORATORIES
;		PO BOX 5800
;		ALBUQUERQUE, NM 87185
;
;	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 originally SPONSORED AND FUNDED BY:
;
;		    HEADQUARTERS, ESD / OCB / STOP 36
;		    HANSCOM AIR FORCE BASE, MA 01731
;
;
.SBTTL                      ****************
.SBTTL                      *              *
.SBTTL                      * UNCLASSIFIED *
.SBTTL                      *              *
.SBTTL                      ****************
.PAGE
.SBTTL	DESCRIPTION			17-SEP-80/28-Jan-84.

;THIS MODULE CONTAINS FOUR MISCELLANEOUS ROUTINES THAT MAY BE CALLED
;AS EITHER FUNCTIONS OR SUBROUTINES.  NONE OF THESE ROUTINES RETURNS
;AN ERROR.  THIS MODULE IS A PART OF THE LIBRARY OF FORTRAN CALLABLE
;TSX/TSX-PLUS EMT ROUTINES.  THE CODE IS REENTRANT.

;THE "MEMSET" ROUTINE SETS THE TOP MEMORY ADDRESS ALLOCATED TO THE
;PROGRAM.  ON RETURN FROM THIS ROUTINE THE RETURN ARGUMENT CONTAINS
;THE HIGHEST MEMORY ADDRESS ALLOCATED.
;
;CALLING SEQUENCES:
;
;	CALL MEMSET ( IARG [ ,IRET ] )
;		OR
;	IRET = MEMSET ( IARG )

;THE "ISPBLK" ROUTINE RETURNS THE INTEGER VALUE OF THE NUMBER OF FREE
;BLOCKS IN THE SPOOL FILE.
;
;CALLING SEQUENCES:
;
;	CALL ISPBLK ( IRET )
;		OR
;	IRET  = ISPBLK ()

;THE "ITSLIC" ROUTINE RETURNS THE INTEGER VALUE OF THE TSX-PLUS
;LICENSE NUMBER.
;
;CALLING SEQUENCES:
;
;	CALL ITSLIC ( IRET )
;		OR
;	IRET  = ITSLIC ()

;THE "ITSLIN" ROUTINE RETURNS THE INTEGER VALUE OF THE TSX/TSX-PLUS
;LINE NUMBER.  WHEN EXECUTED UNDER RT-11 THIS ROUTINE RETURNS A LINE
;NUMBER OF ZERO.
;
;CALLING SEQUENCES:
;
;	CALL ITSLIN ( IRET )
;		OR
;	IRET  = ITSLIN ()
.PAGE
;Obtain some information about a file.
;
;Calling sequence:
;
;	CALL IFLINF ( ICHAN , IDEV , INFO [ , IERR ] )
;
;where:	ICHAN	is a channel number in the range of zero through
;		sixteen that is not currently in use.
;
;	IDEV	is the name of a four-word array containing the
;		file specification in RAD50.
;
;	INFO	is the name of the seven-word array that is to
;		receive the following information about the file.
;
;		Word 1	Size of the file in 512-byte blocks.
;		Word 2	Zero if the file is not protected, or one
;			if the file is protected.
;		Word 3	Creation date of the file in RT-11 format.
;		Word 4	Creation time of the file is three-second
;			units.
;		Word 5	Starting block number of the file.
;		Word 6	Reserved.
;		Word 7	Reserved.
;
;	IERR	is negative or one of the following:
;
;		0	The channel is currently in use.
;		1	Unable to locate the specified file.
;		2	The specified device is not file structured.
.PAGE
;Set the creation time for a file.
;
;Calling sequences:
;
;	CALL ISTFTM ( ICHAN , IDEV , ITIME [ , IERR ] )
;			or
;	IERR = ISTFTM ( ICHAN , IDEV , ITIME )
;
;where:	ICHAN	is a channel number in the range of zero through
;		sixteen that is not currently in use.
;
;	IDEV	is the name of a four-word array containing the
;		file specification in RAD50.
;
;	ITIME	is the time value is three-second units since
;		midnight.
;
;	IERR	is negative or one of the following:
;
;		0	The channel is currently in use.
;		1	Unable to locate the specified file.
;		2	The specified device is not file structured.

;Get the user name associated with the current job.
;
;Calling sequence:
;
;	CALL GTUNAM ( USRNAM )
;
;where:	USRNAM	is the name of the twelve-character array that is to
;		receive the user name ASCII string.

;Set the user name associated with the current job.
;
;Calling sequences:
;
;	CALL STUNAM ( USRNAM [ , IERR ] )
;			or
;	IERR = STUNAM ( USRNAM )
;
;where:	USRNAM	is the name of the twelve-character array that
;		contains the user name ASCII string.
;
;	IERR	is negative or as follows:
;
;		0	The job does not have operator privilege.
.PAGE
;Set the current job's priority value.
;
;	CALL ISTPRV ( IPRVAL )
;
;where:	IPRVAL	is the priority value in the range of 0 through 99.

;Control the release time of a spooled file.
;
;	CALL ISPCTL ( ICHAN , IFLAG )
;
;where:	ICHAN	is the number of the channel that is open to the
;		file.
;
;	IFLAG	is an integer value as follows:
;
;		0	Release the file immediately.
;		1	Hold the release until the file is closed.


.SBTTL	DIRECTIVES			17-SEP-80/28-Jan-84.

	.IDENT	\84a28a\	;TELL LINKER OUR VERSION
	.PSECT	TSXLIB,I
	.GLOBL	TSLBID
	.WORD	TSLBID
	.DSABL	GBL

.SBTTL	Assignments			28-Jan-84/.

	ERRBYT	=52		;EMT error code locationn
	NOERR	=-1		;code for no error condition


.SBTTL	MACROS				17-SEP-80/.

	.MCALL	.HERR		;LET MONITOR INTERCEPT FATAL ERRORS
	.MCALL	.SERR		;INTERCEPT FATAL ERRORS
.PAGE
.SBTTL	ENTRY POINTS			17-SEP-80/28-Jan-84.

;DETERMINE THE NUMBER OF FREE BLOCKS IN THE SPOOL FILE.
;
ISPBLK::MOV	#107	,R1		;EMT CODE
	JSR	PC	,DOIT		;GET THE NUMBER OF BLOCKS
	RTS	PC

;DETERMINE THE TSX/TSX-PLUS LICENSE NUMBER.
;
ITSLIC::MOV	#124	,R1		;EMT CODE
	JSR	PC	,DOIT		;GET THE LICENSE NUMBER
	RTS	PC

;DETERMINE THE TSX LINE NUMBER.
;
ITSLIN::.SERR				;INTERCEPT FATAL ERRORS
	MOV	#110	,R1		;EMT CODE
	JSR	PC	,DOIT		;GET THE LINE NUMBER
	MOV	R0	,-(SP)		;SAVE FOR FUNCTION RETURN VALUE
	.HERR				;LET MONITOR INTERCEPT FATAL ERRORS
	MOV	(SP)+	,R0		;RESTORE FUNCTION RETURN VALUE
	RTS	PC

;SET THE TOP MEMORY ADDRESS
;
MEMSET::MOV	#141	,R1		;EMT CODE
	JSR	PC	,DOIT1		;SET THE ALLOCATION
	RTS	PC

;Obtain some information about a file.
;
IFLINF::MOV	#145	,R1		;EMT code
	CALL	DOIT2			;get the information
	RETURN

;Set the creation time for a file.
;
ISTFTM::MOV	#146	,R1		;EMT code
	CALL	DOIT2			;set the time
	RETURN

;Get the user name associated with the current job.
;
GTUNAM::MOV	#147	,R1		;EMT code
	CLR	R2			;EMT id
	CALL	DOIT3			;get the name
	RETURN
.PAGE
;Set the user name associated with the current job.
;
STUNAM::MOV	#147	,R1		;EMT code
	MOV	#1	,R2		;EMT id
	CALL	DOIT3			;set the name
	RETURN

;Set the current job's priority value.
;
ISTPRV::MOV	#150	,R1		;EMT code
	CALL	DOIT1			;set the value
	RETURN

;Control the release time of a spooled file.
;
ISPCTL::MOV	#151	,R1		;EMT code
	CALL	DOIT4			;control the release
	RETURN
.PAGE
.SBTTL	SUPPORTING SUBROUTINES		17-SEP-80/28-Jan-84.

DOIT:	CLR	-(SP)			;LO BYTE = 0
	MOV	SP	,R0		;SET UP THE POINTER
	MOVB	R1	,1(R0)		;HI BYTE = EMT CODE
	EMT	375			;LET TSX DO IT
	BCC	1$			; IF NO ERROR
	CLR	R0			; RETURN ZERO ON ERROR
1$:	TSTB	(R5)			;FUNCTION CALL?
	BEQ	2$			; YES
	MOV	R0	,@2(R5)		; NO, SUBROUTINE CALL
2$:	TST	(SP)+			;FIX THE STACK POINTER
	RTS	PC

DOIT1:	MOV	@2(R5)	,-(SP)		;PASS THE ARGUMENT
	CLR	-(SP)			;LO BYTE = 0
	MOV	SP	,R0		;SET UP THE POINTER
	MOVB	R1	,1(R0)		;HI BYTE = EMT CODE
	EMT	375			;LET TSX DO IT
	CMPB	#2	,(R5)		;SUBROUTINE ARGUMENT RETURN?
	BNE	1$			; NO
	MOV	R0	,@4(R5)		; YES
1$:	CMP	(SP)+	,(SP)+		;FIX THE STACK POINTER
	RTS	PC

DOIT2:	MOV	6(R5)	,-(SP)		;pass argument 3 address
	MOV	4(R5)	,-(SP)		;pass argument 2 address
	MOV	@2(R5)	,-(SP)		;pass argument 1 value to lo byte
	MOV	SP	,R0		;set up the EMT pointer
	MOVB	R1	,1(R0)		;hi byte = EMT code
	MOV	#NOERR	,R1		;no error code
	EMT	375			;let TSX do it
	BCC	1$			; if no error
	CLR	R1			; if error
	MOVB	@#ERRBYT,R1		;  get the code
1$:	CMPB	#4	,(R5)		;subroutine error return?
	BNE	2$			; no
	MOV	R1	,@10(R5)	; yes
2$:	MOV	R1	,R0		;function error return
	ADD	#6	,SP		;fix the stack pointer
	RETURN
.PAGE
DOIT3:	MOV	2(R5)	,-(SP)		;pass argument 1 address
	MOV	SP	,R0		;set up the EMT pointer
	MOVB	R1	,1(R0)		;hi byte = EMT code
	MOVB	R2	,(R0)		;lo byte = EMT id
	MOV	#NOERR	,R1		;no error code
	EMT	375			;let TSX do it
	BCC	1$			; if no error
	CLR	R1			; if error
	MOVB	@#ERRBYT,R1		;  get the code
1$:	CMPB	#2	,(R5)		;subroutine error return?
	BNE	2$			; no
	MOV	R1	,4(R5)		; yes
2$:	MOV	R1	,R0		;function error return
	TST	(SP)+			;fix the stack pointer
	RETURN

DOIT4:	MOV	@4(R5)	,-(SP)		;pass argument 2 value
	MOV	@2(R5)	,-(SP)		;pass argument 1 value
	MOV	SP	,R0		;set up the EMT pointer
	MOVB	R1	,1(R0)		;hi byte = EMT code
	EMT	375			;let TSX do it
	CMP	(SP)+	,(SP)+		;fix the stack pointer


.SBTTL	EDIT RECORD			17-SEP-80/28-Jan-84.

;17-SEP-80	ORIGINAL CREATION.
;18-SEP-80	ADDED GLOBAL TO LOCATE DATA IN LINK MAP.
;10-OCT-80	CHANGED TITLE, REVISED AND ADDED ISPBLK.
;25-MAR-81	CORRECTED ADDRESSING ERROR.  CORRECTED EMT # ERRORS.
;08-APR-81	ADDED THE "MEMSET" AND ITSLIC" ROUTINES.  RENAMED
;		"TSXTST" TO "ITSLIN".  ADDED FUNCTION CALLING CODE.
;		MADE CODE REENTRANT.
;14-APR-81	ADDED STATEMENT ABOUT REENTRANT CODE TO DESCRIPTION.
;26-FEB-82	ADDED IDENTIFICATION CODE.
;06-Jan-84	Maintenance assumed by NAB Software Services, Inc.
;28-Jan-84	Added the IFLINF, ISTFTM, GTUNAM, STUNAM, ISTPRV,
;		ISPCTL, DOIT2, DOIT3, and DOIT4 routines.

.SBTTL	END				17-SEP-80/.

	.END