|
» |
|
|
|
In this program, there are six different calls to NLSCANMOVE.
In every call, all parameters are passed to NLSCANMOVE. Since the
upshift/downshift table and the character attributes table are
optional parameters, they may be omitted. For performance reasons
(if NLSCANMOVE is called frequently), they should be passed to the
intrinsic after being read in by the appropriate calls to NLINFO.
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 QUITPARM PIC S9(4) COMP VALUE 0.
1.8 77 LANGNUM PIC S9(4) COMP VALUE 0.
1.9 77 FLAGS PIC S9(4) COMP VALUE 0.
2 77 LEN PIC S9(4) COMP VALUE 70.
2.1 77 NUMCHAR PIC S9(4) COMP VALUE 0.
2.2
2.3 01 TABLES.
2.4 05 CHARSET-table PIC X(256) VALUE SPACES.
2.5 05 UPSHIFT-table PIC X(256) VALUE SPACES.
2.6 05 DOWNSHIFT-table PIC X(256) VALUE SPACES.
2.7
2.8 01 STRINGS.
2.9 05 INSTRING.
3 10 INSTR1 PIC X(40) VALUE SPACES.
3.1 10 INSTR2 PIC X(30) VALUE SPACES.
3.2 05 OUTSTRING PIC X(70) VALUE SPACES.
3.3 05 LANGUAGE PIC X(16) VALUE SPACES.
3.4
3.5 01 ERRORS.
3.6 05 ERR1 PIC S9(4) COMP.
3.7 88 NO-NLS VALUE 1.
3.8 88 NOT-CONFIG VALUE 2.
3.9 05 ERR2 PIC S9(4) COMP VALUE 0.
4
4.1 PROCEDURE DIVISION.
4.2 START-PGM.
4.3 * Initializing the arrays.
4.4
4.5 MOVE "abCDfg6ijkaSXbVcGjGf1f$E!SPO6dLe\1a23%&7"
4.6 TO INSTR1.
4.7 MOVE "a 123&i12fSXgVhklKLabCDASPO6i"
4.8 TO INSTR2.
4.9
|
5 * The user is asked to enter a language name or
5.1
5.2 DISPLAY
5.3 "ENTER A LANGUAGE NAME OR NUMBER (MAX. 16 CHARACTERS):".
5.4 ACCEPT LANGUAGE.
5.5
5.6 CONVERT-NAME-NUM.
5.7 * NLINFO item 22 returns the corresponding
5.8 * lang number in integer format for this language.
5.9
6 CALL INTRINSIC "NLINFO" USING 22,
6.1 LANGUAGE,
6.2 LANGNUM,
6.3 ERRORS.
6.4 IF ERR1 NOT EQUAL 0
6.5 IF NO-NLS
6.6 DISPLAY "NL/3000 IS NOT INSTALLED"
6.7 CALL INTRINSIC "QUIT" USING 1001
6.8 ELSE
6.9 IF NOT-CONFIG
7 DISPLAY "THIS LANGUAGE IS NOT CONFIGURED"
7.1 CALL INTRINSIC "QUIT" USING 1002
7.2 ELSE
7.3 COMPUTE QUITPARM = 1000 + ERR1
7.4 CALL INTRINSIC "QUIT" USING QUITPARM.
7.5
7.6 GET-TABLES.
7.7 * Obtain the character attributes table
7.8 * using NLINFO item 12.
7.9
8 CALL INTRINSIC "NLINFO" USING 12,
8.1 CHARSET-table,
8.2 LANGNUM,
8.3 ERRORS.
8.4 IF ERR1 NOT EQUAL 0
8.5 COMPUTE QUITPARM = 2000 + ERR1
8.6 CALL INTRINSIC "QUIT" USING QUITPARM.
8.7
8.8 * Obtain the upshift table using NLINFO item 15.
8.9
9 CALL INTRINSIC "NLINFO" USING 15,
9.1 UPSHIFT-table,
9.2 LANGNUM,
9.3 ERRORS.
9.4 IF ERR1 NOT EQUAL 0
9.5 COMPUTE QUITPARM = 3000 + ERR1
9.6 CALL INTRINSIC "QUIT" USING QUITPARM.
9.7
|
9.8 * Obtain the downshift table using NLINFO item 16.
9.9
10 CALL INTRINSIC "NLINFO" USING 16
10.1 DOWNSHIFT-table,
10.2 LANGNUM,
10.3 ERRORS.
10.4 IF ERR1 NOT EQUAL 0
10.5 COMPUTE QUITPARM = 4000 + ERR1
10.6 CALL INTRINSIC "QUIT" USING QUITPARM.
10.7
10.8 DISPLAY "THE FOLLOWING STRING IS USED IN ALL EXAMPLES:"
10.9 DISPLAY INSTRING.
11
11.1 EXAMPLE-1-1.
11.2 * The string passed in the array instring should be moved
11.3 * and upshifted simultaneously to the array outstring.
11.4 * Set the until flag (bit 11 = 1) and the
11.5 * upshift flag (bit 10 = 1). All other flags remain 0.
11.6 *
11.7 * 0 1 2 3 4 5 6 7 8 9
11.8 * 0 0 0 0 0 0 0 0 0 0
11.9 *
12 * Note: The 'until flag' is set. Therefore, the operation continues
12.1 * until one of the ending criteria will be true.
12.2 * If no ending condition is set, the operation
12.3 * continues for the number of characters contained in
12.4 * length.
12.5 MOVE 48 TO FLAGS.
12.6
12.7 CALL INTRINSIC "NLSCANMOVE" USING INSTRING,
12.8 OUTSTRING,
12.9 FLAGS,
13 LEN,
13.1 LANGNUM,
13.2 ERRORS,
13.3 CHARSET-table,
13.4 UPSHIFT-table
13.5 GIVING NUMCHAR.
13.6 IF ERR1 NOT EQUAL 0
13.7 COMPUTE QUITPARM = 5000 + ERR1
13.8 CALL INTRINSIC "QUIT" USING QUITPARM.
13.9
14 DISPLAY "UPSHIFTED: (EXAMPLE 1-1)".
14.1 DISPLAY OUTSTRING.
14.2
|
14.3 EXAMPLE-1-2.
14.4 *
14.5 * The string passed in the array instring should be moved
14.6 * and upshifted to the array outstring (same as EXAMPLE 1-1).
14.7 * Set the while flag (bit 11 = 0) and the
14.8 * (bit 10 = 1). In addition all ending conditions will be
14.9 * set (bits 12 - 15 all 1).
15 *
15.1 * 0 1 2 3 4 5 6 7 8 9
15.2 * 0 0 0 0 0 0 0 0 0 0
15.3 *
15.4 * Note: The 'while flag' is set. Therefore, the operation
15.5 * continues while one of the end criteria is true.
15.6 * Since all criteria are set, one of them will be
15.7 * always true, and the operation continues for the
15.8 * number of characters contained in length.
15.9
16 MOVE SPACES TO OUTSTRING.
16.1 MOVE 0 TO FLAGS.
16.2 MOVE 47 TO FLAGS.
16.3
16.4 CALL INTRINSIC "NLSCANMOVE" USING INSTRING,
16.5 OUTSTRING,
16.6 FLAGS,
16.7 LEN,
16.8 LANGNUM,
16.9 ERRORS,
17 CHARSET-table,
17.1 UPSHIFT-table
17.2 GIVING NUMCHAR.
17.3
17.4 IF ERR1 NOT EQUAL 0
17.5 CALL INTRINSIC "QUIT" USING 6.
17.6
17.7 DISPLAY "UPSHIFTED: (EXAMPLE 1-2)".
17.8 DISPLAY OUTSTRING.
17.9
18 EXAMPLE-2-1.
18.1 * The string passed in the array instring should be
18.2 * scanned for the first occurrence of a special character.
18.3 * All characters before the first special character are
18.4 * moved to outstring.
18.5 * Set the until flag (bit 11 = 1) and the
18.6 * character flag (bit 12 = 1). All other flags remain
18.7 *
18.8 * 0 1 2 3 4 5 6 7 8 9
18.9 * 0 0 0 0 0 0 0 0 0 0
19 *
|
19.1 * Note: The 'until flag' is set and the ending condition
19.2 * set to 'special character'. Therefore, the operation
19.3 * continues until the first special character is found
19.4 * or until the number of characters contained in
19.5 * length is processed.
19.6
19.7 MOVE SPACES TO OUTSTRING.
19.8
19.9 MOVE 24 TO FLAGS.
20
20.1 CALL INTRINSIC "NLSCANMOVE" USING INSTRING,
20.2 OUTSTRING,
20.3 FLAGS,
20.4 LEN,
20.5 LANGNUM,
20.6 ERRORS,
20.7 CHARSET-table,
20.8 UPSHIFT-table
20.9 GIVING NUMCHAR.
21 IF ERR1 NOT EQUAL 0
21.1 COMPUTE QUITPARM = 7000 + ERR1
21.2 CALL INTRINSIC "QUIT" USING QUITPARM.
21.3
21.4 DISPLAY "SCAN/MOVE UNTIL SPECIAL: (EXAMPLE 2-1)".
21.5 DISPLAY OUTSTRING.
21.6
21.7 EXAMPLE-2-2.
21.8 * The string passed in the array instring should
21.9 * be scanned for the first occurrence of a special
22 * character. All characters before the first special
22.1 * character are moved to outstring (same as EXAMPLE 2-1).
22.2 * Set the while flag (bit 11 = 0) and all
22.3 * flags except for special characters (bits 13 - 15 =
22.4 *
22.5 * 0 1 2 3 4 5 6 7 8 9
22.6 * 0 0 0 0 0 0 0 0 0 0
22.7 *
22.8 * Note: The 'while flag' is set and all ending criteria
22.9 * except for special characters are set. Therefore, the
23 * operation continues while an uppercase, a lowercase, or
23.1 * a numeric character is found. When a special
23.2 * character is found, or the number of characters
23.3 * contained in length is processed, the operation will
23.4 * terminate.
23.5
23.6 MOVE SPACES TO OUTSTRING.
23.7
23.8 MOVE 7 TO FLAGS.
23.9
|
24 CALL INTRINSIC "NLSCANMOVE" USING INSTRING,
24.1 OUTSTRING,
24.2 FLAGS,
24.3 LEN,
24.4 LANGNUM,
24.5 ERRORS,
24.6 CHARSET-table,
24.7 UPSHIFT-table
24.8 GIVING NUMCHAR.
24.9
25 IF ERR1 NOT EQUAL 0
25.1 COMPUTE QUITPARM = 8000 + ERR1
25.2 CALL INTRINSIC "QUIT" USING QUITPARM.
25.3
25.4 DISPLAY "SCAN/MOVE WHILE ALPHA OR NUM: (EXAMPLE 2-2)".
25.5 DISPLAY OUTSTRING.
25.6
25.7 EXAMPLE-3-1.
25.8 * The string passed in the array instring should be
25.9 * scanned for the first occurrence of a special or numeric
26 * character. All characters before one of these characters
26.1 * are moved to outstring and downshifted simultaneously.
26.2 * Set the until flag (bit 11 = 1) and the ending condition
26.3 * flags for special and numeric characters (bits 12-13 = 1).
26.4 * To perform downshifting set bit 9 to 1.
26.5 *
26.6 * 0 1 2 3 4 5 6 7 8 9
26.7 * 0 0 0 0 0 0 0 0 0 1
26.8 *
26.9 * Note: The 'until flag' is set and the ending condition
27 * set to 'special character' and to 'numeric character'.
27.1 * Therefore, the operation continues until the first
27.2 * special or numeric character is found, or
27.3 * until the number of characters contained in length
27.4 * is processed.
27.5 *
27.6
27.7 MOVE SPACES TO OUTSTRING.
27.8
27.9 MOVE 92 TO FLAGS.
28
28.1 CALL INTRINSIC "NLSCANMOVE" USING INSTRING,
28.2 OUTSTRING,
28.3 FLAGS,
28.4 LEN,
28.5 LANGNUM,
28.6 ERRORS,
28.7 CHARSET-table,
28.8 DOWNSHIFT-table
28.9 GIVING NUMCHAR.
29
|
29.1 IF ERR1 NOT EQUAL TO 0
29.2 COMPUTE QUITPARM = 9000 + ERR1
29.3 CALL INTRINSIC "QUIT" USING QUITPARM.
29.4
29.5 DISPLAY
29.6 "SCAN/MOVE/DOWNSHIFT UNTIL NUM. OR SPEC.: (EXAMPLE 3-1)".
29.7 DISPLAY OUTSTRING.
29.8
29.9 EXAMPLE-3-2.
30 * The string passed in the array instring should be
30.1 * scanned for the first occurrence of a special or numeric
30.2 * character. All characters before one of these characters
30.3 * are moved to outstring and downshifted simultaneously
30.4 * (same as EXAMPLE-3-2).
30.5 * Set the while flag (bit 11 = 0) and the
30.6 * flags for upper and lower case characters (bits 14-15 =
30.7 * To perform downshifting set bit 9 to 1.
30.8 *
30.9 * 0 1 2 3 4 5 6 7 8 9
31 * 0 0 0 0 0 0 0 0 0 1
31.1 *
31.2 * Note: The 'while flag' is set and the ending criteria
31.3 * uppercase and lowercase characters are set.
31.4 * Therefore, the operation continues while an uppercase or
31.5 * a lowercase character is found. When a special
31.6 * or a numeric character is found, or the number of
31.7 * characters contained in length is processed, the
31.8 * operation will terminate.
31.9
32 MOVE SPACES TO OUTSTRING.
32.1
32.2 MOVE 67 TO FLAGS.
32.3
32.4 CALL INTRINSIC "NLSCANMOVE" USING INSTRING,
32.5 OUTSTRING,
32.6 FLAGS,
32.7 LEN,
32.8 LANGNUM,
32.9 ERRORS,
33 CHARSET-table,
33.1 DOWNSHIFT-table
33.2 GIVING NUMCHAR.
33.3
33.4 IF ERR1 NOT EQUAL 0
33.5 COMPUTE QUITPARM = 10000 + ERR1,
33.6 CALL INTRINSIC "QUIT" USING QUITPARM.
33.7
|
33.8 DISPLAY
33.9 "SCAN/MOVE/DOWNSHIFT WHILE ALPHA: (EXAMPLE 3-2)".
34 DISPLAY OUTSTRING.
34.1
34.2 STOP RUN.
|
Executing the program results in the following:
:RUN PROGRAM
ENTER A LANGUAGE NAME OR NUMBER (MAX. 16 CHARACTERS):
GERMAN
THE FOLLOWING STRING IS USED IN ALL EXAMPLES:
abCDfg6ijkaSXbVcGjGf1f$E!SPO6dLe\1a23%&7a 123&i12fSXgVhklKLabCDASPO6i
UPSHIFTED: (EXAMPLE 1-1)
ABCDFG6IJKASXBRCGJGF1F$E!SP[6DXE\1A23%&7A 123&I12FSXGRHKLKLABCDASP[6I
UPSHIFTED: (EXAMPLE 1-2)
ABCDFG6IJKASXBRCGJGF1F$E!SP[6DXE\1A23%&7A 123&I12FSXGRHKLKLABCDASP[6I
SCAN/MOVE UNTIL SPECIAL: (EXAMPLE 2-1)
abCDfg6ijkaSXbVcGjGf1f
SCAN/MOVE WHILE ALPHA OR NUM: (EXAMPLE 2-2)
abCDfg6ijkaSXbVcGjGf1f
SCAN/MOVE/DOWNSHIFT UNTIL NUM. OR SPEC.: (EXAMPLE 3-1)
abcdfg
SCAN/MOVE/DOWNSHIFT WHILE ALPHA: (EXAMPLE 3-2)
abcdfg
END OF PROGRAM
|
|