[COBOL400-L] RE: Never Ending Program

[qsrvbas@xxxxxxxxxxxx (Tom Liotta)]

cobol400-l-request@xxxxxxxxxxxx wrote:

>   1.  Re: Never Ending Program (Cesar Mendoza)
>
>    Thank you for taking the time to share your opinions and suggestions.
>    I've  resolved my case using Local Data Area and changed the logical in
>   the program to access the LDA when the flag is on. It's on when the cut of
>   day occur.

Cesar:

I'm not clear on how the LDA will help, but I'll share another technique 
anyway. I didn't see anything similar in other responses.

The following program is an example of a COBOL Never Ending Program (NEP) that 
reacts immediately to a change in a 'date' field. The 'date' field is stored in 
a user space and checked each time the NEP goes through another loop in its 
processing. Another program can change the 'date' in the user space, and the 
NEP will see it almost immediately.

My example uses an 11-byte user space. The first position is a control 
character. The remaining 10 bytes is where the 'date' is stored. This control 
character can be '0', '1' or 'E'. When it's '1', it means the 'date' has been 
changed. When it's 'E', it means the NEP should end.

When the NEP sees a '1', it retrieves the new 'date'; it also changes the 
control character from a '1' to a '0'. This change might tell another program 
that the 'date' was retrieved.

You can submit the program to batch and test it this way:

 ==> call QUSCRTUS ('DATESPC   mylib' 'DATEWORK  '  +
          x'0000000B' X'00' '*ALL      '  +
          'Test changing dates' '*YES      '  +
          x'0000000000000000' )

The space is created. Now put a value into it:

 ==> call QUSCHGUS ('DATESPC   mylib' x'00000001'  +
          x'0000000B' '101/01/2004' '0')

Now, submit the NEP program to batch. Since the first character of the value is 
a '1', the COBOL program will grab the next 10 bytes, '01/01/2004'. It should 
run and do nothing but loop over and over. You can change it to do some work or 
to delay a few seconds so it doesn't just use CPU cycles doing nothing.

After you're sure the program is running and will continue to run, execute this:

 ==> call QUSCHGUS ('DATESPC   mylib' x'00000001'  +
          x'0000000B' 'E01/01/2004' '0')

This time there's an 'E' in the first position of the space value. As soon as 
the NEP sees it, it should end. And it ought to happen pretty fast.

The example program:
----------------------------- Begin
       PROCESS OPTIONS APOST
       Identification Division.
       Program-ID.     AUTODATE.

       Environment Division.

       Configuration Section.
       Source-computer.    IBM-AS400.
       Object-computer.    IBM-AS400.

       Data Division.
       Working-storage Section.

       01  WS-US-PTR                       pointer.

       01  WS-US.
           05  WS-US-NAME                  pic x(10) value 'DATESPC'.
           05  WS-US-LIB                   pic x(10) value 'mylib'.

       01  WS-US-ERR-DATA.
           05  WS-US-PROVIDED              pic s9(6) binary
                                               value zero.
           05  WS-US-AVAILABLE             pic s9(6) binary
                                               value zero.
           05  WS-US-EXCEPTION-ID          pic x(7).
           05  WS-US-RESERVED              pic x(1).
           05  WS-US-EXCEPTION-DATA        pic x(128).

       01  Date-Area                       pic x(11).

       01  Date-BrkDown redefines Date-Area.
           05  Date-Cntl                   pic x(1).
           05  Date-Fld                    pic x(10).

       01  WS-SWITCHES.
           05  END-Process-SW              pic 1.
               88  END-Process                 value b'1'.
               88  MORE-Process                value b'0'.

       Linkage Section.

      *   These Linkage items will be pointed at the user space...

       01  US-Date-Area                    pic x(11).

       01  US-Date-BrkDown redefines US-Date-Area.
           05  US-Date-Cntl                pic x(1).
           05  US-Date-Fld                 pic x(10).

       Procedure Division
           .

       0000-SETUP.

      *
      * Get our user space pointer to track date changes...
      *
           call 'QUSPTRUS' using
                              WS-US
                              WS-US-PTR

      *
      * Link our date area to the space via the pointer...
      *
           set address of US-Date-Area    to  WS-US-PTR

           set MORE-Process            to  true
           .

       0000-Process-Until-End.

      *
      * Perform until told to stop. When Date is changed, move
      *   the new date into working storage...
      *
           perform until END-Process
               if  US-Date-Cntl = 'E'
                   set END-Process to  true
               else
               if  US-Date-Cntl = '1'
                    move    US-Date-Area  to  Date-Area
                    move    '0'     to  US-Date-Cntl
               else
      *   Do some work...
               end-if
               end-if
           end-perform

           goback
           .
----------------------------- End

You can use the QUSCHGUS API to change the space or you can use QUSPTRUS in 
another program just like in the example. You might want to establish and test 
locks on the space in order to help guarantee that things happen in the order 
you expect; just remember that user spaces can be accessed and changed 
regardless of locks.

This can be a handy technique, a form of shared memory. Wish I had thought of 
it, but it's a bright idea of a coworker, Gary.

Tom Liotta

-- 
Tom Liotta
The PowerTech Group, Inc.
19426 68th Avenue South
Kent, WA 98032
Phone  253-872-7788 x313
Fax    253-872-7904
http://www.powertech.com


__________________________________________________________________
New! Unlimited Netscape Internet Service.
Only $9.95 a month -- Sign up today at http://isp.netscape.com/register
Act now to get a personalized email address!

Netscape. Just the Net You Need.