next up previous 61
Next: Cancelling in multi-task subsystems
Up: Making tea and coffee
Previous: Making coffee

Controlling tea and coffee making

interface test_control
#  Test control task
    parameter max
        type '_integer'
        range 1,10
        prompt 'Number of actions'
        vpath 'prompt'
        default 1
    endparameter
    parameter time
        type '_integer'
        range -1,3600
        prompt 'Timeout in seconds'
        vpath 'prompt'
        default 10
    endparameter
    action brew
        obey
            needs max
            needs time
        endobey
    endaction
endinterface

      SUBROUTINE TEST_CONTROL (STATUS)

*     Test control task that controls and reschedules multiple actions
*     in multiple subsidiary tasks

      IMPLICIT NONE
      INTEGER   STATUS          ! Modified STATUS
 
      INCLUDE   'ADAMDEFNS'
      INCLUDE   'SAE_PAR'
      INCLUDE   'MESSYS_ERR'
      INCLUDE   'ACT_ERR'
      INCLUDE   'DTASK_ERR'
 
      INTEGER   I               ! Counter
      INTEGER   MAX             ! Number of TEA/COFFEE actions to start
      INTEGER   TIME            ! Timeout in seconds
      INTEGER   SEQ             ! Action sequence number
      INTEGER   PATH            ! Path to task in which OBEY completed
      INTEGER   MESSID          ! Message id of OBEY that completed
      INTEGER   TEA_PATH        ! Path to TEA task
      INTEGER   TEA_MESSID      ! Message ID of TEA's LAPSANG action
      INTEGER   TEA_ACTIVE      ! Number of active LAPSANG actions
      INTEGER   COFFEE_PATH     ! Path to COFFEE task
      INTEGER   COFFEE_MESSID   ! Message ID of COFFEE's MOCHA action
      INTEGER   COFFEE_ACTIVE   ! Number of active MOCHA actions
      INTEGER   CONTEXT         ! Context (OBEY or CANCEL)
      CHARACTER NAME*24         ! Action name
      CHARACTER VALUE*200       ! Action returned value
      CHARACTER INVAL*1         ! Action input value (unused)
      CHARACTER OUTVAL*1        ! Action output value (unused)
      INTEGER EVENT             ! Event which caused reschedule

      SAVE TEA_ACTIVE,COFFEE_ACTIVE,TIME ! Retain these values
 
      IF (STATUS .NE. SAI__OK) RETURN

*  Pick up required "ACT parameters"

      CALL TASK_GET_NAME (NAME,STATUS)
      CALL TASK_GET_SEQ (SEQ,STATUS)

*  Loop through possible OBEYs
 
      IF (NAME .EQ. 'BREW') THEN
 
*  First time through, initiate the actions ...
 
         IF (SEQ .EQ. 0) THEN

*  ... actions LAPSANG1 .. LAPSANG'MAX etc are initiated with a timeout
*  of TIME seconds ...

            CALL PAR_GET0I ('MAX',MAX,STATUS)
            CALL PAR_GET0I ('TIME',TIME,STATUS)

*  ... in the tea-maker ...

            TEA_ACTIVE = 0
            DO I = 1,MAX
               NAME = 'LAPSANG'//CHAR(48+I)
               INVAL = ' '
               CALL TASK_OBEY ('TEST_TEA',NAME,INVAL,
     :           OUTVAL,TEA_PATH,TEA_MESSID,STATUS)
               IF (STATUS .EQ. DTASK__ACTSTART) THEN
                  STATUS = SAI__OK
                  CALL TASK_ADD_MESSINFO (TEA_PATH,TEA_MESSID,
     :              STATUS)
                  TEA_ACTIVE = TEA_ACTIVE + 1
               ELSE
                  CALL MSG_SETC ('NAME',NAME)
                  CALL ERR_REP (' ',
     :              'CONTROL: Failed to start ^NAME: '//
     :              '^STATUS',STATUS)
*              Output reports associated with this failed OBEY
*              and try next
                  CALL ERR_FLUSH ( STATUS )
               ENDIF
            ENDDO

*  ... and in the coffee-maker ...

            COFFEE_ACTIVE = 0
            DO I = 1,MAX
               NAME = 'MOCHA'//CHAR(48+I)
               INVAL = ' '
               CALL TASK_OBEY ('TEST_COFFEE',NAME,INVAL,
     :           OUTVAL,COFFEE_PATH,COFFEE_MESSID,STATUS)
               IF (STATUS .EQ. DTASK__ACTSTART) THEN
                  STATUS = SAI__OK
                  CALL TASK_ADD_MESSINFO (COFFEE_PATH,COFFEE_MESSID,
     :              STATUS)
                  COFFEE_ACTIVE = COFFEE_ACTIVE + 1
               ELSE
                  CALL MSG_SETC ('NAME',NAME)
                  CALL ERR_REP (' ',
     :              'CONTROL: Failed to start ^NAME: '//
     :              '^STATUS',STATUS)
*              Output reports associated with this failed OBEY
*              and try next
                  CALL ERR_FLUSH ( STATUS )
               ENDIF
            ENDDO
 
*  ... and, if OK, set time-out period and set ACT__MESSAGE request.
 
            IF (TEA_ACTIVE .GT. 0 .OR. COFFEE_ACTIVE .GT. 0) THEN
               IF (TIME .NE. -1) THEN
                  CALL TASK_PUT_DELAY ( 1000*TIME, STATUS )
               ENDIF
               CALL TASK_PUT_REQUEST ( ACT__MESSAGE, STATUS )
            ENDIF
 
*  On subsequent entries, get the details of the message that has
*  caused this entry (it should either correspond to a subsidiary
*  action completion, TRIGGER or a timeout).
 
         ELSE
            CALL TASK_GET_MESSINFO (PATH,CONTEXT,NAME,VALUE,MESSID,
     :        EVENT,STATUS)

*  First check for timeout in which case abort the action ...

            IF (EVENT .EQ. MESSYS__RESCHED) THEN
               CALL MSG_SETI ('TIME',TIME)
               CALL ERR_REP (' ',
     :           'CONTROL: Timeout occurred after ^TIME '//
     :           'seconds',EVENT)

*  ... or check whether this is a triggering message, in which case
*  simply report and set ACT__MESSAGE request

            ELSE IF (EVENT .EQ. MESSYS__TRIGGER) THEN
               CALL MSG_SETC ('NAME',NAME)
               CALL MSG_SETC ('VALUE',VALUE)
               CALL MSG_OUT (' ',
     :           'CONTROL: Triggered by ^NAME: ^VALUE',
     :           STATUS)
               IF (TIME .NE. -1) THEN
                 CALL TASK_PUT_DELAY ( 1000*TIME, STATUS )
               ENDIF
               CALL TASK_PUT_REQUEST ( ACT__MESSAGE, STATUS )

*  ... or determine which action has completed. Set ACT__MESSAGE request
*  if more remain. Otherwise the BREW action is complete.
 
            ELSE
               IF (NAME(1:7) .EQ. 'LAPSANG') THEN
                  TEA_ACTIVE = TEA_ACTIVE - 1
               ELSE IF (NAME(1:5) .EQ. 'MOCHA') THEN
                  COFFEE_ACTIVE = COFFEE_ACTIVE - 1
               ENDIF

*  Report normal subsidiary action completion ...
               CALL MSG_SETC ('NAME',NAME)
               IF (EVENT .EQ. DTASK__ACTCOMPLETE) THEN
                  CALL MSG_OUT (' ',
     :            'CONTROL: Action ^NAME completed normally',STATUS)
*  including VALUE returned.
                  IF ( VALUE .NE. ' ' ) THEN
                     CALL MSG_SETC( 'VALUE', VALUE )
                     CALL MSG_OUT (' ',
     :               'CONTROL: Value string: ^VALUE', STATUS)
                  ENDIF                  
*  or failure ...
               ELSE
                  CALL ERR_REP (' ',
     :            'CONTROL: Action ^NAME completed: ^STATUS',EVENT)
*  including VALUE returned.
                  IF ( VALUE .NE. ' ' ) THEN
                     CALL MSG_SETC( 'VALUE', VALUE )
                     CALL ERR_REP (' ',
     :               'CONTROL: Value string: ^VALUE', EVENT)
                  ENDIF                  
*  Flush 
                  CALL ERR_FLUSH ( EVENT )
               ENDIF
               IF (TEA_ACTIVE .GT. 0 .OR. COFFEE_ACTIVE .GT. 0) THEN
                  IF (TIME .NE. -1) THEN
                     CALL TASK_PUT_DELAY ( 1000*TIME, STATUS )
                  ENDIF
                  CALL TASK_PUT_REQUEST ( ACT__MESSAGE, STATUS )
               ENDIF
            ENDIF
         ENDIF
      ENDIF
      END



next up previous 61
Next: Cancelling in multi-task subsystems
Up: Making tea and coffee
Previous: Making coffee

ADAM Guide to Writing Instrumentation Tasks
Starlink User Note 134
B D Kelly
A J Chipperfield

30 March 1992
E-mail:ussc@star.rl.ac.uk

Copyright © 2000 Council for the Central Laboratory of the Research Councils