Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
C
C IPCLIB
C
C LIBRARY OF ROUTINES TO DO [SYSTEM]IPCC FUNCTIONS
C
C MIKE BARNES UTHSCD(MCRC)
C
C ROUTINES:
C IPCSE ENALBLE JOB TO RECEIVE PACKETS
C IPCSD DISABLE JOB TO RECEIVE PACKETS
C IPCSI GET PID OF [SYSTEM]INFO
C IPCSJ RETURN JOB NUMBER OF PID
C IPCSR GET SEND AND RECEIVE QUOTAS OF JOB
C
C INTERNAL SUPPORT:
C IPCZZA ROUTINE THAT DOES [SYSTEM]IPCC POKING
C
C EXTERNAL SUPPORT:
C IPCFS SEND A PACKET
C IPCFR RECEIVE A PACKET
C IPCTAB GET IPCF INFORMATION FROM GETTAB
C LSH DO A LOGICAL SHIFT
C
INTEGER FUNCTION IPCSE(JBNUM,CODE)
C
C IPCSE
C
C ENABLE JOB TO RECEIVE PACKETS
C
C CALL:
C I = IPCSE(JBNUM,CODE)
C
C WHERE:
C I ERROR CODE
C JBNUM JOB NUMBER TO BE ENABLED
C CODE PACKET ID
C
INTEGER JBNUM,CODE,ERR,DUMMY
C
C --SET UP
C
ERR = 0
DUMMY = 0
C
C --GO TO IT
C
CALL IPCZZA(JBNUM,DUMMY,CODE,ERR,1)
IPCSE = ERR
RETURN
END
INTEGER FUNCTION IPCSD(JBNUM,CODE)
C
C IPCSD
C
C DISABLE JOBS ABILITY TO RECIEVE PACKETS
C
C CALL:
C I = IPCSD(JBNUM,CODE)
C
C WHERE:
C I ERROR CODE RETURNED
C JBNUM JOB NUMBER TO BE DISABLED
C CODE PACKET ID
C
INTEGER JBNUM,CODE,ERR,DUMMY
C
C --SET UP
C
ERR = 0
DUMMY = 0
C
C --GO TO IT
C
CALL IPCZZA(JBNUM,DUMMY,CODE,ERR,2)
IPCSD = ERR
RETURN
END
INTEGER FUNCTION IPCSI(CODE,ERR)
C
C IPCSI
C
C RETURN PID OF [SYSTEM]INFO
C
C CALL:
C I = IPCFSI(CODE,ERR)
C
C WHERE:
C I PID RETURNED
C CODE PACKET ID
C ERR ERROR RETURN IN STANDARD FORMAT
C
INTEGER CODE,ERR,PID
C
C --GO TO IT
C
CALL IPCZZA(0,PID,CODE,ERR,3)
IPCSI = PID
RETURN
END
INTEGER FUNCTION IPCSJ(PID,CODE,ERR)
C
C IPCSJ
C
C RETURN JOB NUMBER ASSOCIATED WITH SPECIFIED PID
C
C CALL:
C I = IPCSJ(PID,CODE,ERR)
C
C WHERE:
C I JOB NUMBER
C PID PID OF WHICH JOB NUMBER IS TO BE FOUND
C CODE PACKET ID
C ERR ERROR CODE
C
INTEGER CODE,PID,ERR,JOBNUM
C
C --SET UP
C
JOBNUM = 0
ERR = 0
C
C --GO TO IT
C
CALL IPCZZA(PID,JOBNUM,CODE,ERR,9)
IPCSJ = OOBNUM
RETURN
END
INTEGER FUNCTION IPCSR(JBORPD,SENDQ,RECQ,CODE)
C
C IPCSR
C
C GET SEND AND RECIEVE QUOTAS OF SPECIFIED JOB
C
C CALL:
C ERR = IPCSR(JBORPD,SENDQ,RECQ,CODE)
C
C WHERE:
C ERR ERROR CODE
C JBORPD JOB NUMBER (PID WILL NOT WORK)
C SENDQ SEND QUOTA (RETURNED)
C RECQ RECEIVE QUOTA (RETURNED)
C
INTEGER JBORPD,SENDQ,RECQ,CODE,ERR,LSH,SRQ
C
C --SET UP
C
ERR = 0
SENDQ = 0
RECQ = 0
C
C --GO TO IT
C
CALL IPCZZA(JBORPD,SRQ,CODE,ERR,11)
C
C --SET ERROR, GO HOME IF ERROR EXISTS
C
IPCSR = ERR
IF (ERR .NE. 0) RETURN
C
C --MOVE SEND AND RECEIVE QUOTAS TO RIGHT PLACES
C
RECQ = SRQ .AND. "777
SENDQ = LSH(SRQ,-9) .AND. "777
RETURN
END
SUBROUTINE IPCZZA(WRDIN,WRDOUT,CODE,ERR,FUNC)
C
C IPCZZA
C
C INTERNAL SUPPORT ROUTINE FOR [SYSTEM]IPCC FUNCTIONS
C
INTEGER PACKET(10),WRDIN,WRDOUT,CODE,ERR,IPCCPD,FUNC,Z,FLAGS
C
C --SET UP
C
Z = 0
ERR = 0
C
C --GET [SYSTEM]IPCC PID
C
IPCCPD = IPCTAB(5)
C
C --CLEAR PACKET
C
DO 10 I1 = 1,10
10 PACKET(I1) = 0
C
C --PREPARE PACKET
C
PACKET(1) =FUNC + LSH(CODE,18)
PACKET(2) = WRDIN
C
C --SEND PACKET, GO HOME ON ERROR
C
ERR = IPCFS(0,0,IPCCPD,PACKET,4)
ERR = LSH(ERR,18)
IF (ERR .NE. 0) RETURN
C
C --CLEAR PACKET
C
DO 20 I1 = 1,10
20 PACKET(I1) = 0
C
C --RECEIVE PACKET
C
ERR = IPCFR(FLAGS,Z,Z,PACKET,4,Z,Z)
IF (ERR .NE. 0) RETURN
ERR = FLAGS .AND. "7700
IF (ERR .NE. 0) RETURN
C
C --FINISH AND GO HOME
C
WRDOUT = PACKET(2)
IF(FUNC .EQ. 9) WRDOUT = PACKET(3) !**[01]
IF(FUNC .EQ. 11) WRDOUT = PACKET(3) !**[01]
RETURN
END