FTN4,L
C 
C 
C 
C  ***************************************************************
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     *
C  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
C  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
C  ***************************************************************
C 
C 
C           NAME:   EDITU 
C           SOURCE: 92074-18002 
C           RELOC:  PART OF 92074-12001 
C           PGMR:   J.D.J.
C 
C 
C 
C     SUBROUTINE TO FETCH A LINE (MAINTAINS COMMAND STACK)
C     RETURNS BYTE COUNT AS VALUE AND DATA BY REFERENCE 
C 
C 
      INTEGER FUNCTION RDREC(BUF,LU,STATUS,LEN) 
     C,92074-1X002 REV.2034 800818
      IMPLICIT INTEGER (A-Z)
      COMMON /CMDSK/CMDSTK(40,20),STKSIZ(20)
      INTEGER CMDVAL
C 
C     CHECK FOR TERMINAL
C 
      CALL REIO(100001B,LU,BUF,-150)
  770 GOTO 799
  780 CALL ABREG(STATUS,LEN)
  222 IF (LEN.LE.0) GOTO 1000 
      IF (LBYTE(BUF,1) .NE. 57B) GOTO 1000
C 
C     HERE TO ACCESS COMMAND STACK
C     STOP NUMERIC SCAN AT FIRST NON-NUMERIC
C 
      IF(LEN .LT. 150)CALL SBYTE(BUF,LEN+1,40B) 
      CMDIND = 2
      CMDSIZ = 1
      CMDVAL = 0
      J = LBYTE(BUF,CMDSIZ+1) 
      IF(J .EQ. 57B ) GOTO 630
      GOTO 331
  
  330 J = LBYTE(BUF,CMDSIZ+1) 
  331 IF (J.LT.60B.OR.J.GT.71B) GOTO 333
      CMDVAL = 10*CMDVAL + J - 60B
      CMDSIZ = CMDSIZ + 1 
      GOTO 330
C 
C  COUNT SLASHES
C 
  630  CMDVAL = CMDVAL+1
       CMDSIZ = CMDSIZ + 1
       J = LBYTE(BUF,CMDSIZ+1)
       IF( J .EQ. 57B ) GOTO 630
  
  333 IF (CMDVAL .GT. 20) CMDVAL = 0
C 
C     IF OUT OF RANGE OR UNSPECIFIED, DISPLAY ALL 
C 
      J = 21 - CMDVAL 
      IF( CMDVAL .EQ. 0 ) J = 1 
      K = 0 
C 
C  FIRST PRINT OUT TOP LINE 
C 
      CALL EXEC(100002B,LU,2H  ,-2) 
  760  GOTO 799 
  761 CALL EXEC(100002B,LU,14H---Commands---,-14) 
  762  GOTO 799 
  763 CONTINUE
C 
C  PRINT OUT STACK
C 
      DO 140 I=J,20 
      IF (STKSIZ(I).EQ.0) GOTO 140
      CALL EXEC(100002B,LU,CMDSTK(1,I),-STKSIZ(I))
  771 GOTO 799
  781 K = K+1 
  140 CONTINUE
C** 
  
      IF( CMDVAL .EQ. 0 .OR. CMDVAL .GT. K ) GOTO 160 
  150 CALL EXEC(100002B,2000B+LU, 
     *  44HAAAAAAAAAAAAAAAAAAAAAA,
     *  CMDVAL) 
  772  GOTO 799 
  160 CALL REIO(100001B,LU,BUF,128) 
  773  GOTO 799 
 783  CALL ABREG(STATUS,DUMMY)
      LEN = 1 
      IF (IAND(240B,STATUS).NE.0) LEN = 0 
      IF (LEN.LE.0) GOTO 1000 
      CALL EXEC(100002B,LU,9HRJAd_,-9)
  774 GOTO 799
  784 CALL EXEC(100001B,3000B+LU,BUF,-150)
  775 GOTO 799
  785 CALL ABREG(STATUS,LEN)
      IF (IAND(STATUS,240B).NE.0) LEN = 0 
      GOTO 222
C 
C 
C 
C     HERE WITH LEN = LENGTH IN BYTES OF COMMAND
C     UPDATE COMMAND STACK
C 
 1000 CONTINUE
C1000 IF (LEN.LE.0) GOTO 1010 
C     CALL ADDSK(BUF,LEN) 
C 
C     RETURN LENGTH OF LINE IN BYTES TO CALLER
C 
 1010 RDREC = LEN 
      RETURN
C 
C   GET HERE WHEN THERE IS AN REIO/ EXEC ERROR ERROR
C 
799   RDREC = -1
      RETURN
C 
C 
C 
      END 
C 
C  ADD BUFFER TO COMMAND STRAK
C 
C 
      SUBROUTINE ADDSK(BUF,LEN) 
     C,92074-1X002 REV.2034 800818
      IMPLICIT INTEGER (A-Z)
      COMMON /CMDSK/CMDSTK(40,20),STKSIZ(20)
C 
C 
C  IF THE LINE IS ZERO LENGHT  JUST FORGET IT 
C 
      IF( LEN .LE. 0 ) RETURN 
C 
C  'PUSH' THE STACK WITH A MOVE WORDS.
C 
      CALL BLT(CMDSTK(1,2),CMDSTK(1,1),19*40) 
      CALL BLT(STKSIZ(2),STKSIZ(1),19)
      CALL BLT(BUF,CMDSTK(1,20),40) 
      STKSIZ(20) = LEN
C 
C     IF IT IS AN EXACT DUPLICATE OF AN EXISTING LINE, ZAP OLD ONE
C 
      I = 1 
 1002 IF (I.GE.20) GOTO 1009
      IF (LEN.NE.STKSIZ(I)) GOTO 1008 
      IF (CBYTE(BUF,1,CMDSTK(1,I),1,LEN).NE.0) GOTO 1008
      J = I - 1 
 1003 IF (J.LE.0) GOTO 1005 
      CALL BLT(CMDSTK(1,J),CMDSTK(1,J+1),40)
      STKSIZ(J+1) = STKSIZ(J) 
      J = J - 1 
      GOTO 1003 
 1005 STKSIZ(1) = 0 
 1008 I = I + 1 
      GOTO 1002 
 1009 CONTINUE
      RETURN
      END 
C 
      BLOCK DATA
     C,92074-1X002 REV.2034 800818
      IMPLICIT INTEGER (A-Z)
      COMMON /CMDSK/ CMDSTK(40,20),STKSIZ(20) 
      DATA STKSIZ/20*0/ 
      END 
                                                    