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.
*
* 変更BIT位置の指定 X'??'=B'12345678'
* 左から1~8
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'位置にした確認用データがONの時
* CHG-BITの変更BIT ONなので、引く(OFF)する
*
SUBTRACT BIT-FLIPPER-NUM FROM CHG-BITS-NUM
*
WHEN CHK-BIT-IS-OFF
* 変更BITをX'80'位置にした確認用データがOFFの時
* 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のみだと
計算で桁数(この場合4桁)を超えても、桁数に収めて再格納します。
B"12345678"(数値は位置、実際は1or0)
1の位置に乗算で左シフトしたとき
6位置 255 × 032 = 8160 は4桁SAFE
7位置 255 × 064 = 16320 は5桁OUT
16320
00111111-11000000 だが
6320で格納される
00011000-10110000 =>9(04) COMP
内容が壊れます。
8位置 255 × 128 = 32640 は5桁OUT
32640
1111111-10000000 だが
2640で格納
00001010-01010000 =>9(04) COMP
内容が壊れます。
<END>