• Subject: Re: How many objects in a system?
  • From: Douglas Handy <dhandy1@xxxxxxxxxxxxx>
  • Date: Tue, 30 Jan 2001 11:36:31 -0500

Bernd,

>Does anyone know of a quick way to get the total number of objects in a
>system?

As Leif points out, this is complicated by how you define "objects", with a
prime example being whether multi-member files (eg source files) count as one
object or one per member (plus one for the object itself).

But if all you want is an approximation, and you know how you want to handle
member counts, then I do have a partial solution for you.  I once spent some
time investigating how to get a fast object count for a single library, and came
up with the solution below.  It counts objects from a system perspective, so I
also have it back out the member count.  In my testing this made it match the
expected object count for most libraries, and was within 1% for QSYS.

The following program demonstrates the technique for a single library.  You'd
have to roll your own loop to accumulate the sum for all libraries after using
an API to list the library names.  I'll leave that as an excercise for the
reader.

     H Option( *SrcStmt: *NoDebugIO )
     H DftActGrp( *No )
     H ActGrp( *Caller )
     
      * Program to demonstrate how to get the approximate
      * number of objects in a specified library.

     D RtvObjCnt       PR            10I 0
     D  LibName                      10A   Const

     D Input           S             10A
     D Library         S             10A
     D Count           S             10I 0

     D BegTime         S               Z
     D EndTime         S               Z
     D Duration        S             15P 0
     D Seconds         S             12P 3
     D Msg             S             52A

     D Lower           C                   'abcdefghijklm+
     D                                      nopqrstuvwxyz'
     D Upper           C                   'ABCDEFGHIJKLM+
     D                                      NOPQRSTUVWXYZ'

      * Get library name; quit when no name is keyed
     C                   Eval      Input = *Blanks
     C     'Library?'    Dsply                   Input
     C                   If        Input = *Blanks
     C                   Eval      *InLR = *On
     C                   Return
     C                   Endif

      * Display object count and time required to retrieve it
     C     Lower:Upper   Xlate     Input         Library
     C                   Time                    BegTime
     C                   Eval      Count = RtvObjCnt( Library )
     C                   Time                    EndTime
     C     EndTime       Subdur    BegTime       Duration:*MS
     C                   Eval      Seconds = Duration / 1000000
     C                   Eval      Msg = %trim( %editc( Count: 'N' ) ) + 
     C                                   ' Objects; ' +
     C                                   %trim( %editc( Seconds: 'N' ) ) +
     C                                   ' Seconds'
     C     Msg           Dsply

      * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     P RtvObjCnt       B
     
     D RtvObjCnt       PI            10I 0
     D  LibName                      10A   Const

     D                 DS
     D LibSysPtrA              1     16A
     D  LibSysPtr              1     16*   ProcPtr Inz( *Null )

     D ObjCnt          S             10I 0
     D MbrCnt          S             10I 0

     D RslvSp2         PR                  Extproc( '_RSLVSP2' )
     D  Object                         *   ProcPtr
     D  ObjID_Auth                   34A   Const
     
     D MatCtx          PR                  Extproc( 'QusMaterializeContext' )
     D  RcvVar                             Like( RcvVar )  Options( *VarSize )
     D  CtxSysPtr                    16A   Value
     D  Options                            Like( MatCtxOpt )  Const

     D MatCtxOpt       DS
     D  MatInfo                       1A   Inz( x'03' )
     D  MatSelect                     1A   Inz( x'00' )
     D  MatNamLen                     5I 0 Inz( 0 )
     D  MatType                       1A   Inz( x'00' )
     D  MatSubType                    1A   Inz( x'00' )
     D  MatName                      30A
     D  MatDTS                        8A   Inz( x'0000000000000000' )

     D RcvVar          DS                  
     D  CtxBytPrv                    10I 0 Inz( %size( RcvVar ) )
     D  CtxBytAvl                    10I 0 Inz( 0 )
     D  CtxID                        32A
     D   CtxType                      1A   Overlay( CtxID : 1 )
     D   CtxSubType                   1A   Overlay( CtxID : 2 )
     D   CtxName                     30A   Overlay( CtxID : 3 )
     D  CtxOptions                    4A
     D   CtxOpt1                      1A   Overlay( CtxOptions: 1 )
     D   CtxOpt2                      1A   Overlay( CtxOptions: 2 )
     D   CtxOpt3                      1A   Overlay( CtxOptions: 3 )
     D   CtxOpt4                      1A   Overlay( CtxOptions: 4 )
     D  CtxRecover                    4A
     D   CtxRecover1                  1A   Overlay( CtxRecover: 1 )
     D  CtxSize                      10I 0
     D  CtxInitVal                    1A
     D  CtxClass                      4A
     D   CtxClass1                    1A   Overlay( CtxClass: 1 )
     D                                7A
     D                               16A
     D CtxAccGrp                       *   ProcPtr
     D* (Array of entries would start here if RcvVar was bigger)

      * First resolve library name to system pointer; if the library
      * is not found *PSSR will get control and return an object
      * count of -1
     C                   Callp     RslvSp2( LibSysPtr:
     C                                      x'0401' + 
     C                                      LibName +
     C                                      '                    ' + 
     C                                      x'0000' )

      * Materialize Context with no selection criteria or room for any
      * context entries to be returned.  The bytes available in the
      * receiver variable will give us an estimate of the total number
      * of objects in the library if we subtract the size of the header
      * then divide by the entry length for one object.  This object
      * count is a low-overhead approximation and includes one entry for
      * each member in each database file.
     C                   Eval      MatSelect = x'00'
     C                   Callp     MatCtx( RcvVar: 
     C                                     LibSysPtrA:
     C                                     MatCtxOpt )

      * If nothing got returned (not even the header data), then a
      * problem occured and we'll return -1 as the count rather than
      * zero which is an otherwise valid object count.
     C                   If        CtxBytAvl <= *Zero
     C                   Return    -1
     C                   Endif

      * Convert the bytes available into an object count
     C                   Eval      ObjCnt = (CtxBytAvl - 96 ) / 48

      * Repeat the operation but select only database file members
     C                   Eval      MatSelect  = x'02'
     C                   Eval      MatType    = x'0D'
     C                   Eval      MatSubtype = x'50'
     C                   Callp     MatCtx( RcvVar: 
     C                                     LibSysPtrA:
     C                                     MatCtxOpt )

      * Convert the bytes available into a member count and adjust
      * our previous object count to exclude database members
     C                   Eval      MbrCnt = (CtxBytAvl - 96 ) / 48
     C                   Eval      ObjCnt = ObjCnt - MbrCnt

     C                   Return    ObjCnt

     C     *PSSR         Begsr
     C                   Return    -1
     C                   Endsr     
     
     P RtvObjCnt       E
      * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---

This thread ...

Follow-Ups:
Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2019 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].