C     BREAK - Written by Howard B. Halstead for Power Technologies, Inc.
C             March 1, 1988
C
C           - Used to determine if the device is a terminal and then
C             set the terminal characteristics to generate a hardware BREAK.
C
      CHARACTER*64 NEWNAM
      INTEGER   NEWLN
      LOGICAL   FLAG
C
      INTEGER*4 STATUS
      INTEGER*2 INPUT_CHAN
      STRUCTURE /IOSTAT_BLOCK/
        INTEGER*2 IOSTAT
        BYTE      TRANSMIT,
     2            RECEIVE,
     2            CRFILL,
     2            LFFILL,
     2            PARITY,
     2            ZERO
      END STRUCTURE
      RECORD /IOSTAT_BLOCK/ IOSB
C
      STRUCTURE /CHARACTERISTICS/
        BYTE      CLASS,
     2            TYPE
        INTEGER*2 WIDTH
        UNION
          MAP
            INTEGER*4 BASIC
          END MAP
          MAP
            BYTE LENGTH(4)
          END MAP
        END UNION
        INTEGER*4 EXTENDED
      END STRUCTURE
      RECORD /CHARACTERISTICS/ CHARBUF
C
      INCLUDE '($IODEF)'
      INCLUDE '($TTDEF)'
C
      INTEGER*4 SYS$ASSIGN, SYS$QIOW
C
C     Find out the device class of "TT"
C     If it is a batch job, do NOT send a break signal
C
      CALL VTERM (FLAG)
      IF (FLAG) GOTO 100    
C
C     Do a logical name translation on "TT"
C     If the name begins with "R", then assume a romote process
C     and do NOT send a break signal
C
      CALL LOGTRN('TT',NEWNAM,NEWLN)
      IF (NEWNAM(1:1) .EQ. 'R') GOTO 100   ! REMOTE PROCESS...
C
C     Assign channnel to terminal
C
      STATUS = SYS$ASSIGN('TT', INPUT_CHAN,,)
      IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
C
C     Get current characteristics
C
      STATUS = SYS$QIOW (,
     2                   %VAL(INPUT_CHAN),
     2                   %VAL(IO$_SENSEMODE),
     2                   IOSB,,,
     2                   CHARBUF,
     2                   %VAL(12),,,,)
       IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
       IF (.NOT. IOSB.IOSTAT) CALL LIB$SIGNAL(%VAL(IOSB.IOSTAT))
C
C     Set new characteristics, which is Start transmition of a break signal
C
      STATUS = SYS$QIOW (,
     2                   %VAL(INPUT_CHAN),
     2                   %VAL(IO$_SETMODE),
     2                   IOSB,,,
     2                   CHARBUF,
     2                   %VAL(12),,,%VAL(TT$M_BREAK),)
       IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
       IF (.NOT. IOSB.IOSTAT) CALL LIB$SIGNAL(%VAL(IOSB.IOSTAT))
C
C     Wait for one second
C
      CALL HIBER (1)
C
C     Set new characteristics, which is turning off signal break
C
      STATUS = SYS$QIOW (,
     2                   %VAL(INPUT_CHAN),
     2                   %VAL(IO$_SETMODE),
     2                   IOSB,,,
     2                   CHARBUF,
     2                   %VAL(12),,,%VAL(0),)
       IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
       IF (.NOT. IOSB.IOSTAT) CALL LIB$SIGNAL(%VAL(IOSB.IOSTAT))
C
 100   CONTINUE
       CALL EXIT
       END
C
C----------------------------------------
C 
      SUBROUTINE VTERM (FLAG)
C
C     Determine if running from a terminal
C
      LOGICAL   FLAG
C
      INTEGER*4 IOUT,ILEN, NSTR, ITRM
      INTEGER*4 ISTAT
C
C     The following is a lazy way of calling system service routines.
C
      INTEGER*4 LIB$GETDEVI, DVI$_DEVCHAR, DEV$V_TRM
      EXTERNAL  LIB$GETDEVI, DVI$_DEVCHAR, DEV$V_TRM
C
      ISTAT=LIB$GETDVI(%LOC(DVI$_DEVCHAR),,'TT',IOUT,NSTR,ILEN)
      IF (.NOT. ISTAT) CALL LIB$SIGNAL(%VAL(ISTAT))
C
      ITRM = IOUT .AND. %LOC(DEV$V_TRM)
      FLAG = ITRM .EQ. 0
C
      RETURN
C
      END
C
C----------------------------------------
C 
      SUBROUTINE LOGTRN(OLDNAM,NEWNAM,NEWLN)
C
C     Do a recursive translation of oldnam to newnam
C
      CHARACTER OLDNAM*(*), NEWNAM*(*)
      INTEGER   NEWLN
      INTEGER*4 ISTAT
C
      INTEGER   OLENO
      INTEGER*4 SYS$TRNLOG, SS$_NOTRAN
      EXTERNAL  OLENO
      EXTERNAL  SYS$TRNLOG, SS$_NOTRAN
      INTRINSIC LEN
C
      NEWNAM=OLDNAM
      NEWLN=OLENO(OLDNAM)
C
 1    CONTINUE
         ISTAT = SYS$TRNLOG(NEWNAM(1:NEWLN),NEWLN,NEWNAM, , , )
         IF (ISTAT .EQ. %LOC(SS$_NOTRAN)) GOTO 100
         IF (.NOT. ISTAT) GOTO 200
      GOTO 1
C
 100  CONTINUE
      IF (NEWLN.LT.LEN(NEWNAM)) NEWNAM(NEWLN+1:)=' '
      RETURN
C
 200  CONTINUE
      CALL LIB$SIGNAL(%VAL(ISTAT))
      NEWNAM=' '
      NEWLN=1
      RETURN
      END
C
C----------------------------------------
C
      SUBROUTINE HIBER (NSEC)
C
C     Routine to hibernate (i.e. sleep) for NSEC seconds.
C     NSEC must be in the range 1-60 seconds...
C
      EXTERNAL SYS$BINTIM,SYS$SCHDWK,SYS$HIBER
C
      INTEGER NSEC
C
      CHARACTER ASCINV*8
      INTEGER*4 BININV(2)
C
      IF (NSEC.LT.1) NSEC=1
      IF (NSEC.GT.60) NSEC=60
      WRITE (ASCINV,10) NSEC   ! Put NSEC into delta time.
   10 FORMAT ('0 0:0:',I2.2)
      CALL SYS$BINTIM (ASCINV,BININV) ! ASCII => BINARY
      CALL SYS$SCHDWK (,,BININV,)     ! Schedule wake-up.
      CALL SYS$HIBER                  ! Go to sleep...
      RETURN
      END
C 
C----------------------------------------
C
      INTEGER FUNCTION OLENO(STRNG)
C
C     RETURNS OPERATIONAL LENGTH OF A STRING (POSITION OF LAST
C     NON-BLANK CHARACTER).  WILL RETURN A ONE IF STRING IS EMPTY
C
      CHARACTER STRNG*(*)
C
      INTRINSIC LEN
      INTEGER   L
C
      IF (STRNG.EQ.' ') GOTO 100
C
      L=LEN(STRNG)
C
 10   IF (L .EQ. 1) GOTO 20
      IF (STRNG(L:L) .NE. ' ') GOTO 20
      L = L - 1
      GOTO 10
C
 20   CONTINUE
      OLENO=L
      RETURN
C
 100  CONTINUE
      OLENO=1
      RETURN
      END