Versions Compared

Key

  • This line was added.
  • This line was removed.
  • Formatting was changed.

次のプログラムは、機能的には変わっていませんが、処理に要する時間やコンピュータ資源は大きく削減されています。追加または変更したコマンドを「->」で示します。

...

          ********

...

   Define work variables and browse list to be used
     DEFINE     FIELD(#L1COUNT)

...

 TYPE(*DEC)

...

 LENGTH(7)

...

 DECIMALS(0)

...

     ->   DEFINE     FIELD(#L1PAGE)

...

 TYPE(*DEC)

...

 LENGTH(7)

...

 DECIMALS(0)

...

     ->   DEFINE     FIELD(#L1TOP)

...

 TYPE(*DEC)

...

 LENGTH(7)

...

 DECIMALS(0)

...

     ->   DEFINE     FIELD(#L1POS)

...

 TYPE(*CHAR)

...

 LENGTH(7)

...

     ->   DEF_LIST   NAME(#L1)

...

 FIELDS((#SURNAME)

...

 (#GIVENAME)

...

 (#EMPNO)

...

 
               (

...

#ADDR ESS1))

...

 COUNTER(#L1COUNT)

...

 PAGE_SIZE(#L1PAGE)

...

 
                TOP_ENTRY(

...

# L1TOP) SCROLL_TXT(#L1POS)
     ********

...

   Loop until terminated by EXIT or CANCEL
      BEGIN_LOOP
     ********

...

   Get surname to search for
     REQUEST    FIELDS(#SURNAME)
     ********

...

   Build list of generically identical names
     CLR_LIST   NAMED(#L1)

...

     ->   CHANGE     FIELD(#IO$KEY)

...

 TO(UP)

...

     ->   CHANGE     FIELD(#L1TOP)

...

 TO(1)

...

     ->   SELECT     FIELDS(#L1)

...

 FROM_FILE(PSLMSTV1)
                WITH_KEY(#SURNAME)

...

 GENERIC(*YES)

...

 

...

     ->              WHERE('

...

#IO$KEY =

...

 UP')

...

 OPTIONS(*ENDWHERE)

...

     ->   EXECUTE    SUBROUTINE(DISPLAY)

...

 WITH_PARMS('''More...''')
     ADD_ENTRY  TO_LIST(#L1)
     ENDSELECT
     ********

...

   If names found, display list to user
     IF         COND('

...

#L1COUNT *GT 0')

...

     ->   EXECUTE    SUBROUTINE(DISPLAY)

...

 WITH_PARMS('''Bottom''')
     ********

...

   else issue error indicating none found
     ELSE
     MESSAGE    MSGTXT('No employees have a surname matching
                 request')
     ENDIF
     ********

...

   Loop back and request next name to search for
     END_LOOP
     ********
     ********

...

   Display names if page is full or list is complete
     ********

...

     ->   SUBROUTINE NAME(DISPLAY)

...

 PARMS(#L1POS)

...

     ->   DEFINE     FIELD(#L1REMN)

...

 TYPE(*DEC)

...

 LENGTH(5)

...

 DECIMALS(5)

...

     ->   CHANGE     FIELD(#L1REMN)

...

 TO('

...

#L1COUNT /

...

 #L1PAGE')

...

     ->   IF         COND('(

...

#L1COUNT *NE 0) *AND 
                (#IO$KEY = UP) *AND
                ((#L1POS = ''Bottom'')

...

 *

...

OR 
                (

...

#L1REMN *EQ 0.00000))')

...

     ->   DOUNTIL     COND('(

...

#L1POS *

...

NE ''Bottom'')

...

 *

...

OR 
                (

...

#IO$KEY *NE UP)')

...

     ->   DISPLAY    BROWSELIST(#L1)

...

 USER_KEYS((*ROLLUP))

...

     ->   ENDUNTIL
->   CHANGE     FIELD(#L1TOP)

...

 TO('

...

#L1TOP +

...

 #L1PAGE')

...

     ->   ENDIF
->   ENDROUTINE

この手法は、表示するリストの行数が膨大になりうる状況で一般的に使えるもので、処理性能の向上にも効果があります。

「最初の例」に挙げたような、SELECTとDISPLAYを組み合わせて実装したプログラムは、この手法を取り入れて比較的簡単に最適化できます。プログラム構成や処理の流れにはあまり手を入れず、局所的な修正で対処できることがわかるでしょう。

この手法を実際に組み込むためには、サイトの要求に合致した「標準」アルゴリズムを設計し、充分にテストしておくとよいでしょう。これをテンプレートとして個々のアプリケーションに適用することができます。