なんとか理解できました。あるCOBOLロジック。

COBOL General discussion - Difficult recognizable tricks in COBOL -

http://www.tek-tips.com/viewthread.cfm?qid=839069&page=1

のあるロジックを試してみました。少し改変しています。

 IDENTIFICATION            DIVISION.
 PROGRAM-ID                BITONOFF.
*
 DATA                      DIVISION.
 WORKING-STORAGE           SECTION.
 01  WS-WORK-AREAS.
*
*       変更ＢＩＴ位置の指定  X'??'=B'12345678'
*                             左から１～８
     05  BIT-NBR                   PIC  9(04) COMP.
*
*        BIT ON/OFF用データ
*            変更用データから足し引きする為の値
     05  BIT-FLIPPER.
         10  BIT-FLIPPER-NUM       PIC  9(04) COMP VALUE 0.
*
     05  FLD-1.
         10  FILLER                PIC  X(01).
         10  1ST-CHK-BYTE          PIC  X(01).
             88  CHK-BIT-IS-ON     VALUE X'80' THRU X'FF'.
             88  CHK-BIT-IS-OFF    VALUE X'00' THRU X'7F'.
*        確認用データ
     05  CHK-BITS      REDEFINES   FLD-1.
         10  CHK-BITS-NUM          PIC  9(04) COMP.
*
*        変更用データ
     05  CHG-BITS.
         10  CHG-BITS-NUM          PIC  9(04) COMP.
*
*        シフト用テーブル
     05  BIT-SHIFT-VALUES.
*        X'??'=B'12345678'
*                |  |   |---X'80'の位置にするには、掛ける*128
*                |  |-------X'80'の位置にするには、掛ける*008
*                |----------X'80'の位置にするには、掛ける*001
         10  BIT-1                 PIC  9(04) COMP VALUE   1.
         10  BIT-2                 PIC  9(04) COMP VALUE   2.
         10  BIT-3                 PIC  9(04) COMP VALUE   4.
         10  BIT-4                 PIC  9(04) COMP VALUE   8.
         10  BIT-5                 PIC  9(04) COMP VALUE  16.
         10  BIT-6                 PIC  9(04) COMP VALUE  32.
         10  BIT-7                 PIC  9(04) COMP VALUE  64.
         10  BIT-8                 PIC  9(04) COMP VALUE 128.
     05  BIT-SHIFT-TBL REDEFINES   BIT-SHIFT-VALUES.
         10  SHIFT-ENT             PIC  9(04) COMP
                                   OCCURS 8.
*       結果出力用データ
     05  KEKKA                     PIC  X(01).
 01  TBL-HEX.
     05  FILLER                  PIC  X(001)  VALUE  '0'.
     05  FILLER                  PIC  X(004)  VALUE  '0000'.
     05  FILLER                  PIC  X(001)  VALUE  '1'.
     05  FILLER                  PIC  X(004)  VALUE  '0001'.
     05  FILLER                  PIC  X(001)  VALUE  '2'.
     05  FILLER                  PIC  X(004)  VALUE  '0010'.
     05  FILLER                  PIC  X(001)  VALUE  '3'.
     05  FILLER                  PIC  X(004)  VALUE  '0011'.
     05  FILLER                  PIC  X(001)  VALUE  '4'.
     05  FILLER                  PIC  X(004)  VALUE  '0100'.
     05  FILLER                  PIC  X(001)  VALUE  '5'.
     05  FILLER                  PIC  X(004)  VALUE  '0101'.
     05  FILLER                  PIC  X(001)  VALUE  '6'.
     05  FILLER                  PIC  X(004)  VALUE  '0110'.
     05  FILLER                  PIC  X(001)  VALUE  '7'.
     05  FILLER                  PIC  X(004)  VALUE  '0111'.
     05  FILLER                  PIC  X(001)  VALUE  '8'.
     05  FILLER                  PIC  X(004)  VALUE  '1000'.
     05  FILLER                  PIC  X(001)  VALUE  '9'.
     05  FILLER                  PIC  X(004)  VALUE  '1001'.
     05  FILLER                  PIC  X(001)  VALUE  'A'.
     05  FILLER                  PIC  X(004)  VALUE  '1010'.
     05  FILLER                  PIC  X(001)  VALUE  'B'.
     05  FILLER                  PIC  X(004)  VALUE  '1011'.
     05  FILLER                  PIC  X(001)  VALUE  'C'.
     05  FILLER                  PIC  X(004)  VALUE  '1100'.
     05  FILLER                  PIC  X(001)  VALUE  'D'.
     05  FILLER                  PIC  X(004)  VALUE  '1101'.
     05  FILLER                  PIC  X(001)  VALUE  'E'.
     05  FILLER                  PIC  X(004)  VALUE  '1110'.
     05  FILLER                  PIC  X(001)  VALUE  'F'.
     05  FILLER                  PIC  X(004)  VALUE  '1111'.
*
 01  TBL-HEX-R                   REDEFINES    TBL-HEX.
     05  TBLHEX      OCCURS      16  TIMES.
         10  T-HEX               PIC  X(001).
         10  T-BIT               PIC  X(004).
*
 01  CONV-BIT.
     05  CNV-BIT-LV              PIC  X(001).
     05  CNV-BIT-CHR             PIC  X(001).
 01  CONV-BIT-R                  REDEFINES   CONV-BIT.
     05  CNV-BIN                 PIC  9(004) COMP.
*
 01  IX-UP                       PIC  9(004) COMP.
 01  IX-DW                       PIC  9(004) COMP.
*
 01  WK-BIT-EDIT.
     05  WK-BIT-UP               PIC  X(004).
     05  WK-BIT-DW               PIC  X(004).
*
 01  WK-HEX-EDIT.
     05  WK-HEX-UP               PIC  X(001).
     05  WK-HEX-DW               PIC  X(001).
*
*
*
 PROCEDURE                 DIVISION.
*   CHK-BITは対象BIT ON/OFFの確認用
*   CHG-BITは対象BIT ON/OFFの変更用
*    MOVE    your data             TO  CHK-BITS(2:1)
*                                      CHG-BITS(2:1).
*            your dataをX'FF'で試行
     MOVE    X'FF'                 TO  CHK-BITS(2:1)
                                       CHG-BITS(2:1).
     MOVE    LOW-VALUE             TO  CHK-BITS(1:1)
                                       CHG-BITS(1:1).
*
*    X(01)=B'???1????'をOFFしてみる
*    変更BIT位置を指定 X(01)=B'12345678'、
*                   BIT NBR = 4で試行
*    MOVE    BIT NBR               TO  BIT-NBR.
     MOVE    4                     TO  BIT-NBR.
*
*    BIT ON/OFF値初期化
     MOVE    X'00'                 TO  BIT-FLIPPER(1:1)
     MOVE    X'80'                 TO  BIT-FLIPPER(2:1)
*
*    確認用データ
*        対象BITをB'12345678' 1の位置にする
*        この場合X'10'をX'80'にする
     COMPUTE  CHK-BITS-NUM         =   CHK-BITS-NUM
                                   *   SHIFT-ENT(BIT-NBR).
*    BIT ON/OFF用データ
*      BIT ON/OFFを変更BITの場所に合わせる
*      この場合X'80'=B'10000000'をX'10'=B'00010000'
     COMPUTE  BIT-FLIPPER-NUM      =   BIT-FLIPPER-NUM
                                   /   SHIFT-ENT(BIT-NBR).

     EVALUATE TRUE
     WHEN  CHK-BIT-IS-ON
*          変更BITをX'80'位置にした確認用データがＯＮの時
*              CHG-BITの変更BIT ONなので、引く(OFF)する
*
           SUBTRACT  BIT-FLIPPER-NUM   FROM  CHG-BITS-NUM
*
     WHEN  CHK-BIT-IS-OFF
*          変更BITをX'80'位置にした確認用データがＯＦＦの時
*              CHG-BITの変更BIT OFFなので、足す(ON)する
*
           ADD       BIT-FLIPPER-NUM   TO    CHG-BITS-NUM
*
     WHEN  OTHER
           DISPLAY 'HOUSTON WE HAVE A PROBLEM'
           STOP RUN
     END-EVALUATE.
*
*    MOVE  CHG-BITS(2:1)   TO  your receiving area.
     MOVE  CHG-BITS(2:1)   TO  KEKKA
                               CNV-BIT-CHR.
     PERFORM     BIN2HEX-SUB   THRU    BIN2HEX-SUB-EXT.
*
     DISPLAY 'KEKKA="'  KEKKA  '"'   UPON  SYSOUT.
     DISPLAY 'KEKKA="'  WK-HEX-EDIT '-' WK-BIT-EDIT  '"'
                                     UPON  SYSOUT.

     GOBACK.
****************************************************************
*                                                              *
****************************************************************
 BIN2HEX-SUB.
     MOVE        LOW-VALUE       TO      CNV-BIT-LV.
     MOVE        ZERO            TO      IX-UP.
     MOVE        ZERO            TO      IX-DW.
*
     DIVIDE      16              INTO    CNV-BIN
                                 GIVING      IX-UP
                                 REMAINDER   IX-DW
*
     MOVE    T-BIT(IX-UP + 1)    TO      WK-BIT-UP.
     MOVE    T-BIT(IX-DW + 1)    TO      WK-BIT-DW.
*
     MOVE    T-HEX(IX-UP + 1)    TO      WK-HEX-UP.
     MOVE    T-HEX(IX-DW + 1)    TO      WK-HEX-DW.
*
 BIN2HEX-SUB-EXT.
     EXIT.

FUJITSU　COBOL85使用

＜2011/05/18 追記 START＞
IBM汎用機では

CHK-BITS-NUM の COMP を COMP-5にすれば、

000220*        確認用データ
000230     05  CHK-BITS      REDEFINES   FLD-1.
000240         10  CHK-BITS-NUM          PIC  9(04) COMP-5.

BIT-NBR 7,8 を　BIT-NBR 1(X'80')位置に
内容を壊さずにシフトできるので、
このロジックでも7,8位置のBIT ON/OFFは可能になります。

一般的なCOMP系の説明
＠IT（アットマーク・アイティ）
＠IT総合トップ ＞ ＠IT CORE ＞ Coding Edge ＞  これであなたもCOBOLプログラマ 
第2回 これであなたもCOBOLプログラマ
http://www.atmarkit.co.jp/fcoding/articles/cobol/02/cobol02b.html

COMP-5の説明。
http://dai2rou.web.fc2.com/cobol.html
「だいたいこんな感じ」様

S9(桁) ,9(桁)に　COMP-5 をつけた時の数値範囲
http://plaza.rakuten.co.jp/u703331/diary/200705220001/
「さすらいのプログラマ」様

  COMPのみだと
  計算で桁数（この場合４桁）を超えても、桁数に収めて再格納します。

  B"12345678"(数値は位置、実際は1or0)
    1の位置に乗算で左シフトしたとき

    6位置 255 × 032 =  8160 は４桁SAFE
    7位置 255 × 064 = 16320 は５桁OUT
    16320
         00111111-11000000 だが
     6320で格納される
         00011000-10110000 =>9(04) COMP
         内容が壊れます。
    8位置 255 × 128 = 32640 は５桁OUT
    32640
         1111111-10000000 だが
     2640で格納
         00001010-01010000 =>9(04) COMP
         内容が壊れます。
＜END＞

COBOL85でBITシフト

①COBOL85でBITシフト

000010 IDENTIFICATION                  DIVISION.
000020 PROGRAM-ID.                     BITSHIFT.
000030*
000040 ENVIRONMENT                     DIVISION.
000050 INPUT-OUTPUT                    SECTION.
000060 FILE-CONTROL.
000070*    SELECT      INA             ASSIGN      TO  COBIN.  
000080*    SELECT      OUT             ASSIGN      TO  COBOT.
000090*
000100 DATA                            DIVISION.
000110 FILE                            SECTION.
000120*FD  INA
000130*    LABEL       RECORD          IS  STANDARD
000140*    RECORDING   MODE            F.
000150*01  IN-REC                      PIC  X(080).
000160*
000170*FD  INA
000180*    LABEL       RECORD          IS  STANDARD
000190*    RECORDING   MODE            F.
000200*01  OUT-REC                     PIC  X(080).
000210*
000220 WORKING-STORAGE                 SECTION.
000230*
000240 01  TCOMP-A                     PIC  9(004) COMP.
000250 01  FILLER  REDEFINES           TCOMP-A.
000260     05  XBIT-00A                PIC  X(001).
000270     05  XBIT-A                  PIC  X(001).
000280*
000290 01  TCOMP-B                     PIC  9(004) COMP.
000300 01  FILLER  REDEFINES           TCOMP-B.
000310     05  XBIT-00B                PIC  X(001).
000320     05  XBIT-B                  PIC  X(001).
000330*
000340 01  TCOMP-C                     PIC  9(004) COMP.
000350 01  FILLER  REDEFINES           TCOMP-C.
000360     05  XBIT-00C                PIC  X(001).
000370     05  XBIT-C                  PIC  X(001).
000380*
000390 01  TBL-HEX.
000400     05  FILLER                  PIC  X(001)  VALUE  '0'.
000410     05  FILLER                  PIC  X(004)  VALUE  '0000'.
000420     05  FILLER                  PIC  X(001)  VALUE  '1'.
000430     05  FILLER                  PIC  X(004)  VALUE  '0001'.
000440     05  FILLER                  PIC  X(001)  VALUE  '2'.
000450     05  FILLER                  PIC  X(004)  VALUE  '0010'.
000460     05  FILLER                  PIC  X(001)  VALUE  '3'.
000470     05  FILLER                  PIC  X(004)  VALUE  '0011'.
000480     05  FILLER                  PIC  X(001)  VALUE  '4'.
000490     05  FILLER                  PIC  X(004)  VALUE  '0100'.
000500     05  FILLER                  PIC  X(001)  VALUE  '5'.
000510     05  FILLER                  PIC  X(004)  VALUE  '0101'.
000520     05  FILLER                  PIC  X(001)  VALUE  '6'.
000530     05  FILLER                  PIC  X(004)  VALUE  '0110'.
000540     05  FILLER                  PIC  X(001)  VALUE  '7'.
000550     05  FILLER                  PIC  X(004)  VALUE  '0111'.
000560     05  FILLER                  PIC  X(001)  VALUE  '8'.
000570     05  FILLER                  PIC  X(004)  VALUE  '1000'.
000580     05  FILLER                  PIC  X(001)  VALUE  '9'.
000590     05  FILLER                  PIC  X(004)  VALUE  '1001'.
000600     05  FILLER                  PIC  X(001)  VALUE  'A'.
000610     05  FILLER                  PIC  X(004)  VALUE  '1010'.
000620     05  FILLER                  PIC  X(001)  VALUE  'B'.
000630     05  FILLER                  PIC  X(004)  VALUE  '1011'.
000640     05  FILLER                  PIC  X(001)  VALUE  'C'.
000650     05  FILLER                  PIC  X(004)  VALUE  '1100'.
000660     05  FILLER                  PIC  X(001)  VALUE  'D'.
000670     05  FILLER                  PIC  X(004)  VALUE  '1101'.
000680     05  FILLER                  PIC  X(001)  VALUE  'E'.
000690     05  FILLER                  PIC  X(004)  VALUE  '1110'.
000700     05  FILLER                  PIC  X(001)  VALUE  'F'.
000710     05  FILLER                  PIC  X(004)  VALUE  '1111'.
000720*
000730 01  TBL-HEX-R                   REDEFINES    TBL-HEX.
000740     05  TBLHEX      OCCURS      16  TIMES.
000750         10  T-HEX               PIC  X(001).
000760         10  T-BIT               PIC  X(004).
000770*
000780 01  CONV-BIT.
000790     05  CNV-BIT-LV              PIC  X(001).
000800     05  CNV-BIT-CHR             PIC  X(001).
000810 01  CONV-BIT-R                  REDEFINES   CONV-BIT.
000820     05  CNV-BIN                 PIC  9(004) COMP.
000830*
000840 01  IX-UP                       PIC  9(004) COMP.
000850 01  IX-DW                       PIC  9(004) COMP.
000860*
000870 01  WK-BIT-EDIT.
000880     05  WK-BIT-UP               PIC  X(004).
000890     05  WK-BIT-DW               PIC  X(004).
000900*
000910 01  WK-HEX-EDIT.
000920     05  WK-HEX-UP               PIC  X(001).
000930     05  WK-HEX-DW               PIC  X(001).
000940*
000950*01  EOF-FLG                     PIC  X(001)  VALUE '0'.
000960****************************************************************
000970*                                                              *
000980****************************************************************
000990 PROCEDURE                       DIVISION.
001000*    OPEN    INPUT               INA.
001010*            OUTPUT              OUT.
001020*
001030*****MOVE    255                 TO      TCOMP-A.
001040*            ↓ここにSET
001050     MOVE    X'FF'               TO      XBIT-A.
001060     MOVE    LOW-VALUE           TO      XBIT-00A.
001070*
001080     MOVE    XBIT-A              TO      CNV-BIT-CHR.
001090     PERFORM     BIN2HEX-SUB     THRU    BIN2HEX-SUB-EXT.
001100*
001110     DISPLAY     'XBIT-A="'      XBIT-A  '"'
001120                                 UPON    SYSOUT.
001130     DISPLAY     'XBIT-A="'      WK-HEX-EDIT '-' WK-BIT-EDIT
001140                                 UPON    SYSOUT.
001150*
001160*左シフト
001170     COMPUTE     TCOMP-B =   TCOMP-A     *   16.
001180     MOVE    X'00'               TO      XBIT-00B.
001190     MOVE    XBIT-B              TO      CNV-BIT-CHR.
001200     PERFORM     BIN2HEX-SUB     THRU    BIN2HEX-SUB-EXT.
001210*
001220     DISPLAY     'XBIT-B="'      XBIT-B  '"'
001230                                 UPON    SYSOUT.
001240     DISPLAY     'XBIT-B="'      WK-HEX-EDIT '-' WK-BIT-EDIT
001250                                 UPON    SYSOUT.
001260*
001270*右シフト
001280     COMPUTE     TCOMP-C =   TCOMP-A     /   16.
001290     MOVE    X'00'               TO      XBIT-00C.
001300     MOVE    XBIT-C              TO      CNV-BIT-CHR.
001310     PERFORM     BIN2HEX-SUB     THRU    BIN2HEX-SUB-EXT.
001320*
001330     DISPLAY     'XBIT-C="'      XBIT-C  '"'
001340                                 UPON    SYSOUT.
001350     DISPLAY     'XBIT-C="'      WK-HEX-EDIT '-' WK-BIT-EDIT
001360                                 UPON    SYSOUT.
001370*
001380*    CLOSE                      INA.
001390*                               OUT.
001400     GOBACK
001410****************************************************************
001420*                                                              *
001430****************************************************************
001440 BIN2HEX-SUB.
001450     MOVE        LOW-VALUE       TO      CNV-BIT-LV.
001460     MOVE        ZERO            TO      IX-UP.
001470     MOVE        ZERO            TO      IX-DW.
001480*
001490     DIVIDE      16              INTO    CNV-BIN
001500                                 GIVING      IX-UP
001510                                 REMAINDER   IX-DW
001520*
001530     MOVE    T-BIT(IX-UP + 1)    TO      WK-BIT-UP.
001540     MOVE    T-BIT(IX-DW + 1)    TO      WK-BIT-DW.
001550*
001560     MOVE    T-HEX(IX-UP + 1)    TO      WK-HEX-UP.
001570     MOVE    T-HEX(IX-DW + 1)    TO      WK-HEX-DW.
001580*
001590 BIN2HEX-SUB-EXT.
001600     EXIT.
001610

②シフトして空いた所、にBITを立ててみる
　　（件数は、大体X'00'ですが。）

000990 PROCEDURE                       DIVISION.
001000*
001010*右２bitシフトして空いた上位bitに
001020*例えばアクセス件数
001030*      本日　X'00'…50件以下               =000
001040*      本日　X'01'…50件超～100件以下      =064
001050*      本日　X'10'…100件件超～500件以下   =128
001060*      本日　X'11'…500件超                =192
001070* を立てるとする。
001080     MOVE        255             TO      TCOMP-A.
001090     COMPUTE     TCOMP-C =   TCOMP-A     /   4.
001100     COMPUTE     TCOMP-C =   TCOMP-C     +   0
001110     MOVE    X'00'               TO      XBIT-00C.
001120     MOVE    XBIT-C              TO      CNV-BIT-CHR.
001130     PERFORM     BIN2HEX-SUB     THRU    BIN2HEX-SUB-EXT.
001140*
001150     DISPLAY     '* 本日　X'00'…50件以下               =000'
001160                                 UPON    SYSOUT.
001170     DISPLAY     'XBIT-C='       XBIT-C  '"'
001180                                 UPON    SYSOUT.
001190     DISPLAY     'XBIT-C='       WK-HEX-EDIT '-' WK-BIT-EDIT
001200                                 UPON    SYSOUT.
001210*
001220****************************************************************
001230     COMPUTE     TCOMP-C =   TCOMP-A     /   4.
001240     COMPUTE     TCOMP-C =   TCOMP-C     +  64.
001250     MOVE    X'00'               TO      XBIT-00C.
001260     MOVE    XBIT-C              TO      CNV-BIT-CHR.
001270     PERFORM     BIN2HEX-SUB     THRU    BIN2HEX-SUB-EXT.
001280*
001290     DISPLAY     '* 本日　X'01'…50件超～100件以下      =064'
001300                                 UPON    SYSOUT.
001310     DISPLAY     'XBIT-C='       XBIT-C  '"'
001320                                 UPON    SYSOUT.
001330     DISPLAY     'XBIT-C='       WK-HEX-EDIT '-' WK-BIT-EDIT
001340                                 UPON    SYSOUT.
001350*
001360****************************************************************
001370     COMPUTE     TCOMP-C =   TCOMP-A     /   4.
001380     COMPUTE     TCOMP-C =   TCOMP-C     + 128.
001390     MOVE    X'00'               TO      XBIT-00C.
001400     MOVE    XBIT-C              TO      CNV-BIT-CHR.
001410     PERFORM     BIN2HEX-SUB     THRU    BIN2HEX-SUB-EXT.
001420*
001430     DISPLAY     '* 本日　X'10'…100件件超～500件以下   =128'
001440                                 UPON    SYSOUT.
001450     DISPLAY     'XBIT-C='       XBIT-C  '"'
001460                                 UPON    SYSOUT.
001470     DISPLAY     'XBIT-C='       WK-HEX-EDIT '-' WK-BIT-EDIT
001480                                 UPON    SYSOUT.
001490****************************************************************
001500     COMPUTE     TCOMP-C =   TCOMP-A     /   4.
001510     COMPUTE     TCOMP-C =   TCOMP-C     + 192.
001520     MOVE    X'00'               TO      XBIT-00C.
001530     MOVE    XBIT-C              TO      CNV-BIT-CHR.
001540     PERFORM     BIN2HEX-SUB     THRU    BIN2HEX-SUB-EXT.
001550*
001560     DISPLAY     '* 本日　X'11'…500件超                =192'
001570                                 UPON    SYSOUT.
001580     DISPLAY     'XBIT-C='       XBIT-C  '"'
001590                                 UPON    SYSOUT.
001600     DISPLAY     'XBIT-C='       WK-HEX-EDIT '-' WK-BIT-EDIT
001610                                 UPON    SYSOUT.
001620*
001630     GOBACK.

 

＜2011/05/18 追記 START＞
左６シフト *  64
左７シフト * 128
は内容が壊れます。
  COMPだと
  計算で範囲を超えても、桁数に収めて再格納します。
  左５シフト *  32
          255 × 032 =  8160 は４桁SAFE
  左６シフト *  64
          255 × 064 = 16320 は５桁OUT
    16320
         00111111-11000000 だが
     6320で格納される
         00011000-10110000 =>9(04) COMP
         内容が壊れます。
  左７シフト * 128
         255 × 128 = 32640 は５桁OUT
    32640
         1111111-10000000 だが
     2640で格納
         00001010-01010000 =>9(04) COMP
         内容が壊れます。
＜END＞