TAA Tools
STACK       STACK FUNCTIONS                            TAACLPN

The Stack  tool provides a  series of commands  to operate on  a stack.
A  stack is a  list of  entries or elements.   The  stack is kept  in a
variable  in  your  program.   The  commands  allow you  work  with the
stack.

   SNDSTK        Sends an  element to the  stack.   The new element  is
                 always added  at the first available slot.   An option
                 exists  to  determine if  duplicates  should  exist in
                 the  stack.    An  option  exists  to   determine  the
                 element number used.

   RCVSTK        Receives an element  from the stack.   A named element
                 can  be received  or every element  in the  stack (one
                 element at a  time) from  beginning to  end in  either
                 FIFO or  LIFO sequence.   An  option exists to  remove
                 an entry when it is received.

   UPDSTK        Updates an  element in the stack.   The entire element
                 is updated.

   LKPSTK        Does  a  lookup  of  the  stack  to  determine  if  an
                 element  is  already  in  the  stack.     Returns  the
                 element number found in the stack.

   INZSTK        Initializes  the stack  so  that all  of the  elements
                 contain  the  same value.   This  command  is normally
                 used with  LKPSTK for  an  alternating array  type  of
                 approach.

   SORTSTK       Sorts the  stack in ascending or  descending sequence.
                 The entire element is treated as the key.

Some  CL programs  need a stack  function.   Rather than  coding unique
logic in every one of these  programs, the Stack commands can be  used.
While they provide  a simple solution,  the performance is not  as good
as specifying the same functions totally within your CL program.

The  stack is  2000 bytes  in  length and  holds a  variable  number of
elements  depending on  the length.   A 20  byte length  will allow for
100 elements.

The following describes a  simple SNDSTK/RCVSTK type of processing.   A
later section will describe complete samples of typical uses.

A typical approach  would be to take an element  (&ELEMENT) and use the
SNDSTK  command to place the occurrences into  a stack (&STACK).  Later
on in  your program, you  would use  the RCVSTK  command in  a loop  to
receive each of the elements.

             DCL        &ELMLEN *DEC LEN(5 0) VALUE(10)
             DCL        &ELEMENT *CHAR LEN(100)
             DCL        &STACK *CHAR LEN(2000)
             DCL        &FULL *CHAR LEN(1)
             .
             .
 LOOP1:      .          /* Move field to be stacked to &ELEMENT */
             .
             SNDSTK     ELEMENT(&ELEMENT) ELMLEN(&ELMLEN) +
                          STKVAR(&STACK) FULL(&FULL)
             GOTO       LOOP1
             .
             .
 LOOP2:      RCVSTK     ELEMENT(&ELEMENT) ELMLEN(&ELMLEN) +
                          STKVAR(&STACK) STKNBR(&STKNBR)
             IF         (&STKNBR *GT 0) DO /* Element exists */
             .
             .          /* Process element */
             .
             GOTO       LOOP2
             ENDDO      /* Element exists */

Note  that the  ELMLEN parameter  is defined  with a  variable that  is
initialized  with a value of  10.  In  general, it is  good practice to
use this approach rather  than specifying a  constant in every  command
to ensure consistency across all of the Stack commands.

After the SNDSTK  command completes, the &STACK variable  would contain
the element that was sent.

It is invalid  to send in a blank element to the  stack.  A blank entry
is used to determine that there are no more elements in the stack.

If  you attempt to write  more than what the  stack variable will hold,
TAA9891 (from TAAMSGF) will be sent as an escape message.

An optional  return  variable (FULL)  can be  specified  to return  the
'full' indication  when the last slot  is filled.  Normally,  you would
not  test until you  determine that there  is another entry  to be sent
to the stack.   The following  describes how the  test occurs prior  to
writing the next element:

 LOOP1:      .          /* Move field to be stacked to &ELEMENT */
             .
             IF         (&FULL *EQ '1') DO /* Stack is full */
             .
             .          /*  Exceeded limit - an error condition */
             .
             ENDDO      /* Stack is full */
             SNDSTK     ELEMENT(&ELEMENT) ELMLEN(&ELMLEN) +
                          STKVAR(&STACK) FULL(&FULL)
             GOTO       LOOP1

Thus there are three ways to handle a full stack condition:

  **   Code  for  the   return  variable  which  indicates   the  'full
       condition'  and  provide  logic  in  your  program to  test  the
       condition.   The  'full  condition' is  optionally  passed  back
       when the last element is entered into the stack.

  **   Do nothing.   If you attempt  to send too many  entries, TAA9891
       occurs.

  **   Monitor  for the  TAA9891  condition and  provide  program logic
       for the exception.

The  RCVSTK  command supports  the STKNBR  parameter.   This determines
which entry  will be  accessed from  the stack.   The  entry should  be
passed with a value  of 1 less than desired.  This  allows you to start
with a  0 value.  The value returned  will be the actual element number
passed back.  Thus  for normal coding, you  just loop back and  request
the next element  without ever incrementing the value.   When there are
no  more elements  (the  STKNBR value  exceeds the  number  of elements
written or is out of  bounds), the STKNBR field is  set to -1.  If  you
request a value  of less than zero, CPF9898  will be sent as  an escape
message.

You  can  use  the   SNDSTK/RCVSTK  commands  multiple  times  in  your
program.   If you want a different stack,  you can either blank out the
existing  STKVAR  variable or  use  a  different  variable.    You  can
receive from  the same stack multiple  times.  However, you  must reset
the STKNBR variable for each receive sequence.

Alternating array approach
--------------------------

It   is  possible  to  have  multiple   stack  variables  and  have  an
alternating array structure as in RPG.

For example, you  could use  one stack  for unique names  and a  second
stack  to count  the occurrences  that the  unique names  were used  or
total  amounts.  You would  first initialize the second  stack (such as
for totals) with the INZSTK command  so that it contains all  non-blank
entries.  Note  that you can only  place character values in  the stack
so that you would normally specify something like:

         DCL        &ELMLEN1 *DEC LEN(5 0) VALUE(10)
         DCL        &ELMLEN2 *DEC LEN(5 0) VALUE(5)
          .
          .
         INZSTK     ELEMENT('00000') ELMLEN(&ELMLEN2) STKVAR(&STACK2)

The  INZSTK command  should only  be used  for  this type  of approach.
Normally,  the stack  will be blank  to begin with.   A  blank entry is
used  to  determine  the  end  of  stack  condition  for  most  of  the
commands.

When a  name arrives you  would do a  SNDSTK command against  the first
stack  and receive  back  the element  number (STKNBR  parameter) where
the  element  was  added  (or  already  exists  if  DUPLICATES(*NO)  is
specified).


         SNDSTK     ELEMENT(&NAME) ELMLEN(&ELMLEN1) STKVAR(&STACK1)
                      DUPLICATES(*NO) STKNBR(&STKNBR)

Note that  it is not  necessary to use  the LKPSTK command  function if
you  are  interested  in  adding  an  element  if  it does  not  exist.
Whether the element exists  or not, the STKNBR  value now contains  the
location where the element exists.

The RCVSTK  command can now  be used to  receive the existing  value of
the alternating  array.  First you  must subtract 1 from  the STKNBR in
order to allow RCVSTK to access the proper element.

         CHGVAR     &PRVNBR (&STKNBR - 1)
         RCVSTK     ELEMENT(&ELEMENT) ELMLEN(&ELMLEN2) STKVAR(&STACK2)
                      STKNBR(&PRVNBR)

Using  the  STKNBR value,  you would  use UPDSTK  to update  the second
stack.   Note  that the  &ELEMENT  field is  character.   You  need  to
convert  to decimal,  perform the  add, convert  to character  and then
use UPDSTK.

         CHGVAR     &DECWORK &ELEMENT
         CHGVAR     &DECWORK (&DECWORK + &TOTAL)
         CHGVAR     &ELEMENT &DECWORK
         UPDSTK     ELEMENT(&ELEMENT) ELMLEN(&ELMLEN2) STKVAR(&STACK2)
                      STKNBR(&STKNBR)

When  all updates were  complete, you could  use the  RCVSTK command on
both stacks to output the results.

SNDSTK command parameters                             *CMD
-------------------------

Sends an element  to the  stack.  The  new element is  always added  to
the next available  slot in the stack  (first blank entry).   An option
exists  to  determine if  duplicates should  exist  in the  stack.   An
option exists to determine the element number used.

   ELEMENT       The element to  be sent to  the stack.   It can be  up
                 to  100 bytes  in  length.    An all  blank  value  is
                 invalid.   The element will  always be written  in the
                 first blank entry.

   ELMLEN        The  element  length of  the  ELEMENT variable.   This
                 must be  a  *DEC LEN(5  0) field.    It cannot  exceed
                 100, but  may be  less than 100.   A  consistent value
                 must  be specified on all  commands involving the same
                 stack.

   STKVAR        The variable  in your  program that  holds the  stack.
                 It must be  2000 bytes in length.   The stack commands
                 assume  that it  will be initialized  to blanks.   The
                 stack variable is updated by SNDSTK and returned.

   STKNBR        The element number that  contains the entry after  the
                 stack is updated.   Any value passed into  the command
                 is  ignored.  STKNBR  is an optional  return variable.
                 It   must  be  specified   as  *DEC  LEN(5   0).    If
                 DUPLICATES(*YES) is  specified, the  element is  added
                 at  the  first blank  entry.    If DUPLICATES(*NO)  is
                 specified,  the number represents the  entry where the
                 duplicate was found or  the location where the  unique
                 element was written.

   FULL          A 1  byte character value  that describes  whether the
                 stack  is full.   A '1' means  that it is  full.  This
                 will be passed  back when  the last  element is  added
                 to  the  stack.    If  you  attempt  to  send  another
                 element  to   the  stack,  TAA9891   from  TAAMSGF  in
                 TAATOOL  will  be  sent  as an  escape  message.   The
                 parameter is optional.

   DUPLICATES    An option  to control whether  duplicates are  allowed
                 in the  stack.   The default is  *YES.  This  means if
                 you  stack   the  same  value  more  than  once,  each
                 occurrence will be in the stack.

                 The  *NO  entry  means  that  you  only   want  unique
                 occurrences  in the  stack.   If  you  stack an  entry
                 that  already  exists, the  command  just  returns (no
                 error occurs).   The *NO entry  is intended for  usage
                 where you are going to process only unique values.

RCVSTK command parameters                             *CMD
-------------------------

Receives  an  element from  the  stack.    A specific  element  can  be
received or every  element in the stack (one  at a time) from beginning
to  end in either  FIFO or LIFO  sequence.  An  option exists to remove
an entry when it is received.

   ELEMENT       The element to  be received.   It must be declared  as
                 100  bytes  in  length.    The actual  length  of  the
                 element  should be specified in  the ELMLEN parameter.

   ELMLEN        The element  length of  the  ELEMENT variable.    This
                 must  be a  *DEC LEN(5  0)  field.   It cannot  exceed
                 100,  but may be  less than  100.  A  consistent value
                 must be specified on  all commands involving the  same
                 stack.   The length  specified is  normally less  than
                 the ELEMENT length.

   STKVAR        The  variable in  your program  that holds  the stack.
                 It  must be  2000 bytes  in length.   The  variable is
                 returned to  your  program.   If  you  have  requested
                 REMOVE(*YES),   the  variable   will  be   changed  on
                 return.

   STKNBR        The  stack number.   It must be defined  as *DEC LEN(5
                 0).  This value  must be passed  as one less than  the
                 element you  want to receive.   It is returned  as the
                 element found  in the stack.  This  allows you to take
                 the default declare entry  (an initial value of  zero)
                 and not  have  to update  the variable  to obtain  the
                 next element.

                 When  no  more elements  exist,  the  value is  passed
                 back  as  -1.    Your  program  logic  should  prevent
                 another RCVSTK  command unless  you change the  value.

                 It is possible  to loop thru the same  stack more than
                 once  to  receive the  same  elements.   When  you are
                 ready to  start with  the  first element  again,  just
                 reset the STKNBR variable to zero.

                 See  the special  considerations with  SEQUENCE(*LIFO)
                 and REMOVE(*YES).

   SEQUENCE      This  controls FIFO or  LIFO sequencing.   The default
                 is *FIFO.

                 If *LIFO is  specified, the elements  are received  in
                 a 'last in  - first out'  basis.  The STKNBR  value to
                 be  specified should be  one greater than  the element
                 to  be received (except  for the special  value of 0).
                 For example, if  you specify SEQUENCE(*LIFO) and  want
                 the 12th element, you would specify STKNBR(13).

                 If   you  want   to  process   the  entire   stack  in
                 SEQUENCE(*LIFO)   beginning  with  the  last  element,
                 start with  STKNBR(0).    This  will  cause  the  last
                 entry sent  to the stack to  be received.   The number
                 of  the  last entry  returned  will be  in  the STKNBR
                 parameter.  Therefore, you do  not need to modify  the
                 STKNBR parameter  if you  need to  receive all of  the
                 entries.    When  there  are  no more  entries  to  be
                 returned,  STKNBR will be set to  -1.  You can receive
                 the same entries  again by resetting the  STKNBR value
                 to 0.

   REMOVE        Whether  to  remove  the  entry  or leave  it  in  the
                 stack.   The default is *NO to  leave the entry in the
                 stack.

                 If you  are  receiving  all  of the  entries  in  FIFO
                 sequence  and  specify REMOVE(*YES),  each  entry  you
                 receive  will have the STKNBR  of 1.   This is because
                 the stack  will  continually shift  left  and  overlay
                 the  last  entry  sent back  to  you.    Therefore,  a
                 STKNBR value  of 0 or  1 operates the same  if you are
                 using  REMOVE(*YES).   This allows you  to receive all
                 of the entries without updating the STKNBR value.

                 Note  that  the  1   entry  is  a  special  case   for
                 REMOVE(*YES).    For  REMOVE(*NO),  a  1  entry  would
                 return  the 2nd element.  For  REMOVE(*YES), a 1 entry
                 always returns the 1st element.

                 Assuming SEQUENCE(*FIFO)  and  you  specify  a  STKNBR
                 greater than  1, the  N +  1 entry  is returned.   For
                 example,  if you specify STKNBR(12),  the 13th element
                 is returned  and the  stack is  shifted left  so  that
                 the 14th  element is now  where the 13th  element was.

                 When there  are no more  elements to be  received, the
                 STKNBR value is passed back as -1.

UPDSTK command parameters                             *CMD
-------------------------

Updates an element in the stack.  The entire element is updated.

   ELEMENT       The  element value  to be placed  into the  stack.  It
                 can be  up  to 100  bytes in  length.   A  LOKUP of  a
                 blank value is invalid.

   ELMLEN        The  element length  of  the ELEMENT  variable.   This
                 must  be  a *DEC  LEN(5 0)  field.   It  cannot exceed
                 100, but may  be less  than 100.   A consistent  value
                 must be specified  on all commands involving  the same
                 stack.

   STKVAR        The  variable in  your program  that holds  the stack.
                 It must  be 2000  bytes in  length.   The variable  is
                 returned to your program with the updated element.

   STKNBR        The  stack element  you  want  updated.   It  must  be
                 defined as  *DEC LEN(5 0).  The  element must exist or
                 an  escape  message  will  be  sent.    UPDSTK  always
                 operates on  the  element  number specified  and  does
                 not  increment  or  decrement  the number.    Thus  to
                 update  every element in  the stack,  you must control
                 the stack number in your program.

LKPSTK command parameters                             *CMD
-------------------------

Does a lookup  of the stack to  determine if an  element is already  in
the stack.  The element number found in the stack is returned.

   ELEMENT       The element  value to be searched  for.  It can  be up
                 to  100  bytes  in length.    An  all  blank value  is
                 invalid.

   ELMLEN        The element  length of  the  ELEMENT variable.    This
                 must be  a  *DEC LEN(5  0) field.    It cannot  exceed
                 100,  but may be  less than  100.  A  consistent value
                 must  be specified on all  commands involving the same
                 stack.

   STKVAR        The variable  in your  program that  holds the  stack.
                 It must be 2000 bytes in length.

   STKNBR        The stack  number returned that  satisfies the lookup.
                 The  variable must be  defined as *DEC LEN(5  0).  The
                 STKNBR can be  passed in  as any value  (the value  is
                 ignored).   The lookup  always starts  with the  first
                 element.   The value  will be returned  with the value
                 of  the  first  element   that  matches  the   element
                 specified.  If no  match occurs, the value will  be 0.

                 Note  that   there  is  no   way  to  find   a  second
                 occurrence of the same value with LKPSTK.

INZSTK command parameters                             *CMD
-------------------------

Initializes  the stack  so that  all of  the elements contain  the same
value.  This  command is normally used  with LKPSTK for an  alternating
array type of  approach.  It should  not be used with a  stack that you
do  SNDSTK to.   If you  want to initialize  a stack that  you will use
with SNDSTK, the  normal method  would be to  use CHGVAR to  set it  to
blanks.

   ELEMENT       The  element  value  used  to initialize  all  of  the
                 elements.   It can be  up to 100 bytes  in length.  An
                 all blank value is invalid.

   ELMLEN        The element  length of  the  ELEMENT variable.    This
                 must be  a  *DEC LEN(5  0) field.    It cannot  exceed
                 100,  but may be  less than  100.  A  consistent value
                 must  be specified on all  commands involving the same
                 stack.

   STKVAR        The variable  in your  program that  holds the  stack.
                 It  must  be 2000  bytes  in  length.   The  value  is
                 returned to your program.

SORTSTK command parameters                            *CMD
--------------------------

Sorts  the stack in ascending  or descending sequence.   If no elements
exist,  the  command  completes  normally  and  a   special  completion
message is sent.

The entire  element is  used as  the sort field.   If  you have  one or
more sort  fields followed by other data in  the element, you can place
the sort fields in high order  sequence in the element followed by  the
other data.

   ELMLEN        The  element length  of  the  elements in  the  stack.
                 This  must  be  a *DEC  LEN(5  0)  field.   It  cannot
                 exceed  100, but may  be less than  100.  A consistent
                 value must  be  specified  on all  commands  involving
                 the same stack.

   STKVAR        The  variable in  your program  that holds  the stack.
                 It  must  be  2000  bytes  in  length.    It  will  be
                 returned in  the specified  sequence.   If no  entries
                 exist  (the stack  is  all  blank), the  command  will
                 complete successfully.

   SEQUENCE      Whether  to  use  ascending  (*ASCEND)  or  descending
                 (*DESCEND) sequence.   *ASCEND  is the  default.   The
                 entire element is used for the comparison.

Updating the stack with your own logic
--------------------------------------

It is possible  to update the stack with  your own CL statements.   For
example,  you could  move data into  the stack  variable with  your own
logic  and then use  the LKPSTK or  SORTSTK commands to  operate on the
stack.  However,  the commands assume that  the stack does not  contain
any blank  elements except for  those beyond the last  element written.
The  commands  will  sense  an 'end  of  stack'  condition  if  a blank
element is found.

You must be consistent  with your handling of  the ELMLEN parameter  to
described the  element length with the  stack commands as well  as your
own code.

Restrictions
------------

None.

Prerequisites
-------------

The following TAA Tools must be on your system:

           SNDCOMPMSG     Send completion message
           SNDESCMSG      Send escape message

Implementation
--------------

None, the tool is ready to use.

Objects used by the tool
------------------------

   Object        Type       Attribute      Src member     Src file
   ------        -----      ---------      ----------     -----------

   SNDSTK        *CMD                      TAACLPN        QATTCMD
   RCVSTK        *CMD                      TAACLPN2       QATTCMD
   UPDSTK        *CMD                      TAACLPN3       QATTCMD
   LKPSTK        *CMD                      TAACLPN4       QATTCMD
   INZSTK        *CMD                      TAACLPN5       QATTCMD
   SORTSTK       *CMD                      TAACLPN6       QATTCMD
   TAACLPNC      *PGM          CLP         TAACLPNC       QATTCL
   TAACLPNC2     *PGM          CLP         TAACLPNC2      QATTCL
   TAACLPNC3     *PGM          CLP         TAACLPNC3      QATTCL
   TAACLPNC4     *PGM          CLP         TAACLPNC4      QATTCL
   TAACLPNC5     *PGM          CLP         TAACLPNC5      QATTCL
   TAACLPNC6     *PGM          CLP         TAACLPNC6      QATTCL

Structure
---------
   SNDSTK command
     TAACLPNC CL pgm

   RCVSTK command
     TAACLPNC2 CL pgm

   UPDSTK command
     TAACLPNC3 CL pgm

   LKPSTK command
     TAACLPNC4 CL pgm

   INZSTK command
     TAACLPNC5 CL pgm

   SORTSTK command
     TAACLPNC6 CL pgm

Sample 1 - A typical Send, Sort, Receive application
----------------------------------------------------

/* STACK1 - Sample Send, Sort and Receive */
/*                                                                  */
/* This program will build an outfile of all message queues in      */
/*   a library. It will use SNDSTK to build a stack of elements.    */
/*   Each element is made up of storage size, name and library.     */
/*   When all message queues have been read, the stack is sorted    */
/*   in descending order (the largest size first). RCVSTK is        */
/*   then used to access the elements. The elements are printed     */
/*   with the TAA Tool PRINT command.                               */
/*                                                                  */
             PGM
             DCLF       QADSPOBJ /* DSPOBJD outfile */
             DCL        &ELMLEN *DEC LEN(5 0) VALUE(30)
             DCL        &ELEMENT *CHAR LEN(100)
                        /* The element must be defined as 100 for */
                        /*   RCVSTK, but the &ELMLEN controls the */
                        /*   actual length sent and received.     */
             DCL        &STACK *CHAR LEN(2000)
             DCL        &STKNBR *DEC LEN(5 0)
             DCL        &SIZEA *CHAR LEN(10)
             DCL        &SIZE *DEC LEN(10 0)
             DCL        &MSGQ *CHAR LEN(10)
             DCL        &LIB *CHAR LEN(10)
             DCL        &LINE *CHAR LEN(132)
                        /* Print heading with TAA Tool PRINT tool  */
             PRINT      ACTION(*OPN) TITLE('Message queues in +
                          descending size order')
                        /* Build outfile of Message queues */
             DSPOBJD    OBJ(xxxxxx/*ALL) OBJTYPE(*MSGQ) DETAIL(*FULL) +
                          OUTPUT(*OUTFILE) OUTFILE(QTEMP/DSPOBJDP)
             OVRDBF     QADSPOBJ TOFILE(QTEMP/DSPOBJDP)
 LOOP1:      RCVF       /* Receive object records */
             MONMSG     MSGID(CPF0864) EXEC(GOTO EOF)
             CHGVAR     &SIZEA &ODOBSZ
             CHGVAR     &ELEMENT (&SIZEA *CAT &ODOBNM *CAT &ODLBNM)
             SNDSTK     ELEMENT(&ELEMENT) ELMLEN(&ELMLEN) +
                          STKVAR(&STACK)
             GOTO       LOOP1 /* Get next object */
 EOF:                   /* All have been read, sort the stack */
             SORTSTK    ELMLEN(&ELMLEN) STKVAR(&STACK) +
                          SEQUENCE(*DESCEND)
 LOOP2:                 /* Receive all and print */
             RCVSTK     ELEMENT(&ELEMENT) ELMLEN(&ELMLEN) +
                          STKVAR(&STACK) STKNBR(&STKNBR)
                        /* If &STKNBR is GT 0, an element exists */
             IF         (&STKNBR *GT 0) DO /* Print element */
                        /* Extract fields from the stack */
             CHGVAR     &SIZE %SST(&ELEMENT 1 10)

             CHGVAR     &MSGQ %SST(&ELEMENT 11 10)
             CHGVAR     &LIB %SST(&ELEMENT 21 10)
                        /* TAA Tool BLDPRTLIN command */
             BLDPRTLIN  LINE(&LINE) CHARFLDS((&MSGQ 1) (&LIB 13)) +
                          DECFLDS((&SIZE 36))
             PRINT      LINE(&LINE)
             GOTO       LOOP2
             ENDDO      /* Print element */
                        /* When stack is done, close print */
             PRINT      ACTION(*CLO)
             ENDPGM

Sample 2 - A typical alternating array application
--------------------------------------------------

/* STACK2 - Alternating array concept using INZSTK and UPDSTK       */
/*                                                                  */
/* This program will build an outfile of all message queues in      */
/*   a library. An alternating array concept will be used. The .    */
/*   first stack will contain the owner name. The second stack      */
/*   will contain the number of objects he owns and the total       */
/*   size. When all objects have been processed, the RCVSTK         */
/*   command is used to process both stacks. The elements are       */
/*   printed with the TAA Tool PRINT command.                       */
/*                                                                  */
             PGM
             DCLF       QADSPOBJ /* DSPOBJD outfile */
             DCL        &ELMLEN1 *DEC LEN(5 0) VALUE(10)
             DCL        &ELEMENT1 *CHAR LEN(100)
                        /* The element must be defined as 100 for  */
                        /*   RCVSTK, but the &ELMLEN1 controls the */
                        /*   actual length sent and received.      */
             DCL        &STACK1 *CHAR LEN(2000)
             DCL        &STKNBR1 *DEC LEN(5 0)
             DCL        &ELMLEN2 *DEC LEN(5 0) VALUE(15)
             DCL        &ELEMENT2 *CHAR LEN(100)
             DCL        &STACK2 *CHAR LEN(2000)
             DCL        &STKNBR2 *DEC LEN(5 0)
             DCL        &OWNER *CHAR LEN(10)
             DCL        &SIZEA *CHAR LEN(10)
             DCL        &SIZE *DEC LEN(10 0)
             DCL        &COUNTA *CHAR LEN(5)
             DCL        &COUNT *DEC LEN(5 0)
             DCL        &LINE *CHAR LEN(132)
                        /* Print heading with TAA Tool PRINT tool  */
             PRINT      ACTION(*OPN) TITLE('Message queues by +
                          owner with count and totals')
                        /* Inlz STACK2 with zeros */
             CHGVAR     &SIZEA &SIZE
             CHGVAR     &COUNTA &COUNT
             CHGVAR     &ELEMENT2 (&SIZEA *CAT &COUNTA)
             INZSTK     ELEMENT(&ELEMENT2) ELMLEN(&ELMLEN2) +
                          STKVAR(&STACK2)
                        /* Build outfile of Message queues */
             DSPOBJD    OBJ(xxxxxx/*ALL) OBJTYPE(*MSGQ) DETAIL(*FULL) +
                          OUTPUT(*OUTFILE) OUTFILE(QTEMP/DSPOBJDP)
             OVRDBF     QADSPOBJ TOFILE(QTEMP/DSPOBJDP)
 LOOP1:      RCVF       /* Read A MSGQ object */
             MONMSG     MSGID(CPF0864) EXEC(GOTO EOF)
                        /* Send unique owner name to STACK1, get nbr */
                        /*   DUPLICATES(*NO) causes unique entry */
             SNDSTK     ELEMENT(&ODOBOW) ELMLEN(&ELMLEN1) +
                          STKVAR(&STACK1) STKNBR(&STKNBR1) +

                          DUPLICATES(*NO)
                        /* STKNBR has the number actually used */
                        /* Decrement STKNBR to do RCVSTK */
             CHGVAR     &STKNBR2 (&STKNBR1 - 1)
                        /* Receive alternating element in 2nd stack */
             RCVSTK     ELEMENT(&ELEMENT2) ELMLEN(&ELMLEN2) +
                          STKVAR(&STACK2) STKNBR(&STKNBR2)
                        /* Extract from char to decimal */
             CHGVAR     &SIZE %SST(&ELEMENT2 1 10)
             CHGVAR     &COUNT %SST(&ELEMENT2 11 5)
                        /* Increment size and count */
             CHGVAR     &SIZE (&SIZE + &ODOBSZ)
             CHGVAR     &COUNT (&COUNT + 1)
                        /* Insert back into element */
             CHGVAR     %SST(&ELEMENT2 1 10) &SIZE
             CHGVAR     %SST(&ELEMENT2 11 5) &COUNT
                        /* Update the alternating stack */
             UPDSTK     ELEMENT(&ELEMENT2) ELMLEN(&ELMLEN2) +
                          STKVAR(&STACK2) STKNBR(&STKNBR2)
             GOTO       LOOP1
 EOF:                   /* All have been read */
                        /* Inlz stack numbers */
             CHGVAR     &STKNBR1 0
             CHGVAR     &STKNBR2 0
 LOOP2:                 /* Receive from each stack and print */
             RCVSTK     ELEMENT(&ELEMENT1) ELMLEN(&ELMLEN1) +
                          STKVAR(&STACK1) STKNBR(&STKNBR1)
             RCVSTK     ELEMENT(&ELEMENT2) ELMLEN(&ELMLEN2) +
                          STKVAR(&STACK2) STKNBR(&STKNBR2)
                        /* If &STKNBR is GT 0, an element exists */
             IF         (&STKNBR1 *GT 0) DO /* Print element */
                        /* Get owner from 1st stack element */
             CHGVAR     &OWNER %SST(&ELEMENT1 1 10)
                        /* Get size and count from 2nd stack element */
             CHGVAR     &SIZE %SST(&ELEMENT2 1 10)
             CHGVAR     &COUNT %SST(&ELEMENT2 11 5)
                        /* TAA Tool BLDPRTLIN command */
             BLDPRTLIN  LINE(&LINE) CHARFLDS((&OWNER 1)) +
                          DECFLDS((&SIZE 26) (&COUNT 43))
             PRINT      LINE(&LINE)
             GOTO       LOOP2 /* Get next stack element */
             ENDDO      /* Print element */
                        /* When no more elements, close print */
             PRINT      ACTION(*CLO)
             ENDPGM
					

Added to TAA Productivity tools April 1, 1995


Home Page Up to Top