feat: add benchmark-programs — 58 telecom COBOL test programs
作为子目录纳入系统，与核心测试管道协同 Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
NB-076
@@ -0,0 +1,710 @@
|
||||
*> ============================================================
|
||||
*> 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.
|
||||
Reference in New Issue
Block a user