From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 29-JUN-1989 16:41
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Re: Dynamic Sys$Announce/Sys$Welcome --- correction to code.

Message-Id:  <8906292028.AA25007@crdgw1.ge.com>
Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Thu, 29 JUN 89 11:34:53 PDT
Received: from NSFnet-Relay.AC.UK by KL.SRI.COM with TCP; Thu, 29 Jun 89 11:08:37 PDT
Received: from vaxb.rhbnc.ac.uk by NSFnet-Relay.AC.UK   via Janet with NIFTP
           id aa10434; 29 Jun 89 19:00 BST
Date: 		Thu, 29 JUN 89 19:01:44 BST
From: CHAA006%vaxb.rhbnc.ac.uk@NSFnet-Relay.AC.UK
To: Info-Vax <@NSFnet-Relay.AC.UK:Info-Vax@kl.sri.com>
Subject:        Re: Dynamic Sys$Announce/Sys$Welcome --- correction to code.
Sender: "JANET CHAA006@UK.AC.RHBNC.VAXB" <CHAA006%vaxb.rhbnc.ac.uk@NSFnet-Relay.AC.UK>
Reply-To: Philip Taylor (RHBNC) <P.Taylor%vaxb.rhbnc.ac.uk@NSFnet-Relay.AC.UK>
Originally-To:  $INFO-VAX,NSFNET%"Jms@Mis.Arizona.Edu"
Mailer:         Janet_Mailshr V3.4 (23-May-1989)

The old Sys$Announce program that Joel recently re-posted to Info-Vax 
regrettably contained an error in the protection mask for the mailbox
(as I discovered to my cost when I tried it today).  The corrected
version is appended.  I have also converted the <tab>s to eight spaces,
as the version which I received back had converted them to four, causing
the program to fail to compile.

					** Phil.


        program sys$announce
C
C --- Creates & services a mailbox, defined as the translation of Sys$Announce
C
        implicit none
        integer * 2 channel
        integer sys$crembx, sys$hiber
        call function (
     &        sys$crembx
     &            (%val (1),
     &                channel, , ,
     &                    %val ('2202'X), ,
     &                        'SYS$ANNOUNCE_MBX'))
        call enable (channel)
        call function (sys$hiber ())
        end
     
        subroutine enable (channel)
C
C --- Enables routine AST to deal with ASTs on CHANNEL
C
        implicit none
        include '($iodef)'
        integer * 2 channel
        integer ast, sys$qiow
        external ast
        call function (sys$qiow
     &        (, %val (channel),%val (io$_setmode .or. io$m_readattn),
     &            , , , ast, channel, , , ,))
        return
        end
     
        subroutine ast (channel)
C
C --- Gets a few useful things, and writes them to the mailbox;
C --- also re-declares itself as AST handler
C
        implicit none
        include '($iodef)'
        include '($syidef)'
        integer * 2 channel
        integer max, n, lib$day_of_week
        integer sys$asctim, lib$getsyi, str$trim, sys$qiow
        character cr, lf
        character * 6 nodename
        character * 23 datime
        character * 132 buffer
        character * (9) days (7)
        integer length
        data days /'Monday', 'Tuesday', 'Wednesday', 'Thursday',
     &            'Friday', 'Saturday', 'Sunday'/
        cr = char (13)
        lf = char (10)
        call function (lib$day_of_week (, n))
        call function (sys$asctim (, datime, , ))
        call function (lib$getsyi (syi$_nodename, ,nodename, length))
        write (buffer, 9000) nodename (1:length),
     &            days (n), datime, cr, lf
        call function (str$trim (buffer, buffer, length))
        call function (sys$qiow
     &        (, %val (channel),%val (io$_writevblk),
     &            , , , %ref (buffer), %val (length) , , , ,))
        call function (sys$qiow
     &        (, %val (channel),%val (io$_writeof .or. io$m_now),
     &            , , , , , , , ,))
        call enable (channel)
        return
C
C --- Change the following line as necessary !!! SYSDEP !!!
C
 9000    format ('    RHBNC VAX-Cluster on node ',
     &            A, ' at ', A, X, A, A, A)
        end
     
        subroutine function (status)
C
C --- Signals errors if they occur
C
        implicit none
        integer status
        if (.not. status) call lib$signal (%val (status))
        return
        end