FTN,L 
      SUBROUTINE DIGIN(ISLOT,IDATA),09580-16427 1926 790420 
C---------------------------------------------------------
C 
C     RELOC.                 09580-16427
C     SOURCE                 09580-18427
C 
C     L.CORTEZ
C 
C     TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETRY 
C     MATERIAL OF THE HEWLETT-PACKARD COMPANY.
C 
C     (C) COPYRIGHT  HEWLETT-PACKARD COMPANY  1979
C     ALL RIGHTS RESERVED. NO PART OF THIS PROGRAM
C     MAY BE PHOTOCOPIED, REPRODUCED OR TRANSLATED
C     TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR 
C     WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. 
C 
C-----------------------------------------------------------
C 
C     BRANCH AND MNEMONIC TABLES ENTRIES: 
C     ----------------------------------
C 
C        DIGIN(I,IV),      OV#=XX,     ENT=DIGIN,  FIL=%DIGIN 
C 
C-----------------------------------------------------------
C 
C     THIS SUBROUTINE PROGRAMS THE HP 69431A TTL INPUT
C     CARD. 
C 
      DIMENSION IERMS(5)
      DATA IDTN/23/ 
      DATA IERMS/10,5,2HDI,2HGI,2HN / 
      ISTN = ISN(DUMMY) 
      LU = LUDV(ISTN,IDTN)
      IF(LU)800,800,30
30    CALL XIGIN(LU,IERMS,ISLOT,IDATA)
      IF(IERMS)800,40,800 
40    CONTINUE
      RETURN
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
C 
      SUBROUTINE XIGIN(LU,IERR,ISLOT,IDATA),
     +09580-16427 1926 790420 
C 
C 
C                LU = LOGICAL UNIT NUMBER OF 6940 
C                IERR = 5-WORD ERROR ARRAY
C                      WHERE: IERR(1) = ERROR CODE
C                                       0 = NO ERRORS 
C                                      -1 = PARAMETER ERROR 
C                                      -2 = TIME OUT ERROR
C                                      -9 = I/O CALL REJECTED 
C                                     -10 = ILLEGAL LU
C                             IERR(2) = CHARACTER COUNT 
C                             IERR(3) - IERR(5) = DEVICE MNEMONIC 
C               ISLOT = UNIT ADDRESS + SLOT ADDRESS 
C                       0 - 14    (6940)
C                       100 - 114 (6941 UNIT #1)
C                       200 - 214 (6941 UNIT #2)
C                       300 - 314 (6941 UNIT #3)
C                       ------------------------
C                       1500 - 1514 (MAX) 
C 
C               IDATA = INPUT DATA
C                       0 - 7777 (OCTAL)
C 
      DIMENSION IADDR(7),IBUF(2)
      DIMENSION IERR(5),IREG(2) 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
C 
      DATA IADDR/100000B,110000B,120000B,130000B,140000B,150000B, 
     1160000B/
      DATA ICNWD/170200B/ 
C 
C ***  PARAMETER CHECK
C 
      IERR = 0
      IF(IUNIT.GT.1514)GO TO 8000 
C 
C ***   FIND UNIT AND SLOT ADDRESSES
C 
      NUMBR = 0 
      IUNUM = ISLOT 
20    CONTINUE
      IF(IUNUM.LT.0)GO TO 8000
      IF(IUNUM.LE.15)GO TO 30 
      NUMBR = NUMBR + 1 
      IUNUM = IUNUM - 100 
      GO TO 20
30    CONTINUE
      IF(IUNUM.GT.14)GO TO 8000 
      IBUF = IOR(ICNWD,NUMBR) 
      IF(IUNUM.LT.8)IBUF(2) = IUNUM*10000B
      IF(IUNUM.GT.7)IBUF(2) = IADDR(IUNUM-7)
C 
C ***   OUTPUT WORD TO MULTI-PROGRAMMER 
C 
  90  CALL REIO(100002B,100B+LU,IBUF,2) 
      GOTO 7000 
  95  CALL ABREG(IA,IB) 
      IF(IAND(IREG,377B) .NE.0) GOTO 7500 
 100  CONTINUE
C 
C ***  INPUT DATA FROM MULTI-PROGRAMMER 
C 
 110  CALL REIO(100001B,100B+LU,IDATA,1)
      GOTO 7000 
 120  CALL ABREG(IA,IB) 
      IF (IAND(IREG,377B) .NE. 0) GOTO 7500 
 130  CONTINUE
C 
 140  ITEST=IDATA 
      ITEST=(IAND(7777B,ITEST)) 
C 
C *** ISOLATE DIGITAL DATA TO OCTAL 
C 
C 
      ID1=ITEST/8 
      R1=ITEST-(ID1*8)
C 
      ID2=ID1/8 
      R2=ID1-(ID2*8)
C 
      ID3=ID2/8 
      R3=ID2-(ID3*8)
C 
      R4=ID3
C 
      DATA=R4*1000.+R3*100.+R2*10.+R1 
C 
      IDATA=INT(DATA) 
C 
      RETURN
C 
C 
C ***   ERROR CONDITIONS
C 
7000  IERR = 9
      GO TO 8100
7500  IERR = 2
      GO TO 8100
8000  IERR = 1
8100  IERR(3) = 2HDI
      IERR(4) = 2HGI
      IERR(5) = 2HN 
      RETURN
      END 
      END$
    