FTN4,L
      SUBROUTINE ACSEN(ISLOT,IRWD), 09580-16429 REV.2001 791023 
C 
C*******************************************************
C 
C  RELOCATABLE  09580-16429 
C  SOURCE       09580-18429 
C 
C  REY UNTALAN     790604 
C  BOB RICHARDS    791023 
C 
C**************************************************** 
C 
C 
C  !=================================================!
C  !                                                 !
C  ! (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979      !
C  !                ALL RIGHTS RESERVED              !
C  !                                                 !
C  ! NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,     !
C  ! REPRODUCED OR TRANSLATED INTO ANOTHER PROGRAM   !
C  ! LANGUAGE WITHOUT THE PRIOR WRITTEN CONSENT OF   !
C  ! THE HEWLETT-PACKARD COMPANY.                    !
C  !                                                 !
C  !-------------------------------------------------!
C  !                                                 !
C  ! TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETARY  !
C  ! MATERIAL OF THE HEWLETT-PACKARD COMPANY.        !
C  !                                                 !
C  ! THIS SOURCE DATA SHALL BE USED SOLELY IN        !
C  ! CONJUNCTION WITH ELECTRONIC COMPUTER SYSTEMS    !
C  ! SUPPLIED TO THE USER BY HEWLETT-PACKARD.        !
C  !                                                 !
C  ! THIS PROPRIETARY DATA SHALL NOT BE COPIED OR    !
C  ! OTHERWISE REPRODUCED WITHOUT THE PRIOR WRITTEN  !
C  ! CONSENT OF HEWLETT-PACKARD, EXCEPT THAT ONE     !
C  ! COPY MAY BE MADE AND RETAINED BY THE USER FOR   !
C  ! ARCHIVE PURPOSES.                               !
C  !                                                 !
C  ! THE USER SHALL NOT DISCLOSE THIS DATA TO ANY    !
C  ! THIRD PARTIES WITHOUT THE PRIOR WRITTEN CONSENT !
C  ! OF HEWLETT-PACKARD. IN ADDITION, THE USER SHALL !
C  ! USE AT LEAST THE SAME CARE AND SAFEGUARDS TO    !
C  ! PROTECT THIS DATA FROM UNAUTHORIZED USE OR      !
C  ! DISCLOSURE AS THE USER USES TO PROTECT ITS OWN  !
C  ! PROPRIETARY DATA.                               !
C  !                                                 !
C  !=================================================!
C 
C  GENERAL: 
C  -------- 
C 
C    THE FOLLOWING DEVICE SUBROUTINES ARE USED
C   TO PROGRAM THE EVENT SENSE CARD (69434) 
C --------------------- 
C 
C HARDWARE
C --------
C 
C 
C 
C   HP 12566-60024 MICROCIRCUIT CARD
C        JUMPERED AS FOLLOWS: 
C 
C         W1-A
C         W2-W4-B 
C         W5-W8-OUT 
C         W9-A
C 
C      JUMPER THE 69434 AS FOLLOWS: 
C 
C          W2 - B 
C          W3 - D (EXT.WORD  NOT EQUAL TO  REF. WORD) 
C          W4 - OUT 
C          W6 - IN
C 
C 
C BRANCH AND MNEMONIC TABLE ENTRIES 
C 
C ACSEN(I,I)    OV=XX,  ENT=ACSEN FIL=%ACSEN
C SENPL(IV,IV)   OV=XX,  ENT=SENPL, FIL=%ACSEN
C 
C************************************************ 
C 
C   ERRORS: 
C           1 = PARAMETER ERROR 
C           9 = I/O ERROR 
C          10 = LU ERROR
C 
C 
C************************************************ 
C 
C 
C     SUBROUTINE ACSEN(ISLOT,IRWD)
C 
C 
C  WHERE: 
C         ISLOT = SLOT # OF 69434A (EVENT SENSE CARD) 
C                 400 THRU 414  OF 6940B MULTIPROGRIMMER
C 
C         IRWD = REFERENCE WORD FOR 69434A
C               0 TO 7777 
C 
C 
C*****************************************
      DIMENSION IERMS(5)
      DATA IERMS/10,5,2HAC,2HSE,2HN / 
      DATA IDTN/23/ 
C 
C  FIND STATION # AND LU #
C 
      IERMS=10
      ISTN=ISN(DUMMY) 
      LU=LUDV(ISTN,IDTN)
      IF(LU)800,800,20
C 
20    CALL XCSEN(LU,IERMS,ISLOT,IRWD) 
      IF(IERMS)800,30,800 
30    RETURN
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
C===============================================================
C 
C 
C 
C 
C   THIS SUBROUTINE WILL POLL EACH SLOT OF THE  6940B 
C   SEQUENTIALLY STARTING AT SLOT 400. THE FIRST CARD 
C   THAT SETS THE IRQ (BIT 15) WILL BE RETURNED IN IWD1   . 
C   IWRD WILL BE THE EXTERNAL WORD. IT IS UP TO THE PROGRAM-
C   MER TO DETERMINE WHICH BIT OR BITS CAUSED THE INTERRUPT.
C 
C 
      SUBROUTINE SENPL(IWD1,IWRD), 09580-16429 REV.2001 791023
C 
C 
      DIMENSION IBUF(2),IERR(5),ID(5),IDBUF(3),ICBUF(3) 
      DATA IDTN /23/
      DATA ICBUF/4,5/ 
C 
C 
C 
      ISTN =ISN(DUMMY)
      LU =LUDV(ISTN,IDTN) 
      IF(LU)800,800,100 
C 
C 
100   IDBL = 2
      ICBL =2 
      IDBUF(1) = 13 
      IBUF(1) = 13
C 
      ICWD = 170200B
C 
      IWD1=-1 
      IWRD=-1 
C 
C  OUTPUT CONTROL WORD
C 
      CALL EXEC(100002B,100B+LU,ICWD,1) 
      GOTO 7000 
C 
C 
C 
C 
C  POLL EACH SLOT 
C 
110   DO 120 ISLOT=0,14 
C 
      IDBUF(2) =ISLOT*10000B
C 
C 
C 
C 
C 
C 
C  OUTPUT SLOT # WITHOUT GATE 
C 
      CALL EXEC(100002B,11300B+LU,IDBUF,2,ICBUF,2)
      GOTO 7000 
C 
C 
C  READ EXTERNAL WORD 
C 
130   CALL EXEC(100001B,11300B+LU,IBUF,2,ICBUF,2) 
      GOTO 7000 
C 
C  CHECK IF BIT(15) IS SET
C 
140   IF(IBUF(2) .LT. 0) GOTO 200 
C 
C  NO IRQ 
C  CHECK NEXT SLOT
C 
120   CONTINUE
C 
C 
C  DID NOT FIND ANY SLOT THAT SET BIT 15
C 
C 
C 
      GOTO 8001 
C 
C   WE FOUND IT 
C 
200   IWD1 = 400+ISLOT
C 
C  PROCESS EXTERNAL WORD
C 
      IWD2=IAND(IBUF(2),7777B)
C 
C 
C 
C 
      ID(1)=IAND(IWD2,7000B)/1000B
      ID(2)=IAND(IWD2,700B)/100B
      ID(3)=IAND(IWD2,70B)/10B
      ID(4)=IAND(IWD2,7B) 
C 
      ID(1)=ID(1)*1000
      ID(2)=ID(2)*100 
      ID(3)=ID(3)*10
C 
C 
      IWRD =ID(1)+ID(2)+ID(3)+ID(4) 
C 
C 
C 
C 
C 
C 
8001  RETURN
C 
C 
C  ERROR EXIT 
C 
800   IERR=10 
      GOTO 8500 
7000  IERR=9
8500  IERR(2)=5 
      IERR(3)=2HSE
      IERR(4)=2HNP
      IERR(5)=2HL 
      CALL ERROR(IERR,IERR(2))
      RETURN
      END 
C===============================================
C 
C 
      SUBROUTINE XCSEN(LU,IERR ,ISLOT,IRWD), 09580-16429 REV.2001 
     +791023
C 
C 
      DIMENSION IERR(5),ID(5),IREG(2),IOBUF(5),ICBUF(5) 
      DIMENSION IDBUF(5)
      EQUIVALENCE(REG,IREG,IA),(IREG(2),IB) 
      DATA ICBUF/4,3/ 
C 
C 
C   CHECK PARAMETERS
C 
      IERR=0
C 
      ISLOT=ISLOT-400 
C 
      IF(ISLOT .LT. 0 .OR. ISLOT .GT. 14) GOTO 8000 
C 
      IF(IRWD .LT. 0 .OR. IRWD .GT. 7777) GOTO 8000 
C 
C 
C   PROCESS REFERENCE WORD
C 
      ID(1) = IRWD/1000 
      ID(2) = (IRWD - (ID(1)*1000))/100 
      ID(3) = (IRWD - (ID(1)*1000) - (ID(2)*100))/10
      ID(4) = IRWD-(ID(1)*1000)-(ID(2)*100)-(ID(3)*10)
C 
C  CHECK EACH DIGIT 
C 
      DO 100 I= 1,4 
      IF(ID(I) .GT. 7) GOTO 8000
100   CONTINUE
C 
C 
C POSITION EACH DIGIT 
C 
      ID(1) = ID(1)*1000B 
      ID(2) = ID(2)*100B
      ID(3) = ID(3)*10B 
C 
C 
C 
C 
C  POSITION SLOT# TO PROPER PLACE 
C 
      ISLOT = ISLOT*10000B
C 
C 
C FORM THE SLOT# AND REFERENCE WORD 
C 
      IDATA=ID(1) 
      DO 200 I=2,4
200   IDATA=IOR(ID(I),IDATA)
C 
C 
      IOBUF(1) = 170000B
      IOBUF(2) = IOR(ISLOT,IDATA) 
      IOBUF(3) = 170420B
C 
C 
      IDBL=2
      ICBL=2
      IDBUF(1) = 13 
      IDBUF(2) = IOBUF(3) 
C 
C 
C 
C 
C  OUTPUT CONTROL WORD ,SLOT # WITH REFERENCE,AND 
C  CONTROL WORD TO SET IEN AND TME ON.
C 
C 
      CALL EXEC(100002B,100B+LU,IOBUF(1),3) 
      GOTO 7000 
C 
C 
C 
C 
C 
1000  CALL EXEC(100002B,11300B+LU,IDBUF,IDBL,ICBUF,ICBL)
      GOTO 7000 
C 
C 
1001  RETURN
C 
C 
C 
C ERROR EXIT
C 
8000  IERR=1
      GOTO 8500 
7000  IERR=9
8500  IERR(2)=5 
      IERR(3)=2HAC
      IERR(4)=2HSE
      IERR(5)=2HN 
      RETURN
      END 
                                        