From:	CSBVAX::MRGATE!OZ%WISCPSL.BITNET@CUNYVM.CUNY.EDU@SMTP  5-AUG-1988 16:12
To:	ARISIA::EVERHART
Subj:	RE: File monitor program


Received: from WISCPSL.BITNET by CUNYVM.CUNY.EDU (IBM VM SMTP R1.1) with BSMTP id 8406; Wed, 03 Aug 88 12:09:07 EDT
Received: by WISCPSL (Jnet BSMTP V0.09) id 1425; Wed,  3 Aug 88 11:02 CST
Date:     Wed,  3 Aug 88 11:02 CST
From:     Jim Osborne <OZ%WISCPSL.BITNET@CUNYVM.CUNY.EDU>
Subject:  RE: File monitor program
To:       EVERHART%ARISIA.decnet@GE-CRD.ARPA
Original_To:  ARPA%"EVERHART%ARISIA.decnet@GE-CRD.ARPA"

> Jim -
> I'd like to get a copy of your monitor program that notifies a process
> when file(s) are created in a directory. I can think of several uses
> for such a thing as a system manager, even if it is incomplete or buggy.
>   Incidentally, if you prefer to send it on tape, and send along a note
> requesting the spring '88 VAX tapes (at 6250; 1 reel at 2400'), I'll
> return that also. Email and tape also are even more desirable.

Here it is in the simplest form I could think of to send it. Sending it
via 9-track tape would be inconvenient for us since we have to drive for
30 minutes to get to the facility where we make 'em.

I can't spend time examining the contents of a SIG tape right now, so
it'd be best if I didn't tempt myself by requesting one.

Use WATCH in good health and with some caution. I'd recommend that you
wait to see if anybody fixes the problems I've already pointed out and
any other problems that people like you might find before placing WATCH
on a SIG tape--though you have my permission to do so if you think it's
in good enough condition.
--- CUT HERE ---
$ ! Here is the WATCH program, in the form of a command procedure
$ ! which does four CREATE commands to create BUILDWATCH.COM,
$ ! WATCH.FOR, WATCHINCL.FOR, and WATCHMAR.MAR. I recommend you
$ ! examine EVERY SINGLE LINE of this procedure before invoking
$ ! it, and use EXTREME CARE when using this program. You can't
$ ! trust me and/or everyone whose system this passed through on
$ ! the way to you.
$ !
$ ! P.S. - Read the comments at the top of WATCH.FOR for some
$ ! changes I've made since describing WATCH on INFO-VAX.
$
$ CREATE BUILDWATCH.COM ! *****************************************************
$ DECK
$ FORTRAN WATCH
$ MACRO WATCHMAR
$ LINK WATCH,WATCHMAR
$ EOD
$
$ CREATE WATCH.FOR ! **********************************************************
$ DECK
! Program to watch files and directories and $WAKE processes when a file
! they've asked to be monitored is modified.
!
! Commands to WATCH's mailbox take the following forms:
!
! WATCH filespec|directoryspec[/lckmode]  - start watching a file
!                                         - lckmode=CRMODE,CWMODE,etc.
!                                         - default is PRMODE, which is
!                                         - appropriate (I think)
! STOP [filespec|directoryspec]           - stop watching (wildcards are
!                                           supported)
! <EOF>                                   - results of FORTRAN or DCL
!                                           CLOSE, treated as 'STOP *'
! EXIT                                    - controlled program exit
!
! 19-JUL-1988 OZ@WISCPSL.Bitnet
!     Original (unrefined) version
!
! 25-JUL-1988 OZ@WISCPSL.Bitnet
!     Drop to EXECUTIVE mode before converting blocked locks from
!     NLMODE back to locked mode. This makes all locks on the same
!     resource drop to NLMODE before reconversion to locked mode
!     begins in EXECUTIVE mode--letting the blockee make its way from
!     the waiting queue to granted rather than watching as the
!     existing locks alternate in the granted and converting queues.
!
!     Use PRMODE as the default lock mode--this combined with the
!     change above allows multiple locks on the same resource.
!
!     Briefly document supported commands.
!
!     Put D_LINES on most of the painfully verbose output.

      program WATCH
      implicit none
      include '($SYSSRVNAM)'
      include 'WATCHINCL'
      integer RC,QUEUE_MBX_READ

      call SAY('WATCH started')
D     call SAY('Creating mailbox')
      EXITSTS=SYS$CREMBX(%val(1),MBXCHN,,,,,'WATCH_MBX')
      if (.not.EXITSTS) then
        call SAY('Error creating mailbox')
        call SIGNAL(%val(EXITSTS))
        goto 700
      endif
      EXITSTS=0
      call QUEUE_MBX_READ()
      do while (EXITSTS.eq.0)
D       call SAY('Hibernating')
        call SYS$HIBER()
D       call SAY('Awakened from hibernation')
      enddo
700   continue
      call CLEAN_UP
      call SYS$EXIT(%val(EXITSTS))

      end









! Queue a read to our mailbox.

      subroutine QUEUE_MBX_READ()
      implicit none
      include '($IODEF)'
      include '($SYSSRVNAM)'
      include 'WATCHINCL'
      integer RC
      external MBX_READ_AST

D     call SAY('Queuing mailbox read')
      RC=SYS$QIO(,%val(MBXCHN),%val(IO$_READVBLK),MBXIOSB,
     1  MBX_READ_AST,,%ref(MBXBUF),%val(len(MBXBUF)),,,,)
      if (.not.RC) then
        call SAY('Error queuing mailbox read')
        call SIGNAL(%val(RC))
        call FORCEX(%val(RC))
      endif
      return

      end









! Mailbox read completed. Mark the mailbox as ready and wake the process
! to do the work at background level.

      subroutine MBX_READ_AST()
      implicit none
      include 'WATCHINCL'

      call DO_MBX_MSG()
      if (EXITSTS.eq.0) call QUEUE_MBX_READ()
      return

      end









! Process a mailbox message.

      subroutine DO_MBX_MSG()
      implicit none
      include '($SSDEF)'
      include 'WATCHINCL'

D     call SAY('Mailbox read completed, PID=!XL',%val(MBXIOSB.PID))
      if (MBXIOSB.RC) then
D       call SAY('Data="!AF"',%val(MBXIOSB.XFR),%ref(MBXBUF))
        else
        if (MBXIOSB.RC.eq.SS$_ENDOFFILE) then
D         call SAY('SS$_ENDOFFILE, will fake "STOP" command')
          MBXIOSB.XFR=6
          MBXBUF(1:4)='STOP *'
        else
          call SAY('Mailbox read completion error')
          call SIGNAL(%val(MBXIOSB.RC))
          call FORCEX(%val(MBXIOSB.RC))
          goto 700
        endif
      endif
      call STR$UPCASE(MBXBUF(1:MBXIOSB.XFR),MBXBUF(1:MBXIOSB.XFR))
      if (MBXIOSB.XFR.ge.4) then
        if (MBXBUF(1:4).eq.'STOP') then
          if (MBXIOSB.XFR.lt.6) then
            MBXIOSB.XFR=6
            MBXBUF(5:6)=' *'
          endif
          call CMD_STOP_WATCH(MBXIOSB.PID,MBXBUF(6:MBXIOSB.XFR))
          goto 700
        elseif (MBXBUF(1:4).eq.'EXIT') then
          call CMD_EXIT(MBXIOSB.PID)
          goto 700
        endif
      endif
      if (MBXIOSB.XFR.ge.5) then
        if (MBXBUF(1:5).eq.'WATCH') then
          if (MBXIOSB.XFR.lt.7) then
            call SAY('WATCH command is too short!')
          else
            call CMD_START_WATCH(MBXIOSB.PID,MBXBUF(7:MBXIOSB.XFR))
          endif
          goto 700
        endif
      endif
      call SAY('Unrecognized mailbox message!')

700   continue
      return

      end









! Handle the WATCH command.

      subroutine CMD_START_WATCH(PID,FILE)
      implicit none
      include '($DVIDEF)'
      include '($LCKDEF)'
      include '($SYSSRVNAM)'
      include 'WATCHINCL'
      integer PID
      character*(*) FILE
      integer IDX,RC
      integer*2 FILEL,VOLNAML,SLASH
      integer COLON,I,IOS,STV
      external USEROPEN
      character VOLNAM*12,VOLLCKNAM*18,FILELCKNAM*10
      record /ITMLST3/ DVIITM(2)
      record /IOSB/ DVIIOSB
      external K_GRANTED_AST,K_BLOCKING_AST
      integer ARGS(12),DSC(2)

      call SAY('Watch requested, PID=!XL, file="!AF"',%val(PID),
     1  %val(len(FILE)),%ref(FILE))
      RC=0

! Find a free slot

      do IDX=1,MAX_WATCHEES
        if (WATCHEE(IDX).PID.eq.0) goto 100
      enddo
      IDX=0
100   continue
      if (IDX.eq.0) then
        call SAY('No free slots available!')
        goto 700
      endif

! Initialize things in the slot.

      WATCHEE(IDX).PID=PID
      WATCHEE(IDX).VOLLKSB.LKID=0
      WATCHEE(IDX).DEAD=.FALSE.

! Trim [optional] /LCKMODE from filename--the default should normally be
! appropriate (I think).

      FILEL=len(FILE)
      SLASH=index(FILE,'/')
      if (SLASH.eq.0) then
        WATCHEE(IDX).LCKMODE=LCK$K_PRMODE
      else
        if (FILEL.lt.1) then
          call SAY('Null file specified!')
          goto 700
        elseif (SLASH.eq.FILEL) then
          call SAY('Null lock mode specified!')
          goto 700
        elseif (FILE(SLASH+1:FILEL).eq.'CRMODE') then
          WATCHEE(IDX).LCKMODE=LCK$K_CRMODE
        elseif (FILE(SLASH+1:FILEL).eq.'CWMODE') then
          WATCHEE(IDX).LCKMODE=LCK$K_CWMODE
        elseif (FILE(SLASH+1:FILEL).eq.'PRMODE') then
          WATCHEE(IDX).LCKMODE=LCK$K_PRMODE
        elseif (FILE(SLASH+1:FILEL).eq.'PWMODE') then
          WATCHEE(IDX).LCKMODE=LCK$K_PWMODE
        elseif (FILE(SLASH+1:FILEL).eq.'EXMODE') then
          WATCHEE(IDX).LCKMODE=LCK$K_EXMODE
        else
          call SAY('Invalid lock mode specified')
          goto 700
        endif
        FILEL=SLASH-1
      endif

! Make sure FILE includes a device name.

      COLON=index(FILE(1:FILEL),':')
      if (COLON.eq.0) then
        call SAY('File has no device in it!')
        goto 700
      endif

! Save file as they typed it now.

      WATCHEE(IDX).FILE=FILE(1:FILEL)
      WATCHEE(IDX).FILEL=FILEL

! If FILE is a directory, convert to the appropriate filename

      if (FILE(FILEL:FILEL).eq.']') then
        do I=FILEL,1,-1
          if (FILE(I:I).eq.'.') goto 200
        enddo
        I=0
200     continue
        if (I.eq.0) then
          WATCHEE(IDX).FULLFILE=FILE(1:COLON)//'[000000]'//
     1  FILE(COLON+2:FILEL-1)//'.DIR;1'
          WATCHEE(IDX).FULLFILEL=FILEL+6+6
        else
          WATCHEE(IDX).FULLFILE=FILE(1:I-1)//']'//
     1  FILE(I+1:FILEL-1)//'.DIR;1'
          WATCHEE(IDX).FULLFILEL=FILEL+5
        endif
      else
        WATCHEE(IDX).FULLFILE=FILE(1:FILEL)
        WATCHEE(IDX).FULLFILEL=FILEL
      endif
      open (unit=1,file=WATCHEE(IDX).FULLFILE(1:
     1  WATCHEE(IDX).FULLFILEL),status='OLD',readonly,
     1  iostat=IOS,useropen=USEROPEN)
      if (IOS.ne.0) then
        call ERRSNS(,RC,STV,,)
        call SAY('Error opening !AF to get FID',
     1  %val(WATCHEE(IDX).FULLFILEL),
     1  %ref(WATCHEE(IDX).FULLFILE))
        call SIGNAL(%val(RC),%val(STV))
        goto 700
      endif
      inquire (unit=1,name=WATCHEE(IDX).FULLFILE)
      WATCHEE(IDX).FULLFILEL=
     1  index(WATCHEE(IDX).FULLFILE,' ')-1 ! cheap trim
      close (unit=1)

! Get the volume name of the device the file is on for use in building
! the volume lock name.

      DVIITM(1).ITMCOD=DVI$_VOLNAM
      DVIITM(1).BUFLEN=len(VOLNAM)
      DVIITM(1).BUFADR=%loc(VOLNAM)
      DVIITM(1).RETLEN=%loc(VOLNAML)
      DVIITM(2).EOL=0
      RC=SYS$GETDVIW(,,WATCHEE(IDX).FILE(1:COLON),DVIITM,DVIIOSB,,,)
      if (RC) RC=DVIIOSB.RC
      if (.not.RC) then
        call SAY('Error getting device''s VOLNAM')
        call SIGNAL(%val(RC))
        goto 700
      endif
      VOLNAM=VOLNAM(1:VOLNAML)    ! blank-fill volume name

! Build the volume lock name (F11B$vVOLUMENAMEbb) and acquire an
! NLMODE lock on the volume.

      VOLLCKNAM='F11B$v'//VOLNAM
      ARGS(1)=11
      ARGS(2)=0
      ARGS(3)=LCK$K_NLMODE
      ARGS(4)=%loc(WATCHEE(IDX).VOLLKSB)
      ARGS(5)=LCK$M_SYSTEM
      ARGS(6)=%loc(DSC)
      ARGS(7)=0
      ARGS(8)=0
      ARGS(9)=0
      ARGS(10)=0
      ARGS(11)=0
      ARGS(12)=0
      DSC(1)=len(VOLLCKNAM)
      DSC(2)=%loc(VOLLCKNAM)
      RC=SYS$CMKRNL(SYS$ENQW,ARGS)
      if (RC) RC=WATCHEE(IDX).VOLLKSB.RC
      if (.not.RC) then
        call SAY('Error acquiring NLMODE lock on volume')
        call SIGNAL(%val(RC))
        goto 700
      endif

! Enqueue an appropriate mode sublock on the file.

      FILELCKNAM(1:6)='F11B$s'
      FILELCKNAM(7:8)=FIDNUMSTR     ! FID$W_NUM
      FILELCKNAM(9:9)=FIDRVNSTR(2:2)        ! FID$B_NMX
      FILELCKNAM(10:10)=FIDRVNSTR(1:1)    ! FID$B_RVN
      ARGS(3)=WATCHEE(IDX).LCKMODE
      ARGS(4)=%loc(WATCHEE(IDX).FILELKSB)
      ARGS(5)=LCK$M_SYSTEM.or.LCK$M_VALBLK
      ARGS(7)=WATCHEE(IDX).VOLLKSB.LKID
      ARGS(8)=%loc(K_GRANTED_AST)
      ARGS(9)=IDX
      ARGS(10)=%loc(K_BLOCKING_AST)
      DSC(1)=len(FILELCKNAM)
      DSC(2)=%loc(FILELCKNAM)
      RC=SYS$CMKRNL(SYS$ENQ,ARGS)
      if (.not.RC) then
        call SAY('Error queuing file lock request')
        call SIGNAL(%val(RC))
        goto 700
      endif

700   continue
      if (RC) then
        call SAY('Watch enabled, PID=!XL, file="!AF", slot=!ZB',
     1  %val(WATCHEE(IDX).PID),%val(WATCHEE(IDX).FULLFILEL),
     1  %ref(WATCHEE(IDX).FULLFILE),%val(IDX))
      else
        call SAY('Failed to enable watch')
        if (IDX.ne.0) call CLEAN_SLOT(IDX)
      endif
      return

      end









! Handle the STOP command.

      subroutine CMD_STOP_WATCH(PID,FILES)
      implicit none
      include 'WATCHINCL'
      integer PID
      character*(*) FILES
      integer*2 FILESL
      integer IDX,CNT,STR$MATCH_WILD

      FILESL=len(FILES)
      call SAY('Watch stop requested, PID=!XL, file(s)="!AF"',
     1  %val(PID),%val(FILESL),%ref(FILES))
      CNT=0
      do IDX=1,MAX_WATCHEES
        if (WATCHEE(IDX).PID.eq.PID) then
          if (STR$MATCH_WILD(WATCHEE(IDX).FILE(1:WATCHEE(IDX).FILEL),
     1      FILES)) then
            call CLEAN_SLOT(IDX)
            CNT=CNT+1
          endif
        endif
      enddo
      if (CNT.eq.0) call SAY('No watches for PID=!XL, file(s)="!AF"',
     1  %val(PID),%val(FILESL),%ref(FILES))
      return

      end









! Handle the EXIT command.

      subroutine CMD_EXIT(PID)
      implicit none
      include 'WATCHINCL'
      integer PID

      call SAY('Exit requested, PID=!XL',%val(PID))
      EXITSTS=1
      call SYS$WAKE(,)
      return

      end









! Clean up a single slot.

      subroutine CLEAN_SLOT(IDX)
      implicit none
      include '($LCKDEF)'
      include '($SYSSRVNAM)'
      include 'WATCHINCL'
      integer IDX
      integer RC,ARGS(5)

      if (WATCHEE(IDX).PID.eq.0) return
      call SAY('Stopping watch, PID=!XL, file="!AF", slot=!XB',
     1  %val(WATCHEE(IDX).PID),%val(WATCHEE(IDX).FILEL),
     1  %ref(WATCHEE(IDX).FILE),%val(IDX))
      WATCHEE(IDX).DEAD=.TRUE.
      if (WATCHEE(IDX).VOLLKSB.LKID.ne.0) then
        ARGS(1)=4
        ARGS(2)=WATCHEE(IDX).VOLLKSB.LKID
        ARGS(3)=0
        ARGS(4)=0
        ARGS(5)=LCK$M_DEQALL
        RC=SYS$CMKRNL(SYS$DEQ,ARGS)
        if (.not.RC) then
          call SAY('Error dequeuing sublocks of volume lock!')
          call SIGNAL(%val(RC))
          call FORCEX(%val(RC))
          return
        endif
        ARGS(5)=0
        RC=SYS$CMKRNL(SYS$DEQ,ARGS)
        if (.not.RC) then
          call SAY('Error dequeuing volume lock!')
          call SIGNAL(%val(RC))
          call FORCEX(%val(RC))
          return
        endif
      endif
      WATCHEE(IDX).PID=0
D     call SAY('Watch stopped')
      return

      end









! Clean up all slots.

      subroutine CLEAN_UP()
      implicit none
      include 'WATCHINCL'
      integer IDX

      do IDX=1,MAX_WATCHEES
        call CLEAN_SLOT(IDX)
      enddo
      return

      end









! Lock granted on file.

      subroutine K_GRANTED_AST(IDXVAL)
      implicit none
      include 'WATCHINCL'
      external IDXVAL
      integer IDX

      IDX=%loc(IDXVAL)
      if (WATCHEE(IDX).FILELKSB.RC) then
D       call SAY('File lock request completed, slot=!XB',%val(IDX))
      else
        call SAY('File lock request failed, slot=!XB',%val(IDX))
        call SIGNAL(%val(WATCHEE(IDX).FILELKSB.RC))
        call CLEAN_SLOT(IDX)
      endif
      return

      end









! Blocking AST on file lock.

      subroutine K_BLOCKING_AST(IDXVAL)
      implicit none
      include '($LCKDEF)'
      include '($PSLDEF)'
      include '($SYSSRVNAM)'
      include 'WATCHINCL'
      external IDXVAL
      integer IDX,RC,ARGS(12)
      external E_BLOCKING_AST,K_CONVERTED_AST

      IDX=%loc(IDXVAL)
      call SAY('Blocking AST fired, slot=!XB',%val(IDX))
      if (WATCHEE(IDX).DEAD) then
D       call SAY('Slot is marked DEAD, so we do nothing')
        return
      endif
      WATCHEE(IDX).OLDDATASEQ=WATCHEE(IDX).FILELKSB.VALBLK(2)
D     call SAY('Converting lock to grant access to blockee')
      ARGS(1)=11
      ARGS(2)=0
      ARGS(3)=LCK$K_NLMODE
      ARGS(4)=%loc(WATCHEE(IDX).FILELKSB)
      ARGS(5)=LCK$M_SYSTEM.or.LCK$M_CONVERT.or.LCK$M_VALBLK
      ARGS(6)=0
      ARGS(7)=0
      ARGS(8)=0
      ARGS(9)=0
      ARGS(10)=0
      ARGS(11)=0
      ARGS(12)=0
      RC=SYS$CMKRNL(SYS$ENQW,ARGS)
      if (RC) RC=WATCHEE(IDX).FILELKSB.RC
      if (.not.RC) then
        call SAY('Error converting lock to NLMODE')
        call SIGNAL(%val(RC))
        call CLEAN_SLOT(IDX)
        return
      endif
D     call SAY('Queuing EXECUTIVE mode AST to convert back')
      RC=SYS$DCLAST(E_BLOCKING_AST,%val(IDX),%val(PSL$C_EXEC))
      if (.not.RC) then
        call SAY('Error queuing EXECUTIVE mode AST')
        call SIGNAL(%val(RC))
        call CLEAN_SLOT(IDX)
      endif
      return

      end









! EXEC AST to convert lock back to locked mode. This routine runs in
! EXEC mode so all KERNEL mode blocking ASTs on the same resource fire
! and convert all locks to NLMODE before we start converting them back
! to the locked mode--and so any user commands to STOP watchees don't
! execute in between (if we were to run this in USER mode).

      subroutine E_BLOCKING_AST(IDXVAL)
      implicit none
      include '($LCKDEF)'
      include '($SYSSRVNAM)'
      include 'WATCHINCL'
      external IDXVAL
      integer RC,IDX,ARGS(12)
      external K_CONVERTED_AST,K_BLOCKING_AST

      IDX=%loc(IDXVAL)
D     call SAY('Queuing conversion back to locked mode')
      ARGS(1)=11
      ARGS(2)=0
      ARGS(3)=WATCHEE(IDX).LCKMODE
      ARGS(4)=%loc(WATCHEE(IDX).FILELKSB)
      ARGS(5)=LCK$M_SYSTEM.or.LCK$M_CONVERT.or.LCK$M_VALBLK
      ARGS(6)=0
      ARGS(7)=0
      ARGS(8)=%loc(K_CONVERTED_AST)
      ARGS(9)=IDX
      ARGS(10)=%loc(K_BLOCKING_AST)
      ARGS(11)=0
      ARGS(12)=0
      RC=SYS$CMKRNL(SYS$ENQW,ARGS)
      if (RC) RC=WATCHEE(IDX).FILELKSB.RC
      if (.not.RC) then
        call SAY('Error queuing lock conversion to locked mode')
        call SIGNAL(%val(RC))
        call CLEAN_SLOT(IDX)
      endif
      return

      end









! File lock conversion completion AST

      subroutine K_CONVERTED_AST(IDXVAL)
      implicit none
      include '($SYSSRVNAM)'
      include 'WATCHINCL'
      external IDXVAL
      integer IDX,RC

      IDX=%loc(IDXVAL)
D     call SAY('Conversion to locked mode completed, slot=!XB',
D    1  %val(IDX))
      if (WATCHEE(IDX).DEAD) then
D       call SAY('Slot is marked DEAD, so we do nothing')
        return
      endif
      if (.not.WATCHEE(IDX).FILELKSB.RC) then
        call SAY('Lock conversion failed')
        call SIGNAL(%val(WATCHEE(IDX).FILELKSB.RC))
        call CLEAN_SLOT(IDX)
        return
      endif
      if (WATCHEE(IDX).OLDDATASEQ.ne.
     1  WATCHEE(IDX).FILELKSB.VALBLK(2)) then
        call SAY(' ')
        call SAY('File "!AF" has been modified!',
     1  %val(WATCHEE(IDX).FILEL),%ref(WATCHEE(IDX).FILE))
D       call SAY('SOUND THE ALARMS!')
D       call SAY(' ')
        call SAY('Waking PID=!XL',%val(WATCHEE(IDX).PID))
        RC=SYS$WAKE(WATCHEE(IDX).PID,)
        if (.not.RC) then
          call SAY('Error waking process')
          call SIGNAL(%val(RC))
          call CLEAN_SLOT(IDX)
        endif
      endif
      return

      end









! Open a file, call a routine to pull the FID out of the NAM block.

      integer function USEROPEN(FAB,RAB,LUN)
      implicit none
      include '($FABDEF)'
      include '($RABDEF)'
      include '($SYSSRVNAM)'
      record /FABDEF/ FAB
      record /RABDEF/ RAB
      integer LUN

      USEROPEN=SYS$OPEN(FAB,,)
      if (USEROPEN) then
        call RECORD_FID(%val(FAB.FAB$L_NAM))
        USEROPEN=SYS$CONNECT(RAB,,)
      endif
      return

      end









! Pull the FID out of the NAM block.

      subroutine RECORD_FID(NAM)
      implicit none
      include '($NAMDEF)'
      include 'WATCHINCL'
      record /NAMDEF/ NAM

      FIDNUM=NAM.NAM$W_FID_NUM
      FIDSEQ=NAM.NAM$W_FID_SEQ
      FIDRVN=NAM.NAM$W_FID_RVN
      return

      end









! Force image exit by setting EXITSTS to the non-zero status passed
! to us and then $WAKE our process.

      subroutine FORCEX(RCVAL)
      implicit none
      include 'WATCHINCL'
      external RCVAL

      EXITSTS=%loc(RCVAL)
      call SYS$WAKE(,)
      return

      end
$ EOD
$
$ CREATE WATCHINCL.FOR ! ******************************************************
$ DECK
      integer MAX_WATCHEES
      parameter (MAX_WATCHEES=8)

      structure /ITMLST3/
        union
          map
            integer*2 BUFLEN,ITMCOD
          endmap
          map
            integer*4 EOL
          endmap
        endunion
        integer*4 BUFADR,RETLEN
      endstructure !ITMLST3!

      structure /IOSB/
        integer*2 RC,XFR
        union
          map
            integer*2 X1,X2
          endmap
          map
            integer*4 PID
          endmap
        endunion
      endstructure !IOSB!

      structure /LKSB/
        integer*2 RC,X
        integer*4 LKID
      endstructure !LKSB!

      structure /LKSB_VAL/
        integer*2 RC,X
        integer*4 LKID
        integer*4 VALBLK(4)
      endstructure !LKSB_VAL!

      structure /WATCHEE/
        integer*4 PID
        integer*2 FILEL,FULLFILEL
        character FILE*128,FULLFILE*255
        logical*1 DEAD
        integer LCKMODE
        record /LKSB/ VOLLKSB
        record /LKSB_VAL/ FILELKSB
        integer OLDDATASEQ
      endstructure !WATCHEE!

      integer*2 MBXCHN
      logical*1 MBXRDY
      character*128 MBXBUF
      record /IOSB/ MBXIOSB
      record /WATCHEE/ WATCHEE(MAX_WATCHEES)
      integer EXITSTS
      integer*2 FIDNUM,FIDSEQ,FIDRVN
      character*2 FIDNUMSTR,FIDSEQSTR,FIDRVNSTR
      equivalence (FIDNUM,FIDNUMSTR)
      equivalence (FIDSEQ,FIDSEQSTR)
      equivalence (FIDRVN,FIDRVNSTR)

      common /WATCH/ MBXCHN,MBXRDY,MBXBUF,MBXIOSB,WATCHEE,EXITSTS,
     1  FIDNUM,FIDSEQ,FIDRVN
$ EOD
$
$ CREATE WATCHMAR.MAR ! *******************************************************
$ DECK
        .title  WATCHMAR - MACRO support routines

        .psect  $LOCAL,pic,con,rel,lcl,noshr,noexe,rd,wrt,long
SAYCHN: .blkw
SAYBUF: .blkb   132
SAYIOSB:.blkq
SAYERR: .byte   0

        .psect  $PDATA,pic,con,rel,lcl,shr,noexe,rd,nowrt,long
TT:     .ascii  "TT:"
        TTL=.-TT

        .psect  $CODE,pic,con,rel,lcl,shr,exe,rd,nowrt,long
        .align  long
        .entry  SAY,^M<>
        blbc    SAYERR,10$
        brw     90$
10$:    tstw    SAYCHN
        bneq    20$
        movaq   -(SP),R0
        movzwl  #TTL,(R0)
        movab   TT,4(R0)
        $assign_s devnam=(R0),chan=SAYCHN
        addl2   #8,SP
        blbc    R0,100$
20$:    movaq   -(SP),R0
        movzwl  #132,(R0)
        movab   SAYBUF,4(R0)
        $faol_s ctrstr=@4(AP),-
                outlen=(R0),-
                outbuf=(R0),-
                prmlst=8(AP)
        movzwl  (SP),R0
        addl2   #8,SP
        $qiow_s chan=SAYCHN,func=#IO$_WRITEVBLK,iosb=SAYIOSB,-
                p1=SAYBUF,p2=R0,p4=#^X8D010000
        blbc    R0,100$
        movzwl  SAYIOSB,R0
        blbc    R0,100$
90$:    clrl    R0              ; we may be a $PUTMSG action routine
        ret
100$:   mnegb   #1,SAYERR
        pushl   R0
        calls   #1,G^FORCEX
        ret

        .entry  SIGNAL,^M<>
        $putmsg_s msgvec=(AP),actrtn=SAY
        ret

        .end
$ EOD
