FTN4
      SUBROUTINE INPUT,92069-16061 REV.1912 790215
C 
C 
C*************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS    *
C RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
C*************************************************************
C 
C 
C     SOURCE:    92069-18098
C     RELOC:     92069-16060
C 
C 
C************************************************************ 
C 
C 
C ABSTRACT: 
C 
C THIS MODULE GETS INPUT AND PUTS IT INTO THE BUFFER IB.
C IT IS RESPONSIBLE FOR PROMPTING THE USER WITH A QUESTION MARK 
C WHENEVER THE INPUT IT FROM AN INTERACTIVE TERMINAL.  IT KNOWS 
C FROM CHECKING THE REMOTE FLAG WHETHER TO MAKE AN REMOTE OR LOCAL
C PROMPT. 
C 
C WHEN THIS ROUTINE ENCOUNTERS AN END-OF-FILE IN A BATCH STREAM,
C IT WILL SWITCH THE INPUT FILE TO THE ORIGINAL INPUT FILE.  THE
C ORIGINAL INPUT FILE IS THAT LU OR FILE WHICH WAS ENTERED AS THE 
C FIRST PARAMETER IN THE RUN STRING.
C 
C WHENEVER AN ERROR IS ENCOUNTERED THE MODULE WILL RETURN TO THE
C COMMAND INTERPRETER.
C 
C 
C 
C 
      LOGICAL IFBRK 
      INTEGER ASK(2)
      INTEGER IREG(2) 
      INTEGER SCOLON
      INTEGER ERR1(8) 
      INTEGER ERR2(6) 
      INTEGER ERR3(31)
      INTEGER ERR6(11)
C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978   $$$$$$$$$$$$$$$$$$$$$
      INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ 
      INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM 
      INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR 
      INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN
      LOGICAL BREAK 
      INTEGER IPFLAG,IOFLAG,RMOTE 
      LOGICAL BATCH,XQBCH 
      INTEGER PAGCNT,LNCNT
      INTEGER PAGLEN,COLLIM 
      REAL    RRCNT 
      REAL    SELT,RSEC 
      INTEGER IPTR
      REAL    RCOUNT
      INTEGER S,R3,TRKNM,IDILU
      INTEGER R6
      REAL    ATOTAL
      INTEGER LIST,L,T,U
      INTEGER LEVSTR,LEVLEN 
      INTEGER IBUFF 
      INTEGER SS(7,100) 
C 
      COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145)
      COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) 
      COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR
      COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN
      COMMON BREAK
      COMMON IPFLAG,IOFLAG,RMOTE
      COMMON BATCH,XQBCH
      COMMON PAGCNT,LNCNT 
      COMMON PAGLEN,COLLIM
      COMMON RRCNT
      COMMON SELT(64),RSEC
      COMMON IPTR 
      COMMON RCOUNT 
      COMMON S(15,50),R3,TRKNM,IDILU
      COMMON R6 
      COMMON ATOTAL(6,5)
      COMMON LIST(101,6),L(7),T(5),U(7,5) 
      COMMON LEVSTR(66,5),LEVLEN(5) 
      COMMON IBUFF(2048)
C 
      EQUIVALENCE (S,SS)
C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978   $$$$$$$$$$$$$$$$$$$$$
      EQUIVALENCE (REG,IREG),(IREG(2),INLEN)
C 
      DATA SCOLON/73B/
      DATA ASK/2H? ,2H_ / 
C INPUT TOO LONG
      DATA ERR1/2H I,2HNP,2HUT,2H T,
     1 2HOO,2H L,2HON,2HG / 
C END OF FILE 
      DATA ERR2/2H E,2HND,2H O,2HF ,2HFI,2HLE/
C INPUT MUST BE CONTAINED WITHIN MULTIPLE LINES OF 72 COLUMNS 
      DATA ERR3/2H I,2HNP,2HUT,2H M,2HUS,2HT ,2HBE,2H C,
     &    2HON,2HTA,2HIN,2HED,2H W,2HIT,2HHI,2HN ,
     &    2HMU,2HLT,2HIP,2HLE,2H L,2HIN,2HES,2H O,2HF ,2H 7,2H2 , 
     &    2HCO,2HLU,2HMN,2HS /
C INPUT I/O WAS ABORTED 
      DATA ERR6/2H I,2HNP,2HUT,2H I,2H/O,2H W,2HAS,2H A,2HBO,2HRT,2HED/ 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C BEGIN 
C 
      IEND = 1
      ISCAN = 1 
      ICNT = 0
C 
C SEE IF INPUT IS FROM A PROCEDURE FILE 
C   IF IPFLAG IS NOT EQUAL TO 0, THEN IT IS A PROCEDURE FILE
C 
5     CONTINUE
      IF(IPFLAG .NE. 0) GOTO 10 
C 
C IF THIS IS BATCH ASSUME INPUT IS LOCAL AND NO PROMPT IS 
C NECESSARY.
C 
      IF(BATCH) GOTO 6
C 
C IF THIS IS LOCAL MAKE A LOCAL PROMPT
C 
      IF(RMOTE .NE. -1) GOTO 7
      CALL QRIO(2,INLU,ASK,-3)
C 
C GET THE LOCAL INPUT (WHETHER BATCH OR INTERACTIVE)
C 
6     CONTINUE
      REG = QRIO(1,INLU,IMA,-74)
      GOTO 9
C 
C MAKE A REMOTE CALL USING THE READ WRITE FEATURE 
C 
7     CONTINUE
      CALL DEXEC(RMOTE,1+100000B,INLU+4000B,IMA,-72,ASK,-3) 
      GOTO 7060 
8     CALL ABREG(IREG,INLEN)
C 
C 
C 
C IF END-OF-FILE
C   THEN IF XEQ FILE
C           THEN GO BACK TO ORIGINAL FILE 
C 
9     CONTINUE
      IF(INLEN .GE. 0  .OR.  INLU .GT. 0) GOTO 20 
C 
C AN END OF FILE WAS FOUND ON A BATCH FILE
C  (THIS WAS DETERMINED BY THE FACT THE INPUT LENGTH WAS LESS THAN 0
C    AND THE DCB/LU DATA STRUCTURE HAS A -1 IN THE FIRST WORD)
C WHEN THE CURRENT INPUT FILE IS A SECONDARY BATCH FILE, CLOSE IT 
C   (XEQ WILL EQUAL 0 WHEN THE CURRENT INPUT FILE IS THE PRIMARY BATCH
C    FILE)
C PUT THE ORIGINAL INPUT FILE, WHICH IS SAVED IN THE DCB/LU STRUCTURE 
C  CALLED XEQ, INTO THE CURRENT DCB/LU STRUCTURE, WHICH IS CALLED INLU
C RESTORE THE BATCH FLAG TO THE ORIGINAL BATCH FLAG, WHICH WAS SAVED IN 
C  XQBCH. 
C GO DEFAULT THE INPUT TO A SEMICOLN
C 
      IF(XEQ .EQ. 0) GOTO 7010
      CALL ECLOS(INLU(2)) 
      CALL SMOVE(XEQ,1,290,INLU,1)
      BATCH = XQBCH 
      XEQ = 0 
      GOTO 25 
C 
C THIS IS A PROCEDURE FILE - GET THE INPUT AND CHECK FOR EOF
C 
10    CONTINUE
      REG = QRIO(1,IDCB,IMA,-74)
      IF(INLEN .LT. 0) GOTO 7010
C 
C IS AN ECHO REQUIRED?
C 
20    CONTINUE
      IF((IOFLAG .NE. 0) .OR. (ECHO .NE. 0))
     &                CALL QRIO(2,ITTY,IMA,-INLEN)
C 
C BE SURE INPUT LINE IS LEGAL 
C 
      IF(INLEN .GT. 72) GOTO 7030 
C 
C IF THIS IS A ZERO LENGTH RECORD ASSUME SEMICOLN 
C 
      IF(INLEN .GT. 0) GOTO 30
25    CALL SPUT(IMA,1,SCOLON) 
      INLEN = 1 
C 
C CONCATENATE THE INPUT INTO THE IB BUFFER
C 
30    CONTINUE
      IF(IEND+INLEN+1 .GT. IBSZ*2) GOTO 7040
C 
C COUNT QUOTES
C 
      DO 40 I = 1,INLEN 
      CALL SGET (IMA,I,ICHAR) 
      IF(ICHAR .EQ. 42B) ICNT = ICNT + 1
40    CONTINUE
      ICNT = ICNT - ICNT/2*2
C 
C FIND LAST NON-BLANK CHARACTER 
C 
      DO 50 I = INLEN,1,-1
      CALL SGET(IMA,I,ICHAR)
      IF(ICHAR .NE. 40B) GOTO 55
50    CONTINUE
C 
C PUT THE INPUT IN THE BUFFER 
C 
55    CONTINUE
      CALL SMOVE (IMA,1,INLEN,IB,IEND)
      IEND = IEND+INLEN 
C 
C   WHEN THE LAST CHARACTER WAS A SEMICOLN AND QUOTES ARE CLOSED
C    RETURN TO THE CALLER, OTHERWISE GET MORE INPUT 
C 
      IF(ICNT .NE. 0) GOTO 5
      IF(ICHAR .EQ. SCOLON ) GOTO 60
C 
C PUT A BLANK AFTER LAST CHARACTER WHEN THE LINE IS TO BE CONTINUED 
C 
      CALL SPUT(IB,IEND,40B)
      IEND = IEND + 1 
      GOTO 5
C 
C END OF INPUT
C 
C    NOTE:  CREATE PROCEDURE FILE (QY09) EXPECTS IEND TO BE SET UP
C           IN JUST THIS MANNER.  BE SURE TO CHANGE QY09  SOMETHING 
C           PREVENTS "END;" FROM BEING THE LAST 4 CHARACTERS OF A LINE. 
C 
C 
60    CONTINUE
      IEND = IEND - 1 
      RETURN
C 
C 
C 
C 
C ERROR PROCESSING
C 
C 
C 
C OUTPUT "END OF FILE"
C 
7010  CALL ERIO(2,ITTY,ERR2,6)
      GOTO 7060 
C 
C OUTPUT "INPUT MUST BE CONTAINED WITHIN MULTIPLE LINES 
C  OF 72 COLUMNS
C 
7030  CALL QRIO(2,ITTY,IMA,-72) 
      CALL ERIO(2,ITTY,ERR3,31) 
      GOTO 7060 
C 
C OUTPUT "INPUT TOO LONG" 
C 
7040  CALL ERIO(2,ITTY,ERR1,8)
      GOTO 7060 
C 
C OUTPUT "I/O WAS ABORTED"
C 
7050  CALL ERIO(2,ITTY,ERR6,11) 
C 
C LOAD AND EXECUTE COMMAND INTERPERTER
C 
7060  CONTINUE
      SNAM(2) = 2H
      CALL LOAD(SNAM) 
      END 
$ 
                                                                                                                                                                                                