 |
» |
|
|
|
The string used in the example is 256 bytes in length and contains
all possible byte values from 0 to 255. This string is converted
from USASCII to EBCDIC. Then the converted string is taken and
translated back to USASCII. This is done according to the
ASCII-to-EBCDIC and EBCDIC-to-ASCII translation tables corresponding
to the entered language.
Afterwards this twice-translated string is displayed. All characters
that are nonprintable (control and undefined characters) in the
character set supporting the given language are replaced by a period
before the string is displayed by calling NLREPCHAR intrinsic.
1 $CONTROL USLINIT
1.1 IDENTIFICATION DIVISION.
1.2 PROGRAM-ID. EXAMPLE.
1.3 AUTHOR. LORO.
1.4 ENVIRONMENT DIVISION.
1.5 DATA DIVISION.
1.6 WORKING-STORAGE SECTION.
1.7 77 QUITNUM PIC S9(4) COMP VALUE 0.
1.8 77 LANGNUM PIC S9(4) COMP VALUE 0.
1.9 77 IND PIC S9(4) COMP VALUE 0.
2
2.1 01 TABLES.
2.2 05 USASCII-EBC-table PIC X(256) VALUE SPACES.
2.3 05 EBC-USASCII-table PIC X(256) VALUE SPACES.
2.4 05 CHARSET-table PIC X(256) VALUE SPACES.
2.5
2.6 01 BUFFER-FIELDS.
2.7 05 INT-FIELD PIC S9(4) COMP VALUE -1.
2.8 05 BYTE-FIELD REDEFINES INT-FIELD.
2.9 10 FILLER PIC X.
3 10 CHAR PIC X.
3.1
3.2 01 STRINGS.
3.3 05 LANGUAGE PIC X(16) VALUE SPACES.
3.4 05 IN-STRING.
3.5 10 IN-BYTE PIC X OCCURS 256.
3.6 05 OUT-STRING.
3.7 10 OUT-STR1 PIC X(80).
3.8 10 OUT-STR2 PIC X(80).
3.9 10 OUT-STR3 PIC X(80).
4 10 OUT-STR4 PIC X(16).
4.1
4.2 01 REPLACE-WORD PIC S9(4) COMP VALUE 0.
4.3 01 REPLACE-BYTES REDEFINES REPLACE-WORD.
4.4 05 REPLACEMENT-CHAR PIC X.
4.5 05 FILLER PIC X.
4.6
|
4.7 01 ERRORS.
4.8 05 ERR1 PIC S9(4) COMP.
4.9 05 ERR2 PIC S9(4) COMP.
5 PROCEDURE DIVISION.
5.1 START-PGM.
5.2 * Initialize the instring array with all possible
5.3 * byte values starting from binary zero until 255.
5.4 MOVE -1 TO INT-FIELD.
5.5 PERFORM FILL-INSTRING VARYING IND FROM 1 BY 1
5.6 UNTIL IND > 256.
5.7 GO TO GET-LANGUAGE.
5.8
5.9 FILL-INSTRING.
6 ADD 1 TO INT-FIELD.
6.1 MOVE CHAR TO IN-BYTE(IND).
6.2
6.3 GET-LANGUAGE.
6.4 *The language is hard-coded, set to 8 (GERMAN).
6.5
6.6 MOVE 8 TO LANGNUM.
6.7
6.8 GET-THE-TABLES.
6.9 * Call the USASCII-EBCDIC and EBCDIC-USASCII
7 * conversion tables and the character attribute table
7.1 * by using the appropriate NLINFO items.
7.2 * Note: NLTRANSLATE and NLREPCHAR may be called without
7.3 * passing the tables (last parameter). For performance
7.4 * reasons the tables should be passed, if these
7.5 * intrinsics are called very often.
7.6
7.7 CALL INTRINSIC "NLINFO" USING 13,
7.8 USASCII-EBC-table,
7.9 LANGNUM,
8 ERRORS.
8.1 IF ERR1 NOT EQUAL 0
8.2 COMPUTE QUITNUM = 1000 + ERR1,
8.3 CALL INTRINSIC "QUIT" USING QUITNUM.
8.4
8.5 CALL INTRINSIC NLINFO ITEM 14,
8.6 EBC-USASCII-table,
8.7 LANGNUM,
8.8 ERRORS.
8.9 IF ERR1 NOT EQUAL 0
9 COMPUTE QUITNUM = 2000 + ERR1,
9.1 CALL INTRINSIC "QUIT" USING QUITNUM.
9.2 CALL INTRINSIC "NLINFO" USING 12,
9.3 CHARSET-table,
9.4 LANGNUM,
9.5 ERRORS.
|
9.6 IF ERR1 NOT EQUAL 0
9.7 COMPUTE QUITNUM = 3000 + ERR1,
9.8 CALL INTRINSIC "QUIT" USING QUITNUM.
9.9
10 CONVERT-ASC-EBC.
10.1 * Convert IN-STRING from USASCII into EBCDIC by
10.2 * using NLTRANSLATE code 2. The converted string will
10.3 * be in OUT-STRING.
10.4
10.5 CALL INTRINSIC "NLTRANSLATE" USING 2,
10.6 IN-STRING,
10.7 OUT-STRING,
10.8 256,
10.9 LANGNUM,
11 ERRORS,
11.1 USASCII-EBC-table.
11.2 IF ERR1 NOT EQUAL 0
11.3 COMPUTE QUITNUM = 4000 + ERR1,
11.4 CALL INTRINSIC "QUIT" USING QUITNUM.
11.5
11.6 CONVERT-EBC-ASC.
11.7 * Convert OUT-STRING back from EBCDIC to USASCII by
11.8 * using NLTRANSLATE code 1. The retranslated string will
11.9 * be in IN-STRING again.
12
12.1 CALL INTRINSIC "NLTRANSLATE" USING 1,
12.2 OUT-STRING,
12.3 IN-STRING,
12.4 256,
12.5 LANGNUM,
12.6 ERRORS,
12.7 EBC-USASCII-table.
12.8 IF ERR1 NOT EQUAL 0
12.9 COMPUTE QUITNUM = 5000 + ERR1,
13 CALL INTRINSIC "QUIT" USING QUITNUM.
13.1
13.2 REPLACE-NON-PRINTABLES.
13.3 * Replace all non-printable characters
13.4 * in IN-STRING and display the string.
13.5
13.6 MOVE "." TO REPLACEMENT-CHAR.
13.7 CALL INTRINSIC "NLREPCHAR" USING IN-STRING,
13.8 IN-STRING,
13.9 256,
14 REPLACE-WORD,
14.1 LANGNUM,
14.2 ERRORS.
14.3 IF ERR1 NOT EQUAL 0
14.4 COMPUTE QUITNUM = 6000 + ERR1,
14.5 CALL INTRINSIC "QUIT" USING QUITNUM.
14.6
14.7 DISPLAY "IN-STRING:"
14.8 DISPLAY IN-STRING.
14.9 STOP RUN.
|
|
