NB-076
711 lines
28 KiB
COBOL
711 lines
28 KiB
COBOL
*> ============================================================
|
|
*> 29-ascii-ebcdic : ASCII->EBCDIC 编码转换 - EXPANDED
|
|
*> Input : FILE-IN (file-in.dat: ASCII编码文件, 80字节)
|
|
*> Output: FILE-OUT (file-out-ebcdic.dat: EBCDIC编码文件)
|
|
*> REPORT-OUT (rpt-ae.dat: 转换统计报告)
|
|
*> Coverage: AE-N001~N003, AE-R001 (original, preserved)
|
|
*> ============================================================
|
|
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. AsciiEbcdic.
|
|
*>
|
|
ENVIRONMENT DIVISION.
|
|
INPUT-OUTPUT SECTION.
|
|
FILE-CONTROL.
|
|
SELECT FILE-IN ASSIGN TO 'file-in.dat'
|
|
ORGANIZATION IS SEQUENTIAL
|
|
ACCESS MODE IS SEQUENTIAL
|
|
FILE STATUS IS WS-FILE-IN-STATUS.
|
|
SELECT FILE-OUT ASSIGN TO 'file-out-ebcdic.dat'
|
|
ORGANIZATION IS SEQUENTIAL
|
|
FILE STATUS IS WS-FILE-OUT-STATUS.
|
|
SELECT REPORT-OUT ASSIGN TO 'rpt-ae.dat'
|
|
ORGANIZATION IS SEQUENTIAL
|
|
FILE STATUS IS WS-REPORT-STATUS.
|
|
*>
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
FD FILE-IN.
|
|
01 IN-REC.
|
|
05 IN-BYTE OCCURS 80 TIMES PIC X(01).
|
|
*>
|
|
FD FILE-OUT.
|
|
01 OUT-REC.
|
|
05 OUT-BYTE OCCURS 80 TIMES PIC X(01).
|
|
*>
|
|
FD REPORT-OUT.
|
|
01 REPORT-REC PIC X(80).
|
|
*>
|
|
WORKING-STORAGE SECTION.
|
|
01 WS-CDR-REF.
|
|
COPY "telecom/TEL-CDR.cpy".
|
|
*>
|
|
01 WS-FILE-IN-STATUS PIC X(02).
|
|
01 WS-FILE-OUT-STATUS PIC X(02).
|
|
01 WS-REPORT-STATUS PIC X(02).
|
|
01 WS-EOF PIC X(01) VALUE 'N'.
|
|
88 WS-EOF-YES VALUE 'Y' FALSE 'N'.
|
|
01 WS-REC-COUNT PIC 9(05) VALUE ZERO.
|
|
01 WS-BYTES PIC 9(03).
|
|
*> Timestamp for tracing
|
|
01 WS-TIMESTAMP.
|
|
05 WS-TS-DATE PIC X(08).
|
|
05 WS-TS-TIME PIC X(08).
|
|
01 WS-TS-STRING PIC X(19).
|
|
01 WS-TRACE-MSG PIC X(80).
|
|
*> Error severity levels
|
|
01 WS-ERROR-SEVERITY PIC X(01).
|
|
88 WS-ERR-INFO VALUE 'I'.
|
|
88 WS-ERR-WARNING VALUE 'W'.
|
|
88 WS-ERR-ERROR VALUE 'E'.
|
|
88 WS-ERR-FATAL VALUE 'F'.
|
|
01 WS-ERROR-COUNT PIC 9(03) VALUE ZERO.
|
|
01 WS-WARN-COUNT PIC 9(03) VALUE ZERO.
|
|
01 WS-ERROR-MSG PIC X(80).
|
|
01 WS-PROCEDURE-NAME PIC X(30).
|
|
*> Conversion table index
|
|
01 WS-ASCII-VAL PIC 9(03) USAGE COMP.
|
|
01 WS-ASCII-VAL-DISP PIC Z(02)9.
|
|
01 WS-IDX PIC 9(02).
|
|
01 WS-IDX-256 PIC 9(03).
|
|
01 WS-IDX-2 PIC 9(02).
|
|
*> ============================================================
|
|
*> ORIGINAL 128-entry conversion table (KEPT UNCHANGED)
|
|
*> ============================================================
|
|
01 WS-CONV-TABLE.
|
|
05 WS-CONV-ENTRY PIC X(01) OCCURS 128 TIMES
|
|
INDEXED BY WS-CONV-IDX.
|
|
01 WS-CONV-DATA.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'00010203372D2E2F1605250B0C0D0E0F'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'101112133C3D322618193F271C1D1E1F'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'405A7F7B5B6C507D4D5D5C4E6B604B61'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'6D7981828384858687888991929394'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'9596979899A2A3A4A5A6A7A8A9C04F'.
|
|
01 WS-CONV-REDEF REDEFINES WS-CONV-DATA.
|
|
05 WS-CONV-BYTE OCCURS 128 TIMES PIC X(01).
|
|
*> ============================================================
|
|
*> EXPANDED: 256-entry full ASCII->EBCDIC conversion table
|
|
*> Includes entries 0-127 (same as original) plus 128-255
|
|
*> ============================================================
|
|
01 WS-FULL-CONV-TABLE.
|
|
05 WS-FULL-ENTRY PIC X(01) OCCURS 256 TIMES
|
|
INDEXED BY WS-FULL-IDX.
|
|
01 WS-FULL-DATA.
|
|
*> Bytes 0-127 (same mapping as original, padded to 16/row)
|
|
05 FILLER PIC X(16) VALUE
|
|
X'00010203372D2E2F1605250B0C0D0E0F'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'101112133C3D322618193F271C1D1E1F'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'405A7F7B5B6C507D4D5D5C4E6B604B61'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E00'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F00'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'6D79818283848586878889919293940000'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'9596979899A2A3A4A5A6A7A8A9C04F00'.
|
|
*> Bytes 128-255 (identity mapping scheme)
|
|
05 FILLER PIC X(16) VALUE
|
|
X'808182838485868788898A8B8C8D8E8F'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'909192939495969798999A9B9C9D9E9F'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'.
|
|
05 FILLER PIC X(16) VALUE
|
|
X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'.
|
|
01 WS-FULL-REDEF REDEFINES WS-FULL-DATA.
|
|
05 WS-FULL-BYTE OCCURS 256 TIMES PIC X(01).
|
|
*> EBCDIC->ASCII reverse table (built programmatically)
|
|
01 WS-REV-CONV-TABLE.
|
|
05 WS-REV-ENTRY PIC X(01) OCCURS 256 TIMES.
|
|
*> Conversion statistics
|
|
01 WS-STATS.
|
|
05 WS-STAT-TOTAL-BYTES PIC 9(09) VALUE ZERO.
|
|
05 WS-STAT-CONVERTED PIC 9(09) VALUE ZERO.
|
|
05 WS-STAT-UNREPLACEABLE PIC 9(09) VALUE ZERO.
|
|
05 WS-STAT-RT-SAMPLES PIC 9(03) VALUE ZERO.
|
|
05 WS-STAT-RT-FAIL PIC 9(03) VALUE ZERO.
|
|
05 WS-STAT-RT-PASS PIC 9(03) VALUE ZERO.
|
|
01 WS-STAT-PCT-DISP PIC Z(02)9.99.
|
|
*> Hash total for audit
|
|
01 WS-HASH-TOTAL PIC 9(09) VALUE ZERO.
|
|
01 WS-HASH-MOD PIC 9(09).
|
|
01 WS-HASH-BYTE PIC 9(03) COMP.
|
|
*> Validation variables
|
|
01 WS-VALID-COUNT PIC 9(03) VALUE ZERO.
|
|
01 WS-INVALID-COUNT PIC 9(03) VALUE ZERO.
|
|
01 WS-UNREP-COUNT PIC 9(03) VALUE ZERO.
|
|
01 WS-UNREP-FLAG PIC X(01).
|
|
88 WS-UNREP-YES VALUE 'Y' FALSE 'N'.
|
|
*> Round-trip verification
|
|
01 WS-RT-SAMPLE-BYTE PIC X(01).
|
|
01 WS-RT-EBC-BYTE PIC X(01).
|
|
01 WS-RT-ASCII-VAL PIC 9(03) COMP.
|
|
01 WS-RT-RESULT PIC 9(03) COMP.
|
|
01 WS-RT-FOUND PIC X(01).
|
|
88 WS-RT-FOUND-YES VALUE 'Y' FALSE 'N'.
|
|
01 WS-SAMPLE-IDX1 PIC 9(02).
|
|
01 WS-SAMPLE-IDX2 PIC 9(02).
|
|
01 WS-SAMPLE-IDX3 PIC 9(02).
|
|
*> Reverse loop variables
|
|
01 WS-REV-ASC PIC 9(03) VALUE ZERO.
|
|
01 WS-REV-RESULT PIC 9(03) VALUE ZERO.
|
|
*> Output formatting
|
|
01 WS-OUT-LINE PIC X(80).
|
|
01 WS-OUT-BYTE-COUNT PIC Z(08)9.
|
|
01 WS-OUT-ERR-COUNT PIC Z(02)9.
|
|
*>
|
|
PROCEDURE DIVISION.
|
|
*>
|
|
MAIN SECTION.
|
|
MB-PROCESS.
|
|
*> [1000] Initialize conversion tables
|
|
PERFORM 1000-INIT THRU 1000-EXIT.
|
|
*> [2000] Open files
|
|
PERFORM 2000-OPEN-FILES THRU 2000-EXIT.
|
|
IF WS-ERR-FATAL
|
|
DISPLAY 'FATAL: Cannot proceed, check file status'
|
|
STOP RUN
|
|
END-IF.
|
|
*>
|
|
PERFORM UNTIL WS-EOF-YES
|
|
READ FILE-IN
|
|
AT END
|
|
SET WS-EOF-YES TO TRUE
|
|
NOT AT END
|
|
PERFORM CONVERT-RECORD
|
|
PERFORM 3100-VALIDATE THRU 3100-EXIT
|
|
PERFORM 3200-CONVERT THRU 3200-EXIT
|
|
PERFORM 3300-FORMAT-OUTPUT THRU 3300-EXIT
|
|
WRITE OUT-REC
|
|
PERFORM 3400-WRITE-OUTPUT THRU 3400-EXIT
|
|
ADD 1 TO WS-REC-COUNT
|
|
END-READ
|
|
END-PERFORM.
|
|
*>
|
|
PERFORM 4000-REPORT THRU 4000-EXIT.
|
|
PERFORM 5000-AUDIT THRU 5000-EXIT.
|
|
PERFORM 6000-ERROR-HANDLE THRU 6000-EXIT.
|
|
PERFORM 9000-EXIT THRU 9000-EXIT.
|
|
STOP RUN.
|
|
*>
|
|
*> ============================================================
|
|
*> EXISTING PROCEDURES (KEPT UNCHANGED FROM ORIGINAL)
|
|
*> ============================================================
|
|
*> --- Initialize conversion table from REDEFINES data ---
|
|
INIT-CONV-TABLE.
|
|
PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 128
|
|
MOVE WS-CONV-BYTE(WS-IDX) TO WS-CONV-ENTRY(WS-IDX)
|
|
END-PERFORM.
|
|
DISPLAY 'ASCII->EBCDIC conversion table initialized '
|
|
'(128 entries)'.
|
|
*>
|
|
*> --- Convert one record from ASCII to EBCDIC ---
|
|
CONVERT-RECORD.
|
|
PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 80
|
|
MOVE IN-BYTE(WS-IDX) TO WS-ASCII-VAL
|
|
IF WS-ASCII-VAL < 128
|
|
SET WS-CONV-IDX TO WS-ASCII-VAL
|
|
ADD 1 TO WS-CONV-IDX
|
|
MOVE WS-CONV-ENTRY(WS-CONV-IDX)
|
|
TO OUT-BYTE(WS-IDX)
|
|
ELSE
|
|
*> Non-ASCII byte (>= 128): pass through unchanged
|
|
MOVE IN-BYTE(WS-IDX)
|
|
TO OUT-BYTE(WS-IDX)
|
|
END-IF
|
|
END-PERFORM.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 1000: INITIALIZATION
|
|
*> ============================================================
|
|
1000-INIT SECTION.
|
|
1000-ENTRY.
|
|
MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE.
|
|
MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME.
|
|
STRING '[' DELIMITED BY SIZE
|
|
WS-TS-DATE DELIMITED BY SIZE
|
|
' ' DELIMITED BY SIZE
|
|
WS-TS-TIME DELIMITED BY SIZE
|
|
- ']' DELIMITED BY SIZE
|
|
INTO WS-TS-STRING
|
|
END-STRING.
|
|
DISPLAY WS-TS-STRING
|
|
' AsciiEbcdic: Starting initialization'.
|
|
*> Initialize original 128-entry table (preserved)
|
|
PERFORM INIT-CONV-TABLE.
|
|
*> Initialize expanded 256-entry table
|
|
PERFORM 1100-INIT-FULL-TABLE THRU 1100-EXIT.
|
|
*> Initialize reverse table
|
|
PERFORM 1200-INIT-REV-TABLE THRU 1200-EXIT.
|
|
*> Initialize error handling
|
|
MOVE 'I' TO WS-ERROR-SEVERITY.
|
|
MOVE ZERO TO WS-ERROR-COUNT.
|
|
MOVE ZERO TO WS-WARN-COUNT.
|
|
MOVE ZERO TO WS-STAT-TOTAL-BYTES.
|
|
MOVE ZERO TO WS-STAT-CONVERTED.
|
|
MOVE ZERO TO WS-STAT-UNREPLACEABLE.
|
|
MOVE ZERO TO WS-STAT-RT-SAMPLES.
|
|
MOVE ZERO TO WS-STAT-RT-FAIL.
|
|
MOVE ZERO TO WS-STAT-RT-PASS.
|
|
MOVE ZERO TO WS-HASH-TOTAL.
|
|
PERFORM BUILD-TIMESTAMP.
|
|
DISPLAY WS-TS-STRING ' INIT complete, ready to process'.
|
|
1000-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> --- [1100] Initialize 256-entry full conversion table ---
|
|
1100-INIT-FULL-TABLE SECTION.
|
|
1100-ENTRY.
|
|
PERFORM VARYING WS-IDX-256 FROM 1 BY 1
|
|
UNTIL WS-IDX-256 > 256
|
|
MOVE WS-FULL-BYTE(WS-IDX-256)
|
|
TO WS-FULL-ENTRY(WS-IDX-256)
|
|
END-PERFORM.
|
|
DISPLAY 'Full ASCII->EBCDIC table initialized '
|
|
'(256 entries)'.
|
|
1100-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> --- [1200] Build reverse table (EBCDIC->ASCII) ---
|
|
1200-INIT-REV-TABLE SECTION.
|
|
1200-ENTRY.
|
|
*> Initialize all to X'00' (not found)
|
|
PERFORM VARYING WS-IDX-256 FROM 1 BY 1
|
|
UNTIL WS-IDX-256 > 256
|
|
MOVE X'00' TO WS-REV-ENTRY(WS-IDX-256)
|
|
END-PERFORM.
|
|
*> For each ASCII code, set reverse[EBCDIC] = ASCII
|
|
PERFORM VARYING WS-ASCII-VAL FROM 0 BY 1
|
|
UNTIL WS-ASCII-VAL > 255
|
|
SET WS-FULL-IDX TO 1
|
|
IF WS-ASCII-VAL > 0
|
|
SET WS-FULL-IDX UP BY WS-ASCII-VAL
|
|
END-IF
|
|
PERFORM VARYING WS-IDX-256 FROM 1 BY 1
|
|
UNTIL WS-IDX-256 > 256
|
|
IF WS-FULL-ENTRY(WS-IDX-256) =
|
|
WS-FULL-ENTRY(WS-FULL-IDX)
|
|
MOVE WS-ASCII-VAL TO WS-HASH-BYTE
|
|
ADD 1 TO WS-HASH-BYTE
|
|
MOVE WS-HASH-BYTE TO WS-IDX-2
|
|
SUBTRACT 1 FROM WS-IDX-2
|
|
MOVE WS-FULL-ENTRY(WS-FULL-IDX)
|
|
TO WS-REV-ENTRY(WS-IDX-256)
|
|
END-IF
|
|
END-PERFORM
|
|
END-PERFORM.
|
|
DISPLAY 'Reverse EBCDIC->ASCII table built '
|
|
'(256 entries)'.
|
|
1200-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> --- Build timestamp helper ---
|
|
BUILD-TIMESTAMP.
|
|
MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE.
|
|
MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME.
|
|
STRING '[' DELIMITED BY SIZE
|
|
WS-TS-DATE DELIMITED BY SIZE
|
|
' ' DELIMITED BY SIZE
|
|
WS-TS-TIME DELIMITED BY SIZE
|
|
- ']' DELIMITED BY SIZE
|
|
INTO WS-TS-STRING
|
|
END-STRING.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 2000: OPEN FILES
|
|
*> ============================================================
|
|
2000-OPEN-FILES SECTION.
|
|
2000-ENTRY.
|
|
PERFORM BUILD-TIMESTAMP.
|
|
*> Open FILE-IN (original code preserved)
|
|
OPEN INPUT FILE-IN.
|
|
IF WS-FILE-IN-STATUS NOT = '00'
|
|
DISPLAY 'ERROR: Cannot open FILE-IN, status: '
|
|
WS-FILE-IN-STATUS
|
|
MOVE 1 TO RETURN-CODE
|
|
MOVE 'F' TO WS-ERROR-SEVERITY
|
|
GO TO 2000-EXIT
|
|
END-IF.
|
|
DISPLAY WS-TS-STRING ' OPEN: FILE-IN status=00 OK'.
|
|
*> Open FILE-OUT (original code preserved)
|
|
OPEN OUTPUT FILE-OUT.
|
|
IF WS-FILE-OUT-STATUS NOT = '00'
|
|
DISPLAY 'ERROR: Cannot open FILE-OUT, status: '
|
|
WS-FILE-OUT-STATUS
|
|
MOVE 1 TO RETURN-CODE
|
|
MOVE 'F' TO WS-ERROR-SEVERITY
|
|
GO TO 2000-EXIT
|
|
END-IF.
|
|
DISPLAY WS-TS-STRING ' OPEN: FILE-OUT status=00 OK'.
|
|
*> Open REPORT-OUT (new extended output)
|
|
OPEN OUTPUT REPORT-OUT.
|
|
IF WS-REPORT-STATUS NOT = '00'
|
|
DISPLAY 'WARNING: Cannot open REPORT-OUT, status: '
|
|
WS-REPORT-STATUS
|
|
MOVE 'W' TO WS-ERROR-SEVERITY
|
|
ELSE
|
|
DISPLAY WS-TS-STRING ' OPEN: REPORT-OUT status=00 OK'.
|
|
2000-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 3100: VALIDATE
|
|
*> ============================================================
|
|
3100-VALIDATE SECTION.
|
|
3100-ENTRY.
|
|
MOVE ZERO TO WS-VALID-COUNT.
|
|
MOVE ZERO TO WS-INVALID-COUNT.
|
|
MOVE ZERO TO WS-UNREP-COUNT.
|
|
MOVE 'N' TO WS-UNREP-FLAG.
|
|
*> Iterate through all 80 bytes
|
|
PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 80
|
|
MOVE IN-BYTE(WS-IDX) TO WS-ASCII-VAL
|
|
IF WS-ASCII-VAL < 128
|
|
*> Standard ASCII always convertible
|
|
ADD 1 TO WS-VALID-COUNT
|
|
ELSE
|
|
IF WS-ASCII-VAL < 256
|
|
ADD 1 TO WS-VALID-COUNT
|
|
MOVE 'Y' TO WS-UNREP-FLAG
|
|
ADD 1 TO WS-UNREP-COUNT
|
|
ELSE
|
|
ADD 1 TO WS-INVALID-COUNT
|
|
MOVE 'W' TO WS-ERROR-SEVERITY
|
|
MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME
|
|
MOVE WS-ASCII-VAL TO WS-ASCII-VAL-DISP
|
|
STRING 'Invalid byte at pos '
|
|
WS-IDX ' val=' WS-ASCII-VAL-DISP
|
|
INTO WS-ERROR-MSG
|
|
END-STRING
|
|
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
|
END-IF
|
|
END-IF
|
|
END-PERFORM.
|
|
3100-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 3200: CONVERT (256-entry + stats + round-trip)
|
|
*> ============================================================
|
|
3200-CONVERT SECTION.
|
|
3200-ENTRY.
|
|
ADD 80 TO WS-STAT-TOTAL-BYTES.
|
|
*> Perform 256-entry conversion and track unreplaceable
|
|
PERFORM VARYING WS-IDX-256 FROM 1 BY 1
|
|
UNTIL WS-IDX-256 > 80
|
|
MOVE IN-BYTE(WS-IDX-256) TO WS-ASCII-VAL
|
|
IF WS-ASCII-VAL >= 128 AND WS-ASCII-VAL < 256
|
|
ADD 1 TO WS-STAT-UNREPLACEABLE
|
|
END-IF
|
|
IF WS-ASCII-VAL < 256
|
|
ADD 1 TO WS-STAT-CONVERTED
|
|
END-IF
|
|
END-PERFORM.
|
|
*> Round-trip verification sampling (3 bytes per record)
|
|
MOVE 1 TO WS-SAMPLE-IDX1.
|
|
MOVE 40 TO WS-SAMPLE-IDX2.
|
|
MOVE 80 TO WS-SAMPLE-IDX3.
|
|
PERFORM 3250-ROUND-TRIP THRU 3250-EXIT.
|
|
3200-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> --- [3250] Round-trip verification for three bytes ---
|
|
3250-ROUND-TRIP SECTION.
|
|
3250-ENTRY.
|
|
MOVE IN-BYTE(WS-SAMPLE-IDX1) TO WS-RT-SAMPLE-BYTE.
|
|
PERFORM 3260-RT-ONE THRU 3260-EXIT.
|
|
MOVE IN-BYTE(WS-SAMPLE-IDX2) TO WS-RT-SAMPLE-BYTE.
|
|
PERFORM 3260-RT-ONE THRU 3260-EXIT.
|
|
MOVE IN-BYTE(WS-SAMPLE-IDX3) TO WS-RT-SAMPLE-BYTE.
|
|
PERFORM 3260-RT-ONE THRU 3260-EXIT.
|
|
3250-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> --- [3260] Round-trip one byte A->E->A ---
|
|
3260-RT-ONE SECTION.
|
|
3260-ENTRY.
|
|
MOVE WS-RT-SAMPLE-BYTE TO WS-ASCII-VAL.
|
|
IF WS-ASCII-VAL < 256
|
|
ADD 1 TO WS-STAT-RT-SAMPLES
|
|
SET WS-FULL-IDX TO 1
|
|
IF WS-ASCII-VAL > 0
|
|
SET WS-FULL-IDX UP BY WS-ASCII-VAL
|
|
END-IF
|
|
MOVE WS-FULL-ENTRY(WS-FULL-IDX) TO WS-RT-EBC-BYTE
|
|
*> Reverse lookup using reverse table
|
|
ADD 1 TO WS-ASCII-VAL GIVING WS-REV-ASC
|
|
MOVE WS-REV-ENTRY(WS-REV-ASC) TO WS-HASH-BYTE
|
|
MOVE WS-HASH-BYTE TO WS-REV-RESULT
|
|
SUBTRACT 1 FROM WS-REV-RESULT
|
|
IF WS-REV-RESULT = WS-ASCII-VAL
|
|
ADD 1 TO WS-STAT-RT-PASS
|
|
ELSE
|
|
ADD 1 TO WS-STAT-RT-FAIL
|
|
MOVE 'W' TO WS-ERROR-SEVERITY
|
|
MOVE '3260-RT-ONE' TO WS-PROCEDURE-NAME
|
|
MOVE WS-ASCII-VAL TO WS-ASCII-VAL-DISP
|
|
STRING 'RT fail: byte ' WS-ASCII-VAL-DISP
|
|
INTO WS-ERROR-MSG
|
|
END-STRING
|
|
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
|
END-IF
|
|
END-IF.
|
|
3260-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 3300: FORMAT OUTPUT
|
|
*> ============================================================
|
|
3300-FORMAT-OUTPUT SECTION.
|
|
3300-ENTRY.
|
|
MOVE WS-UNREP-COUNT TO WS-OUT-ERR-COUNT.
|
|
STRING
|
|
'REC=' WS-REC-COUNT
|
|
' V=' WS-VALID-COUNT
|
|
' I=' WS-INVALID-COUNT
|
|
' U=' WS-UNREP-COUNT
|
|
INTO WS-OUT-LINE
|
|
END-STRING.
|
|
3300-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 3400: WRITE OUTPUT
|
|
*> ============================================================
|
|
3400-WRITE-OUTPUT SECTION.
|
|
3400-ENTRY.
|
|
IF WS-REPORT-STATUS = '00' OR WS-REPORT-STATUS = SPACES
|
|
MOVE WS-OUT-LINE TO REPORT-REC
|
|
WRITE REPORT-REC
|
|
IF WS-REPORT-STATUS NOT = '00'
|
|
MOVE 'E' TO WS-ERROR-SEVERITY
|
|
MOVE '3400-WRITE-OUTPUT' TO WS-PROCEDURE-NAME
|
|
STRING 'REPORT-OUT write failed status='
|
|
WS-REPORT-STATUS
|
|
INTO WS-ERROR-MSG
|
|
END-STRING
|
|
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
|
END-IF
|
|
END-IF.
|
|
3400-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 4000: REPORT
|
|
*> ============================================================
|
|
4000-REPORT SECTION.
|
|
4000-ENTRY.
|
|
PERFORM BUILD-TIMESTAMP.
|
|
DISPLAY WS-TS-STRING ' 4000-REPORT: Generating report'.
|
|
*> Write report header
|
|
MOVE '=== AsciiEbcdic Extended Report ===' TO REPORT-REC.
|
|
WRITE REPORT-REC.
|
|
IF WS-REPORT-STATUS NOT = '00'
|
|
MOVE 'E' TO WS-ERROR-SEVERITY
|
|
MOVE '4000-REPORT' TO WS-PROCEDURE-NAME
|
|
STRING 'REPORT-OUT write failed status='
|
|
WS-REPORT-STATUS
|
|
INTO WS-ERROR-MSG
|
|
END-STRING
|
|
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
|
END-IF.
|
|
*> Write statistics
|
|
MOVE WS-STAT-TOTAL-BYTES TO WS-OUT-BYTE-COUNT.
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Total bytes read: ' WS-OUT-BYTE-COUNT
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE WS-STAT-CONVERTED TO WS-OUT-BYTE-COUNT.
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Bytes converted: ' WS-OUT-BYTE-COUNT
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE WS-STAT-UNREPLACEABLE TO WS-OUT-ERR-COUNT.
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Unreplaceable chars: ' WS-OUT-ERR-COUNT
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
IF WS-STAT-TOTAL-BYTES > 0
|
|
COMPUTE WS-STAT-PCT-DISP ROUNDED =
|
|
(WS-STAT-CONVERTED / WS-STAT-TOTAL-BYTES) * 100
|
|
ELSE
|
|
MOVE ZERO TO WS-STAT-PCT-DISP
|
|
END-IF.
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Conversion rate: ' WS-STAT-PCT-DISP '%'
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE WS-STAT-RT-SAMPLES TO WS-OUT-ERR-COUNT.
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Round-trip samples: ' WS-OUT-ERR-COUNT
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE WS-STAT-RT-PASS TO WS-OUT-ERR-COUNT.
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Round-trip passed: ' WS-OUT-ERR-COUNT
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE WS-STAT-RT-FAIL TO WS-OUT-ERR-COUNT.
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Round-trip failures: ' WS-OUT-ERR-COUNT
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE WS-HASH-TOTAL TO WS-OUT-BYTE-COUNT.
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Hash total: ' WS-OUT-BYTE-COUNT
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE WS-ERROR-COUNT TO WS-OUT-ERR-COUNT.
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Errors: ' WS-OUT-ERR-COUNT
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE WS-WARN-COUNT TO WS-OUT-ERR-COUNT.
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Warnings: ' WS-OUT-ERR-COUNT
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE '=== End of Report ===' TO REPORT-REC.
|
|
WRITE REPORT-REC.
|
|
4000-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 5000: AUDIT
|
|
*> ============================================================
|
|
5000-AUDIT SECTION.
|
|
5000-ENTRY.
|
|
PERFORM BUILD-TIMESTAMP.
|
|
DISPLAY WS-TS-STRING ' 5000-AUDIT: Audit trail'.
|
|
DISPLAY WS-TS-STRING
|
|
' AUDIT: records=' WS-REC-COUNT
|
|
' bytes-total=' WS-STAT-TOTAL-BYTES.
|
|
DISPLAY WS-TS-STRING
|
|
' AUDIT: bytes-converted=' WS-STAT-CONVERTED
|
|
' unrep=' WS-STAT-UNREPLACEABLE.
|
|
DISPLAY WS-TS-STRING
|
|
' AUDIT: rt-pass=' WS-STAT-RT-PASS
|
|
' rt-fail=' WS-STAT-RT-FAIL.
|
|
5000-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 6000: ERROR HANDLE
|
|
*> ============================================================
|
|
6000-ERROR-HANDLE SECTION.
|
|
6000-ENTRY.
|
|
PERFORM BUILD-TIMESTAMP.
|
|
DISPLAY WS-TS-STRING ' 6000-ERROR-HANDLE: Summary'.
|
|
IF WS-ERROR-COUNT > 0
|
|
DISPLAY WS-TS-STRING
|
|
' ERRORS: Total=' WS-ERROR-COUNT
|
|
END-IF.
|
|
IF WS-WARN-COUNT > 0
|
|
DISPLAY WS-TS-STRING
|
|
' WARNINGS: Total=' WS-WARN-COUNT
|
|
END-IF.
|
|
IF WS-ERROR-COUNT = 0 AND WS-WARN-COUNT = 0
|
|
DISPLAY WS-TS-STRING
|
|
' No errors or warnings'
|
|
END-IF.
|
|
6000-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 6100: LOG ERROR
|
|
*> ============================================================
|
|
6100-LOG-ERROR SECTION.
|
|
6100-ENTRY.
|
|
IF WS-ERR-ERROR OR WS-ERR-FATAL
|
|
ADD 1 TO WS-ERROR-COUNT
|
|
END-IF.
|
|
IF WS-ERR-WARNING
|
|
ADD 1 TO WS-WARN-COUNT
|
|
END-IF.
|
|
DISPLAY WS-TS-STRING ' [SEV=' WS-ERROR-SEVERITY '] '
|
|
WS-PROCEDURE-NAME ': ' WS-ERROR-MSG.
|
|
6100-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 9000: EXIT
|
|
*> ============================================================
|
|
9000-EXIT SECTION.
|
|
9000-ENTRY.
|
|
PERFORM BUILD-TIMESTAMP.
|
|
*> Close FILE-IN
|
|
CLOSE FILE-IN.
|
|
IF WS-FILE-IN-STATUS NOT = '00'
|
|
DISPLAY 'ERROR: FILE-IN close status: '
|
|
WS-FILE-IN-STATUS
|
|
MOVE 1 TO RETURN-CODE
|
|
END-IF.
|
|
*> Close FILE-OUT
|
|
CLOSE FILE-OUT.
|
|
IF WS-FILE-OUT-STATUS NOT = '00'
|
|
DISPLAY 'ERROR: FILE-OUT close status: '
|
|
WS-FILE-OUT-STATUS
|
|
MOVE 1 TO RETURN-CODE
|
|
END-IF.
|
|
*> Close REPORT-OUT if open
|
|
IF WS-REPORT-STATUS = '00' OR WS-REPORT-STATUS = SPACES
|
|
CLOSE REPORT-OUT
|
|
IF WS-REPORT-STATUS NOT = '00'
|
|
DISPLAY 'WARNING: REPORT-OUT close status: '
|
|
WS-REPORT-STATUS
|
|
END-IF
|
|
END-IF.
|
|
*> Existing final display (preserved)
|
|
DISPLAY 'AsciiEbcdic: Completed. Records converted: '
|
|
WS-REC-COUNT.
|
|
IF WS-ERROR-COUNT > 0
|
|
MOVE 1 TO RETURN-CODE
|
|
END-IF.
|
|
9000-EXIT-END.
|
|
EXIT.
|
|
*>
|
|
END PROGRAM AsciiEbcdic.
|