#0DIR                                              6-MAY-84  19:45:36 
0      MEMBER DIRECTORY OF TEXT LIBRARY SY:EPPACK.TXT
    MEMBER NAME    FIRST RECORD     DATE       TIME
 
      CDINF              1        14-NOV-83  16:26:28
      EPANS             39        19-OCT-83  17:42:23
      EPBLDC            90         6-MAY-84  19:43:44
      EPBNWT           191        13-NOV-83  21:27:28
      EPBSTA           277        28-JUL-83  20:51:31
      EPBUFF           289        28-JUL-83  20:51:31
      EPCOMN           355         6-MAY-84  19:01:14
      EPERR            381
      EPEV             393        28-JUL-83  20:51:31
      EPINF            438         5-NOV-83  19:01:38
      EPINIT           465        19-OCT-83  17:42:23
      EPNWT            547        13-NOV-83  20:26:06
      EPPMSG           581        16-NOV-83  16:43:18
      EPSETD           602        28-JUL-83  20:51:31
      EPSETE           622        28-JUL-83  20:51:31
      EPSETP           633        27-SEP-83  15:40:44
      EPSETT           658        28-JUL-83  20:51:31
      EPWAIT           672        28-JUL-83  20:51:31
      MSGCOM           700         6-MAY-84  18:25:40
      MSGINC           724         6-MAY-84  19:01:14
      NARGS            729        28-JUL-83  20:51:31
      PTCCMN           744         6-MAY-84  19:01:14
      PTCDEF           761         6-MAY-84  19:01:14
      SLEEP            774        15-NOV-83  16:54:18
0        LAST RECORD -   793
#CDINF                                            14-NOV-83  16:26:28
	SUBROUTINE CDINF(INF)
	IMPLICIT NONE
	INTEGER INF,IND
C
C-->	procedure statements
C
	IND=INF+2
	GOTO (10,20,30,40,50,60,70,80) IND
	CALL MSGCOM(0,8,' Bad inf')
	goto 900
10	CONTINUE
	CALL MSGCOM(0,30,' %INF-Message block not active')
	GOTO 900
20	CONTINUE
	CALL MSGCOM(0,30,' %INF-Open connection. No xfer')
	GOTO 900
30	CONTINUE
	CALL MSGCOM(0,27,' %INF-Transmission pending')
	GOTO 900
40	CONTINUE
	CALL MSGCOM(0,23,' %INF-Receive pending.')
	GOTO 900
50	CONTINUE
	CALL MSGCOM(0,30,' %INF-Transmission completed  ')
	GOTO 900
60	CONTINUE
	CALL MSGCOM(0,24,' %INF-Receive completed')
	GOTO 900
70	CONTINUE
	CALL MSGCOM(0,31,' %INF-Pending message;no buffer')
	GOTO 900
80	CONTINUE
	CALL MSGCOM(0,24,' %INF-New signal arrived')
	GOTO 900
900	continue
	return
	end
#EPANS                                            19-OCT-83  17:42:23
	FUNCTION EPANS(BUF,BUFLEN)
	IMPLICIT NONE
	INTEGER EPAFLG,CRSTAT(2),MAXWC
	INCLUDE 'EPPMSG.inc'
	INCLUDE 'EPCOMN.CMN'
	INCLUDE 'PTCCMN.CMN'
	DATA EPAFLG/0/
C
C****	PROCEDURE STATEMENTS
C
C
C..	START UP SESSION IF NOT STARTED ALREADY
	IF(EPFLAG.EQ.1) GOTO 90
	IF(EPERR(EPINIT('CD ',0,1,180,anx)).NE.0) GOTO 910
C
C...	DO INITIAL READ IF NOT ALREADY DONE:
90	CONTINUE
	IF(EPAFLG.EQ.1) GOTO 100
	CALL CDRCV(EPCHAN,ANX,EPRBUF,8,CRSTAT)
	IF(CRSTAT(1).NE.CDOK) GOTO 910
	EPAFLG=1
100	CONTINUE
	IF(EPWAIT(CRSTAT(2),CRSTAT).NE.CDOK) GOTO 920
	MAXWC=MIN(BUFLEN,EPRBUF(3))
	EPLEN=MAXWC
	EPPTC=EPRBUF(2)
	CALL CDRCV(EPCHAN,ANX,EPRBUF,8,CRSTAT)
	CALL CDXMTW(EPCHAN,EPPTC,BUF,EPLEN,EPSTAT)
	IF(CRSTAT(1).NE.CDOK) GOTO 920	! DID WE QIO SUCCESSFULLY?
	IF(EPSTAT(1).NE.CDOK) GOTO 910  ! DID WE TRANSMIT A BUFFER OK?
	EPANS=0
	GOTO 1100			!EXIT SUCCESSFULLY
C
C
C...	ERROR REPORTING AND EXIT
C
C..	ERROR RECIEVING BUFFER
910	CONTINUE
	CALL EPINF(EPSTAT)
	EPANS=%LOC(EPPACK_ANSUNABRE)
	GOTO 1100
C
C..	ERROR xmitting BUFFER
920	CONTINUE
	CALL EPINF(EPSTAT)
 	EPANS=%LOC(EPPACK_ANSUNABXM)
	GOTO 1100
1100	CONTINUE
	RETURN
	END
#EPBLDC                                            6-MAY-84  19:43:44
$! modified MAY 5 1984 P. Heinicke
$ ! FOR MSGCOM
$ @fermi$login:vmsmulti
$ TEX
EPPACK.TXT
FOR
SY:
EPCOMN
PTCCMN
PTCDEF
MSGINC
EPEV
EPERR
EPBUFF
EPBNWT
EPNWT
EPANS
EPBSTA
EPSETE
EPSETT
EPINF
EPINIT
EPSETP
EPSETD
EPWAIT
MSGCOM
NARGS
SLEEP
EPPMSG
CDINF
$ RENAME PTCCMN.FOR PTCCMN.CMN
$ RENAME PTCDEF.FOR PTCDEF.CMN
$ RENAME EPCOMN.FOR EPCOMN.CMN
$ RENAME MSGINC.FOR EPPMSG.INC
$ MACRO NARGS.FOR
$ FORTRAN/LIST	-
EPEV,               -
CDINF,-
EPERR,-
EPBUFF,-
EPANS,-
EPBNWT,-
EPNWT,-
EPBSTA,-
EPSETE,-
EPSETT,-
EPINF,-
EPINIT,-
EPSETP,-
EPSETD,-
SLEEP,-
MSGCOM,-
EPWAIT
$ DELETE/NOCONFIRM EPEV.FOR;*,-
EPERR.FOR;*,-
EPBUFF.FOR;*,-
EPBNWT.FOR;*,-
EPANS.FOR;*,-
EPBSTA.FOR;*,-
EPSETE.FOR;*,-
EPSETT.FOR;*,-
EPINIT.FOR;*,-
EPSETP.FOR;*,-
EPSETD.FOR;*,-
EPWAIT.FOR;*,-
CDINF.FOR;*,-
EPINF.FOR;*,-
EPNWT.FOR;*,-
MSGCOM.FOR;*,-
SLEEP.FOR;*,-
NARGS.FOR;*
$ library/create eppack
$ LIBRARY/LIST:TT:/FULL EPpack	-
EPNWT,EPERR,EPEV,EPBUFF,EPBNWT,EPANS,EPBSTA, -
EPSETE,EPINF,EPINIT,EPSETP,EPSETD,EPSETT,EPWAIT,-
CDINF,MSGCOM,NARGS,SLEEP
$ DELETE/NOCONFIRM EPEV.OBJ;*,-
EPERR.OBJ;*,-
EPBUFF.OBJ;*,-
EPBNWT.OBJ;*,-
EPANS.OBJ;*,-
EPBSTA.OBJ;*,-
EPSETE.OBJ;*,-
EPSETT.OBJ;*,-
EPINIT.OBJ;*,-
EPSETP.OBJ;*,-
SLEEP.OBJ;*,-
EPSETD.OBJ;*,-
EPWAIT.OBJ;*,-
CDINF.OBJ;*,-
EPINF.OBJ;*,-
EPNWT.OBJ;*,-
MSGCOM.OBJ;*,-
EPCOMN.*;*,-
PTCCMN.*;*,-
PTCDEF.*;*,-
NARGS.OBJ;*
$ MESSAGE EPPMSG.FOR
$ library eppack eppmsg
$ delete/NOCONFIRM eppmsg.*;*
#EPBNWT                                           13-NOV-83  21:27:28
        FUNCTION EPBNWT(BUF,LEN,BUFLEN,PFLAG)
	IMPLICIT NONE
	INTEGER CRSTAT(2),ESTATE,ISSUE,SWAIT
	INTEGER IBFLEN,STATUS,ICODE
	INCLUDE 'EPPMSG.inc'
	INCLUDE 'EPCOMN.CMN'
	INCLUDE 'PTCCMN.CMN'
	data EPflag,ESTATE/0,1/,ISSUE,SWAIT/1,2/
	LOGICAL*1 PFLAG
C
C..	PARSE THE ESTATE (STATUS OF EPBNWT)
10	continue				!restart point
	GOTO (50,200) ESTATE
	EPBNWT=%LOC(EPPACK_BADSTATE)
	GOTO 995
C
C..	ESTATE = ISSUE (request for a buffer)
50	CONTINUE
	IF(EPFLAG.EQ.1) GOTO 100
	IF( EPERR(EPINIT('CD ',0,0,180)).NE.0) GOTO 910
	EPflag=1
C
C..	PREPARE TO RECEIVE MESSAGE
100	CONTINUE
	IBFLEN=BUFLEN		!i*4 compatibility problem fixed-phh
	CALL CDRCV(EPCHAN,EPPTC,BUF,IBFLEN,CRSTAT)
	IF(CRSTAT(1).NE.CDOK) GOTO 900
C
C..	SEND REQUEST TO OTHER SIDE
	EPRBUF(1)=1	!GET NEXT EVENT
	EPRBUF(2)=EPPTC
	EPRBUF(3)=BUFLEN
	EPRBUF(4)=EPETYP
	EPRBUF(5)=0	! don't care request mode
	EPRBUF(6)=0	!get event from current default
	EPRBUF(7)=0	!FUTURE USE
	EPRBUF(8)=0	!FUTURE USE
	CALL CDXMTW(EPCHAN,ANX,EPRBUF,8,EPSTAT)
	IF(EPSTAT(1).NE.CDOK) GOTO 905
C
C..	ESTATE=SWAIT &CHECK IF THE LAST REQUEST WAS ANSWERED
200	ESTATE=SWAIT		!DON'T PUT A CONTINUE HERE!
	STATUS=EPNWT(CRSTAT(2),CRSTAT)
	IF(STATUS.EQ.CDOK) GOTO 600
	IF(STATUS.EQ.WAIT) GOTO 990
C
C..	OTHERWISE DROP THROUGH TO ERROR REPORTING
	CALL EPINF(CRSTAT(1))
	CALL LIB$SIGNAL(EPPACK_RETRY)
	ESTATE=ISSUE
	CALL SLEEP(100)	!SLEEP 100 MILLISECONDS
	GOTO 100
C
C...	 ACK OR NACK OF EVENTS?
600	CONTINUE
	ESTATE=ISSUE
	IF(CRSTAT(2).EQ.2) GOTO 100
	LEN=CRSTAT(2)		!SET THE LENGTH
	GOTO 990		!OTHERWISE ITS A SUCCESS
C
C..	GENERAL LINK ERROR
900	CONTINUE
	ICODE=EPINF(CRSTAT)
	EPBNWT=%LOC(EPPACK_BUFUNABRE)
	GOTO 995
905	CONTINUE
	ICODE=EPINF(EPSTAT)
	EPBNWT=%LOC(EPPACK_BUFUNABXM)
	GOTO 995
C
C..	INIT ERROR
910	CONTINUE
	EPBNWT=%LOC(EPPACK_INITERROR)
C	CALL MSGCOM(0,11,' INIT ERROR')
	ICODE=EPINF(EPSTAT)
	GOTO 995
C
C...	SUCCESS EXIT
990	CONTINUE
	EPBNWT=0
995	CONTINUE
	IF(ESTATE.EQ.ISSUE) PFLAG=.FALSE.
	IF(ESTATE.EQ.SWAIT) PFLAG=.TRUE.
	RETURN
	END
#EPBSTA                                           28-JUL-83  20:51:31
        FUNCTION EPBSTA()
	IMPLICIT NONE
	INTEGER INF
	INCLUDE 'EPPMSG.inc'
	INCLUDE 'EPCOMN.CMN'
	INCLUDE 'PTCCMN.CMN'
	CALL CDSTAT(EPMBN,INF,EPSTAT)
	EPBSTA=EPSTAT(1)
995	CONTINUE
	RETURN
	END
#EPBUFF                                           28-JUL-83  20:51:31
        FUNCTION EPBUFF(BUF,LEN,BUFLEN)
	IMPLICIT NONE
	INTEGER CRSTAT(2),IBFLEN,ICODE
	INCLUDE 'EPPMSG.inc'
	INCLUDE 'EPCOMN.CMN'
	INCLUDE 'PTCCMN.CMN'
	data EPflag/0/
	IF(EPFLAG.EQ.1) GOTO 100
	IF( EPERR(EPINIT('CD ',0,0,180)).NE.0) GOTO 910
	EPflag=1
C
C..	PREPARE TO RECEIVE MESSAGE
100	CONTINUE
	IBFLEN=BUFLEN
	CALL CDRCV(EPCHAN,EPPTC,BUF,IBFLEN,CRSTAT)
	IF(CRSTAT(1).NE.CDOK) GOTO 900
C
C..	SEND REQUEST TO OTHER SIDE
	EPRBUF(1)=1	!GET NEXT EVENT
	EPRBUF(2)=EPPTC
	EPRBUF(3)=BUFLEN
	EPRBUF(4)=EPETYP
	EPRBUF(5)=0	! don't care request mode
	EPRBUF(6)=0	!get event from current default
	EPRBUF(7)=0	!FUTURE USE
	EPRBUF(8)=0	!FUTURE USE
	CALL CDXMTW(EPCHAN,ANX,EPRBUF,8,EPSTAT)
	IF(EPSTAT(1).NE.CDOK) GOTO 905
C
C..	WAIT FOR THIS LAST REQUEST TO BE ANSWERED
	IF(EPWAIT(CRSTAT(2),CRSTAT).EQ.CDOK) GOTO 600
	CALL EPINF(CRSTAT(1))
	CALL LIB$SIGNAL(EPPACK_RETRY)
	CALL SLEEP(100)	!SLEEP 100 MILLISECONDS
	GOTO 100
C
C...	 ACK OR NACK OF EVENTS?
600	CONTINUE
	IF(CRSTAT(2).EQ.2) GOTO 100
	LEN=CRSTAT(2)		!SET THE LENGTH
	GOTO 990		!OTHERWISE ITS A SUCCESS
C
C..	GENERAL LINK ERROR
900	CONTINUE
	ICODE=EPINF(CRSTAT)
	EPBUFF=%LOC(EPPACK_BUFUNABRE)
	GOTO 995
905	CONTINUE
	ICODE=EPINF(EPSTAT)
	EPBUFF=%LOC(EPPACK_BUFUNABXM)
	GOTO 995
C
C..	INIT ERROR
910	CONTINUE
	EPBUFF=%LOC(EPPACK_INITERROR)
C	CALL MSGCOM(0,11,' INIT ERROR')
	ICODE=EPINF(EPSTAT)
	GOTO 995
C
C...	SUCCESS EXIT
990	CONTINUE
	EPBUFF=0
995	CONTINUE
	RETURN
	END
#EPCOMN                                            6-MAY-84  19:01:14
C	STAT- is the return code
C	BUF- is the address of an event buffer
C	(or a location in an event buffer)
C	LEN- is the length of the event buffer in bytes
C	INDEX- is the index of the event (starting with 1) assuming the
C	usual structure of byte count, data, byte count data etc., with
C	an unspecified structure at the location BUF(-1)...BUF(-N)
C	(which in the case of MULTI would contain a buffer byte count
C	at BUF(-1) ). The second event has an index of Length(Event 1)+1
C	EVLEN- Length of the event obtained.
C	BUFLEN- Length of the buffer
C	PTC- Packet type code to be inserted in the IN-66 request packet
C	DEVNAM- Name of device (e.g. CDA0) (INTEGER ARRAY DEVNAM(2))
C	TIMOUT- Timeout value in Ticks (1/60th of a second)
C 	LEN AND BUFLEN SHOULD BE INTEGER*2
	CHARACTER*48 EPDEVN
	INTEGER*2 BUF(1),LEN,BUFLEN,EVLEN,EPRBUF
	INTEGER PTC,ETYP,INDEX,TIMOUT,UNIT,EPUNIT,WAIT
	INTEGER EPSETT,EPSETP,EPSETD,EPSETE,EPBUFF,EPINF,EPNWT
	INTEGER EPANS,EPEV,EPSTAT,EPBSTA,EPINIT,EPBNWT
	INTEGER EPFLAG,EPPTC,EPETYP,EPTIMO,EPLEN,EPWAIT
	INTEGER LASTEV,EPCODE,EPMBN,EPCHAN,EPERR
	COMMON/EPCOMN/EPFLAG,EPTIMO,LASTEV,EPMBN,EPCHAN,EPUNIT,
     &  EPSTAT(2),EPRBUF(8),EPETYP,EPPTC,EPLEN,EPCODE,EPDEVN,WAIT
	DATA WAIT/33/
#EPERR
C	THIS ROUTINE CALLS LIB$SIGNAL IFF THE ARGUMENT .NE. 0
C
	FUNCTION EPERR(IPAS)
	IMPLICIT NONE
	INTEGER EPERR,IPAS
	EPERR=0
	IF(IPAS.EQ.0) RETURN
	EPERR=IPAS
	CALL LIB$SIGNAL(%VAL(IPAS))
	RETURN
	END
#EPEV                                             28-JUL-83  20:51:31
	FUNCTION EPEV(BUF,LEN,INDEX,EVLEN)
	IMPLICIT NONE
	INCLUDE 'EPPMSG.inc'
	INCLUDE 'EPCOMN.CMN'
	INCLUDE 'PTCCMN.CMN'
	IF(LASTEV.NE.0) GOTO 500
	IF(EPERR(EPBUFF(BUF,LEN,BUFLEN)).NE.0) GOTO 900
	IF(LEN.EQ.0) GOTO 950
	LASTEV=1
	INDEX=1
	EVLEN=BUF(1)
	IF(EVLEN.GT.LEN) GOTO 960	! UNPACKING OVERRUN
	GOTO 990
C
C
C..	SIMPLE EVENT UNPACKING CODE
500	CONTINUE
	INDEX=LASTEV+BUF(LASTEV)-1	!INCLUSIVE BYTE COUNT
	EVLEN=BUF(INDEX)
	IF(EVLEN.GT.LEN) GOTO 960
	GOTO 990
C
C...	GENERAL LINK ERROR
900	CONTINUE
	CALL CDINF(EPERR)
	EPEV=%LOC(EPpack_GENLKERR)
	GOTO 995
C
C..	PENDING REQUEST
950	CONTINUE
	EPEV=0
	GOTO 995
C
C... 	UNPACKING OVERRUN
960	CONTINUE
	EPEV=%LOC(EPpack_UNPACKOVRUN)
	GOTO 995
C
C..	SUCCESSFUL REQUEST
990	CONTINUE
	EPEV=0
995	CONTINUE
	RETURN
	END
#EPINF                                             5-NOV-83  19:01:38
        FUNCTION EPINF(CSTAT,INF)
	IMPLICIT NONE
	INTEGER CSTAT(2),INF,LTEXT,LENGTH,NETPTY,NRGS,NARGS,I
	LOGICAL*1 TBUF(256)
	INCLUDE 'EPPMSG.inc'
	INCLUDE 'EPCOMN.CMN'
	INCLUDE 'PTCCMN.CMN'
C
C     CCOMN IS INCLUDED FOR MULTI COMPATIBILITY. CHANGE TO *CCOMN
C     THE FOLLOWING 3 LINES.
C
      INTEGER*2 CILTXT,CITEXT,COLTXT,COTEXT,CIBUFF(1),COBUFF(1)
      COMMON /CCOMN/ CILTXT,CITEXT(40),COLTXT,COTEXT(40)
      EQUIVALENCE (CIBUFF,CILTXT), (COBUFF,COLTXT)
	NRGS=NARGS()		! HOW MANY ARGUMENTS CALLED WITH?
	CALL CDERRT(CSTAT,TBUF,76,LENGTH)
	LENGTH=LENGTH+2
	TYPE 22,(TBUF(I),I=1,LENGTH)
22	FORMAT(' ',80A1)
	ENCODE(80,23,COTEXT)CSTAT
23	FORMAT(' EPSTAT(1)=',I11,'. EPSTAT(2)=',I11,'.')
	CALL MSGCOM(NETPTY,55,COTEXT)
	IF(NRGS.GT.1) CALL CDINF(INF)
995	CONTINUE
	RETURN
	END
#EPINIT                                           19-OCT-83  17:42:23
C	EPINIT- INITIALIZE EPPACK
C	
C	Author: Peter Heinicke
C	
c	Revised: October 19, 1983 (DEFAULTS)
C
c
c
c*>>>
	FUNCTION EPINIT(DEVNAM,UNIT,ETYP,TIMOUT,PTC)
	IMPLICIT NONE
	CHARACTER*(*) DEVNAM
	INTEGER EPGPTC,NAR,NARGS
	INCLUDE 'EPPMSG.inc'
	INCLUDE 'EPCOMN.CMN'
	INCLUDE 'PTCCMN.CMN'
	INCLUDE 'PTCDEF.CMN'
	IF(EPFLAG.EQ.1) GOTO 960
C
C	TRY TO TELL IF THE PTCCMN WAS PROPERLY DATA STATEMENTED
	IF(ITRCMP.NE.3) CALL LIB$SIGNAL(EPPACK_BADPTCDAT)
	EPCHAN=102
	EPFLAG=1
	NAR=NARGS()-1
	IF(NAR.LE. 4) goto 100
	CALL LIB$SIGNAL(EPPACK_INVNUMARGS)
	RETURN
100	CONTINUE
	EPDEVN=DEVNAM
	EPUNIT=UNIT
	EPINIT=EPSETD(DEVNAM,UNIT)
	IF(EPINIT.NE.0) GOTO 910
	IF(NAR.LE.1)EPETYP=1
	IF(NAR.GT.1)EPETYP=ETYP
	IF(NAR.LE.2)EPTIMO=180
	IF(NAR.GT.2)EPTIMO=TIMOUT
	IF(NAR.LE.3)EPPTC=EPGPTC(149)	!GET FIRST AVAIL PTC STARTING @149
	IF(NAR.GT.3)EPPTC=PTC
	EPINIT=EPSETP(EPPTC)+EPSETE(EPETYP)+EPSETT(EPTIMO)
	IF(EPINIT.EQ.0) GOTO 995
C
C..	ERROR EXIT
910	CONTINUE
	EPINIT=%LOC(EPPACK_INITERROR)
	GOTO 995
C
C...	PRE INITED
960	CONTINUE
	EPINIT=%LOC(EPPACK_ALREADY)
995	CONTINUE
	RETURN
	END
C*
C
C	EPGPTC- GET FIRST AVAILABLE PTC STARTING WITH ARGUMENT
C
C	AUTHOR: Peter Heinicke
C	DATE: OCT-14-1983
C
C***
	FUNCTION EPGPTC(ISTPTC)
	INCLUDE 'EPCOMN.CMN'
	INCLUDE 'EPPMSG.INC'
	INCLUDE 'PTCCMN.CMN'
	INTEGER EPGPTC,ISTPTC
	EPGPTC=ISTPTC
100	IF(EPGPTC.GE.255) GOTO 990
	CALL CDOPEN(EPCHAN,EPGPTC,EPSTAT)
	IF(EPSTAT(1).EQ.CDOK) GOTO 995
	EPGPTC=EPGPTC+1
D	TYPE *,' EPGPTC' ,EPGPTC
D	CALL EPINF(EPSTAT)
	GOTO 100
990	CONTINUE
	CALL LIB$SIGNAL(EPPACK_NOPTCAVAIL)
	GOTO 1000
995	CONTINUE
	CALL CDCLOS(EPCHAN,EPGPTC,EPSTAT)
1000	CONTINUE
	RETURN
	END
#EPNWT                                            13-NOV-83  20:26:06
C**
C
C	FUNCTION epnwt IS TO PROVIDE AN EFFICIENT INTERFACE
C	TO THE CDPACK ROUTINES.
C	USAGE:
C	IF(epnwt(MBN,STAT).EQ.CDOK) GOTO GOT_A_MESSAGE
c	IF(EPNWT(MBN,STAT).EQ.WAIT) GOTO WAITING
C		ELSE REPORT ERRORS
C
C**
        FUNCTION epnwt(MBN,STAT)
	IMPLICIT NONE
	INTEGER STAT(2),INF,MBN,TMBN
	INCLUDE 'EPCOMN.CMN'
	INCLUDE 'PTCCMN.CMN'
C
C	EXECUTABLE STATEMENTS
C
	TMBN=MBN		!in case mbn=stat(2)
	CALL CDSTAT(TMBN,INF,STAT)
	IF(INF.EQ.IRCPND.OR.INF.EQ.ITRPND) GOTO 20
	IF(INF.EQ.IRCCMP.OR.INF.EQ.ITRCMP) GOTO 30
	CALL CDINF(INF)	!REPORT INF ERROR
	STAT(1)=INF	!INF CAN'T BE CDOK IF WE GET HERE
	GOTO 30
C
C...	WAIT CASE
20	CONTINUE
	STAT(1)=WAIT
30	CONTINUE
	epnwt=STAT(1)
	RETURN
	END
#EPPMSG                                           16-NOV-83  16:43:18
	.title		EPPACK sample error and warning mesages
	.facility	EPPACK,1/prefix=EPPACK_
	.severity	error
	.ident		'version 3.20'
	GENLKERR	<EPEV general link error>
	ansunabre	<EPANS unable to receive>
	ansunabxm	<EPANS unable to send>
	NOPTCAVAIL	<No Available PTC's>
	bufunabxm	<EPBUFF unable to send>
	bufunabre	<EPBUFF unable to receive>
	unpackovrun	<unpacking overrun>
	badptcdat	<PTCCMN was not initialised correctly>
	invnumargs	<invalid number of arguments in EPINIT>
	.severity	warning
	.base		10
	initerror	<Initialization error>
	already		<IN-66 protocol already inited>
	retry		<Retrying .... >
	badstate	<EPBNWT state is corrupt>
	.end
#EPSETD                                           28-JUL-83  20:51:31
        FUNCTION EPSETD(DEVNAM,UNIT)
	IMPLICIT NONE
	CHARACTER*(*) DEVNAM
	INCLUDE 'EPCOMN.CMN'
	INCLUDE 'EPPMSG.inc'
	INCLUDE 'PTCCMN.CMN'
	CALL CDASGN(EPCHAN,DEVNAM,UNIT,EPSTAT)
	IF(EPSTAT(1).EQ.CDOK) GOTO 990
	CALL EPINF(EPSTAT)
	EPSETD=1
	GOTO 995
C
C..	SUCCESS EXIT
990	CONTINUE
	EPDEVN=DEVNAM
	EPSETD=0
995	CONTINUE
	RETURN
	END
#EPSETE                                           28-JUL-83  20:51:31
        FUNCTION EPSETE(ETYP)
	IMPLICIT NONE
	INCLUDE 'EPPMSG.inc'
	INCLUDE 'EPCOMN.CMN'
	INCLUDE 'PTCCMN.CMN'
	EPETYP=ETYP
	EPSETE=0
995	CONTINUE
	RETURN
	END
#EPSETP                                           27-SEP-83  15:40:44
        FUNCTION EPSETP(PTC)
	IMPLICIT NONE
	INTEGER ICODE
	INCLUDE 'EPPMSG.inc'
	INCLUDE 'EPCOMN.CMN'
	INCLUDE 'PTCCMN.CMN'
C
C..	TRY TO CLOSE CURRENT SESSION
	EPSETP=1
	CALL CDCLOS(EPCHAN,EPPTC,EPSTAT)
	IF(EPSTAT(1).NE.CDOK) GOTO 995
	EPPTC=PTC
	CALL CDOPEN(EPCHAN,EPPTC,EPSTAT)
	IF(EPSTAT(1).EQ.CDOK) GOTO 990
	ICODE=EPINF(EPSTAT)
	GOTO 995
C
C..	SUCCESS EXIT	
990	CONTINUE
	EPMBN=EPSTAT(2)	! STORE THE SESSION MBN
	EPSETP=0
995	CONTINUE
	RETURN
	END
#EPSETT                                           28-JUL-83  20:51:31
        FUNCTION EPSETT(TIMOUT)
	IMPLICIT NONE
	INCLUDE 'EPPMSG.inc'
	INCLUDE 'EPCOMN.CMN'
	INCLUDE 'PTCCMN.CMN'
C
C...	INDICATE SUCCESS
	CALL CDTMO(TIMOUT,1)	! 1 => TICKS
	EPTIMO=TIMOUT
	EPSETT=0
995	CONTINUE
	RETURN
	END
#EPWAIT                                           28-JUL-83  20:51:31
C**
C
C	FUNCTION EPWAIT IS TO PROVIDE AN EFFICIENT INTERFACE
C	TO THE CDPACK ROUTINES.
C	USAGE:
C	IF(EPWAIT(MBN,STAT).EQ.CDOK) GOTO GOT_A_MESSAGE
C		ELSE REPORT ERRORS
C
C**
        FUNCTION EPWAIT(MBN,STAT)
	IMPLICIT NONE
	INTEGER STAT(2),INF,MBN,TMBN
	INCLUDE 'EPCOMN.CMN'
	INCLUDE 'PTCCMN.CMN'
C
C	EXECUTABLE STATEMENTS
C
	TMBN=MBN
	CALL CDWAIT(TMBN)
	CALL CDSTAT(TMBN,INF,STAT)
	IF(INF.EQ.IRCCMP.OR.INF.EQ.ITRCMP) GOTO 30
	CALL CDINF(INF)	!REPORT INF ERROR
	STAT(1)=INF	!INF CAN'T BE CDOK IF WE GET HERE
30	CONTINUE
	EPWAIT=STAT(1)
	RETURN
	END
#MSGCOM                                            6-MAY-84  18:25:40
C	MSGCOM IS A COMPATIBILITY ROUTINE
C	ALL IT NEEDS TO DO IN RT-11 IS TO
C	CALL MSGOUT (ASSUMING YOU ARE USING THE MULTI I/O
C	SYSTEM. IN VMS, IT IS MORE CONVENIENT TO USE
C	FORTRAN I/O OR FEEL FREE TO USE YOUR OWN SOLUTION
C	TO THE PROBLEM OF OUTPUTTING MESSAGES.
C
C	DATE 4-MAY-84
C	AUTHOR: PETER HEINICKE
C
	SUBROUTINE MSGCOM(PRTY,NCHAR,MSG)
C
C	FOR RT-11
C	CALL MSGOUT(PRTY,NCHAR,MSG)
C	RETURN
C	END
C
	INTEGER PRTY,NCHAR
	LOGICAL*1 MSG(1)
	TYPE 10,(MSG(I),I=1,NCHAR)
10	FORMAT(1X,80A1)
	RETURN
	END
#MSGINC                                            6-MAY-84  19:01:14
	EXTERNAL EPPACK_ANSUNABRE,EPPACK_ANSUNABXM,EPPACK_BUFUNABXM,
     &	EPPACK_BUFUNABRE,EPPACK_UNPACKOVRUN,EPPACK_INVNUMARGS,
     &	EPPACK_INITERROR,EPPACK_ALREADY,EPPACK_RETRY,EPPACK_GENLKERR,
     &	EPPACK_BADPTCDAT,EPPACK_NOPTCAVAIL,EPPACK_BADSTATE
#NARGS                                            28-JUL-83  20:51:31
	.TITLE	NARGS
;+
;	FORTRAN CALLABLE NUMBER OF ARGUMENTS ROUTINE
;	SUGGESTED BY TOM NICINSKI
;	AUTHOR:	PETER HEINICKE
;	DATE:	JULY 26,1983
;	REVISED:
;-
	.IDENT	/V00.00/
	.ENTRY	NARGS,^M<>
	MOVL	8(FP),R0
	MOVZBL	(R0),R0			; mov nargs back to caller register
	RET
	.END
#PTCCMN                                            6-MAY-84  19:01:14
	INTEGER ALL,FREE,BUSY,SAMPLE
	INTEGER EVR,EVX,ANX,RTANR
	INTEGER IREQCD,IPTC,ISIZ,ITYP,IMOD,IGET
	INTEGER NDOWN,CDOK,PTCALO
	INTEGER INACTV,IOPCN,ITRPND,IRCPND,ITRCMP,IRCCMP
 	INTEGER INEWSG,IPNDMS
	INTEGER LKEXI1,LKANA1,LKLOG1,LKSEN1,LKINI1
	INTEGER LKINI2,LKINI3,LKANA3,LKANA2
	INTEGER LKFRE1,LKFRE2,LKREC1,LKSEN3
	COMMON/ERRIND/LKEXI1,LKANA1,LKANA2,LKLOG1,LKSEN1,LKINI1,
     1  LKFRE1,LKFRE2,LKREC1,LKSEN3,LKINI2,LKINI3,LKANA3
	COMMON/NTSTAT/INACTV,IOPCN,ITRPND,IRCPND,ITRCMP,IRCCMP,
     2 IPNDMS,INEWSG,CDOK,PTCALO
	COMMON/PTCDAT/EVR,EVX,ANX,RTANR,ALL,SAMPLE,NDOWN,BUSY,
     1	FREE
	COMMON/REQOFF/IREQCD,IPTC,ISIZ,ITYP,IMOD,IGET
#PTCDEF                                            6-MAY-84  19:01:14
	DATA ALL/0/, SAMPLE/1/,NDOWN/10/,PTCALO/10/,CDOK/1/
	DATA FREE/-1/,BUSY/2/
	DATA EVR/1/,EVX/2/,ANX/3/,RTANR/4/
	DATA IREQCD/1/,IPTC/2/,ISIZ/3/,ITYP/4/,IMOD/5/,IGET/6/
C	SYMBOLIC RETURNS FROM A CDSTAT CALL (CF CDPACK)
	DATA  INACTV/-1/, IOPCN/0/, ITRPND/1/, IRCPND/2/, ITRCMP/3/
	DATA IRCCMP/4/,IPNDMS/5/, INEWSG/6/
C	ERROR INDICES
	DATA LKANA2/3/
	DATA LKEXI1/1/,LKANA1/2/,LKLOG1/4/,LKSEN1/5/,LKINI1/6/
	DATA LKFRE1/7/,LKFRE2/8/,LKREC1/10/,LKSEN3/11/
	DATA LKINI2/12/,LKINI3/13/,LKANA3/14/
#SLEEP                                            15-NOV-83  16:54:18
d20	accept *,it
d	call sleep(it)
d	goto 20
d10	stop
d	end
	SUBROUTINE SLEEP(TIME)
C
C	HIBERNATE FOR (TIME) MILISECONDS
C
	INTEGER DEL(2), TIME
	INTEGER SYS$SCHDWK, SYS$HIBER
	DEL(2) = -1
	DEL(1) = -TIME*1000*10		! 100 NS UNITS TO SLEEP
	ISTATS = SYS$SCHDWK(,,DEL,)	! SCHEDULE WAKEUP
	IF (.NOT.ISTATS) TYPE *,'SYS$SCHSWK returns error',istats
	ISTATH = SYS$HIBER()		! GO TO SLEEP
	IF (.NOT.ISTATH) TYPE *,'SYS$HIBER returns error',istath
	RETURN
	END