Is there an easy way to determine how many records are held by the current session?

Hello all,

following “classic” problem: I got a NAT3047 in Batch. NISNHQ is set to 6000. I’m doing an END TRANSACTION every 1000 records processed by my main program.

The reason is: There is a huge nested callnat-Structure called for every record. And ist not predictable how many additional records will be changed inside the nested callnat structure. In most cases no records are changed. In some rare cases there are hundreds of records changed for one record in the main program.

Solution No. 1 would be of course: Implementing a counter as a paramter used by all programs in the nested structre. In my case that would mean to change (and to test) > 30 subprograms. Not good.

Solution No. 2 would be: END TRANSACTION for every record read by the main program. This would result in > 1,000,000 senseless transactions. Runtime would rise. Not good.

Solution No. 3 would be to determine (in the main program) how many records are held by the current session, and to do an END TRANSACTION if more than (e.g.) 1000 records held. But the question is: How to do this? Is there any system variable or USR-Call to do this?

Thanks

Matthias

P.S.: I did this post initially in the adabas-forums, but I think the natural-Forums is the better place.

There is a way to do this, but this method is not intended for the type of thing you need. Likely it would cause longer run times than Solution No. 2 if invoked a million times.

Use USR1052N (or CALL “SHCMD” ) to generate a User Queue report. The command will look similar to this.

adaopr.exe" dbid=### display=uq_full > C:\TEMP\jobname-userid-dbid-uq.txt

Read the WORK file/report, scanning for “Login Id” to identify your job. Twelve lines below that, look for “ISNs Held”.

To be honest: I already got such a subprogram called ADAOPR1N (Adabas Version 6.3.2.06 @ Unix). I wrote it in 2014/2015 for another issue. But as you stated, this is to much overhead. To get my session’s HQ, I would go for ET-ID rather than Login Id.

By the way. Here’s my code. Any improvements?

* ADAOPR1N
*
* call Command ADAOPR DI=UQ_FULL DI=UQ_FILES DI=HQ
*
DEFINE DATA PARAMETER USING ADAOPR1A
*
LOCAL
1 #OPTIONS
  2 #TEMPFILE_FOLDER (A) DYNAMIC CONST <'/tmp/'> /* trailing slash!
  2 #TSEP            (A1)  CONST <','>           /* thousands separator
  2 #ERROR_MAIL_TO   (A40) CONST <'user@host.com'>
*
1 #TEMPUDB      (N5)
1 #TEMPFILE     (A) DYNAMIC
1 #TEMPPARM     (A) DYNAMIC
1 #SHCMD        (A) DYNAMIC
1 #A100         (A100)
1 REDEFINE #A100   /* UQ_FULL
  2 #FU-NAME1  (A13)
  2 #FU-NAME2  (A15)
  2 #FU-VALUE2 (A17)
  2 #FU-NAME3  (A14)
  2 #FU-VALUE3 (A41)
1 REDEFINE #A100
  2 FILLER 29X
  2 #FU-TIMESTAMP (A50)
1 REDEFINE #A100   /* UQ_FILES
  2 #FI-ID     (A10)
  2 #FI-TYPE   (A9)
  2 #FI-MODE   (A5)
  2 #FI-FILES  (A76)
1 REDEFINE #A100   /* HQ
  2 #HQ-ID     (A10)
  2 #HQ-NODE   (A10)
  2 #HQ-LOGIN  (A09)
  2 #HQ-ES_ID  (A10)
  2 #HQ-USER   (A10)
  2 #HQ-FILE   (A04)
  2 #HQ-ISN    (A14)
  2 #HQ-LOCKS  (A06)
  2 #HQ-FLAG   (A27)
*
1 #COUNT        (I4)
1 #SECTION      (A22)
1 #OCC          (I2)
1 #OCC2         (I2)
1 #I4           (I4)
1 #TEMP_ID      (I4)
1 #TEMP_ACC     (A1)
1 #FILE_TAB     (I4/1:*)
1 #SUBJECT      (A50)
1 #ATTACHMENTS  (B/1) DYNAMIC
*
END-DEFINE
*
ON ERROR
  COMPRESS *PROGRAM 'Error' *ERROR-NR 'Line' *ERROR-LINE INTO #SUBJECT
  CALLNAT 'XXWRKF6N' 30 #ATTACHMENTS(1)                   /* 2015-01-28
  CALLNAT 'XXWRKF7N' #ATTACHMENTS(1) 'adaopr.txt'         /* 2015-01-28
  CALLNAT 'XXMAILSN' #OPTIONS.#ERROR_MAIL_TO #SUBJECT 1X #A100
    5X #ATTACHMENTS(*)
  ESCAPE MODULE
END-ERROR
*
REDUCE ARRAY #ADAOPR-UQ TO 0
REDUCE ARRAY #ADAOPR-HQ TO 0
*
IF NOT #I-ADAOPR1A.#I-UDB SPECIFIED OR #I-ADAOPR1A.#I-UDB = 0
  CALLNAT 'XGETUDBN' #TEMPUDB
ELSE
  #TEMPUDB := #I-ADAOPR1A.#I-UDB
END-IF
IF #I-ADAOPR1A.#FILE SPECIFIED AND #I-ADAOPR1A.#FILE NE 0
  COMPRESS NUMERIC ' file=' #I-ADAOPR1A.#FILE INTO #TEMPPARM LEAVING NO
END-IF
IF #I-ADAOPR1A.#ISN_HOLD SPECIFIED AND #I-ADAOPR1A.#ISN_HOLD NE 0
  COMPRESS NUMERIC #TEMPPARM ' isn=' #I-ADAOPR1A.#ISN_HOLD 
    TO #TEMPPARM LEAVING NO
END-IF
*
* /* adaopr interprets parameter USER as a search string
* IF #I-ADAOPR1A.#USER_ID SPECIFIED AND #I-ADAOPR1A.#USER_ID NE ' '
*   COMPRESS NUMERIC #TEMPPARM ' user=' #I-ADAOPR1A.#USER_ID 
*     TO #TEMPPARM LEAVING NO
* END-IF
*
IF #I-ADAOPR1A.#ADA_ID SPECIFIED AND #I-ADAOPR1A.#ADA_ID > 2
  COMPRESS NUMERIC #TEMPPARM ' id=' #I-ADAOPR1A.#ADA_ID 
    TO #TEMPPARM LEAVING NO
END-IF
IF #I-ADAOPR1A.#ES_ID SPECIFIED AND #I-ADAOPR1A.#ES_ID NE 0
  COMPRESS NUMERIC #TEMPPARM ' es_id=' #I-ADAOPR1A.#ES_ID 
    TO #TEMPPARM LEAVING NO
END-IF
*
COMPRESS #OPTIONS.#TEMPFILE_FOLDER *PROGRAM '_' *PID '.txt'
  INTO #TEMPFILE LEAVING NO
COMPRESS NUMERIC 'adaopr db=' #TEMPUDB #TEMPPARM
  ' di=uq_full di=uq_files di=hq >' #TEMPFILE INTO #SHCMD LEAVING NO
*
CALL 'SHCMD' #SHCMD
*
DEFINE WORK FILE 30 #TEMPFILE ATTRIBUTES 'DELETE'
READ WORK 30 #A100
  ADD 1 TO #COUNT
  IF #A100 = ' ' 
  OR SUBSTR(#A100,1,8)  = '%ADAOPR-'
  OR SUBSTR(#A100,1,15) = 'ADANUC Version'
  OR SUBSTR(#A100,1,38) = '                       ADANUC Version'
  OR SUBSTR(#A100,1,9)  = 'Database' AND #A100 = SCAN (', startup at')
    ESCAPE TOP
  END-IF
*
* Section Headlines
*
  IF SUBSTR(#A100,1,17) = '        Database'
  AND SUBSTR(#A100,49,3) = 'on'
    #SECTION := SUBSTR(#A100,24,22)
    #SECTION := *TRIM(#SECTION)
    ESCAPE TOP
  END-IF
*
  DECIDE ON FIRST VALUE OF #SECTION
    VALUE 'Full User Queue Entry'
      IF  #A100.#FU-NAME1 = ' '
      AND #A100.#FU-NAME2 = 'Timestamp Id  :'
      OR  #A100.#FU-NAME1 = ' '
      AND #A100.#FU-NAME2 = 'User Type     :'
      AND #A100.#FU-NAME3 = 'User Status  :'
      OR  #A100.#FU-NAME1 = 'Settings:'
      AND #A100.#FU-NAME2 = 'User Encoding :'
      OR  #A100.#FU-NAME1 = '-------------'
      AND #A100.#FU-NAME2 = '---------------'
      AND #A100.#FU-NAME3 = '--------------'
        ESCAPE TOP
      END-IF
*
      IF  #A100.#FU-NAME1 = 'User Entry:'
      AND #A100.#FU-NAME2 = 'Id            :'
      AND #A100.#FU-NAME3 = 'ES Id        :'
        #OCC := *OCC(#ADAOPR-UQ.#ADA_ID) + 1
        EXPAND ARRAY #ADAOPR-UQ TO (1:#OCC)
        IF *OCC(#ADAOPR-UQ.#ADA_FILES,2) = 0
          EXPAND ARRAY #ADAOPR-UQ.#ADA_FILES TO (1:*,1:1)
        END-IF
        #ADAOPR-UQ.#ADA_ID(#OCC):= VAL(#A100.#FU-VALUE2)
        #ADAOPR-UQ.#ES_ID(#OCC) := VAL(#A100.#FU-VALUE3)
        ESCAPE TOP
      END-IF
      IF  #A100.#FU-NAME1 = ' '
      AND #A100.#FU-NAME2 = 'Node Id       :'
      AND #A100.#FU-NAME3 = 'Login Id     :'
        #ADAOPR-UQ.#NODE_ID(#OCC) := *TRIM(#A100.#FU-VALUE2)
        #ADAOPR-UQ.#LOGIN_ID(#OCC):= *TRIM(#A100.#FU-VALUE3)
        ESCAPE TOP
      END-IF
      IF  #A100.#FU-NAME1 = ' '
      AND #A100.#FU-NAME2 = 'User Id       :'
      AND #A100.#FU-NAME3 = ' '
        #ADAOPR-UQ.#ADA_USER(#OCC) := *TRIM(#A100.#FU-VALUE2)
        ESCAPE TOP
      END-IF
      IF  #A100.#FU-NAME1 = 'Time Stamps:'
      AND #A100.#FU-NAME2 = 'Session Start :'
        IF #A100.#FU-TIMESTAMP NE '**-***-**** **:**:**'  /* 2015-01-28
          #ADAOPR-UQ.#SESSION_START(#OCC) := 
            #A2TIME(<#A100.#FU-TIMESTAMP>)  /* ADAOPR17
        END-IF
        ESCAPE TOP
      END-IF
      IF  #A100.#FU-NAME1 = ' '
      AND #A100.#FU-NAME2 = 'Trans. Start  :'
        #ADAOPR-UQ.#TRANS_START(#OCC) := #A2TIME(<#A100.#FU-TIMESTAMP>)
        ESCAPE TOP
      END-IF
      IF  #A100.#FU-NAME1 = ' '
      AND #A100.#FU-NAME2 = 'Last Activity :'
        IF #A100.#FU-TIMESTAMP NE '**-***-**** **:**:**'  /* 2015-03-13
          #ADAOPR-UQ.#LAST_ACTIVITY(#OCC) := 
            #A2TIME(<#A100.#FU-TIMESTAMP>)
        END-IF
        ESCAPE TOP
      END-IF
      IF  #A100.#FU-NAME1 = 'Time Limits:'
      AND #A100.#FU-NAME2 = 'TT            :'
      AND #A100.#FU-NAME3 = 'TNA          :'
        EXAMINE #A100.#FU-VALUE2 FOR #OPTIONS.#TSEP DELETE
        #I4 := VAL(#A100.#FU-VALUE2) * 10
        #ADAOPR-UQ.#TRANS_TIMEOUT (#OCC) := #I4
        EXAMINE #A100.#FU-VALUE3 FOR #OPTIONS.#TSEP DELETE
        #I4 := VAL(#A100.#FU-VALUE3) * 10
        #ADAOPR-UQ.#TNA(#OCC) := #I4
        ESCAPE TOP
      END-IF
      IF  #A100.#FU-NAME1 = 'Resources:'
      AND #A100.#FU-NAME2 = 'ISN Lists     :'
      AND #A100.#FU-NAME3 = 'ISNs Held    :'
        EXAMINE #A100.#FU-VALUE2 FOR #OPTIONS.#TSEP DELETE
        #ADAOPR-UQ.#ISN_LISTS(#OCC) := VAL(#A100.#FU-VALUE2)
        EXAMINE #A100.#FU-VALUE3 FOR #OPTIONS.#TSEP DELETE
        #ADAOPR-UQ.#ISNS_HELD(#OCC) := VAL(#A100.#FU-VALUE3)
        ESCAPE TOP
      END-IF
      IF  #A100.#FU-NAME1 = ' '
      AND #A100.#FU-NAME2 = 'Open Files    :'
      AND #A100.#FU-NAME3 = ' '
        EXAMINE #A100.#FU-VALUE2 FOR #OPTIONS.#TSEP DELETE
        #ADAOPR-UQ.#OPEN_FILES(#OCC) := VAL(#A100.#FU-VALUE2)
        ESCAPE TOP
      END-IF
      IF  #A100.#FU-NAME1 = 'Activity:'
      AND #A100.#FU-NAME2 = 'ADABAS Calls  :'
      AND #A100.#FU-NAME3 = 'Transactions :'
        EXAMINE #A100.#FU-VALUE2 FOR #OPTIONS.#TSEP DELETE
        #ADAOPR-UQ.#ADABAS_CALLS(#OCC) := VAL(#A100.#FU-VALUE2)
        EXAMINE #A100.#FU-VALUE3 FOR #OPTIONS.#TSEP DELETE
        #ADAOPR-UQ.#TRANSACTIONS(#OCC) := VAL(#A100.#FU-VALUE3)
        ESCAPE TOP
      END-IF
*
    VALUE 'User Files'
      IF  #A100.#FI-ID   = '        Id'
      AND #A100.#FI-TYPE = '  Type'
      AND #A100.#FI-MODE = 'Mode'
      AND #A100.#FI-FILES= 'Files'
      OR  #A100.#FI-ID   = '        --'
      AND #A100.#FI-TYPE = '  ----'
      AND #A100.#FI-MODE = '----'
      AND #A100.#FI-FILES= '-----'
      OR  #A100.#FI-ID   = 'Selected:'
        ESCAPE TOP
      END-IF
      IF #A100.#FI-ID NE ' '
        #TEMP_ID := VAL(#A100.#FI-ID)
      END-IF
      IF #A100.#FI-MODE NE ' '
        #TEMP_ACC := SUBSTR(#A100.#FI-MODE,1,1)
      END-IF
      IF #A100.#FI-FILES NE ' '
        PERFORM SEARCH4ID
        CALLNAT 'XXCVAN2N' #A100.#FI-FILES 2X #FILE_TAB(*)
        FOR #I4 = 1 TO *OCC(#FILE_TAB)
          #OCC2 := #FILE_TAB(#I4)
          IF #OCC2 > *OCC(#ADAOPR-UQ.#ADA_FILES,2)
            EXPAND ARRAY #ADAOPR-UQ.#ADA_FILES TO (1:*,1:#OCC2)
          END-IF
          #ADAOPR-UQ.#ADA_FILES(#OCC,#OCC2) := #TEMP_ACC
        END-FOR
      END-IF
      ESCAPE TOP
*
    VALUE 'Hold Queue'
      IF #A100 = 'Queue is empty'
      OR #A100 = 'Structure modified during display'
      OR #A100.#HQ-ID = 'Selected:' OR = '        --' OR = '        Id'
        ESCAPE TOP
      END-IF
      IF #A100.#HQ-ID NE ' '
        #OCC := *OCC(#ADAOPR-HQ.#ADA_ID) + 1
        EXPAND ARRAY #ADAOPR-HQ TO (1:#OCC)
        #ADAOPR-HQ.#ADA_ID  (#OCC) :=   VAL(#A100.#HQ-ID)
        #ADAOPR-HQ.#NODE_ID (#OCC) := *TRIM(#A100.#HQ-NODE)
        #ADAOPR-HQ.#LOGIN_ID(#OCC) := *TRIM(#A100.#HQ-LOGIN)
        #ADAOPR-HQ.#ES_ID   (#OCC) :=   VAL(#A100.#HQ-ES_ID)
        #ADAOPR-HQ.#ADA_USER(#OCC) := *TRIM(#A100.#HQ-USER)
        #ADAOPR-HQ.#FILE_NO (#OCC) :=   VAL(#A100.#HQ-FILE)
        EXAMINE #A100.#HQ-ISN FOR #OPTIONS.#TSEP DELETE
        #ADAOPR-HQ.#ISN_HOLD(#OCC) :=   VAL(#A100.#HQ-ISN)
        #ADAOPR-HQ.#LOCKS   (#OCC) := *TRIM(#A100.#HQ-LOCKS)
        #ADAOPR-HQ.#FLAGS   (#OCC) := *TRIM(#A100.#HQ-FLAG)
        ESCAPE TOP
      END-IF
*
    NONE VALUE
      IGNORE
  END-DECIDE
*
* Debugging:
*   WRITE NOTITLE #COUNT (EM=99) 
*     '-+----1----+----2----+----3----+----4' -
*     '----+----5----+----6----+----7----+-'
*     #SECTION (AL=2)
*   WRITE NOTITLE #A100 (AL=79)
*
END-WORK
CLOSE WORK FILE 30
*
**********************************
DEFINE SUBROUTINE SEARCH4ID
**********************************
RESET #OCC
FOR #OCC = 1 TO *OCC(#ADAOPR-UQ.#ADA_ID)
  IF #TEMP_ID = #ADAOPR-UQ.#ADA_ID(#OCC)
    ESCAPE ROUTINE
  END-IF
END-FOR
/* not found
#OCC := *OCC(#ADAOPR-UQ.#ADA_ID) + 1
EXPAND ARRAY #ADAOPR-UQ TO (1:#OCC)
#ADAOPR-UQ.#ADA_ID(#OCC) := #TEMP_ID
*
END-SUBROUTINE /* SEARCH4ID
*
END

* ADAOPR1A
* PDA for ADAOPR1N
*
DEFINE DATA PARAMETER
1 #ADAOPR-UQ(1:*)
  2 #ADA_ID        (I4)
  2 #NODE_ID       (A8)
  2 #LOGIN_ID      (A8)
  2 #ES_ID         (I4)
  2 #ADA_USER      (A8)
  2 #SESSION_START  (T)
  2 #TRANS_START    (T)
  2 #LAST_ACTIVITY  (T)
  2 #TRANS_TIMEOUT  (T)
  2 #TNA            (T)
  2 #ISN_LISTS     (I4)
  2 #OPEN_FILES    (I4)
  2 #ISNS_HELD     (I4)
  2 #ADABAS_CALLS  (F8)
  2 #TRANSACTIONS  (F8)
  2 #ADA_FILES     (A1/1:*)  /* A = ACC , U = UPD
*
1 #ADAOPR-HQ(1:*)
  2 #ADA_ID      (I4)
  2 #NODE_ID     (A8)
  2 #LOGIN_ID    (A8)
  2 #ES_ID       (I4)
  2 #ADA_USER    (A8)
  2 #FILE_NO     (N5)
  2 #ISN_HOLD   (P10)
  2 #LOCKS       (A5)
  2 #FLAGS       (A3)
*
1 #I-ADAOPR1A
  2 #FILE        (N5) BY VALUE OPTIONAL
  2 #ISN_HOLD   (P10) BY VALUE OPTIONAL
  2 #ADA_ID      (I4) BY VALUE OPTIONAL
  2 #ES_ID       (I4) BY VALUE OPTIONAL
  2 #I-UDB       (N5) BY VALUE OPTIONAL /* 0 = current DB
END-DEFINE

In my years of IBM mainframe Natural experience, I have occasionally wondered if the *TIME-OUT (N5) system variable would be useful in a situation like yours. According to the manual it requires Natural Security to work, which might be why I never experimented with it, and I’ve never hear of it being used.

If you have Natural Security at your shop, you could experiment with it. You could check it after returning to the main program from the lower level modules. If *TIME-OUT is zero then no records were put on hold and no ET is needed. But if not zero, issue an ET which will reset *TIME-OUT. This would avoid the need for > 1,000,000 ETs if you ET for each main file record read.

Other thoughts:

  1. Reduce your ET counter from 1000 to 100, or maybe 50. What is the maximum number of updates that could be done for a single main file record? Typically I’ve only seen 1000 used for read-only jobs, mostly to keep the UQE active on the main database while accessing a secondary database for long running data extracts and reports.

  2. If no records are currently on hold, I’ve always found the ET to be a very cheap command, re CPU and elapsed time.

  3. As a programmer, I would say the correct, best solution is your first option, to fix the subprograms/subroutines and pass back (or use AIVs) counts of records read and updated by file, and maybe by module. Print them out in an audit/control report so they can be used for future tuning/efficiency improvements, and to check during testing if any changes affected the file I/O.

  4. I wonder if any of the subprograms are putting records on hold but not updating them? Another classic Adabas/Natural issue that can cause the ISN queue to overflow.

    Good luck !

George Cooper,

thank you for answering.

We got no Natural Security. *TIME-OUT is 0 always.

Not predictable. The program has to deal with (recursive) BOM explosion.

You’re right. With no records on hold you could do almost 1 Million ETs in 1 second.

As a programmer, I’m very lazy :wink:

To be more precise: In that case, putting on hold means updating them. So there are no needless holds.

Conclusion: There’s no easy way to determine how many records are currently held by my program.

So I did the following: ET-Counter is 100. And I combined it with time measuring. Every 60 seconds, an additional ET is done.
Let’s see…

I don’t believe that you will find a quick and easily solution to your problem. At some point you may need to implement significant code changes.

Regarding what has been posted so far:

  • Checking *TIME-OUT=0 (or the more-common #ET-COUNT = 0) is a waste of effort. This only adds overhead. Natural knows whether records are on hold and will suppress END TRANSACTION and BACKOUT TRANSACTION statements automatically. There is no need to test for this condition explicitly in your code.
  • The reason ETs seem so cheap when no records are on hold is that in that case, the statement is not executed. Run a program that does nothing but ET. You won’t see the associated command in the Adabas command log. (This is much easier to see on the mainframe via the TEST DBLOG command.)
  • Over the years I’ve heard a few programmers suggest testing elapsed time, but I reject the technique because it doesn’t guarantee success. Let’s say everything is OK at 59 seconds, so no ET. Then 2 seconds later you’ve exceed the hold queue. In practice it’s a random test, not a 60-second test.

So do I.

ET-COUNTER alone doesn’t guarantee sucess as well.
Just think about TT-Parameter of ADABAS. In my case TT (Transaction Timeout) is set to 1800 seconds. Let’s say you have to read billions of records an only have to Change some 10000. And the records to Change are unequally distributed…

An improvement: instead of doing an EXPAND ARRAY every time:

  1. initialize the size of the array to something reasonable - let’s say 200 (target is something that perhaps 80% of the time is sufficient)
  2. when you need to add something to the array, check if you have exceeded upper bounds of it. If so, do another EXPAND ARRAY, adding another 200 (or 500) occurrences (increment depends on your data - if more than the 80%, then is it likely to exceed the current size by a little or a lot).
  3. if necessary, when the array is fully loaded with the values you need, use the RESIZE or REDUCE ARRAY to reduce it to the number of occurrences actually used.

Why? When you do an EXPAND ARRAY (or RESIZE to a larger size), memory is allocated for the new array, old values are copied to the new and the old array space is freed up. The larger your array, the more expensive that copy is. When you increase it by one occurrence at a time, you are slowing your program down the more you have to increase it. Do it in blocks to minimize this overhead, yet still have a robust program that won’t fail because you have more occurrences than anticipated (ok, unless you run out of memory).

Today I got some time to try out your suggestion. Very interesting… It’s 1.5s runtime vs. 0.1s in my sample.

define data local
1 #a100 (A100/1:*)
1 #i2 (I2)
1 #I4 (I4)
end-define
write '=' *TIMX (EM=HH:II:SS.T)
for #I2 = 1 to 10000
#I4 := *OCC(#a100) + 1
expand array #a100 TO (1:#I4)
end-for
write '=' *TIMX (EM=HH:II:SS.T)  *OCC(#a100)
end

TIMX: 10:54:23.6
TIMX: 10:54:25.1 10000

define data local
1 #a100 (A100/1:*)
1 #i2 (I2)
1 #I4 (I4)
end-define
write '=' *TIMX (EM=HH:II:SS.T)
for #I2 = 1 to 10000
if *OCC(#a100) < #I2
#I4 := *OCC(#a100) + 100
expand array #a100 TO (1:#I4)
end-if
end-for
write '=' *TIMX (EM=HH:II:SS.T) *OCC(#a100)
end

TIMX: 10:58:43.5
TIMX: 10:58:43.6 10000

Your first program expands #A100 to 1,000 occurrences. Your second program expands #A to 1,000,000 occurrences. For a proper comparison, change the second program to

FOR #I2 = 1 TO 100

You should see a drastic drop in run time and CPU consumption.

No, both will expand to 10000. See my output.

And yes, I can see the drop in run time.

It seems that another way of “tuning” is to use dynamics rather then fixed length variables… It’s 0.5s then. Instead of 1.5s before. of course Dynamics + less expands is even faster (0.1s)

define data local
1 #a100 (A   /1:*) dynamic
1 #i2 (I2)
1 #I4 (I4)
end-define
write '=' *TIMX (EM=HH:II:SS.T)
for #I2 = 1 to 10000
#I4 := *OCC(#a100) + 1
expand array #a100 TO (1:#I4)
#a100(#I4) :=
'12345678901234567890123456789012345678901234567890'-
'12345678901234567890123456789012345678901234567890'
end-for
write '=' *TIMX (EM=HH:II:SS.T)  *OCC(#a100)
end

TIMX: 10:23:09.5
TIMX: 10:23:10.0 10000

define data local
1 #a100 (A   /1:*) dynamic
1 #i2 (I2)
1 #I4 (I4)
end-define
write '=' *TIMX (EM=HH:II:SS.T)
for #I2 = 1 to 10000
if *OCC(#a100) < #I2
#I4 := *OCC(#a100) + 100
expand array #a100 TO (1:#I4)
end-if
#a100(#I2) :=
'12345678901234567890123456789012345678901234567890'-
'12345678901234567890123456789012345678901234567890'
end-for
write '=' *TIMX (EM=HH:II:SS.T) *OCC(#a100)
end

TIMX: 10:25:00.6
TIMX: 10:25:00.7 10000