FTN4
      SUBROUTINE IOM75, 92903-16570 REV.1913  790302
C 
C 
C  SOURCE FILE:  &IOM75   P/N 92903-18570 
C  RELOC. FILE:  %IOM75   P/N 92903-16570 
C 
C 
C  PMGR:  STEVE WITTEN, 
C         DATA SYSTEMS DIVISION,
C         CUPERTINO, CALIFORNIA 
C 
C 
C  ************************************************************** 
C  *                                                            * 
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    * 
C  * RESERVED.  NO PART OF THIS PROGRAM MY BE PHOTOCOPIED, RE-  * 
C  * PRODUCED, OR TRANSLATED INTO ANOTHER PROGRAM LANGUAGE WITH-* 
C  * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY   * 
C  *                                                            * 
C  ************************************************************** 
C 
C  THIS PROGRAM IS PART OF THE: 
C 
C                  DATA CAPTURE SOFTWARE
C                    ( D A T A C A P) 
C 
C  IT USES FEATURES OF THE TERMINAL MONITOR SOFTWARE (TMS). 
C 
C  THIS MODULE, %IOM75 IS A T.U.S. OF THE TMP (TERMINAL MONITOR PROGRAM). 
C     IT IS THE INTERFACE BETWEEN TMP AND THE MULTIPOINT DRIVER (DVR07).
C 
C 
C*********************************************STEVE WITTEN (DSD)********
C 
C  TRUE COMMON
C 
      COMMON ICOM00(5)
C 
C  THIS COMMON BLOCK IS FOR TMS USE ONLY.  N.B. FOR DEBUGGING, ICOM00(1)
C      CONTAINS THE LU# OF THE TERMINAL THAT SCHEDULED TMP. 
C 
C 
C*********************
C                    *
C  COMMON BLOCK # 1  *
C                    *
C*********************
C 
      COMMON LLU(24),IFC,IORTAD,ITRST,ITSNUM(2),ITIM(6),LITE1,LITE2 
     *      ,OUTDEV,INPDEV,ITSNAM(5),OTBFLN,OTBUFR(40)
C 
C  LLU --> ARRAY OF 24 WORDS NEEDED BY TMP.  THIS ROUTINE ONLY NEEDS
C          WORDS 1, 4, AND 5 WHICH ARE "EQUIVALENCED" LATER.
C 
C  IFC --> THE FUNCTION CODE FOR DISPATCHING TO THE APPROPRIATE SECTION 
C          OF THIS CODE.
C 
C  IORTAD --> TEMPORARY STORAGE FOR RETURN ADDRESSES WITHIN I/O MODULE
C                  SO THAT CODE SECTIONS CAN BE REUSED. 
C 
C  ITRST --> THE "USEFUL" SUBSET OF THE 6-BYTE TERMINAL HARDWARE STATUS 
C 
C  ITSNUM -->  WORD#1 IS THE TRANS.SPEC. NUMBER-- 
C              WORD#2 IS THE TRANSACTION STEP.
C 
C  ITIM --> A SIX-WORD BUFFER HOLDING THE SYSTEM TIME IN A FORMAT DE- 
C              SCRIBED IN THE RTE-IV PROGRAMMER'S REFERENCE MANUAL. 
C 
C  LITE1 --> THE HI AND LO BYTES CONTAIN THE LOGICAL NUMBERS OF PROMPTING 
C            LIGHTS TO BE LIT.
C 
C  LITE2 --> THE HI AND LO BYTES CONTAIN THE LOGICAL NUMBERS OF PROMPTING 
C            LIGHTS TO BE LIT.
C 
C  OUTDEV --> OUTPUT DEVICE WORD.  DESCRIBES THE DEVICE TO WHICH OUTPUT 
C             FROM TMP WILL BE ROUTED. BITS 15, 1, AND 0 ARE THE POWER
C             FAIL, PRINTER, AND DISPLAY BITS, RESPECTIVELY.
C 
C  INPDEV --> INPUT DEVICE WORD.  DESCRIBES THE DEVICE FROM WHICH THIS
C             ROUTINE WILL GET INPUT TO PASS TO TMP.  LO BYTE CONTAINS
C             DEVICE DESCRIPTION.  HI BYTE CONTAINS INPUT DESCRIPTION.
C 
C  ITSNAM --> ARRAY OF 5 WORDS TO HOLD THE TRANS.SPEC.# AND SEC.CODE WHEN 
C             THE USER FIRST ADDRESSES A 307X TERMINAL UNDER DATACAP/1000 
C             CONTROL. ITSNAM(4) WILL HOLD TS# AND ITSNAM(5) HOLDS SC.
C             ITSNAM(1,2,3,4) HAVE DIFFERENT MEANINGS IN OTHER PARTS OF THE 
C             CODE AND WILL BE "EQUIVALENCED" LATER.
C 
C  OTBFLN --> LENGTH IN BYTES OF THE BUFFER OF INFORMATION TO BE WRITTEN
C             FROM TMP TO THE 307X TERMINAL.
C 
C  OTBUFR --> BUFFER OF INFORMATION TO BE WRITTEN FROM TMP TO 307X TERMINAL.
C 
C 
C******************** 
C                   * 
C  COMMON BLOCK #3  * 
C                   * 
C******************** 
C 
C 
      COMMON IFIL1(85 ),INBFLN,INBUFR(100)
C 
C 
C  IFIL1 --> ARRAY OF 85 WORDS NEEDED BY TMP.  THIS ROUTINE NEEDS NONE OF 
C            THESE WORDS. 
C 
C  INBFLN --> MAX.LENGTH IN BYTES OF INFORMATION TO BE READ FROM TERMINAL 
C             AND PASSED TO TMP.  TMP GETS THIS NUMBER FROM THE TRANS.SPEC. 
C 
C  INBUFR --> BUFFER OF INFORMATION GOTTEN FROM THE 307X TERMINAL.
C 
C******************** 
C                   * 
C  LAST COMMON WORD * 
C                   * 
C******************** 
C 
C 
      COMMON ICOMEN 
C 
C 
C  THIS WORD NOT NEEDED IN THIS ROUTINE BUT IS NEEDED TO PRESERVE 
C  THE TMS ENVIRONMENT. 
C 
C 
      EQUIVALENCE (LLU(1),LU),(LLU(4),IST),(LLU(5),ITL) 
C 
C  TERMINAL LOGICAL UNIT #, 
C  I/O COMPLETION STATUS, AND 
C  I/O TRANSMISSION LOG, RESPECTIVELY.
C 
C 
      EQUIVALENCE (ISTATS,ITSNAM(1)),(ITRNLG,ITSNAM(2)),
     *            (ISFK2,ITSNAM(4)),(ISFK1,ITSNAM(3)),
     *            (ITSNA5,ITSNAM(5)), 
     *            (LUOXX,ICOM00(1)) 
C 
C 
C  I/O MODULE STATUS (MAINTAINED BY THIS ROUTINE),
C  I/O TRANSMISSION LOG (MAINTAINED BY THIS ROUTINE), 
C  SFK-AS-INPUT-TERMINATOR WORDS (USED BY PARTS OF THIS ROUTINE 
C       TO ENABLE/DISABLE SFK'S AS INPUT TERMINATORS -- BIT POSITION
C       AND CONDITION <<SET OR CLEAR>> INDICATE ENABLE/DISABLE KEY
C       AS INPUT TERMINATOR.), AND
C  LU# OF THE TERMINAL THAT SCHEDULED TMP (USED FOR DEBUGGING). 
C 
C 
C  LOCAL STORAGE
C 
C 
C  DECLARE INTGER AND LOGICAL VARIABLES 
C 
      INTEGER OUTDEV,OTBFLN,OTBUFR
      LOGICAL ISBIT,ISBTW,INUM,KEY75
      DIMENSION MSGBFR(50),ITEMP(10),ISASFK(3),IMN1(2)
      DATA ISTRQ/015536B/,IST75/015534B/,IMN1/177777B,177777B/
      DATA I32768/100000B/,ISASFK/015455B,2Hk0,2H[ /
      DATA IRST/015505B/
C 
C  BEGIN OF PROGRAM 
C 
C  DISPATCH ON FUNCTION CODE
C 
      CALL TMDFN(LLU,LLU,IFIL1,IFIL1,ICOMEN)
      GO TO (111,222,333,444,555),IFC 
C 
C  SET OUTPUT DEVICE AS DISPLAY 
C 
111   OUTDEV=1
C 
C  CLEAR DESTINATION BUFFER 
C 
      DO 199 LL=1,5 
199   ITSNAM(LL)=0
C 
C   RESET THE TERMINAL AND THE DRIVER 
C 
      CALL TMBCT(23B,170000B) 
      ITRST=0 
63    CALL TMBWR(ISTRQ,-2)
64    CALL TMRD(ITEMP,-6) 
      IF(.NOT.ISBIT(IST,5).AND.ITL.EQ.0)GO TO 64
      IF(ITEMP.NE.IST75)GO TO 1050
      IF(ITL.NE.5)GO TO 1050
      IF(.NOT.ISBIT(ITEMP(2),13))GO TO 65 
      CALL TMPZ(50) 
      ITRST=ITRST+1 
      IF(ITRST.GT.60)GO TO 65 
      GO TO 63
65    CALL TMBWR(IRST,-2) 
C 
C   ENABLE ALL SPECIAL FUNCTION KEY 
C 
75    CALL MOVEW(ISASFK,MSGBFR,3) 
      MBLN=5
C 
C   SET RETURN ADDR FROM GET STATUS FOR  IFC=1
C 
      ASSIGN 1060 TO IORTAD 
      ASSIGN 1051 TO ITSNA5 
C 
C   ENTRY TO GET TERMINAL STATUS, CHECK IT AND SAVE IT
C 
100   CONTINUE
      CALL MOVCA(ISTRQ,1,MSGBFR,MBLN+1,2) 
      MBLN=MBLN+2 
D     WRITE(ICOM00,656)LLU(1),MBLN,(MSGBFR(I),I=1,(MBLN+1)/2) 
1051  CALL TMBWR(MSGBFR,-MBLN)
1052  CALL TMRD(ITEMP,-6) 
      IF(.NOT.ISBIT(IST,5).AND.ITL.EQ.0)GO TO 1052
D     WRITE(ICOM00,657)LLU(1),(ITEMP(I),I=1,3)
D657  FORMAT(" /IOM75 LU"I3", TERM. STATUS: "3@8) 
      IF(ITEMP(1).NE.IST75)GO TO 1050 
      IF(ITL.NE.5)GO TO 1050
      IBYT1=IGETB(ITEMP,4)
      IBYT2=IGETB(ITEMP,5)
      ITRST=(IBYT1*256)+IBYT2 
C 
C  REFORMAT ITRST (VALUABLE INFO IN HARDWARE STATUS BYTES) TO 
C     FOLLOWING FORMAT: 
C 
C  UPPER BYTE CONTAINS FOLLOWING: 
C 
C    BITS 0-2 --> PRODUCT # (0=3075,1=3076,2=3077)
C    BITS 3-7 --> UNUSED
C 
C  LOWER BYTE CONTAINS FOLLOWING: 
C 
C    BIT 0 --> ALWAYS A ZERO
C 
C    BIT 1 --> 1 IF DISPLAY IS PRESENT (QUALIFIED BY BIT 7) 
C              0 IF NO DISPLAY IS PRESENT 
C 
C    BIT 2 --> 1 IF KEYBOARD IS PRESENT (QUALIFIED BY BIT 6)
C              0 IF NO KEYBOARD IS PRESENT
C 
C    BIT 3 --> 1 IF PRINTER PRESENT 
C              0 IF NO PRINTER PRESENT
C 
C    BIT 4 --> 1 IF TYPE III READER PRESENT 
C              0 IF NO TYPE III PRESENT 
C 
C    BIT 5 --> 1 IF TYPE V READER PRESENT 
C              0 IF NO TYPE V PRESENT 
C 
C    BIT 6 --> 1 KEYBOARD IS ALPHANUMERIC 
C              0 KEYBOARD IS NUMERIC ONLY 
C 
C    BIT 7 --> 1 DISPLAY IS ALPHANUMERIC
C              0 DISPLAY IS NUMERIC ONLY
C 
C 
C  ISOLATE PRODUCT #
C 
      IPROD=IAND(IGETB(ITRST,2),7B) 
C 
C  DEFAULT IS 3075/3076 
C 
      ITMP=6B 
C 
C  CHECK IF IT IS A 3077
C 
      IF(IPROD.GE.2)ITMP=0B 
C 
C  CHECK FOR TYPE V 
C 
      IF(ISBIT(ITRST,13).OR.ISBIT(ITRST,10))CALL SETBT(ITMP,5,1)
C 
C  CHECK FOR TYPE III 
C 
      IF(ISBIT(ITRST,12).OR.ISBIT(ITRST,9))CALL SETBT(ITMP,4,1) 
C 
C  CHECK FOR PRINTER
C 
      IF(ISBIT(ITRST,11).OR.ISBIT(ITRST,8))CALL SETBT(ITMP,3,1) 
C 
C  CHECK FOR ALPHA DISPLAY
C 
      IF(ISBIT(ITRST,4))CALL SETBT(ITMP,7,1)
C 
C  SET BIT 1 IF PRODUCT IS A 3077 
C 
      IF(IPROD.GE.2)CALL SETBT(ITMP,1,1)
C 
C  CHECK FOR ALPHA KEYBOARD 
C 
      IF(ISBIT(ITRST,5))CALL SETBT(ITMP,6,1)
C 
C  PUT ITRST IN ABOVE FORMAT
C 
      ITRST=(IPROD*256)+ITMP
C 
C  GO TO RIGHT PLACE
C 
      GOTO IORTAD 
C 
C  THE TERMINAL IS NOT A 3075/76/77 ??? THE TERMINAL IS DOWN??? 
C 
1050  ASSIGN 615 TO I 
      CALL TMPER(I,31,ITSNUM,LLU,LLU,0) 
615   CALL TMPZ(3000) 
      GO TO ITSNA5
C 
C   RETURN FOR IFC=1, AFTER THE GET TERMINAL STATUS 
C  DECONFIGURE ALL DEVICES BUT KEYBOARD & DISPLAY 
C 
1060  ASSIGN 1070 TO IORTAD 
1065  MBLN=0
C 
C  CONFIGURE DISPLAY AND KEYBOARD -- DECONFIGURE ALL OTHER DEVS.
C 
      IDEV=6B 
      CALL DEV75(ITRST,IDEV,MSGBFR,MBLN)
C 
C  LIGHT TS# [-SC] LIGHT
C 
      LITE2=15
      GOTO 1121 
C 
C  GO TO PRINT THE MESSAGE IF ANY, LIGHT THE LIGHT AND RETURN 
C  AT THE FOLLOWING LINE
C 
C  THE MESSAGE FOR THE DISPLAY, FROM ZTMP IS TO OUTPUT ONLY ONCE. 
C 
1070  OTBFLN=0
      LITE1=0 
C 
C  DO THE WRITE 
C 
D     WRITE(ICOM00,656)LLU(1),MBLN,(MSGBFR(I),I=1,(MBLN+1)/2) 
      CALL TMWR(MSGBFR,-MBLN) 
C 
C  READ THE TS-SC 
C 
1071  CALL TMRD(ITEMP,-20,4B) 
      IF(.NOT.ISBIT(IST,5).AND.ITL.EQ.0)GO TO 1071
C 
C  INIT SC
C 
      ITSNA5=0
C 
C  GET TS# FROM LAST CHAR IN INPUT BUFFER -- USER PUSHES SFK
C 
      IF(KEY75(LIGNUM,IMN1,ITEMP,ITL))
     *      CALL TMPER(0,99,ITSNUM,LLU,322,LIGNUM)
C 
C  IF USER PUSH ATT -- RESET & TRY AGAIN
C 
      IF(LIGNUM.GE.128)GO TO 111
C 
C  USER INPUTS GARBAGE -- GENERATE ERR
C 
      IF(LIGNUM.GT.0.AND.ITL.NE.0)GO TO 200 
C 
C  A GOOD TS# HAS BEEN OBTAINED 
C 
      IF(LIGNUM.GT.0)GO TO 300
C 
C  USER PUSHES ONLY ENTER KEY 
C 
      IF(ITL.EQ.0)GO TO 200 
C 
C  SCAN FOR A "-", IF PRESENT, THEN USER INPUTS TS#-SC
C 
      DO 170 ITT=1,ITL
      IF(IGET1(ITEMP,ITT).EQ.1H-)GO TO 175
170   CONTINUE
175   CONTINUE
C 
C  CONVERT TS# TO NUMERIC 
C 
      IF(INUM(ITEMP,1,ITT-1,LIGNUM))GO TO 200 
C 
C  IS TS# BETWEEN 0 AND 9999?  IF NOT GENERATE ERR
C 
      IF(ISBTW(LIGNUM,0,9999))GO TO 200 
C 
C  CHECK TO SEE IF HAVE TO CONVERT SC TO NUMERIC ALSO 
C 
      IF(ITT-1.GE.ITL)GO TO 300 
C 
C  CONVERT SC TO NUMERIC
C 
190   IF(INUM(ITEMP,ITT+1,ITL-ITT,I))GO TO 200
      IF(FLOAT(I).LT.-32767. .OR. FLOAT(I).GT.32767.) GOTO 200
      ITSNA5=I
C 
C  A GOOD SET OF NUMBERS -- PUT IN A FROM COMPATIBLE WITH TMP 
C 
300   ITSNAM=I32768 
      ITSNAM(4)=LIGNUM
      RETURN
C 
C  OBVIOUS ERROR DETECTED BY THE I/O MODULE.
C 
200   LITE1=128 
      GOTO 1060 
C 
C   ENTRY POINT FOR GENERATING STRING FOR THE DISPLAY/LIGHT/... 
C 
C 
C  CHECK FOR DISPLAY -- IF REQUIRED MOVE "ESC J" TO FRONT OF BUFFER 
C 
1121  IF(.NOT.ISBIT(OUTDEV,0))GO TO 1127
      CALL MOVCA(015512B,1,MSGBFR,MBLN+1,2) 
      MBLN=MBLN+2 
1127  CALL MOVCA(OTBUFR,1,MSGBFR,MBLN+1,OTBFLN) 
      MBLN=MBLN+OTBFLN+1
      CALL PUTCA(MSGBFR,6400B,MBLN) 
C 
C  GENERATE LIGHT STRING
C 
      IF(ISBIT(OUTDEV,0))CALL LIT75(LITE1,LITE2,MSGBFR,MBLN)
      GOTO IORTAD 
C 
C*********************************************************************
C 
C 
C  FUNCTION CODE #2 -- READ SECURITY CODE WITHOUT ECHO
C 
C 
C  GO UPDATE DISPLAY
C 
222   ASSIGN 2225 TO IORTAD 
      GOTO 1065 
C 
C  RETURN FROM THE LIGHT/MESSAGE GENERATOR
C 
C  DISABLE THE DISPLAY
C 
2225  CALL DEV75(ITRST,4B,MSGBFR,MBLN)
C 
C  WRITE STRING 
C 
D     WRITE(ICOM00,656)LLU(1),MBLN,(MSGBFR(I),I=1,(MBLN+1)/2) 
      CALL TMBWR(MSGBFR,-MBLN)
C 
C  READ THE SECURITY CODE 
C 
2226  CALL TMRD(ITEMP,-20)
      IF(.NOT.ISBIT(IST,5).AND.ITL.EQ.0)GO TO 2226
C 
C  CHECK FOR ATT -- IF ATT, THEN DO ENTIRE FUNCTION AGAIN 
C 
      IKTMP=ITL 
      IF(KEY75(KEYNO,ISFK1,ITEMP,IKTMP))
     *       CALL TMPER(0,99,ITSNUM,LLU,322,KEYNO)
      IF(KEYNO.EQ.0 .AND. ITL.NE.0)GO TO 2241 
C 
C  THE USER USE A SFK OR ATT, RESTART  IFC=1
C 
      OTBFLN=0
      LITE1=0 
      GO TO 111 
C 
C  CONVERT SECURITY CODE TO DECIMAL -- IF CONVERSION ERR, DO AGAIN
C 
2241  IF(INUM(ITEMP,1,ITL,I))GO TO 1065 
      IF(FLOAT(I).LT.-32767. .OR. FLOAT(I).GT.32767.)GO TO 1065 
      ITSNA5=I
      RETURN
C 
C*********************************************************************
C 
C 
C  FUNCTION CODE # 3 -- TERMINAL FEATURE CHECK
C 
C 
C  SAVE REQUIRED FEATURES WORD FROM INPUT BUFFER
C 
333   ICHEK=INBUFR(1) 
      ISTATS=0
      DO 335 I=3,7
335   IF(ISBIT(ICHEK,I).AND.(.NOT.ISBIT(ITRST,I)))ISTATS=1
      RETURN
C 
C********************************************************************** 
C 
C 
C  FUNCTION CODE #4 -- RESET THE TERMINAL AND THEN
C                      ENABLE/DISABLE SFK'S AS REQUIRED BY TGP WORDS
C 
C 
444   CALL TMBWR(IRST,1)
C 
C  SET RETURN ADDRESS IN CASE TERM. IS DOWN 
C 
      ASSIGN 444 TO ITSNA5
C 
C  GENERATE SFK STRING
C 
      ASSIGN 4446 TO IORTAD 
      CALL SFK75(ITRST,ISFK1,ISFK2,MSGBFR,MBLN) 
C 
C  WRITE STRING TO TERMINAL AND GET THE TERMINAL STATUS 
C 
      GOTO 100
C 
C  RETURN FROM THE RESET/GET TERMINAL STATUS SECTION
C 
4446  CONTINUE
      IF(ISBIT(IST,7))CALL TMPER(0,99,ITSNUM,LLU,324,IST) 
      IF(ISBIT(IST,4))GO TO 444 
      RETURN
C 
C*********************************************************************
C 
C  FUNCTION CODE #5 -- WRITE, READ, AND WRITE/READ
C 
C  CHECK POWERFAIL BIT
C 
555   IF(.NOT.ISBIT(OUTDEV,15))GO TO 5555 
C 
C  SET RETURN ADDRESS IN CASE TERMINAL IS DOWN
C 
      ASSIGN 555 TO ITSNA5
C 
C  RESET THE TERMINAL IF NECESSARY
C 
      CALL SETBT(OUTDEV,15,0) 
5552  CALL TMBWR(IRST,1)
5553  ASSIGN 5555 TO IORTAD 
      CALL SFK75(ITRST,ISFK1,ISFK2,MSGBFR,MBLN) 
      GO TO 100 
C 
C  CHECK TO SEE THAT AT LEAST ONE BUFFER LENGTH IS POSITIVE 
C      IF NOT, THEN ERROR!!!
C 
5555  CONTINUE
C#################################################################
D     WRITE(ICOM00,6566)IFC,INPDEV,INBFLN,OUTDEV,OTBFLN 
D6566 FORMAT(1X,"/IOM75: IFC=",I2," INPDEV=",@8," INBFLN=",I3,
D    *" OUTDEV=",@8," OTBFLN=",I3)
C#################################################################
      IF(OTBFLN.GT.0.OR.LITE1.NE.0.OR.LITE2.NE.0)GO TO 590
      IF(INBFLN.GT.0)GO TO 580
C 
C  GASP!!! BOTH BUFFER LENGTHS ARE ZERO AND POWERFAIL BIT IS CLEAR!!
C 
C                  CWHAT DO I DO???@
C 
5556  CALL TMPER(0,99,ITSNUM,LLU,320,OTBFLN)
C 
C  PERFORM THE OUTPUT SECTION OF IFC=5
C 
590   IF(OUTDEV.EQ.0)CALL TMPER(0,99,ITSNUM,LLU,321,OUTDEV) 
      IDEV=0B 
      IF(ISBIT(OUTDEV,0))CALL SETBT(IDEV,1,1) 
      IF(ISBIT(OUTDEV,1))CALL SETBT(IDEV,3,1) 
C 
C  BUILD APPROPRIATE COMMAND STRING 
C 
      MBLN=0
      CALL DEV75(ITRST,IDEV,MSGBFR,MBLN)
C 
C  GO BUILD THE STRING FOR MESSAGE AND LIGHTS AND THEN RETURN HERE
C 
      ASSIGN 580 TO IORTAD
      GO TO 1121
C 
C  RETURN FROM MSG.GENERATE IS HERE 
C 
C 
C  CHECK TO SEE IF AN INPUT IS NEEDED 
C 
580   IF(INBFLN.GT.0)GO TO 583
C################################################################## 
D     WRITE(ICOM00,656)LLU(1),MBLN,(MSGBFR(I),I=1,(MBLN+1)/2) 
D656  FORMAT("  IOM75 LU"I3,"   TMWR: LEN=mY"I5,2(/50A2)) 
C################################################################## 
      CALL TMWR(MSGBFR,-MBLN) 
      ISTATS=0
      IF(ISBIT(IST,7))CALL TMPER(0,99,ITSNUM,LLU,324,IST) 
      IF(ISBIT(IST,4))GO TO 5882
      RETURN
C 
C  READ SECTION OF THE IFC=5
C 
C  SET UP ESC SEQUENCE TO CNFG INPUT DEVICE 
C 
583   CALL RST75(ITRST,INPDEV,MSGBFR,MBLN,INBFLN,IER) 
      IF(IER.GT.0)  GOTO 581
D     WRITE(ICOM00,656)LLU(1),MBLN,(MSGBFR(I),I=1,(MBLN+1)/2) 
      CALL TMWR (MSGBFR,-MBLN)
      ISTATS=0
      IF(ISBIT(IST,7))CALL TMPER(0,99,ITSNUM,LLU,324,IST) 
      IF(ISBIT(IST,4))GO TO 5882
      I=2 
      IF(IAND(IALF2(LITE2),377B) .EQ. 128) I=I+20 
      CALL LOGEV(ICOM00(2),LLU,I,MBLN,ITSNUM,ITIM)
584   CALL TMRD(INBUFR,-INBFLN) 
      IF(.NOT.ISBIT(IST,5).AND.ITL.EQ.0)GO TO 584 
      CALL LOGEV(ICOM00(2),LLU,3,ITL,ITSNUM,ITIM) 
C 
C  RETRIEVE THE KEY# OF KEY THAT COMPLETED READ (IF A KEY DID)
C      OR PICK UP RVI IF PRINTER OUT OF PAPER 
C 
      ITRNLG=ITL
      IF(KEY75(ISTATS,ISFK1,INBUFR,ITRNLG)) 
     *       CALL TMPER(0,99,ITSNUM,LLU,322,ISTATS) 
C 
C  IF ISTATS=128 (ATT KEY),CHECK TO SEE IF PRINTER IS BUSY
C 
C 
      IF(ISTATS.EQ.128)GO TO 5888 
C  SCAN FOR NON-TERMINATING SFK'S IN BUFFER 
C 
607   CALL SCN75(INBUFR,ITRNLG) 
      RETURN
C 
C  ERROR!! NON-EXISTENT DEVICE
C 
581   CALL TMPER(0,99,ITSNUM,LLU,323,OUTDEV)
C 
C  AN RVI (REVERSE INTERRUPT) HAS BEEN SENT BY THE TERMINAL-- 
C         CHECK THE CONDITION OF THE PRINTER.  IF THE PRINTER IS
C         BUSY, WAIT 5 SEC. BEFORE RESETTING AND REISSUING THEL 
C         THE LAST WRITE -- IF THE PRINTER IS NOT BUSY JUST RESET AND WRITE 
C 
5882  ITSNA5=0
      ASSIGN 5888 TO IORTAD 
5885  IF(ITSNA5.EQ.0) CALL TMPER(IORTAD,30,ITSNUM,LLU,LLU,0)
5888  CALL TMBWR(ISTRQ,-2)
587   CALL TMRD(ITEMP,-6) 
      IF(.NOT.ISBIT(IST,5).AND.ITL.EQ.0)GO TO 587 
      IF(.NOT.ISBIT(ITEMP(2),8))GO TO 5886
      CALL TMPZ(50) 
      ITSNA5=ITSNA5+1 
      IF(ITSNA5 .GT. 60)  ITSNA5=0
      GO TO 5885
C 
C  RVI WAS NOT FROM PRINTER OUT OF PAPER
C 
5886  IF(ISTATS.EQ.0)GO TO 5555 
      IF(ISTATS.EQ.128)GO TO 607
      CALL TMPER(0,99,ITSNUM,LLU,325,ISTATS)
      END 
      SUBROUTINE DEV75(ITRST,IDEV,IBF,IBFL) 
     *, 92903-16570 REV.1913  790109
      INTEGER ZERO,ONE,IESC(2),TEMP,IHOLD(5)
      LOGICAL ISBIT,ISBTW 
      DATA IESC/015455B,061400B/,ZERO/030000B/,ONE/030400B/ 
      DATA IHOLD/062000B,065400B,070000B,071000B,061000B/ 
      IRSHFT(M1)=M1/256 
C 
C  MOVE "ESC - c" TO END OF BUFFER & BUMP POINTER 
C 
      CALL MOVCA(IESC,1,IBF,IBFL+1,3) 
      IBFL=IBFL+3 
C 
C  BEGIN PARSING IDEV & ITRST -- ASSUME DISPLAY AND KEYBOARD ARE
C    ALWAYS THERE (THIS ASSUMPTION WILL HAVE TO CHANGE FOR HP3077A).
C 
      DO 1 I=1,5
      ITMP=ZERO+IRSHFT(IHOLD(I))
      IF(ISBIT(IDEV,I))ITMP=ONE+IRSHFT(IHOLD(I))
      IF(ISBIT(ITRST,I))GO TO 7 
      GO TO 1 
7     CALL MOVCA(ITMP,1,IBF,IBFL+1,2) 
      IBFL=IBFL+2 
1     CONTINUE
C 
C  MAKE THE LAST CHAR. AN UPPER-CASE
C 
      CALL PUTCA(IBF,IGET1(IBF,IBFL)-20000B,IBFL) 
      RETURN
      END 
      LOGICAL FUNCTION KEY75(KEYNO,ISFK,INBF,ITLOG) 
     *, 92903-16570 REV.1913  790123
C 
C  THIS FUNCTION RETURNS AN INTEGER FROM 0 TO 27 CORRESPONDING TO 
C     THE 28 SFK'S ON THE HP 3075/76/77 KEYBOARD. 
C 
C 
C     ISFK --> ARRAY CONTAINING THE SFK TERMINATOR BITS FROM TGP
C 
C     INBF --> ARRAY CONTAINING INFORMATION READ FROM THE TERMINAL
C 
C     ITLOG --> THE DVR07 TRANSMISSION LOG
C 
C     KEYNO --> THE RETURNED INTEGER CODE FOR THE KEY PRESSED 
C 
C          N.B.  0="ENTER" KEY
C           1...26="SFK#1"..."SFK#26" 
C              128="BREAK" KEY
C 
C          SRCHTB IS A SEARCH TABLE CONTAINING THE CHARACTER CODES
C               FOR THE SPECIAL FUNCTION KEYS.
C 
C 
      DIMENSION INBF(1),ISFK(1) 
      LOGICAL ISBIT,ISBTW 
      INTEGER SRCHTB(26)
      DATA SRCHTB/        000161B,000162B,000163B,000164B,000165B,
     *           000166B, 
     *            000167B,000170B,000171B,000172B,000141B,000142B,
     *            000143B,
     *            000144B,000145B,000146B,000147B,000150B,000151B,
     *            000152B,000153B,000154B,000155B,000156B,000157B,
     *            000160B/
C 
C  INITIALIZE FUNCTION VALUE TO ZERO (I.E. "ENTER" KEY IS DEFAULT)
C 
      KEY75=.FALSE. 
      KEYNO=0 
C 
C  ISOLATE LAST BYTE OF INPUT BUFFER
C 
      LSTCHR=IGETB(INBF,ITLOG)
C 
C  CHECK FOR BREAK KEY
C 
      IF(LSTCHR.EQ.000030B)GO TO 997
C 
C  CHECK TO SEE IF LAST CHAR IS CR (DENOTING "ENTER" KEY) 
C 
      IF(ISBTW(LSTCHR,141B,172B))RETURN 
C 
C  IT IS A VALID SFK -- FIND SUBRANGE (1-16 OR 17-26) 
C 
      IF(.NOT.ISBTW(LSTCHR,147B,160B))GO TO 32
C 
C  IT IS Q-Z
C 
      L=1 
      M=16
      J=1 
      GO TO 26
C 
C  IT IS A-P
C 
32    L=17
      M=26
      J=2 
C 
C  DO TABLE SEARCH
C 
26    DO 25 I=L,M 
      IF(LSTCHR.NE.SRCHTB(I))GO TO 25 
      IF(ISBIT(ISFK(J),I-L))GO TO 998 
      RETURN
25    CONTINUE
C 
C  SHOULD NEVER GET HERE
C 
      KEY75=.TRUE.
      KEYNO=LSTCHR
      RETURN
C 
C  AN SFK 
C 
998   KEYNO=I 
      ITLOG=ITLOG-1 
      RETURN
C 
C  "BREAK" KEY
C 
997   KEYNO=128 
      ITLOG=0 
      RETURN
      END 
      SUBROUTINE SFK75(ITRST,ISFK1,ISFK2,IWRD,IWRDL)
     *, 92903-16570 REV.1913  790109
      DIMENSION IWRD(1) 
      LOGICAL ISBIT 
      IWRD(1)=015455B 
      IWRD(2)=065460B 
      DO 28 I=3,12
      J=(I+110)*256+60B 
28    IWRD(I)=J 
      DO 29 I=13,28 
      J=(I+84)*256+60B
29    IWRD(I)=J 
      DO 25 I=2,17
      IF(.NOT.ISBIT(ISFK1,I-2))IWRD(I)=IWRD(I)+1B 
25    CONTINUE
      DO 26 I=18,27 
      IF(.NOT.ISBIT(ISFK2,I-18))IWRD(I)=IWRD(I)+1B
26    CONTINUE
      IWRDL=23
      IF(ISBIT(ITRST,6))IWRDL=55
      CALL PUTCA(IWRD,IGET1(IWRD,IWRDL)-20000B,IWRDL) 
      RETURN
      END 
      SUBROUTINE LIT75(LITE1,LITE2,IWORD,IWRDLN)
     *, 92903-16570 REV.1913  790109
C 
C  SUBROUTINE TO GENERATE ESCAPE SEQUENCES TO PERFORM THE FOLLOWING:
C 
C      A)  CLEAR ALL THE DISPLAY LIGHTS  AND
C 
C      B)  LIGHT UP THE LIGHTS WHOSE FOUR LOGICAL NUMBERS ARE IN
C              THE BYTES OF LITE1 AND LITE2.
C 
C  IWORD IS A BUFFER OF IWRDLN CHARACTERS CONTAINING THE COMMAND STRING 
C 
C  ICLR IS A COMMAND STRING FOR CLEARING ALL THE PROMPTING LIGHTS 
C 
C  SRCHLC IS A SEARCH TABLE OF LOWER-CASE CHARACTERS
C 
C      N.B.  UPPER-CASE CHARACTER(I)=SRCHLC(I)-020000B (I=2,3,...17)
C 
C 
      LOGICAL ISBIT 
      DIMENSION IWORD(1),IBYT(4),ICLR(5)
      INTEGER SRCHLC(17),ONE
C 
C  INITIALIZE LOCAL DATA
C 
      DATA ICLR/015455B,062060B,075400B/,ONE/030400B/ 
      DATA SRCHLC/060000B,060400B,061000B,061400B,062000B,062400B,
     *            063000B,063400B,064000B,064400B,065000B,065400B,
     *           066000B,066400B,067000B,067400B,070000B/ 
C 
C  ISOLATE LIGHT NUMBERS
C 
      IBYT(1)=IGETB(LITE1,1)
      IBYT(2)=IGETB(LITE1,2)
      IBYT(3)=IGETB(LITE2,1)
      IBYT(4)=IGETB(LITE2,2)
C 
C  PUT "CLEAR ALL LIGHTS" COMMAND AT HEAD OF COMMAND STRING 
C 
      CALL MOVCA(ICLR,1,IWORD,IWRDLN+1,5) 
      IWRDLN=IWRDLN+5 
C 
C  DECODE LIGHTS AND BUILD REST OF COMMAND
C 
      DO 27 I=1,4 
      IF(IBYT(I).EQ.0)GO TO 27
      IF(IBYT(I).EQ.128)GO TO 110 
      IF(IBYT(I).EQ.129)GO TO 111 
      IF(IBYT(I).GE.6.AND.IBYT(I).LE.10)GO TO 112 
      IF(IBYT(I).GE.11.AND.IBYT(I).LE.15)IBYT(I)=IBYT(I)+2
      GO TO 113 
110   IBYT(I)=6 
      GO TO 113 
111   IBYT(I)=12
      GO TO 113 
112   IBYT(I)=IBYT(I)+1 
113   CONTINUE
C 
C 
C  IBYT(I) IS THE LOCATION IN THE SEARCH TABLE FOR THE APPROPRIATE
C       COMMAND CHARACTER 
C 
      CALL PUTCA(IWORD,ONE,IWRDLN+1)
      IWRDLN=IWRDLN+1 
      CALL PUTCA(IWORD,SRCHLC(IBYT(I)),IWRDLN+1)
      IWRDLN=IWRDLN+1 
27    CONTINUE
      CALL PUTCA(IWORD,IGET1(IWORD,IWRDLN)-20000B,IWRDLN) 
C 
C  ALL DONE -- RETURN NOW 
C 
      RETURN
      END 
      SUBROUTINE RST75(ITRST,INPDEV,MSGBFR,MBLN,INBFLN,IER) 
     *, 92903-16570 REV.1913  790109
      DIMENSION MSGBFR(1),ITMP(6) 
      LOGICAL ISBIT 
      IER=0 
      ITMP1=0 
      INLOW=IGETB(INPDEV,2) 
      INLOW=INLOW+1 
      GO TO(2,3,5,6),INLOW
6     IER=1 
      RETURN
2     CALL SETBT(ITMP1,1,1) 
      CALL SETBT(ITMP1,2,1) 
      INBFLN=20 
      GO TO 7 
3     CALL SETBT(ITMP1,4,1) 
      INBFLN=82 
      GO TO 7 
5     CALL SETBT(ITMP1,5,1) 
      INBFLN=22 
7     CALL MOVCA(015455B,1,MSGBFR,MBLN+1,2) 
      GO TO(9,10,11),INLOW
C-----GENERATE THE CONFIGURE INPUT DEVICE STRING BEFORE EXIT. 
9     CALL DEV75(ITRST,ITMP1,MSGBFR,MBLN) 
      RETURN
C 
C-----GENERATE THE STRING TO CONFIGURE THE MODE ON THE INPUT PERIPHERAL 
C 
10    MBLN=MBLN+2 
      ITMP(1)=071060B 
      IF(.NOT.ISBIT(INPDEV,14))ITMP(1)=ITMP(1)+1B 
      ITMP(2)=067060B 
      IF(ISBIT(INPDEV,13).AND.ISBIT(INPDEV,12))ITMP(2)=060460B
      IF(.NOT.ISBIT(INPDEV,13).AND.ISBIT(INPDEV,12))ITMP(2)=67460B
      IF(ISBIT(INPDEV,15))ITMP(2)=ITMP(2)+1B
      ITMP(3)=064460B 
      ITMP(4)=061460B 
      ITMP(5)=046400B 
      IBFL=9
      GO TO 12
11    MBLN=MBLN+2 
      ITMP(1)=071060B 
      IF(.NOT.ISBIT(INPDEV,15))ITMP(1)=ITMP(1)+1B 
      ITMP(2)=065060B 
      ITMP(3)=046000B 
      IBFL=5
12    CALL MOVCA(ITMP,1,MSGBFR,MBLN+1,IBFL) 
      MBLN=MBLN+IBFL
      GO TO 9 
      END 
      SUBROUTINE SCN75(INPUT,INLEN), 92903-16570 REV.1913  790109 
      LOGICAL ISBTW 
      INTEGER A,Q,Z,INPUT(1)
      DATA A/141B/,Q/161B/,IK/153B/,Z/172B/ 
      L=IK-A
      M=Q+L 
      N=Z+L 
      IQ=A-M
      DO 45 I=1,INLEN 
      K=IGETB(INPUT,I)
      IF(ISBTW(K,A,Z))GO TO 45
      K=K+L 
      IF(.NOT.ISBTW(K,M,N))K=K+IQ 
      CALL PUTCA(INPUT,K*256,I) 
45    CONTINUE
      RETURN
      END 
      END$