PDP-10 Archive: from

Trailing-Edge - PDP-10 Archives - -

There are no other files named in the archive.

C
C	INFLIB
C
C	LIBRARY OF ROUTINES TO DO [SYSTEM]INFO FUNCTIONS
C
C	MIKE BARNES UTHSCD(MCRC)
C
C	ROUTINES:
C		INFCIW	FIND PID ASSOCIATED WITH NAME
C		INFCIG	RETURN THE NAME OF A SPECIFIED PID
C		INFCII	ASSIGN A PID TO BE LOST ON RESET
C		INFCIJ	ASSIGN A PID TO BE LOST ON LOGOUT
C		INFCID	THE SPECIFIED PID WILL BE DROPPED
C		INFCIR	DROP ALL PIDS CREATED BY INFCII
C		INFCIL	DROP ALL PIDS CREATED BY INFCIL
C
C	INTERNAL SUPPORT:
C		INFZZA	SET UP PACKETS
C		INFZZB	DOES [SYSTEM]INFO POKING
C		INFZZC	DOES [SYSTEM]INFO POKING
C
C	EXTERNAL SUPPORT:
C		IPCFS	SEND A PACKET
C		IPCFR	RECEIVE A PACKET
C		ZERBLK	PREPARE ASCII WORD FOR [SYSTEM]INFO
C		LSH	DO A LOGICAL SHIFT
C
C
C	COMMON PARAMETERS:
C		NAME	FIVE WORD ASCII ARRAY
C		N	NUMBER OF WORDS TO BE USED FROM NAME
C		CODE	18-BIT QUALITY TO ASSOCIATE RESPONSE
C		COPY	PID TO GET DUPLICATE RESPONSE
C		PID	PROCESS ID
C		JOBNUM	JOB NUMBER
C		FLAGS	FLAG WORD RETURNED FROM IPCFR
C		ERR	ERROR RETURN OF THE FOLLOWING 36-BIT FORMAT:
C
C				XX000000	SEND ERROR.
C						IF 06 THEN IPCF COULD
C						BE DOWN.
C				XX00		RECEIVE ERROR DETECTED
C						IN RETURN FLAG
C				XX		RECIEVE ERROR
C

	INTEGER FUNCTION INFCIW (NAME,N,CODE,COPY,ERR)
C
C	INFCIW
C
C	FIND THE PID ASSOCIATED WITH NAME
C
C	CALL:
C		PID = INFCIW(NAME,N,CODE,COPY,ERR)
C
	INTEGER NAME(5),N,CODE,COPY,ERR,IPCTAB,IPCC
	INTEGER IPCFS,IPCFR,Z,PACKET(10),FLAGS,ZERBLK
C
C	--SEE IF ARGUMENT ERROR
C
	IF((N .GT. 0) .AND. (N .LE. 5)) GOTO 10
	INFCIW = -1
	RETURN
C
C	--CLEAR PACKET
C
10	DO 30 I8 = 1,10
30	PACKET(I8) = 0
C
C	--SET UP PACKET
C
	PACKET(1) = 1+LSH(CODE,18)
	Z = 0
	PACKET(2) = COPY
C
C	--PUT NAME IN PACKET
C
	DO 20 I1 = 1,N
	I2 = I1+2
	PACKET(I2) = NAME(I1)
20	CONTINUE
C
C	--SPECIAL KLUDGE FOR IPCF BECAUSE [SYSTEM]INFO DOES NOT
C	--LIKE SPACES
C
	PACKET(I2) = ZERBLK(PACKET(I2))
C
C	--SEND PACKET
C
	ERR = IPCFS(0,0,0,PACKET,8)
	ERR = LSH(ERR,18)
	IF (ERR .NE. 0) RETURN
C
C	--CLEAR PACKET
C
	DO 40 I14 = 1,10
	PACKET(I14) = 0
40	CONTINUE
C
C	--RECEIVE PACKET
C
	ERR = IPCFR(FLAGS,Z,Z,PACKET,8,Z,Z)
	IF(ERR .NE. 0) RETURN
	ERR = FLAGS .AND. "7700
	INFCIW = PACKET(2)
	RETURN
	END
	INTEGER FUNCTION INFCIG(PID,NAME,CODE,COPY,ERR)
C
C	INFCIG
C
C	RETURN NAME OF SPECIFIED PID
C
C	CALL:
C		FLAGS = INFCIG(PID,NAME,CODE,COPY,ERR)
C
	INTEGER NAME(5),CODE,COPY,ERR,LSH,PID,IPCFS,IPCFR,Z
	INTEGER PACKET(10),FLAGS
C
C	--CLEAR PACKET
C
	DO 10 I1 = 1,10
10	PACKET(I1) = 0
C
C	--SETUP PACKET
C
	PACKET(1) = 2+LSH(CODE,18)
	PACKET(2) = COPY
	PACKET(3) = PID
C
C	--SEND PACKET
C
	ERR = IPCFS(0,0,0,PACKET,8)
	ERR = LSH(ERR,18)
	IF (ERR .NE. 0) RETURN
	Z = 0
C
C	--CLEAR PACKET
C
	DO 20 I2 = 1,10
20	PACKET(I2) = 0
C
C	--RECEIVE PACKET
C
	ERR = IPCFR(FLAGS,Z,Z,PACKET,8,Z,Z)
	IF (ERR .NE. 0) RETURN
	ERR = FLAGS .AND. "7700
	INFCIG = FLAGS
	IF (ERR .NE. 0) RETURN
C
C	--PUT PACKET IN NAME
C
	DO 30 I3 = 1,5
	NAME(I3) = PACKET(I3+2)
30	CONTINUE
	RETURN
	END
	INTEGER FUNCTION INFCII(NAME,N,CODE,COPY,ERR)
C
C	INFCII
C
C	GET PID BASED ON NAME (GOOD TILL RESET UUO)
C
C	CALL:
C		PID = INFCII(NAME,N,CODE,COPY,ERR)
C
	INTEGER NAME(5),CODE,COPY,ERR,LSH,PID,N,INFZZB
C
C	--SETUP
C
	PID = 0
C
C	--DO ALL THE WORK HERE
C
	CALL INFZZB(NAME,N,CODE,COPY,ERR,3,PID)
	INFCII = PID
	RETURN
	END
	INTEGER FUNCTION INFCIJ(NAME,N,CODE,COPY,ERR)
C
C	INFCIJ
C
C	GET A PID BASED ON NAME (GOOD TILL LOGOUT)
C
C	CALL:
C		PID = INFCIJ(NAME,N,CODE,COPY,ERR)
C
	INTEGER NAME(5),CODE,COPY,ERR,LSH,PID,N
C
C	--SETUP
C
	PID = 0
C
C	--DO ALL THE WORK
C
	CALL INFZZB(NAME,N,CODE,COPY,ERR,4,PID)
	INFCIJ = PID
	RETURN
	END
	INTEGER FUNCTION INFCID(PID,CODE,COPY,ERR)
C
C	INFCID
C
C	THE SPECIFIED PID WILL BE DROPPED
C
C	CALL:
C		FLAGS = INFCID(PID,CODE,COPY,ERR)
C
	INTEGER PID,CODE,COPY,ERR,PACKET(3),FLAGS
C
C	--SETUP PACKET
C
	CALL INFZZA(PACKET,5,PID,COPY,CODE)
C
C	--DO ALL THE WORK
C
	CALL INFZZC(PACKET,ERR,0,FLAGS)
	INFCID = FLAGS
	RETURN
	END
	INTEGER FUNCTION INFCIR(PID,CODE,COPY,ERR)
C
C	INFCIR
C
C	DROP ALL PIDS CREATED BY INFCII
C
C	CALL:
C		FLAGS = INFCIR(JOBNUM,CODE,COPY,ERR)
C
	INTEGER PID,CODE,COPY,ERR,PACKET(3),FLAGS
C
C	--SETUP PACKET
C
	CALL INFZZA(PACKET,6,PID,COPY,CODE)
C
C	--DO ALL THE WORK
C
	CALL INFZZC(PACKET,ERR,0,FLAGS)
	INFCIR = FLAGS
	RETURN
	END
	INTEGER FUNCTION INFCIL(PID,CODE,COPY,ERR)
C
C	INFCIL
C
C	DROP ALL PIDS CREATED BY INFCIJ
C
C	CALL:
C		FLAGS = INFCIL(JOBNUM,CODE,COPY,ERR)
C
	INTEGER PID,CODE,COPY,ERR,PACKET(3),FLAGS
C
C	--SET UP PACKET
C
	CALL INFZZA(PACKET,7,PID,COPY,CODE)
C
C	--DO ALL THE WORK
C
	CALL INFZZC(PACKET,ERR,0,FLAGS)
	INFCIL = FLAGS
	RETURN
	END
	SUBROUTINE INFZZA(PACKET,FUNC,NAME,COPY,CODE)
C
C	INFZZA
C
C	INTERNAL SUPPORT ROUTINE TO SETUP PACKET
C
	INTEGER PACKET(3),FUNC,NAME,COPY,CODE,LSH
C
C	--SETUP PACKET
C
	PACKET(1) = FUNC+LSH(CODE,18)
	PACKET(2) = COPY
	PACKET(3) = NAME
	RETURN
	END
	SUBROUTINE INFZZB(NAME,N,CODE,COPY,ERR,FUNC,PID)
C
C	INFZZB
C
C	INTERNAL SUPPORT ROUTINE FOR [SYSTEM]INFO FUNCTIONS
C
	INTEGER PACKET(10),NAME(5),N,CODE,COPY,ERR,PID
	INTEGER IPCFS,IPCFR,ZERBLK,LSH,FUNC,Z,FLAGS
C
C	--SETUP
C
	Z = 0
	FLAGS = 0
C
C	--CLEAR PACKET
C
	DO 10 I1 = 1,10
	PACKET(I1) = 0
10	CONTINUE
C
C	--SETUP PACKET
C
	PACKET(1) = FUNC+LSH(CODE,18)
	PACKET(2) = COPY
C
C	--PUT NAME IN PACKET
C
	DO 20 I1 = 1,N
	I2 = I1+2
	PACKET(I2) = NAME(I1)
20	CONTINUE
C
C	--SPECIAL KLUDGE FOR [SYSTEM]INFO
C
	PACKET(I2) = ZERBLK(PACKET(I2))
C
C	--SEND PACKET
C
	ERR = IPCFS(0,0,0,PACKET,8)
	ERR = LSH(ERR,18)
	IF(ERR .NE. 0) RETURN
C
C	--CLEAR PACKET
C
	DO 30 I3 = 1,10
30	PACKET(I3) = 0
C
C	--RECEIVE PACKET
C
	ERR = IPCFR(FLAGS,Z,Z,PACKET,8,Z,Z)
	IF(ERR .NE. 0) RETURN
	PID = PACKET(2)
	ERR = FLAGS .AND. "7700
	RETURN
	END
	SUBROUTINE INFZZC(PACKET,ERR,SPID,FLAGS)
C
C	INFZZC
C
C	INTERNAL SUPPORT ROUTINE FOR [SYSTEM]INFO FUNCTIONS
C
	INTEGER PACKET(3),ERR,SPID,IPCFS,IPCFR,Z,FLAGS,LSH
C
C	--SETUP
C
	FLAGS = 0
	Z = 0
C
C	--SEND PACKET
C
	ERR = IPCFS(0,SPID,0,PACKET,3)
	ERR = LSH(ERR,18)
	IF (ERR .NE. 0) RETURN
C
C	--RECEIVE PACKET
C
	ERR = IPCFR(FLAGS,Z,Z,PACKET,3,Z,Z)
	ERR = FLAGS .AND. "7700
	RETURN
	END