Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Test bit settings?? 3

Status
Not open for further replies.

Red1

Programmer
Dec 27, 2000
5
US
I would like to use COBOL to test bit settings, like an ALC test under mask. Any comments on the best way to accomplish this?
 
Routine in RM/COBOL that accept string of 8 0/1' to a binary
and vice versa.
=================================================
Code:
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID. BITCOMP.
000003 ENVIRONMENT DIVISION.
000004 DATA DIVISION.
000005 WORKING-STORAGE SECTION.
000006 01  I                PIC 9(4) COMP-6.
000007 01  PRTN             PIC 9(4) COMP-6.
000008 01  REMNDR           PIC 9(4) COMP-6.
000009 01  N-X.
000010     02 N-1-4         PIC 9999.
000011     02 N-5-8         PIC 9999.
000012 01  N REDEFINES N-X PIC 9(08).
000013 01  XX               PIC XX VALUE LOW-VALUES.
000014 01  XX-R REDEFINES XX.
000015     02 FILLER        PIC X.
000016     02 X             PIC X.
000017 01  X-9 REDEFINES XX PIC 9(4) COMP-4.
000018 01  VECTOR-BIN PIC X(132)
000019       VALUE   "00000001001000110100010101100111100010011010101111@A01
000020-            "00110111101111                                      @B
000021-            "                              ".                    @C
000022 01  VECTOR-BIN-R REDEFINES VECTOR-BIN.
000023     02 VEC-BIN PIC 9(4) OCCURS 16.
000024 01  VECTOR-HEX PIC X(132)
000025       VALUE   "00000001000200030004000500060007000800090010001100@A02
000026-            "1200130014001500000016003200480064008000960112012801@B
000027-            "44016001760192020802240240    ".                    @C
000028 01  VECTOR-HEX-R REDEFINES VECTOR-HEX.
000029     02 VEC-HEX PIC 9(4) OCCURS 32.
000030 LINKAGE SECTION.
000031 01  SW           PIC 9.
000032 01  COMP-FIELD   PIC 9(8).
000033 01  BIT-FIELD-X.
000034     02 BIT-FIELD PIC 9.
000035 PROCEDURE DIVISION USING SW COMP-FIELD BIT-FIELD-X.
000036 MAIN SECTION.
000037 1.  IF SW = 1 MOVE COMP-FIELD TO N
000038               PERFORM IN-COMPRESS
000039               MOVE X TO BIT-FIELD-X
000040      ELSE IF SW = 2 MOVE BIT-FIELD-X TO X
000041                     PERFORM OUT-COMPRESS
000042                     MOVE N TO COMP-FIELD.
000043 EXIT-PROGRAM.
000044     EXIT PROGRAM.
000045 IN-COMPRESS.
000046     PERFORM DEC-TO-BIN1 VARYING I FROM 1 BY 1 UNTIL I > 16.
000047     IF I < 77 DISPLAY "ERROR-1 IN BITCOMP"
000048               DISPLAY N-1-4
000049               CALL "cancel".
000050     PERFORM DEC-TO-BIN2 VARYING I FROM 1 BY 1 UNTIL I > 16.
000051     IF I < 77 DISPLAY "ERROR-2 IN BITCOMP"
000052               DISPLAY N-5-8
000053               CALL "cancel".
000054    DEC-TO-BIN1.
000055     IF N-1-4 = VEC-BIN(I) ADD 16 TO I
000056                           MOVE VEC-HEX(I) TO X-9
000057                           MOVE 77 TO I.
000058    DEC-TO-BIN2.
000059     IF N-5-8 = VEC-BIN(I) ADD VEC-HEX(I) TO X-9
000060                           MOVE 77 TO I.
000061 EX-IN-COMPRESS.
000062 OUT-COMPRESS.
000063     DIVIDE X-9 BY 16 GIVING PRTN REMAINDER REMNDR.
000064     ADD 1 TO PRTN REMNDR.
000065     MOVE VEC-BIN(PRTN) TO N-1-4.
000066     MOVE VEC-BIN(REMNDR) TO N-5-8.
000067 EX-OUT-COMPRESS.
Barry
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top