COBOL BIT操作 その４

＜その４＞

　　　＜その１＞の別法
C'11110000'(８バイト)  を  X'F0'(1バイト)

C'00110001'(８バイト)  を  X'31'(1バイト)

にします。

000010*BIT形式のキャラクタ８バイトを１バイトにする。
000020 IDENTIFICATION                  DIVISION.
000030 PROGRAM-ID.                     TEST10.
000040 ENVIRONMENT                     DIVISION.
000050 INPUT-OUTPUT SECTION.
000060 FILE-CONTROL.
000070     SELECT  IN-FILE     ASSIGN  TO  'TEST10.IN.DAT'.
000080     SELECT  OUT-FILE   ?ASSIGN  TO  'TEST10.OUT.DAT'.
000090 DATA                            DIVISION.
000100 FILE SECTION.
000110 FD  IN-FILE.
000120 01  IN-REC.
000130     05  IN-DATA.
000131         10 IN-DATA-64           PIC X(002).
000132         10 IN-DATA-16           PIC X(002).
000133         10 IN-DATA-04           PIC X(002).
000134         10 IN-DATA-01           PIC X(002).
000140     05  IN-CRLF                 PIC X(002).
000150*
000160 FD  OUT-FILE.
000170 01  OUT-REC.
000180     05  OUT-DATA                PIC X(001).
000190*
000200 WORKING-STORAGE SECTION.
000210*
000220 01  WORK-AREA.
000230     05  WORK-CHAR8.
000240         10  W-CHAR              PIC  X(001)  OCCURS 8.
000250*
000260     05  WORK-HEX                PIC  9(004)  COMP.
000270*
000280 01  HEX-CHANGE-BEFORE           PIC  9(004) COMP.
000290 01  HEX-CHG-AFT     REDEFINES   HEX-CHANGE-BEFORE.
000300     05  FILLER                  PIC  X(001).
000310     05  HEX-CHANGE-AFTER        PIC  X(001).
000320*
000330 01  END-FLG                     PIC  X(001)  VALUE '0'.
000340*
000350 01  WK-CURRENT-STA              PIC  X(021).
000351 01  WK-CURRENT-END              PIC  X(021).
000352*
000353 PROCEDURE                       DIVISION.
000360 MAIN-CONTROL.
000370*
000380     MOVE    FUNCTION    CURRENT-DATE    TO  WK-CURRENT-STA.
000381     PERFORM                     INIT-RTN.
000390*
000400     PERFORM     UNTIL   END-FLG =  "1"
000410         PERFORM                 MAIN-RTN
000420     END-PERFORM.
000430*
000440     PERFORM                     TERM-RTN.
000450*
000451     MOVE   FUNCTION     CURRENT-DATE    TO  WK-CURRENT-END.
000452*
000453     DISPLAY   'E N D='  WK-CURRENT-END  UPON  SYSOUT.
000454     DISPLAY   'START='  WK-CURRENT-STA  UPON  SYSOUT.
000455*
000460     STOP RUN.
000470*
000480******************************************************************
000490*                                                                *
000500******************************************************************
000510 INIT-RTN.
000520     OPEN    INPUT               IN-FILE.
000530     OPEN    OUTPUT              OUT-FILE.
000540*
000550     PERFORM                     READ-RTN.
000560*
000570******************************************************************
000580*                                                                *
000590******************************************************************
000600 MAIN-RTN.
000610*
000620     MOVE        IN-DATA         TO      WORK-CHAR8.
000630     MOVE        ZERO            TO      WORK-HEX.
000640*
000641*
000650     IF          IN-DATA-64      =       '00'
000660             ADD         0       TO      WORK-HEX
000670     ELSE
000690       IF        IN-DATA-64      =       '01'
000691             ADD        64       TO      WORK-HEX
000692       ELSE
000693         IF      IN-DATA-64      =       '10'
000700             ADD       128       TO      WORK-HEX
000701         ELSE
000702           IF    IN-DATA-64      =       '11'
000703             ADD       192       TO      WORK-HEX
000704           END-IF
000705         END-IF
000706       END-IF
000707     END-IF.
000710*
000711*
000712     IF          IN-DATA-16      =       '00'
000713             ADD         0       TO      WORK-HEX
000714     ELSE
000715       IF        IN-DATA-16      =       '01'
000716             ADD        16       TO      WORK-HEX
000717       ELSE
000718         IF      IN-DATA-16      =       '10'
000719             ADD        32       TO      WORK-HEX
000720         ELSE
000721           IF    IN-DATA-16      =       '11'
000722             ADD        48       TO      WORK-HEX
000723           END-IF
000724         END-IF
000725       END-IF
000726     END-IF.
000727*
000728*
000729     IF          IN-DATA-04      =       '00'
000730             ADD         0       TO      WORK-HEX
000731     ELSE
000732       IF        IN-DATA-04      =       '01'
000733             ADD         4       TO      WORK-HEX
000734       ELSE
000735         IF      IN-DATA-04      =       '10'
000736             ADD         8       TO      WORK-HEX
000737         ELSE
000738           IF    IN-DATA-04      =       '11'
000739             ADD        12       TO      WORK-HEX
000740           END-IF
000741         END-IF
000742       END-IF
000743     END-IF.
000744*
000745     IF          IN-DATA-01      =       '00'
000746             ADD         0       TO      WORK-HEX
000747     ELSE
000748       IF        IN-DATA-01      =       '01'
000749             ADD         1       TO      WORK-HEX
000750       ELSE
000751         IF      IN-DATA-01      =       '10'
000752             ADD         2       TO      WORK-HEX
000753         ELSE
000754           IF    IN-DATA-04      =       '11'
000755             ADD         3       TO      WORK-HEX
000756           END-IF
000757         END-IF
000758       END-IF
000759     END-IF.
000761*
001200*
001210     MOVE    WORK-HEX            TO      HEX-CHANGE-BEFORE.
001220     WRITE   OUT-REC             FROM    HEX-CHANGE-AFTER.
001230*
001240     PERFORM                     READ-RTN.
001250*
001260******************************************************************
001270*                                                                *
001280******************************************************************
001290 READ-RTN.
001300     READ    IN-FILE     AT  END
001310         MOVE    '1'             TO      END-FLG
001320     END-READ.
001330*
001340******************************************************************
001350*                                                                *
001360******************************************************************
001370 TERM-RTN.
001380     CLOSE                       IN-FILE
001390                                 OUT-FILE.

COBOL BIT操作 その３

＜その３＞

C'F0'(2バイト)  を　 X'F0'(1バイト)

C'31'(2バイト)  を　 X'31'(1バイト)

にします。

000010*２バイトHEXキャラを１バイトにする。
000020 IDENTIFICATION DIVISION.
000030 PROGRAM-ID. TEST05.
000040 ENVIRONMENT DIVISION.
000050 INPUT-OUTPUT SECTION.
000060 FILE-CONTROL.
000070     SELECT IN-FILE      ASSIGN  TO  'TEST05.IN.DAT'.
000080     SELECT OUT1-FILE    ASSIGN  TO  'TEST05.OUT.DAT'.
000090 DATA    DIVISION.
000100 FILE    SECTION.
000110 FD  IN-FILE.
000120 01  IN-REC.
000130     05  IN-DATA.
000140         10 IN-DATA-UP           PIC X(001).
000150         10 IN-DATA-DOWN         PIC X(001).
000160     05 IN-DATA-CRLF             PIC X(002).
000170*
000180 FD  OUT1-FILE.
000190 01  OUT1-REC.
000200     05  OUT1-DATA               PIC X(001).
000210*
000220 WORKING-STORAGE SECTION.
000230 01  CON-CRLF                    PIC X(002)  VALUE  X'0D0A'.
000240*
000250 01  WORK-AREA.
000260     05  WORK-HEX.
000270         10  WORK-HEX-UP         PIC  X(001).
000280         10  WORK-HEX-DOWN       PIC  X(001).
000290*
000300     05  WORK-BIN                PIC  9(004)  COMP.
000310     05  WK-BIN-DATA  REDEFINES  WORK-BIN.
000320         10  FILLER              PIC  X(001).
000330         10  WK-BIN              PIC  X(001).
000340*  
000350     05  WORK-BIN-UP             PIC  9(004)  COMP.
000360     05  WORK-BIN-DOWN           PIC  9(004)  COMP.
000370*
000380 01  TBL-CHANGE-DATA.
000390     05  FILLER                  PIC  X(001) VALUE 'A'.
000400     05  FILLER                  PIC  X(004) VALUE '1010'.
000410     05  FILLER                  PIC  9(004) COMP VALUE 10.
000420     05  FILLER                  PIC  X(001) VALUE 'B'.
000430     05  FILLER                  PIC  X(004) VALUE '1011'.
000440     05  FILLER                  PIC  9(004) COMP VALUE 11.
000450     05  FILLER                  PIC  X(001) VALUE 'C'.
000460     05  FILLER                  PIC  X(004) VALUE '1100'.
000470     05  FILLER                  PIC  9(004) COMP VALUE 12.
000480     05  FILLER                  PIC  X(001) VALUE 'D'.
000490     05  FILLER                  PIC  X(004) VALUE '1101'.
000500     05  FILLER                  PIC  9(004) COMP VALUE 13.
000510     05  FILLER                  PIC  X(001) VALUE 'E'.
000520     05  FILLER                  PIC  X(004) VALUE '1110'.
000530     05  FILLER                  PIC  9(004) COMP VALUE 14.
000540     05  FILLER                  PIC  X(001) VALUE 'F'.
000550     05  FILLER                  PIC  X(004) VALUE '1111'.
000560     05  FILLER                  PIC  9(004) COMP VALUE 15.
000570 01  TBL-DATA    REDEFINES       TBL-CHANGE-DATA.
000580     05  TBL-CHG     OCCURS      6   TIMES. 
000590         10  TBL-HEX-CHAR        PIC  X(001).
000600         10  TBL-BIT-CHAR        PIC  X(004).
000610         10  TBL-BIN-DATA.
000620            15  FILLER           PIC  X(001).
000630            15  TBL-BIN          PIC  X(001).
000640*
000650 01  IDX                        PIC  9(004)  COMP.
000660*
000670 01  END-FLG                     PIC  X(001)  VALUE '0'.
000680*
000690 01  WK-CURRENT-STA              PIC  X(021).
000691 01  WK-CURRENT-END              PIC  X(021).
000692*
000693 PROCEDURE DIVISION.
000700 MAIN-CONTROL.
000710*
000720     MOVE    FUNCTION  CURRENT-DATE  TO  WK-CURRENT-STA.
000721     PERFORM         INIT-RTN.
000730*
000740     PERFORM     UNTIL   END-FLG     =   '1'
000750         PERFORM     MAIN-RTN
000760     END-PERFORM.
000770*
000780     PERFORM         TERM-RTN.
000790     MOVE    FUNCTION  CURRENT-DATE  TO  WK-CURRENT-END.
000791*
000800     DISPLAY     'E N D='    WK-CURRENT-END  UPON SYSOUT.
000801     DISPLAY     'START='    WK-CURRENT-STA  UPON SYSOUT.
000802     STOP RUN.
000810*
000820******************************************************************
000830*                                                                *
000840******************************************************************
000850 INIT-RTN.
000860     OPEN    INPUT               IN-FILE.
000870     OPEN    OUTPUT              OUT1-FILE.
000880*
000890     PERFORM     READ-RTN.
000900*
000910******************************************************************
000920*                                                                *
000930******************************************************************
000940 MAIN-RTN.
000950*
000960     MOVE        IN-DATA         TO      WORK-HEX.
000970     MOVE        ZERO            TO      WORK-BIN.
000980     MOVE        ZERO            TO      WORK-BIN-UP.
000990     MOVE        ZERO            TO      WORK-BIN-DOWN.
001000*
001010     IF  WORK-HEX-UP             IS      NUMERIC
001020         MOVE  WORK-HEX-UP       TO      WORK-BIN-UP
001030     ELSE
001040         PERFORM   VARYING  IDX  FROM    1   BY  1 
001050             UNTIL TBL-HEX-CHAR(IDX) =   WORK-HEX-UP  
001060             CONTINUE
001070         END-PERFORM
001080         MOVE      TBL-BIN(IDX)  TO      WORK-BIN-UP
001090     END-IF.
001100*
001110     IF  WORK-HEX-DOWN           IS      NUMERIC
001120         MOVE  WORK-HEX-DOWN     TO      WORK-BIN-DOWN
001130     ELSE
001140         PERFORM   VARYING  IDX  FROM   1   BY  1 
001150             UNTIL TBL-HEX-CHAR(IDX) =   WORK-HEX-DOWN  
001160             CONTINUE
001170         END-PERFORM
001180         MOVE      TBL-BIN(IDX)  TO      WORK-BIN-DOWN
001190     END-IF.
001200
001210     COMPUTE  WORK-BIN  =  ( WORK-BIN-UP *  16 ) + WORK-BIN-DOWN.
001220     WRITE    OUT1-REC           FROM    WK-BIN.
001230*
001240     PERFORM  READ-RTN.
001250*
001260******************************************************************
001270*                                                                *
001280******************************************************************
001290 READ-RTN.
001300     READ    IN-FILE     AT  END
001310         MOVE    '1'             TO      END-FLG
001320     END-READ.
001330*
001340******************************************************************
001350*                                                                *
001360******************************************************************
001370 TERM-RTN.
001380     CLOSE                       IN-FILE
001390                                 OUT1-FILE.

************************************************************************

'Char"A"=10進'65'
    If bytWorkUp(0) < 65 Then
       'Char"0"=10進'48'を０にする    SJIS
       bytChar(intHexIdx - 1) = (bytWorkUp(0) - 48) * 16
    Else
       'Char"A"=10進'65'を１０にする  SJIS
       bytChar(intHexIdx - 1) = (bytWorkUp(0) - 55) * 16
    End If

000000*
000000     IF  WORK-HEX-UP             IS      NUMERIC
000000         COMPUTE  WORK-HEX-UP    =   WORK-BIN-UP   -  48
000000     ELSE
000000         COMPUTE  WORK-HEX-UP    =   WORK-BIN-UP   -  55
000000     END-IF.
000000*
000000     IF  WORK-HEX-UP             IS      NUMERIC
000000         COMPUTE  WORK-HEX-UP    =   WORK-BIN-DOWN -  48 
000000     ELSE
000000         COMPUTE  WORK-HEX-UP    =   WORK-BIN-DOWN -  55
000000     END-IF.
000000*
000000     COMPUTE  WORK-BIN  =  ( WORK-BIN-UP *  16 ) + WORK-BIN-DOWN.

COBOL BIT操作 その２

＜その２＞

X'F0'(1バイト)  を　 C'11110000'(８バイト) と　C'F0'(２バイト)

X'31'(1バイト)  を　 C'00110001'(８バイト) と　C'31'(２バイト)

にします。

＜データ準備＞

   ＜その１＞ で実行したアウトプットを使用します

＜サンプル　ソース＞

000010*１バイト　を８バイトBITキャラクタヘ変換
000020 IDENTIFICATION DIVISION.
000030 PROGRAM-ID. TEST04.
000040 ENVIRONMENT DIVISION.
000050 INPUT-OUTPUT SECTION.
000060 FILE-CONTROL.
000070     SELECT IN-FILE     ASSIGN   TO  'TEST04.IN.DAT'.
000080     SELECT OUT1-FILE   ASSIGN   TO  'TEST04.BIT.OUT'.
000090     SELECT OUT2-FILE   ASSIGN   TO  'TEST04.HEX.OUT'.
000100 DATA DIVISION.
000110 FILE SECTION.
000120 FD  IN-FILE.
000130 01 IN-REC.
000140    05 IN-DATA                   PIC X(001).
000160*8-1----+----2----+----3----+----4----+----5----+----6----+----7-*
000170 FD OUT1-FILE.
000180 01  OUT1-REC.
000190     05  OUT1-DATA.
000191         10 OUT1-DATA-UP         PIC X(004).
000192         10 OUT1-DATA-DOWN       PIC X(004).
000200     05  OUT1-CRLF               PIC X(002).
000220*
000230 FD  OUT2-FILE.
000240 01  OUT2-REC.
000250     05 OUT2-DATA.
000251        10 OUT2-DATA-UP          PIC X(001).
000252        10 OUT2-DATA-DOWN        PIC X(001).
000260     05 OUT2-CRLF                PIC X(002).
000270*
000280 WORKING-STORAGE SECTION.
000290 01  CON-CRLF                    PIC X(002)  VALUE  X'0D0A'.
000300*
000310 01  WORK-AREA.
000320     05  WORK-HEX-UP             PIC  9(004)  COMP.
000330     05  WORK-HEX-DOWN           PIC  9(004)  COMP.
000340*
000350     05  WORK-HEX                PIC  9(004)  COMP.
000360*
000370 01  HEX-CHG-BEF.
000371     05  HEX-CHANGE-LV           PIC  X(001).
000372     05  HEX-CHANGE-BEFORE       PIC  X(001).
000380 01  HEX-CHG-AFT      REDEFINES  HEX-CHG-BEF.
000400     05  HEX-CHANGE-AFTER        PIC  9(004)  COMP.
000410*
000420 01  TBL-CHANGE-DATA.    
000430    05  FILLER                   PIC  X(004) VALUE '0000'.
000440    05  FILLER                   PIC  X(001) VALUE '0'.
000450    05  FILLER                   PIC  X(004) VALUE '0001'.
000460    05  FILLER                   PIC  X(001) VALUE '1'.
000470    05  FILLER                   PIC  X(004) VALUE '0010'.
000480    05  FILLER                   PIC  X(001) VALUE '2'.
000490    05  FILLER                   PIC  X(004) VALUE '0011'.
000500    05  FILLER                   PIC  X(001) VALUE '3'.
000510    05  FILLER                   PIC  X(004) VALUE '0100'.
000520    05  FILLER                   PIC  X(001) VALUE '4'.
000530    05  FILLER                   PIC  X(004) VALUE '0101'.
000540    05  FILLER                   PIC  X(001) VALUE '5'.
000550    05  FILLER                   PIC  X(004) VALUE '0110'.
000560    05  FILLER                   PIC  X(001) VALUE '6'.
000570    05  FILLER                   PIC  X(004) VALUE '0111'.
000580    05  FILLER                   PIC  X(001) VALUE '7'.
000590    05  FILLER                   PIC  X(004) VALUE '1000'.
000600    05  FILLER                   PIC  X(001) VALUE '8'.
000610    05  FILLER                   PIC  X(004) VALUE '1001'.
000620    05  FILLER                   PIC  X(001) VALUE '9'.
000630    05  FILLER                   PIC  X(004) VALUE '1010'.
000640    05  FILLER                   PIC  X(001) VALUE 'A'.
000650    05  FILLER                   PIC  X(004) VALUE '1011'.
000660    05  FILLER                   PIC  X(001) VALUE 'B'.
000670    05  FILLER                   PIC  X(004) VALUE '1100'.
000680    05  FILLER                   PIC  X(001) VALUE 'C'.
000690    05  FILLER                   PIC  X(004) VALUE '1101'.
000700    05  FILLER                   PIC  X(001) VALUE 'D'.
000710    05  FILLER                   PIC  X(004) VALUE '1110'.
000720    05  FILLER                   PIC  X(001) VALUE 'E'.
000730    05  FILLER                   PIC  X(004) VALUE '1111'.
000740    05  FILLER                   PIC  X(001) VALUE 'F'.
000000*
000750 01  TBL-DATA    REDEFINES       TBL-CHANGE-DATA.
000760     05  TBL-CHG     OCCURS      16 TIMES. 
000770        10  TBL-BIT-CHAR         PIC  X(004).
000780        10  TBL-HEX-CHAR         PIC  X(001).
000830*
000840 01  END-FLG                     PIC  X(001)  VALUE '0'.
000850*
000851 01  WK-CURRENT-STA              PIC  X(021).
000852 01  WK-CURRENT-END              PIC  X(021).
000853*
000860 PROCEDURE DIVISION.
000870 MAIN-CONTROL.
000880*
000890     MOVE  FUNCTION  CURRENT-DATE  TO   WK-CURRENT-STA.
000891     PERFORM         INIT-RTN.
000900*
000910     PERFORM  UNTIL  END-FLG  =  "1"
000920            PERFORM  MAIN-RTN
000930     END-PERFORM.
000940*
000950     PERFORM         TERM-RTN.
000960     MOVE   FUNCTION  CURRENT-DATE  TO   WK-CURRENT-END.
000961*
000962     DISPLAY  'E N D='   WK-CURRENT-END UPON SYSOUT.
000971     DISPLAY  'START='   WK-CURRENT-STA UPON SYSOUT.
000972     GOBACK.
000980*
000990******************************************************************
001000*                                                                *
001010*8-1----+----2----+----3----+----4----+----5----+----6----+----7-*
001020 INIT-RTN.
001030     OPEN    INPUT       IN-FILE.
001040     OPEN    OUTPUT      OUT1-FILE
001041                         OUT2-FILE.
001050*
001060     PERFORM  READ-RTN.
001070*
001080******************************************************************
001090*                                                                *
001100*8-1----+----2----+----3----+----4----+----5----+----6----+----7-*
001110 MAIN-RTN.
001120*
001130     MOVE    IN-DATA             TO      HEX-CHANGE-BEFORE.
001140     MOVE    LOW-VALUE           TO      HEX-CHANGE-LV.
001150*
001710*
001720     DIVIDE  16  INTO  HEX-CHANGE-AFTER  GIVING     WORK-HEX-UP
001721                                         REMAINDER  WORK-HEX-DOWN.
001730*
001731     MOVE     TBL-BIT-CHAR(WORK-HEX-UP + 1)   TO  OUT1-DATA-UP.
001732     MOVE     TBL-BIT-CHAR(WORK-HEX-DOWN + 1) TO  OUT1-DATA-DOWN.
001733     MOVE     CON-CRLF                        TO  OUT1-CRLF.
001734     WRITE    OUT1-REC.
001740*
001741     MOVE     TBL-HEX-CHAR(WORK-HEX-UP + 1)   TO  OUT2-DATA-UP.
001742     MOVE     TBL-HEX-CHAR(WORK-HEX-DOWN + 1) TO  OUT2-DATA-DOWN.
001743     MOVE     CON-CRLF                        TO  OUT2-CRLF.
001744     WRITE    OUT2-REC.
001746*
001750     PERFORM  READ-RTN.
001760*
001770******************************************************************
001780*                                                                *
001790*8-1----+----2----+----3----+----4----+----5----+----6----+----7-*
001800 READ-RTN.
001810     READ    IN-FILE     AT  END
001820         MOVE    '1'             TO      END-FLG
001830     END-READ.
001840*
001850******************************************************************
001860*                                                                *
001870*8-1----+----2----+----3----+----4----+----5----+----6----+----7-*
001880 TERM-RTN.
001890     CLOSE   IN-FILE
001900             OUT1-FILE
001910             OUT2-FILE.

COBOL BIT操作 その１

＜消してしまったので再UP＞

第４次規格COBOL２００２以降ではＢＩＴ操作できるようです。

COBOL Consortium(COBOLコンソーシアム)

http://www.cobol.gr.jp/knowledge/next_standard/standard002.html

3 章 ビット操作機能

http://www.cobol.gr.jp/knowledge/next_standard/standard0002/chap03.pdf

＜その１＞

C'11110000'(８バイト)  を　X'F0'(1バイト)

C'00110001'(８バイト)  を　X'31'(1バイト)

にします。

＜データ準備＞

INPUTはEXCELで、
A1～A256に0～255を入れて、
Bn(n=1～256)に =DEC2BIN(A1,8)で作る。
   DEC2BINを使うには、2007以前のEXCELでは、
     http://okwave.jp/qa/q2495441.html

Bn(n=1～256)をコピーして、TEXTに貼り付ける。

IBM HOSTには、プライベートPO（PDS）メンバーに転送する。
FILE-CONTROL 変更する。

＜サンプル　ソース＞
FUJITSU COBOL85使用

000010*BIT形式のキャラクタ８バイトを１バイトにする。
000020 IDENTIFICATION DIVISION.
000030 PROGRAM-ID. AAA0001.
000040 ENVIRONMENT DIVISION.
000050 INPUT-OUTPUT SECTION.
000060 FILE-CONTROL.
000070     SELECT IN-FILE    ASSIGN  TO  'TEST03.IN.DAT'.
000080     SELECT OUT-FILE   ASSIGN  TO  'TEST03.OUT.DAT'.
000090 DATA DIVISION.
000100 FILE SECTION.
000110 FD IN-FILE.
000120 01  IN-REC.
000130     05  IN-DATA                   PIC X(008).
000140     05  IN-CRLF                   PIC X(002).
000150*
000160 FD OUT-FILE.
000170 01  OUT-REC.
000180     05 OUT-DATA                   PIC X(001).
000190*
000200 WORKING-STORAGE SECTION.
000210*
000220 01  WORK-AREA.
000230     05  WORK-CHAR8.
000240         10  W-CHAR                PIC  X(001)  OCCURS 8.
000250*
000260  05  WORK-HEX                     PIC  9(004) COMP.
000270*
000280 01  HEX-CHANGE-BEFORE             PIC  9(004) COMP.
000290 01  HEX-CHG-AFT       REDEFINES   HEX-CHANGE-BEFORE.
000300     05  FILLER                    PIC  X(001).
000310     05  HEX-CHANGE-AFTER          PIC  X(001).
000320*
000330 01  END-FLG                       PIC  X(001)  VALUE '0'.
000340*
000350 01  WK-CURRENT-STA                PIC  X(021).
000351 01  WK-CURRENT-END                PIC  X(021).
000352******************************************************************
000353 PROCEDURE DIVISION.
000360 MAIN-CONTROL.
000370*
000380     MOVE  FUNCTION  CURRENT-DATE  TO  WK-CURRENT-STA.
000381     PERFORM  INIT-RTN.
000390*
000400     PERFORM  UNTIL  END-FLG  =  "1"
000410         PERFORM  MAIN-RTN
000420     END-PERFORM.
000430*
000440     PERFORM  TERM-RTN.
000450*
000451     MOVE  FUNCTION  CURRENT-DATE  TO  WK-CURRENT-END.
000452*
000453     DISPLAY  'E N D='   WK-CURRENT-END UPON SYSOUT.
000454     DISPLAY  'START='   WK-CURRENT-STA UPON SYSOUT.
000455*
000460     STOP RUN.
000470*
000480******************************************************************
000490*                                                                *
000050*--1----+----2----+----3----+----4----+----5----+----6----+----7-*
000510 INIT-RTN.
000520     OPEN  INPUT      IN-FILE.
000530     OPEN  OUTPUT     OUT-FILE.
000540*
000550     PERFORM          READ-RTN.
000560*
000570******************************************************************
000580*                                                                *
000590*--1----+----2----+----3----+----4----+----5----+----6----+----7-*
000600 MAIN-RTN.
000610*
000620     MOVE        IN-DATA         TO      WORK-CHAR8.
000630     MOVE        ZERO            TO      WORK-HEX.
000640*
000650     IF      W-CHAR(1)   =   '0'
000660     THEN
000670         CONTINUE
000680     ELSE
000690         ADD     128             TO      WORK-HEX
000700     END-IF.
000710*
000720     IF      W-CHAR(2)   =   '0'
000730     THEN
000740         CONTINUE
000750     ELSE
000760         ADD      64             TO      WORK-HEX
000770     END-IF.
000780*
000790     IF      W-CHAR(3)   =    '0'
000800     THEN
000810         CONTINUE
000820     ELSE
000830         ADD      32             TO      WORK-HEX
000840     END-IF.
000850*
000860     IF      W-CHAR(4)   =    '0'
000870     THEN
000880         CONTINUE
000890     ELSE
000900         ADD      16             TO      WORK-HEX
000910     END-IF.
000920*
000930     IF      W-CHAR(5)   =    '0'
000940     THEN
000950         CONTINUE
000960     ELSE
000970         ADD       8             TO      WORK-HEX
000980     END-IF.
000990*
001000     IF      W-CHAR(6)   =    '0'
001010     THEN
001020         CONTINUE
001030     ELSE
001040         ADD       4             TO      WORK-HEX
001050     END-IF.
001060*
001070     IF    W-CHAR(7)     =    '0'
001080     THEN
001090         CONTINUE
001100     ELSE
001110         ADD       2             TO      WORK-HEX
001120     END-IF.
001130*
001140     IF    W-CHAR(8)     =    '0'
001150     THEN
001160         CONTINUE
001170     ELSE
001180         ADD       1             TO      WORK-HEX
001190     END-IF.
001200*
001210     MOVE    WORK-HEX            TO      HEX-CHANGE-BEFORE.
001220     WRITE   OUT-REC             FROM    HEX-CHANGE-AFTER.
001230*
001240     PERFORM  READ-RTN.
001250*
001260*******************************************************************
001270*                                                                 *
001280**--1----+----2----+----3----+----4----+----5----+----6----+----7-*
001290 READ-RTN.
001300     READ     IN-FILE     AT  END
001310         MOVE     '1'             TO      END-FLG
001320     END-READ.
001330*
001340*******************************************************************
001350*                                                                 *
001360*******************************************************************
001370 TERM-RTN.
001380     CLOSE   IN-FILE
001390             OUT-FILE.

FUJITSU COBOL85は、ダウンロード終了してました。
3,4,5年？前にダウンロードして、確認していませんでした。

Today Fujitsu NetCOBOL compilers are only sold
at their full retail price, starting at $3,300 (USD)
- a price that is set by the value delivered for business use.

 This price is usually beyond the reach of
 most students and academic institutions.
 We regret that at this time we cannot offer
 a product for student use.

とのことです。解ってません。
「有料でならありますが、企業向けお値段です。
  ごめんね。」ということでしょうか。

ダウンロード・インストール・使用の際は
「サルでもわかるCOBOL入門　ひよこグミ」様サイト
http://www16.plala.or.jp/hiyokogumi/
にお世話になりました。
今も操作忘れたときにお世話になってます。
感謝致します。

IBM 汎用機 ASM（アセンブラ）入門書 入手方法

IBM 汎用機　ASM（アセンブラ）入門書　入手方法

＜20140711sta＞
多分IBMの関連会社　IBM製品系の研修機関だろう

i-Learning株式会社
http://www.i-learning.jp/

z/OSプログラミング（COBOL, PL/I, REXX, アセンブラー）講座
http://www.i-learning.jp/service/it/cobol.html

アセンブラー言語 -自習方式
コースコード 24010 
受講料 10,800円
(税別価格10,000円)
期間 標準学習時間： 42時間 
https://www.i-learning.jp/products/detail.php?course_code=24010

OS/VSアセンブラー・プログラミング -自習方式
コースコード 24230
受講料 10,800円
(税別価格10,000円)
期間 標準学習時間： 35時間
https://www.i-learning.jp/products/detail.php?course_code=24230
.
＜20140711end＞

1. 日本ＩＢＭのホームページへ行く
2.「サポート＆ダウンロード」　の「研修／トレーニング」を選択
3.「研修コースの検索」を選択
4.「コースのクイック検索」にてキーワード「アセンブラ」を入力し検索

2010年11月3日10:50時点

(24010)10,500円
アセンブラー言語 −自習方式

(24230)10,500円
OS/VSアセンブラー・プログラミング −自習方式

(24341)7,875円
アセンブラー使用者のためのVSAMプログラミング−自習方式

(6HA10)115,500円
Assemblerの基礎 −CD-ROMコース

(DA050) 値段？　実習
アセンブラー言語　演習

(ES260)141,750円
SMP/E for z/OS ワークショップ

(ZPC75)103,950円
Assemblerの基礎 −CD-ROMコース
.
IBM社員　IBM子関連会社社員に買わせる。コピる。