Load hex values of EBCDIC character set into a table

, ,
1

In my last posted question, the suggestion was made to create a table of 256 characters and then to use the EXAMINE TRANSLATE statement where every alphanumeric character I’m searching would translate to itself and all others would translate to something else, like “#”.

I’m trying an exercise where I load the hex values of of the EBCDIC character set into a table.

Here’s what I have so far:



01 #TRANSLATE-TBL(A2/256)
01 #HEX-VALUE(A1/1:16) INIT <'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'>

01 #H1(A2)                                                           
01 #H2(A2)                                                           


FOR #A 1 16                                                         
  MOVE #HEX-VALUE(#A) TO SUBSTR(#H1,1,1)                            
  FOR #B 1 16                                                       
    MOVE #HEX-VALUE(#B) TO SUBSTR(#H1,2,1)                          
    IF #H1 = 'C1' THRU 'C9' OR   /* IF ALPHANUMERIC, MOVE #H1 TO #H2
       #H1 = 'D1' THRU 'D9' OR                                      
       #H1 = 'E2' THRU 'E9' OR                                      
       #H1 = 'F0' THRU 'F9'                                         
      MOVE #H1 TO #H2                                               
    ELSE                                                            
      MOVE '7B' TO #H2           /* ELSE MOVE '#' TO #H2            
    END-IF                                                          
    ADD 1 TO #TBL-CTR                                               
** here's where I'm stuck -- 
** instead of moving a constant (e.g., H'007B') to #TRANSLATE-TBL(#TBL-CTR), can I move the hex representation of a variable?
**
  END-FOR                                                           
END-FOR

and then later I would use

  EXAMINE #NAME TRANSLATE USING #TRANSLATE-TBL(*)
  EXAMINE #NAME FOR '#' DELETE
2

To get “the hex representation of a variable” you would need to redefine it, as in

01 #H2 (A2)
01 REDEFINE #H2
  02 #H2HEX (B2)
3

What I’ve always taught is

Here are three examples of how to initialize your table at compile time.

DEFINE DATA LOCAL
1 #HEX1 (A512) CONST 
  <H'00000100020003000400050006000700'      /* ........ */
 - H'080009000A000B000C000D000E000F00'      /* ........ */
 - H'10001100120013001400150016001700'      /* ........ */
 - H'180019001A001B001C001D001E001F00'      /* ........ */
 - H'20002100220023002400250026002700'      /* ........ */
 - H'280029002A002B002C002D002E002F00'      /* ........ */
 - H'30003100320033003400350036003700'      /* ........ */
 - H'380039003A003B003C003D003E003F00'      /* ........ */
 - H'40404100420043004400450046004700'      /*  ....... */
 - H'480049004A4A4B4B4C4C4D4D4E4E4F4F'      /* .. .<(+| */
 - H'50005100520053005400550056005700'      /* ........ */
 - H'580059005A5A5B5B5C5C5D5D5E5E5F5F'      /* ..!$*);  */
 - H'60606161626263636464656566666767'      /* -/...... */
 - H'680069006A6A6B6B6C6C6D6D6E6E6F6F'      /* .. ,%_>? */
 - H'70007100720073007400750076007700'      /* ........ */
 - H'780079797A7A7B7B7C7C7D7D7E7E7F7F'      /* .`:#@'=" */
 - H'80008181828283838484858586868787'      /* .abcdefg */
 - H'888889898A008B008C008D008E008F00'      /* hi...... */
 - H'90009191929293939494959596969797'      /* .jklmnop */
 - H'989899999A009B009C009D009E009F00'      /* qr...... */
 - H'A000A1A1A2A2A3A3A4A4A5A5A6A6A7A7'      /* .~stuvwx */
 - H'A8A8A9A9AA00AB00AC00AD00AE00AF00'      /* yz...... */
 - H'B000B100B200B300B400B500B600B700'      /* ........ */
 - H'B800B900BA00BB00BC00BD00BE00BF00'      /* ........ */
 - H'C0C0C12EC22EC32EC42EC52EC62EC72E'      /* {ABCDEFG */
 - H'C8C8C9C9CA00CB00CC00CD00CE00CF00'      /* HI...... */
 - H'D0D0D1D1D2D2D3D3D4D4D5D5D6D6D7D7'      /* }JKLMNOP */
 - H'D8D8D9D9DA00DB00DC00DD00DE00DF00'      /* QR...... */
 - H'E0E0E100E2E2E3E3E4E4E5E5E6E6E7E7'      /* \.STUVWX */
 - H'E8E8E9E9EA00EB00EC00ED00EE00EF00'      /* YZ...... */
 - H'F0F0F1F1F2F2F3F3F4F4F5F5F6F6F7F7'      /* 01234567 */
 - H'F8F8F9F9FA00FB00FC00FD00FE00FF00'>     /* 89...... */
                   1 REDEFINE #HEX1
  2 #TRT1 (A2/256)
*
1 #TRT2 (A2/256) CONST <H'00' - H'00'
                       ,H'01' - H'00'
*                      , ...
                       ,H'40' - H'40'
*                      , ...
                       ,H'80' - H'00'
                       ,'a'   - 'A'    /* force uppercase?
                       ,'b'   - 'B'
*                      , ...
                       ,H'C0' - H'00'
                       ,'A'   - 'A'
                       ,'B'   - 'B'
*                      , ...
                       ,H'F0' - '0'
                       ,H'F1' - '1'
*                      , ...
                       ,H'FE' - H'00'
                       ,H'FF' - H'00'
                       >
1 #TRT3 (A2/256) CONST <
  H'00'-'#', H'01'-'#', H'02'-'#', H'03'-'#',
  H'04'-'#', H'05'-'#', H'06'-'#', H'07'-'#',
  H'08'-'#', H'09'-'#', H'0A'-'#', H'0B'-'#',
                                              /*
  H'40'-' ', H'41'-'#', H'42'-'#', H'43'-'#',
                                              /*
  H'80'-' ', H'81'-'a', H'82'-'b', H'83'-'c',
    'd'-'d',   'e'-'e',   'f'-'f',   'g'-'g',
                                              /*
  H'C0'-'#', H'C1'-'A', H'C2'-'B', H'C3'-'C',
    'D'-'D',   'E'-'E',   'F'-'F',   'G'-'G',
                                              /*
  H'FC'-'#', H'FD'-'#', H'FE'-'#', H'FF'-'#'
                     >
END-DEFINE
END

Decide for yourself between brevity and legibility. I use the #HEX1/#TRT1 method in my own code.

Also note that these samples accept all printable characters - adjust as necessary. The first two tables convert unwanted characters to H’00’ while the third uses ‘#’.

WARNING:
I make no warranties as to the accuracy of these tables. My working code is for ASCII. I manually converted to EBCDIC for this thread, but have not tested every character pair.

4

You won’t need this technique here, Dan, because you’re going to initialize your table at compile time :smiley: , but you can “pack” a string into its hex equivalent with a MOVE EDITED into a Binary variable. You must ensure that the string contains only characters 0-9 and A-F.

DEFINE DATA LOCAL
1 #S (A2) INIT <'7B'>
1 #C (A1) 1 REDEFINE #C
 2 #B (B1)
END-DEFINE
MOVE EDITED #S TO #B (EM=HH)
DISPLAY #S #C #B
END

In this example, the character string ‘7B’ within #S is converted to a 1-byte H’7B’ in #B.

5

Thanks, Wolfgang and Ralph!

6

I think it would be very easy to fill out that “translation table” in IBM ASSEMBLER (I used to program in that language in my “dark dust past” :-).

This is my attempt to simulate it in Natural; well, what I can say about it that it works, but Ralph`s approach is better - much shorter (although it is not very easy to build that table :slight_smile:

Best regards,
Nikolay

0010 DEFINE DATA LOCAL
0020 1 TRANS-TABLE (A2/0:255)
0030 1 #BEG (B1)
0040 1 #END (B1)
0050 1 #I (I4)
0060 1 #J (I4)
0070 1 #FROMTO (A2)
0080 1 REDEFINE #FROMTO
0090 2 #FROM (B1)
0100 2 #TO (B1)
0110 1 #HEX (B1)
0120 1 #BEG-INT (I2)
0130 1 #END-INT (I2)
0140 **
0150 1 #ALPHA(A2)
0160 1 REDEFINE #ALPHA
0170 2 #CHAR-1 (A1)
0180 2 #CHAR-2 (A1)
0190 1 #DEC (P3)
0200 1 #INT (I4)
0210 1 #STRING (A100)
0220 END-DEFINE
0230 #BEG := H’00’
0240 #END := H’FF’
0250 MOVE #BEG TO #HEX
0260 PERFORM HEX-TO-DEC
0270 #BEG-INT := #INT
0280 MOVE #END TO #HEX
0290 PERFORM HEX-TO-DEC
0300 #END-INT := #INT
0310 #J := #BEG-INT
0320 /* Initially EVERYTHING → ‘#’
0330 FOR #I = #BEG-INT TO #END-INT
0340 MOVE #J TO #FROM
0350 MOVE ‘#’ TO #TO
0360 MOVE #FROMTO TO TRANS-TABLE (#I)
0370 ADD 1 TO #J
0380 END-FOR
0390 ** Now lets consider only letters to be "legal"; every letter --> itself 0400 #BEG := H'C1' /* 'A' 0410 #END := H'C9' /* 'I' 0420 PERFORM FILLOUT-FROMBEG-TOEND 0430 ** 0440 #BEG := H'D1' /* 'J' 0450 #END := H'D9' /* 'R' 0460 PERFORM FILLOUT-FROMBEG-TOEND 0470 ** 0480 #BEG := H'E2' /* 'S' 0490 #END := H'E9' /* 'Z' 0500 PERFORM FILLOUT-FROMBEG-TOEND 0510 ** 0520 #BEG := H'81' /* 'a' 0530 #END := H'89' /* 'i' 0540 PERFORM FILLOUT-FROMBEG-TOEND 0550 ** 0560 #BEG := H'91' /* 'j' 0570 #END := H'99' /* 'r' 0580 PERFORM FILLOUT-FROMBEG-TOEND 0590 ** 0600 #BEG := H'A1' /* 's' 0610 #END := H'A9' /* 'z' 0620 PERFORM FILLOUT-FROMBEG-TOEND 0630 #BEG := H'40' /* ' ' lets consider space legal as well
0640 #END := H’40’ /* ’ ’
0650 PERFORM FILLOUT-FROMBEG-TOEND
0660 /* And finally the test
0670 #STRING := ‘This is THE story of El Lute, a man who was born ’ -
0680 ’ to be hunted like a wild animal’
0690 EXAMINE #STRING TRANSLATE USING TRANS-TABLE(*)
0700 DISPLAY #STRING (AL=79)
0710 ** ============================================ **
0720 DEFINE SUBROUTINE FILLOUT-FROMBEG-TOEND
0730 ** ============================================ **
0740 MOVE #BEG TO #HEX
0750 PERFORM HEX-TO-DEC
0760 #BEG-INT := #INT
0770 MOVE #END TO #HEX
0780 PERFORM HEX-TO-DEC
0790 #END-INT := #INT
0800 #J := #BEG-INT
0810 FOR #I = #BEG-INT TO #END-INT
0820 MOVE #J TO #FROM
0830 MOVE #J TO #TO
0840 MOVE #FROMTO TO TRANS-TABLE (#I)
0850 ADD 1 TO #J
0860 END-FOR
0870 END-SUBROUTINE
0880 ** ============================================ **
0890 DEFINE SUBROUTINE HEX-TO-DEC
0900 ** ============================================ **
0910 MOVE EDITED #HEX (EM=HH) TO #ALPHA
0920 DECIDE ON FIRST VALUE OF #CHAR-1
0930 VALUE ‘0’:‘9’
0940 #DEC := VAL (#CHAR-1)
0950 #INT := #DEC * 16
0960 VALUE ‘A’
0970 #INT := 10 * 16
0980 VALUE ‘B’
0990 #INT := 11 * 16
1000 VALUE ‘C’
1010 #INT := 12 * 16
1020 VALUE ‘D’
1030 #INT := 13 * 16
1040 VALUE ‘E’
1050 #INT := 14 * 16
1060 VALUE ‘F’
1070 #INT := 15 * 16
1080 NONE VALUE
1090 TERMINATE 32
1100 END-DECIDE
1110 DECIDE ON FIRST VALUE OF #CHAR-2
1120 VALUE ‘0’:‘9’
1130 #DEC := VAL (#CHAR-2)
1140 ADD #DEC TO #INT
1150 VALUE ‘A’
1160 ADD 10 TO #INT
1170 VALUE ‘B’
1180 ADD 11 TO #INT
1190 VALUE ‘C’
1200 ADD 12 TO #INT
1210 VALUE ‘D’
1220 ADD 13 TO #INT
1230 VALUE ‘E’
1240 ADD 14 TO #INT
1250 VALUE ‘F’
1260 ADD 15 TO #INT
1270 NONE VALUE
1280 TERMINATE 32
1290 END-DECIDE
1300 END-SUBROUTINE
1310 END