C*** C TITLE XXPACK C C Version 1.0 March 2nd 1982 C C *** THIS PACKAGE OF FORTRAN SUBROUTINES IS NOW DEFUNCT AND WRONG. WITH C THE EXCEPTION OF CDWAKE ALL THE OTHER SUBROUTINES ARE NOW WRITTEN IN C MACRO AND PART OF THE STANDARD CDPACK PACKAGE C *** C C C FACILITY: Communications Driver package for DR11W link C C ABSTRACT: C This is a package of Fortran callable routines to issue the C QIO's to the XX DR11W device driver. C C C CALLING SEQUENCE: C CALL XXDPTC(LUN,PTC,EF) - DEFINE PTC FOR WHICH MESSAGES ARE C TO BE RECEIVED C CALL XXRPTC(LUN,PTC) - REMOVE PTC FROM REQUIRED PTCS C CALL XXSIGN(LUN,PTC,SIG) - SEND SIGNAL C CALL XXXMT(LUN,PTC,BUF,WCNT,XWC,MODE) - TRANSMIT MESSAGE C CALL XXRCV(LUN,PTC,BUF,LEN,XWC,MODE) - RECEIVE MESSAGE C CALL CDWAKE(LUN) - WAKE UP XX DRIVER C CALL XXERR - REPORT LAST ERROR C C MODE = 1 FOR SLEEP ON THIS XMT OR RCV C MODE = 2 FOR QUEUE THIS RECEIVE (OVERRIDES SLEEP MODE) C C AUTHOR Vicky White C Computing Department, C Fermi National Accelerator Lab C (on leave of absence from DD Division, CERN, Geneva, Switzerland) C C CREATION DATE: March 2nd 1982 C C MODIFIED BY: C C*** C C DEFINE RECEIVE PTC C SUBROUTINE XXDPTC(LUN,PTC,EF) IMPLICIT INTEGER (A-Z) LOGICAL WC COMMON/XXERRC/IERR,IERR2 COMMON/ERRCOM/ERR COMMON/XXCOM/XXLEN,RCVEF,LASPTC,LASWC,ISTAT(2), & ASTFLG,ASTERR,DEBUG DATA WC/.FALSE./ DIMENSION PARAMS(6) !QIO PARAMETER LIST C DIMENSION ISTAT(2) !IO STATUS BLOCK FOR QIO C IO FUNCTION CODES FOR XX DRIVER DATA SPA, XMT,XMTS, RCV, RCVS, RCVQ, SSIG, AWA, RPA/ & "14400,"400,"401,"1000,"1001,"1004,"17000,"16400,"15000/ C FNC=SPA PARAMS(1)=PTC CALL GETADR(PARAMS(2),XXAST) RCVEF=EF !EF TO BE SET WHEN MESSAGE COMES IF(DEBUG.EQ.1) & CALL DLOUTO(' ADDRESS OF XXAST ROUTINE (OCTAL)=',PARAMS(2)) GOTO 100 C C REMOVE PACKET TYPE CODE FROM RECEIVE LIST C ENTRY XXRPTC(LUN,PTC) FNC=RPA PARAMS(1)=PTC GOTO 100 C C SEND SIGNAL ROUTINE C ENTRY XXSIGN(LUN,PTC,SIG) PARAMS(1)=SIG PARAMS(2)=PTC PARAMS(3)=PTC FNC=SSIG GOTO 100 C C TRANSMIT MESSAGE C ENTRY XXXMT(LUN,PTC,BUF,WCNT,XWC,MODE) FNC=XMT IF(MODE.EQ.1) FNC=XMTS CALL GETADR(PARAMS(1),BUF) PARAMS(2)=WCNT*2 PARAMS(3)=PTC WC=.TRUE. GOTO 100 ENTRY XXRCV(LUN,PTC,BUF,LEN,XWC,MODE) FNC=RCV IF(MODE.EQ.1) FNC=RCVS IF(MODE.EQ.2) FNC=RCVQ CALL GETADR(PARAMS(1),BUF) PARAMS(2)=LEN*2 WC = .TRUE. GOTO 100 C C WAKE UP XX DRIVER C ENTRY CDWAKE(LUN) FNC=AWA PARAMS(1)=0 GOTO 100 C C DO ACTUAL QIO TO DRIVER C 100 CONTINUE IF(DEBUG.NE.1) GOTO 104 CALL DLOUTO(' FUNCTION = ',FNC) CALL DLOUTO(' PARAMS (OCTAL) ',PARAMS(1),PARAMS(2),PARAMS(3)) 104 CALL CANMT(LUN) TIMOUT=.FALSE. CALL MARK(LUN,30,2) !30 SECOND TIMEOUT ON RECEIVE CALL QIO(FNC,LUN,LUN,,ISTAT,PARAMS,DSW) IF (DSW.EQ.1) GOTO 120 110 CALL DLOUT(' DSW ERROR ON CALL TO XX ',DSW) CALL DLKEY IERR=DSW GOTO 900 120 CALL WAITFR(LUN,DSW) IF(DEBUG.NE.1)GOTO 122 CALL DLOUT(' ERROR RETURNS FROM XX QIO = ',ISTAT(1),ISTAT(2)) CALL DLKEY 122 IERR=ISTAT(1) IF(IERR.EQ.0) TIMOUT=.TRUE. IERR2=ISTAT(2) 900 IF(WC) XWC=ISTAT(2)/2 IF(WC) ISTAT(1)=-2 WC = .FALSE. RETURN C C ERROR REPORTING ROUTINE C ENTRY XXERR(ERR1,ERR2) IF(ERR1.GT.1) ERR1=ERR1-256 CALL DLOUT(' ERROR FROM XX DRIVER ',ERR1,ERR2) RETURN C C SUBROUTINE TO GET STATUS OF RECEIVED MESSAGES OR SIGNALS C FOR A PARTICULAR PTC ENTRY XXSTAT(LUN,PTC,RWC,STAT) IF(DEBUG.NE.1) GOTO 180 CALL DLOUT(' LAST PTC RECEIVED = ',LASPTC) CALL DLOUT(' LAST WC OR SIGNAL RECEIVED = ',LASWC) CALL DLOUT(' PTC PASSED TO REOUTIN = ',PTC) 180 CONTINUE IF(PTC.NE.LASPTC) GOTO 200 RWC=LASWC IF(RWC.EQ.0) GOTO 220 IF(RWC.LT.0) GOTO 210 IF(RWC.GT.0) GOTO 185 C C SIGNAL RECEIVED C 210 STAT=1 LASWC=0 !MARK SIGNAL RECEIVED RETURN C C MESSAGE EITHER RECEIVED OR PENDING C 185 STAT=ISTAT(1) RETURN 200 STAT=-2 !NO I/O FOR THIS PTC RETURN 220 STAT=-1 !NO NEW IO FOR THIS PTC RETURN END