IDENTIFICATION DIVISION. PROGRAM-ID. BCSVGEN. ****************************************************************** * * * PROGRAM: BCSVGEN * * PURPOSE: Generate binary test data for flbcsv BCSV tests. * * * * DESCRIPTION: * * Writes fixed-block (FB) test records to ten output files, * * one for each BCSV sample copybook, plus two variable-block * * (VB) IMS DFSURGU0 files (BCIMSLON, BCIMSSHR), and one DFP * * float file (BCSVDFP). Each file * * contains records with known values covering all COBOL data * * types supported by the FMT2TAB schema compiler (flcl bcsv / * * flbcsv). The binary files are used as IDAT input for the * * FL5 regression test suite (T1). * * * * NOTE: All record layouts are defined inline -- no COPY * * statements are used so that the program can be compiled * * without requiring SRCLIB in the SYSLIB concatenation. * * * * REQUIRED DD-NAMES: * * BCSVCHA - FB LRECL=45 alphanumeric / alphabetic * * BCSVNMD - FB LRECL=29 zoned decimal (DISPLAY) * * BCSVPAK - FB LRECL=26 packed decimal (COMP-3) * * BCSVBIN - FB LRECL=26 binary integer (COMP / COMP-5) * * BCSVFLT - FB LRECL=12 HFP float (COMP-1 / COMP-2) * * BCSVOCC - FB LRECL=38 OCCURS fixed arrays * * BCSVFIL - FB LRECL=32 FILLER variant records * * BCSVOVL - FB LRECL=28 REDEFINES overlay records * * BCSVUNC - FB LRECL=30 NATIONAL / DBCS / UTF-8 * * BCIMSLON - VB DCB-LRECL=69 IMS DFSURGU0 LONG IBM format * * (data record 65B + 4B RDW) * * BCIMSSHR - VB DCB-LRECL=53 IMS DFSURGU0 SHORT IBM format * * (data record 49B + 4B RDW) * * BCSVDFP - FB LRECL=28 DFP float (raw DPD bytes) * * BCSVHDU - VB LRECL=80 IMS HD Unload (DFSURGL0) synthetic * * (max data 76B PARTSEG + 4B RDW) * * BCSVDET - FB LRECL=39 PIC X content for type.detect() * * (DATE/INTEGER/FLOAT/STRING/BINARY coverage) * * SYSOUT - message output * * * * COMPILER REQUIREMENTS: * * IBM Enterprise COBOL 6.1 or later. * * NATIONAL items (PIC N) require NSYMBOL(NATIONAL). * * DBCS items (PIC G) require DBCS compiler option. * * UTF-8 items (PIC U) require CODEPAGE(1208) or UTF8 option. * * * * RETURN CODES: * * 0 all records written successfully * * * ****************************************************************** ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. SYSOUT IS TERMOUT. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT BCSVCHA-FILE ASSIGN TO BCSVCHA ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. SELECT BCSVNMD-FILE ASSIGN TO BCSVNMD ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. SELECT BCSVPAK-FILE ASSIGN TO BCSVPAK ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. SELECT BCSVBIN-FILE ASSIGN TO BCSVBIN ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. SELECT BCSVFLT-FILE ASSIGN TO BCSVFLT ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. SELECT BCSVOCC-FILE ASSIGN TO BCSVOCC ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. SELECT BCSVFIL-FILE ASSIGN TO BCSVFIL ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. SELECT BCSVOVL-FILE ASSIGN TO BCSVOVL ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. SELECT BCSVUNC-FILE ASSIGN TO BCSVUNC ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. SELECT BCIMSLON-FILE ASSIGN TO BCIMSLON ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. SELECT BCIMSSHR-FILE ASSIGN TO BCIMSSHR ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. SELECT BCSVDFP-FILE ASSIGN TO BCSVDFP ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. SELECT BCSVHDU-FILE ASSIGN TO BCSVHDU ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. SELECT BCSVDET-FILE ASSIGN TO BCSVDET ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. * DATA DIVISION. FILE SECTION. * *================================================================= * BCSVCHA - Alphanumeric and alphabetic COBOL field types. * LRECL: 45 bytes (FB) *================================================================= FD BCSVCHA-FILE RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS. 01 BCSV-CHAR-REC. 05 CHA-ALPHA-X10 PIC X(10). 05 CHA-ALPHA-X20 PIC X(20). 05 CHA-ALPHA-A10 PIC A(10). 05 CHA-STATUS PIC X(4). 88 CHA-STATUS-OPEN VALUE 'OPEN'. 88 CHA-STATUS-CLOS VALUE 'CLOS'. 88 CHA-STATUS-HOLD VALUE 'HOLD'. 05 CHA-FLAG PIC X(1). 88 CHA-FLAG-ON VALUE 'Y'. 88 CHA-FLAG-OFF VALUE 'N'. * *================================================================= * BCSVNMD - Zoned decimal (DISPLAY) numeric field types. * LRECL: 29 bytes (FB) *================================================================= FD BCSVNMD-FILE RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS. 01 BCSV-NUMD-REC. 05 NMD-UINT5 PIC 9(5). 05 NMD-SINT5 PIC S9(5). 05 NMD-UDEC72 PIC 9(7)V9(2). 05 NMD-SDEC72 PIC S9(7)V9(2). 05 NMD-DIGIT PIC 9(1). 88 NMD-DIGIT-ZERO VALUE 0. 88 NMD-DIGIT-ONE VALUE 1. 88 NMD-DIGIT-NINE VALUE 9. * *================================================================= * BCSVPAK - Packed decimal (COMP-3) field types. * LRECL: 26 bytes (FB) * Sizes: 9(5)=3B S9(5)=3B 9(7)V9(2)=5B * S9(7)V9(2)=5B S9(18)=10B *================================================================= FD BCSVPAK-FILE RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS. 01 BCSV-PAKD-REC. 05 PAK-UINT5 PIC 9(5) COMP-3. 05 PAK-SINT5 PIC S9(5) COMP-3. 05 PAK-UDEC72 PIC 9(7)V9(2) COMP-3. 05 PAK-SDEC72 PIC S9(7)V9(2) COMP-3. 05 PAK-SINT18 PIC S9(18) COMP-3. * *================================================================= * BCSVBIN - Binary integer (COMP / COMP-5) field types. * LRECL: 26 bytes (FB) * Layout: 0:S9(4)COMP(2) 2:9(4)COMP(2) 4:S9(9)COMP(4) * 8:9(9)COMP(4) 12:S9(18)COMP(8) * 20:S9(4)COMP-5(2) 22:S9(9)COMP-5(4) *================================================================= FD BCSVBIN-FILE RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS. 01 BCSV-BINY-REC. 05 BIN-SHALF PIC S9(4) COMP SYNC. 05 BIN-UHALF PIC 9(4) COMP SYNC. 05 BIN-SFULL PIC S9(9) COMP SYNC. 05 BIN-UFULL PIC 9(9) COMP SYNC. 05 BIN-SDBL PIC S9(18) COMP. 05 BIN-C5HALF PIC S9(4) COMP-5. 05 BIN-C5FULL PIC S9(9) COMP-5. * *================================================================= * BCSVFLT - IBM HFP floating-point field types. * LRECL: 12 bytes (FB) * Layout: 0:COMP-1(4B) 4:COMP-2(8B) *================================================================= FD BCSVFLT-FILE RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS. 01 BCSV-FLT-REC. 05 FLT-SHORT COMP-1. 05 FLT-LONG COMP-2. * *================================================================= * BCSVOCC - OCCURS fixed-length array field types. * LRECL: 38 bytes (FB) * Layout: OCC-STR(3x8=24B) OCC-INT(4x2=8B) * OCC-PKD(2x3=6B) *================================================================= FD BCSVOCC-FILE RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS. 01 BCSV-OCC-REC. 05 OCC-STR PIC X(8) OCCURS 3. 05 OCC-INT PIC S9(4) COMP OCCURS 4. 05 OCC-PKD PIC S9(5) COMP-3 OCCURS 2. * *================================================================= * BCSVFIL - FILLER field variants. * LRECL: 32 bytes (FB) * Layout: * 0 : FIL-KEY(4) * 4 : FILLER(8) * 12 : FIL-DATA1 COMP-3(5) * 17 : FILLER(3) * 20 : FIL-DATA2(6) * 26 : FILLER(4) * 30 : FIL-FLAG(2) *================================================================= FD BCSVFIL-FILE RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS. 01 BCSV-FILL-REC. 05 FIL-KEY PIC X(4). 05 FILLER PIC X(8). 05 FIL-DATA1 PIC S9(9) COMP-3. 05 FILLER PIC X(3). 05 FIL-DATA2 PIC X(6). 05 FILLER PIC X(4). 05 FIL-FLAG PIC X(2). 88 FIL-FLAG-OK VALUE 'OK'. 88 FIL-FLAG-ER VALUE 'ER'. * *================================================================= * BCSVOVL - REDEFINES overlay: two 01-levels sharing storage. * LRECL: 28 bytes (FB) * TYPE-A: OVL-COMMON(4) OVL-A-TEXT(20) OVL-A-CODE(4) * TYPE-B: OVL-B-KEY(4) OVL-B-INT1(4) OVL-B-INT2(4) * OVL-B-PKD(5) OVL-B-PAD(11) *================================================================= FD BCSVOVL-FILE RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS. 01 BCSV-OVL-TYPE-A. 05 OVL-COMMON PIC X(4). 05 OVL-A-TEXT PIC X(20). 05 OVL-A-CODE PIC 9(4). 01 BCSV-OVL-TYPE-B. 05 OVL-B-KEY PIC X(4). 05 OVL-B-INT1 PIC S9(9) COMP. 05 OVL-B-INT2 PIC S9(9) COMP. 05 OVL-B-PKD PIC S9(7)V9(2) COMP-3. 05 OVL-B-PAD PIC X(11). * *================================================================= * BCSVUNC - National and Unicode character field types (z/OS). * LRECL: 30 bytes (FB) * Layout: UNC-NAT(5x2=10B) UNC-DBCS(4x2=8B) UNC-EXT(12B) * NOTE: PIC U -> PIC X(12); IBM COBOL PIC U size is * version-specific (4B/cp on V6R1, 1B on V6R4+). *================================================================= FD BCSVUNC-FILE RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS. 01 BCSV-UNC-REC. 05 UNC-NAT PIC N(5) USAGE NATIONAL. 05 UNC-DBCS PIC G(4) USAGE DISPLAY-1. 05 UNC-EXT PIC X(12). * *================================================================= * BCIMSLON - IMS DFSURGU0 LONG IBM format (VB). * Data record: 65 bytes (20B prefix + 45B data). * DCB LRECL: 69 bytes (data 65B + 4B RDW). * 20-byte prefix layout: * 0-1 : LL (record length, 2B COMP) * 2-3 : ZZ (reserved, X'0000', 2B COMP) * 4 : PCF (process control flag, 1B) * 5 : PEF (process event flag, 1B) * 6-13 : SEGNAM (segment name, 8B EBCDIC) * 14-15: SEQOFF (sequence field offset, 2B COMP) * 16-17: SEQLEN (sequence field length, 2B COMP) * 18-19: RES (reserved, 2B) * PCF values used in this file: * X'04' = root segment (level 1) * X'00' = end-of-file sentinel record * SEGNAM values (first 8 chars of COBOL 01-level name): * 'BCSV-CHA' -> IMS_BCSV-CHA row (BCSVCHA schema) * 'BCSV-NUM' -> IMS_BCSV-NUM row (BCSVNMD schema) * spaces -> caught by IMS_EOF drain row *================================================================= FD BCIMSLON-FILE RECORDING MODE IS V BLOCK CONTAINS 0 RECORDS. 01 BCIMSLON-REC PIC X(65). * *================================================================= * BCIMSSHR - IMS DFSURGU0 SHORT IBM format (VB). * Data record: 49 bytes maximum (4B prefix + 45B data). * DCB LRECL: 53 bytes (data 49B + 4B RDW). * 4-byte prefix layout: * 0-1 : LL (record length, includes LL+ZZ fields) * 2-3 : ZZ (reserved, X'0000', 2B COMP) * Record types: * 3 x 49-byte: BCSVCHA schema (4B prefix + 45B data) * 3 x 33-byte: BCSVNMD schema (4B prefix + 29B data) * 1 x 4-byte: EOF sentinel (LL=4, ZZ=0, no data) * Discrimination relies on fixlen (no SEGNAM field). *================================================================= FD BCIMSSHR-FILE RECORDING MODE IS V BLOCK CONTAINS 0 RECORDS. 01 BCIMSSHR-CHA-REC PIC X(49). 01 BCIMSSHR-NMD-REC PIC X(33). 01 BCIMSSHR-EOF-REC PIC X(4). * *================================================================= * BCSVDFP - DFP decimal floating-point fields (FB). * LRECL: 28 bytes per record (4+8+16 = 28B). * Record layout: * Offset 0 (4B): DFP32 (IEEE 754-2008 decimal32) * Offset 4 (8B): DFP64 (IEEE 754-2008 decimal64) * Offset 12(16B): DFP128 (IEEE 754-2008 decimal128) * Written as raw bytes; FLOAT-SHORT/LONG/EXTENDED are * not supported in this compiler configuration. *================================================================= FD BCSVDFP-FILE RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS. 01 BCSVDFP-REC PIC X(28). * *================================================================= * BCSVHDU - IMS HD Unload (DFSURGL0) synthetic test file (VB). * DCB LRECL=80 (max payload 76B PARTSEG + 4B RDW). * Records written as raw byte buffers via WRITE FROM. * Three record lengths: 44 (hdr/trl), 76 (PARTSEG), 66 * (SUBPART) -- mirrors the observed on-disk layout of * IBM IMS DFSURGL0 HD Unload files. *================================================================= FD BCSVHDU-FILE RECORDING MODE IS V BLOCK CONTAINS 0 RECORDS. 01 BCSVHDU-HDR-REC PIC X(44). 01 BCSVHDU-PART-REC PIC X(76). 01 BCSVHDU-SUB-REC PIC X(66). * *================================================================= * BCSVDET - PIC X columns whose CONTENT exercises every * type.detect() outcome: * DET-DATE X(8) YYYYMMDD -> TYPE.DATE * DET-INT X(9) digits -> TYPE.INTEGER * DET-FLT X(10) d.dd -> TYPE.FLOAT * DET-STR X(8) letters -> TYPE.STRING * DET-BIN X(4) raw bytes -> TYPE.BINARY * All values are constant in kind across the 3 records * so the per-column detector converges. * LRECL: 39 bytes (FB). *================================================================= FD BCSVDET-FILE RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS. 01 BCSV-DET-REC. 05 DET-DATE PIC X(8). 05 DET-INT PIC X(9). 05 DET-FLT PIC X(10). 05 DET-STR PIC X(8). 05 DET-BIN PIC X(4). * WORKING-STORAGE SECTION. * IMS DFSURGU0 LONG prefix + data buffer (65 bytes total). * MUST NOT use SYNC -- offsets are fixed by the IMS standard. 01 WS-IMS-BUF. 05 WS-IMS-LL PIC S9(4) COMP. 05 WS-IMS-ZZ PIC 9(4) COMP. 05 WS-IMS-PCF PIC X(1). 05 WS-IMS-PEF PIC X(1). 05 WS-IMS-SEGNAM PIC X(8). 05 WS-IMS-SEQOFF PIC S9(4) COMP. 05 WS-IMS-SEQLEN PIC S9(4) COMP. 05 WS-IMS-RES PIC X(2). 05 WS-IMS-DATA PIC X(45). * IMS DFSURGU0 SHORT prefix + BCSVCHA data buffer (49 bytes). * MUST NOT use SYNC -- offsets are fixed by the IMS standard. 01 WS-SHRT-CHA. 05 WS-SHRT-CHA-LL PIC S9(4) COMP. 05 WS-SHRT-CHA-ZZ PIC 9(4) COMP. 05 WS-SHRT-CHA-DATA PIC X(45). * IMS DFSURGU0 SHORT prefix + BCSVNMD data buffer (33 bytes). 01 WS-SHRT-NMD. 05 WS-SHRT-NMD-LL PIC S9(4) COMP. 05 WS-SHRT-NMD-ZZ PIC 9(4) COMP. 05 WS-SHRT-NMD-DATA PIC X(29). * IMS DFSURGU0 SHORT EOF sentinel buffer (4 bytes). 01 WS-SHRT-EOF. 05 WS-SHRT-EOF-LL PIC S9(4) COMP. 05 WS-SHRT-EOF-ZZ PIC 9(4) COMP. * DFP floating-point working buffer - raw byte representation. * FLOAT-SHORT/LONG/EXTENDED are not supported by this compiler. 01 WS-DFP-REC. 05 WS-DFP32 PIC X(4). 05 WS-DFP64 PIC X(8). 05 WS-DFP128 PIC X(16). * HDU (IMS HD Unload / DFSURGL0) buffers. * Header/Trailer (44B): STRUCT-CODE(2) ROOT-LEN(2) DB-KEY(8) * PTR(20) TRL(12). 01 WS-HDU-HDR-BUF. 05 WS-HDU-HDR-CODE PIC X(2). 05 WS-HDU-HDR-ROOTLEN PIC X(2). 05 WS-HDU-HDR-DBKEY PIC X(8). 05 WS-HDU-HDR-PTRS PIC X(20). 05 WS-HDU-HDR-TRL PIC X(12). * PARTSEG (76B): SEG-CODE(2) PRE-LEN(2) ROOT-LEN(2) DB-KEY(8) * PTR(20) MARKER(2) PAYLOAD(40). 01 WS-HDU-PART-BUF. 05 WS-HDU-PART-CODE PIC X(2). 05 WS-HDU-PART-PRELEN PIC X(2). 05 WS-HDU-PART-ROOTLEN PIC X(2). 05 WS-HDU-PART-DBKEY PIC X(8). 05 WS-HDU-PART-PTRS PIC X(20). 05 WS-HDU-PART-MARKER PIC X(2). 05 WS-HDU-PART-DATA. 10 WS-HDU-PART-NAME PIC X(20). 10 WS-HDU-PART-DEPT PIC X(10). 10 WS-HDU-PART-ID PIC 9(6). 10 WS-HDU-PART-FLAGS PIC X(4). * SUBPART (66B): SEG-CODE(2) PRE-LEN(2) ROOT-LEN(2) DB-KEY(8) * PTR(20) MARKER(2) PAYLOAD(30). 01 WS-HDU-SUB-BUF. 05 WS-HDU-SUB-CODE PIC X(2). 05 WS-HDU-SUB-PRELEN PIC X(2). 05 WS-HDU-SUB-ROOTLEN PIC X(2). 05 WS-HDU-SUB-DBKEY PIC X(8). 05 WS-HDU-SUB-PTRS PIC X(20). 05 WS-HDU-SUB-MARKER PIC X(2). 05 WS-HDU-SUB-DATA. 10 WS-HDU-SUB-NAME PIC X(20). 10 WS-HDU-SUB-QTY PIC 9(6). 10 WS-HDU-SUB-FLAG PIC X(4). * PROCEDURE DIVISION. MAIN-PARA. DISPLAY 'BCSVGEN: opening output files'. OPEN OUTPUT BCSVCHA-FILE BCSVNMD-FILE BCSVPAK-FILE BCSVBIN-FILE BCSVFLT-FILE BCSVOCC-FILE BCSVFIL-FILE BCSVOVL-FILE BCSVUNC-FILE BCIMSLON-FILE BCIMSSHR-FILE BCSVDFP-FILE BCSVHDU-FILE BCSVDET-FILE. PERFORM WRITE-CHAR-RECS. PERFORM WRITE-NUMD-RECS. PERFORM WRITE-PAKD-RECS. PERFORM WRITE-BINY-RECS. PERFORM WRITE-FLT-RECS. PERFORM WRITE-OCC-RECS. PERFORM WRITE-FILL-RECS. PERFORM WRITE-OVL-RECS. PERFORM WRITE-UNC-RECS. PERFORM WRITE-IMS-RECS. PERFORM WRITE-IMS-SHRT-RECS. PERFORM WRITE-DFP-RECS. PERFORM WRITE-HDU-RECS. PERFORM WRITE-DET-RECS. CLOSE BCSVCHA-FILE BCSVNMD-FILE BCSVPAK-FILE BCSVBIN-FILE BCSVFLT-FILE BCSVOCC-FILE BCSVFIL-FILE BCSVOVL-FILE BCSVUNC-FILE BCIMSLON-FILE BCIMSSHR-FILE BCSVDFP-FILE BCSVHDU-FILE BCSVDET-FILE. DISPLAY 'BCSVGEN: complete - 14 files written'. STOP RUN. * *------------------------------------------------------------ * WRITE-CHAR-RECS * Three BCSV-CHAR-REC records (LRECL=45). * Covers: PIC X, PIC A, 88-level conditions. *------------------------------------------------------------ WRITE-CHAR-RECS. * Record 1: typical alpha values, STATUS=OPEN, FLAG=ON MOVE SPACES TO BCSV-CHAR-REC. MOVE 'ABCDEFGHIJ' TO CHA-ALPHA-X10. MOVE 'KLMNOPQRSTUVWXYZAB' TO CHA-ALPHA-X20. MOVE 'ALPHABETIC' TO CHA-ALPHA-A10. SET CHA-STATUS-OPEN TO TRUE. SET CHA-FLAG-ON TO TRUE. WRITE BCSV-CHAR-REC. * Record 2: digit string, STATUS=CLOSED, FLAG=OFF MOVE SPACES TO BCSV-CHAR-REC. MOVE '0123456789' TO CHA-ALPHA-X10. MOVE 'TRAILING SPACES ' TO CHA-ALPHA-X20. MOVE 'ABCDEFGHIJ' TO CHA-ALPHA-A10. SET CHA-STATUS-CLOS TO TRUE. SET CHA-FLAG-OFF TO TRUE. WRITE BCSV-CHAR-REC. * Record 3: spaces in X10, STATUS=HOLD, FLAG=ON MOVE SPACES TO BCSV-CHAR-REC. MOVE 'LAST ' TO CHA-ALPHA-X10. MOVE 'TWENTIETH RECORD ' TO CHA-ALPHA-X20. MOVE 'ZZZZZZZZZZ' TO CHA-ALPHA-A10. SET CHA-STATUS-HOLD TO TRUE. SET CHA-FLAG-ON TO TRUE. WRITE BCSV-CHAR-REC. DISPLAY 'BCSVGEN: BCSVCHA 3 records written'. * *------------------------------------------------------------ * WRITE-NUMD-RECS * Three BCSV-NUMD-REC records (LRECL=29). * Covers: unsigned/signed PIC 9, PIC 9Vp, PIC S9Vp, * 88-level on a numeric field. *------------------------------------------------------------ WRITE-NUMD-RECS. * Record 1: small positive values MOVE 1 TO NMD-UINT5. MOVE 1 TO NMD-SINT5. MOVE 1.01 TO NMD-UDEC72. MOVE 1.01 TO NMD-SDEC72. SET NMD-DIGIT-ONE TO TRUE. WRITE BCSV-NUMD-REC. * Record 2: typical values, signed negative MOVE 12345 TO NMD-UINT5. MOVE -12345 TO NMD-SINT5. MOVE 1234567.89 TO NMD-UDEC72. MOVE -1234567.89 TO NMD-SDEC72. MOVE 5 TO NMD-DIGIT. WRITE BCSV-NUMD-REC. * Record 3: maximum values MOVE 99999 TO NMD-UINT5. MOVE 99999 TO NMD-SINT5. MOVE 9999999.99 TO NMD-UDEC72. MOVE 9999999.99 TO NMD-SDEC72. SET NMD-DIGIT-NINE TO TRUE. WRITE BCSV-NUMD-REC. DISPLAY 'BCSVGEN: BCSVNMD 3 records written'. * *------------------------------------------------------------ * WRITE-PAKD-RECS * Three BCSV-PAKD-REC records (LRECL=26). * Covers: unsigned/signed COMP-3, with/without fraction, * maximum 18-digit packed field. *------------------------------------------------------------ WRITE-PAKD-RECS. * Record 1: all zeros MOVE 0 TO PAK-UINT5 PAK-SINT5 PAK-UDEC72 PAK-SDEC72 PAK-SINT18. WRITE BCSV-PAKD-REC. * Record 2: typical values, signed negative MOVE 12345 TO PAK-UINT5. MOVE -12345 TO PAK-SINT5. MOVE 1234567.89 TO PAK-UDEC72. MOVE -1234567.89 TO PAK-SDEC72. MOVE -123456789012345678 TO PAK-SINT18. WRITE BCSV-PAKD-REC. * Record 3: maximum values MOVE 99999 TO PAK-UINT5. MOVE 99999 TO PAK-SINT5. MOVE 9999999.99 TO PAK-UDEC72. MOVE 9999999.99 TO PAK-SDEC72. MOVE 999999999999999999 TO PAK-SINT18. WRITE BCSV-PAKD-REC. DISPLAY 'BCSVGEN: BCSVPAK 3 records written'. * *------------------------------------------------------------ * WRITE-BINY-RECS * Three BCSV-BINY-REC records (LRECL=26). * Covers: COMP halfword/fullword/doubleword, COMP-5. * NOTE: BIN-SDBL has no SYNC to avoid implicit padding * that the FMT2TAB Wave-1 schema compiler does not * compute; all fields are therefore tightly packed. *------------------------------------------------------------ WRITE-BINY-RECS. * Record 1: all zeros MOVE 0 TO BIN-SHALF BIN-UHALF BIN-SFULL BIN-UFULL BIN-SDBL BIN-C5HALF BIN-C5FULL. WRITE BCSV-BINY-REC. * Record 2: mixed signed / unsigned values MOVE -1234 TO BIN-SHALF. MOVE 5678 TO BIN-UHALF. MOVE -123456789 TO BIN-SFULL. MOVE 987654321 TO BIN-UFULL. MOVE -12345678901234 TO BIN-SDBL. MOVE -1000 TO BIN-C5HALF. MOVE 1000000 TO BIN-C5FULL. WRITE BCSV-BINY-REC. * Record 3: maximum values for each PIC size MOVE 9999 TO BIN-SHALF. MOVE 9999 TO BIN-UHALF. MOVE 999999999 TO BIN-SFULL. MOVE 999999999 TO BIN-UFULL. MOVE 999999999999999999 TO BIN-SDBL. MOVE 9999 TO BIN-C5HALF. MOVE 999999999 TO BIN-C5FULL. WRITE BCSV-BINY-REC. DISPLAY 'BCSVGEN: BCSVBIN 3 records written'. * *------------------------------------------------------------ * WRITE-FLT-RECS * Three BCSV-FLT-REC records (LRECL=12). * Covers: COMP-1 (4-byte IBM HFP) and * COMP-2 (8-byte IBM HFP). *------------------------------------------------------------ WRITE-FLT-RECS. * Record 1: zero values MOVE 0.0 TO FLT-SHORT FLT-LONG. WRITE BCSV-FLT-REC. * Record 2: positive float values (pi-like) MOVE 1.5 TO FLT-SHORT. MOVE 3.14159265358979 TO FLT-LONG. WRITE BCSV-FLT-REC. * Record 3: negative float values (e-like) MOVE -1.5 TO FLT-SHORT. MOVE -2.71828182845905 TO FLT-LONG. WRITE BCSV-FLT-REC. DISPLAY 'BCSVGEN: BCSVFLT 3 records written'. * *------------------------------------------------------------ * WRITE-OCC-RECS * Three BCSV-OCC-REC records (LRECL=38). * Covers: OCCURS on PIC X, PIC S9 COMP, PIC S9 COMP-3. *------------------------------------------------------------ WRITE-OCC-RECS. * Record 1: named strings, ascending integers MOVE SPACES TO BCSV-OCC-REC. MOVE 'FIRST ' TO OCC-STR(1). MOVE 'SECOND ' TO OCC-STR(2). MOVE 'THIRD ' TO OCC-STR(3). MOVE 1 TO OCC-INT(1). MOVE 2 TO OCC-INT(2). MOVE 3 TO OCC-INT(3). MOVE 4 TO OCC-INT(4). MOVE 11111 TO OCC-PKD(1). MOVE -22222 TO OCC-PKD(2). WRITE BCSV-OCC-REC. * Record 2: padded letter arrays, hundreds MOVE SPACES TO BCSV-OCC-REC. MOVE 'AAAAAAAA' TO OCC-STR(1). MOVE 'BBBBBBBB' TO OCC-STR(2). MOVE 'CCCCCCCC' TO OCC-STR(3). MOVE 100 TO OCC-INT(1). MOVE 200 TO OCC-INT(2). MOVE 300 TO OCC-INT(3). MOVE 400 TO OCC-INT(4). MOVE 0 TO OCC-PKD(1) OCC-PKD(2). WRITE BCSV-OCC-REC. * Record 3: indexed strings, negative integers, max packed MOVE SPACES TO BCSV-OCC-REC. MOVE 'XXXX0001' TO OCC-STR(1). MOVE 'XXXX0002' TO OCC-STR(2). MOVE 'XXXX0003' TO OCC-STR(3). MOVE -1 TO OCC-INT(1). MOVE -2 TO OCC-INT(2). MOVE -3 TO OCC-INT(3). MOVE -4 TO OCC-INT(4). MOVE 99999 TO OCC-PKD(1). MOVE -99999 TO OCC-PKD(2). WRITE BCSV-OCC-REC. DISPLAY 'BCSVGEN: BCSVOCC 3 records written'. * *------------------------------------------------------------ * WRITE-FILL-RECS * Three BCSV-FILL-REC records (LRECL=32). * The three explicit FILLER areas are initialized to * EBCDIC spaces (X'40') via MOVE SPACES to the whole * record, giving predictable values for FILLER=COLUMN * mode. The same binary file is used for all three * filler mode tests (COLUMN / SKIP / ALIGN). *------------------------------------------------------------ WRITE-FILL-RECS. * Record 1: negative FIL-DATA1, FLAG=OK MOVE SPACES TO BCSV-FILL-REC. MOVE 'KEY1' TO FIL-KEY. MOVE -12345678 TO FIL-DATA1. MOVE 'ABCDEF' TO FIL-DATA2. SET FIL-FLAG-OK TO TRUE. WRITE BCSV-FILL-REC. * Record 2: zero FIL-DATA1, FLAG=ERROR MOVE SPACES TO BCSV-FILL-REC. MOVE 'KEY2' TO FIL-KEY. MOVE 0 TO FIL-DATA1. MOVE 'UVWXYZ' TO FIL-DATA2. SET FIL-FLAG-ER TO TRUE. WRITE BCSV-FILL-REC. * Record 3: maximum FIL-DATA1, FLAG=OK MOVE SPACES TO BCSV-FILL-REC. MOVE 'KEY3' TO FIL-KEY. MOVE 99999999 TO FIL-DATA1. MOVE '123456' TO FIL-DATA2. SET FIL-FLAG-OK TO TRUE. WRITE BCSV-FILL-REC. DISPLAY 'BCSVGEN: BCSVFIL 3 records written'. * *------------------------------------------------------------ * WRITE-OVL-RECS * Six BCSV-OVL records (LRECL=28), grouped by TYPE: * three TYPE-A records first, then three TYPE-B records. * Grouped order (TYPA,TYPA,TYPA,TYPB,TYPB,TYPB) improves * FIXDET 2-distinct discriminator detection: * - Each group has >= 3 records for reliable subgroup scan * - TYPE-A text payloads start with different letters * (A-, K-, U-) so FIXDET sees no shared byte prefix and * classifies OVL-A-TEXT as type.string(IBM-1047) * - TYPE-B binary payloads are clearly distinct from the * printable EBCDIC text in TYPE-A records * NOTE: TST.IDAT.BCSVOVL.F28.bin must be regenerated on * z/OS after this change (BCSVGEN compile + run). * Both TYPE-A and TYPE-B share storage; only TYPE-A is * named in the WRITE statement since it is the base record. *------------------------------------------------------------ WRITE-OVL-RECS. * Record 1: TYPE-A (starts with A-range text) MOVE SPACES TO BCSV-OVL-TYPE-A. MOVE 'TYPA' TO OVL-COMMON. MOVE 'ABCDEFGHIJKLMNOABC ' TO OVL-A-TEXT. MOVE 1001 TO OVL-A-CODE. WRITE BCSV-OVL-TYPE-A. * Record 2: TYPE-A (starts with K-range text) MOVE SPACES TO BCSV-OVL-TYPE-A. MOVE 'TYPA' TO OVL-COMMON. MOVE 'KLMNOPQRSTKLMNOPQRS ' TO OVL-A-TEXT. MOVE 2002 TO OVL-A-CODE. WRITE BCSV-OVL-TYPE-A. * Record 3: TYPE-A (starts with U-range text) MOVE SPACES TO BCSV-OVL-TYPE-A. MOVE 'TYPA' TO OVL-COMMON. MOVE 'UVWXYZABCUVWXYZABC ' TO OVL-A-TEXT. MOVE 3003 TO OVL-A-CODE. WRITE BCSV-OVL-TYPE-A. * Record 4: TYPE-B (first numeric record) MOVE SPACES TO BCSV-OVL-TYPE-A. MOVE 'TYPB' TO OVL-B-KEY. MOVE 100000001 TO OVL-B-INT1. MOVE -200000002 TO OVL-B-INT2. MOVE 1234567.89 TO OVL-B-PKD. WRITE BCSV-OVL-TYPE-A. * Record 5: TYPE-B (second numeric record) MOVE SPACES TO BCSV-OVL-TYPE-A. MOVE 'TYPB' TO OVL-B-KEY. MOVE 555555555 TO OVL-B-INT1. MOVE -666666666 TO OVL-B-INT2. MOVE 5555555.55 TO OVL-B-PKD. WRITE BCSV-OVL-TYPE-A. * Record 6: TYPE-B (third numeric record) MOVE SPACES TO BCSV-OVL-TYPE-A. MOVE 'TYPB' TO OVL-B-KEY. MOVE 999999999 TO OVL-B-INT1. MOVE -999999999 TO OVL-B-INT2. MOVE 9999999.99 TO OVL-B-PKD. WRITE BCSV-OVL-TYPE-A. DISPLAY 'BCSVGEN: BCSVOVL 6 records written'. * *------------------------------------------------------------ * WRITE-UNC-RECS * Two BCSV-UNC-REC records (LRECL=30). * Covers: PIC N NATIONAL (UCS-2, 2B/char), * PIC G DISPLAY-1 (DBCS, 2B/char, no SO/SI), * PIC X extension field (12B, EBCDIC raw bytes). * NOTE: PIC U(12) replaced by PIC X(12) (UNC-EXT) because IBM * Enterprise COBOL PIC U storage size is version-specific: * 4B/code-point on V6R1, 1B/code-point on V6R4+. * The DBCS field (UNC-DBCS) is left as LOW-VALUES. * Compiler options required: NSYMBOL(NATIONAL), DBCS. *------------------------------------------------------------ WRITE-UNC-RECS. * Record 1 MOVE LOW-VALUES TO BCSV-UNC-REC. MOVE N'HELLO' TO UNC-NAT. MOVE X'48656C6C6F20202020202020' TO UNC-EXT. WRITE BCSV-UNC-REC. * Record 2 MOVE LOW-VALUES TO BCSV-UNC-REC. MOVE N'WORLD' TO UNC-NAT. MOVE X'576F726C6420202020202020' TO UNC-EXT. WRITE BCSV-UNC-REC. DISPLAY 'BCSVGEN: BCSVUNC 2 records written'. * *------------------------------------------------------------ * WRITE-IMS-RECS * IMS DFSURGU0 LONG IBM format records (LRECL=65 VB). * 3 records with SEGNAM='BCSV-CHA' (BCSVCHA schema data). * 3 records with SEGNAM='BCSV-NUM' (BCSVNMD schema data). * 1 EOF sentinel record with PCF=X'00', SEGNAM=spaces. * * SEGNAM is the first 8 bytes of the COBOL 01-level name; * FMT2TAB IMS mode generates the matching regexp from the * same truncation rule. The IMS_EOF drain row (last in * ENDOFT) catches all records that match no data row spec. * * LL is set to 65 for all records (max logical length). * For NUMD records the data area is padded with spaces * to fill the remaining 16 bytes after the 29-byte payload. * FMT2TAB reads only the declared column bytes from each * record; trailing padding bytes are silently ignored. *------------------------------------------------------------ WRITE-IMS-RECS. * Initialize constant prefix fields MOVE ZEROS TO WS-IMS-ZZ WS-IMS-SEQOFF WS-IMS-SEQLEN. MOVE LOW-VALUES TO WS-IMS-PEF WS-IMS-RES. * * ---- 3 x IMS_BCSV-CHA records (BCSVCHA schema data) ---- MOVE 65 TO WS-IMS-LL. MOVE X'04' TO WS-IMS-PCF. MOVE 'BCSV-CHA' TO WS-IMS-SEGNAM. * Record 1: typical alpha values MOVE SPACES TO BCSV-CHAR-REC. MOVE 'ABCDEFGHIJ' TO CHA-ALPHA-X10. MOVE 'KLMNOPQRSTUVWXYZAB' TO CHA-ALPHA-X20. MOVE 'ALPHABETIC' TO CHA-ALPHA-A10. SET CHA-STATUS-OPEN TO TRUE. SET CHA-FLAG-ON TO TRUE. MOVE BCSV-CHAR-REC TO WS-IMS-DATA. WRITE BCIMSLON-REC FROM WS-IMS-BUF. * Record 2: digit string, STATUS=CLOSED, FLAG=OFF MOVE SPACES TO BCSV-CHAR-REC. MOVE '0123456789' TO CHA-ALPHA-X10. MOVE 'TRAILING SPACES ' TO CHA-ALPHA-X20. MOVE 'ABCDEFGHIJ' TO CHA-ALPHA-A10. SET CHA-STATUS-CLOS TO TRUE. SET CHA-FLAG-OFF TO TRUE. MOVE BCSV-CHAR-REC TO WS-IMS-DATA. WRITE BCIMSLON-REC FROM WS-IMS-BUF. * Record 3: STATUS=HOLD, FLAG=ON MOVE SPACES TO BCSV-CHAR-REC. MOVE 'LAST ' TO CHA-ALPHA-X10. MOVE 'TWENTIETH RECORD ' TO CHA-ALPHA-X20. MOVE 'ZZZZZZZZZZ' TO CHA-ALPHA-A10. SET CHA-STATUS-HOLD TO TRUE. SET CHA-FLAG-ON TO TRUE. MOVE BCSV-CHAR-REC TO WS-IMS-DATA. WRITE BCIMSLON-REC FROM WS-IMS-BUF. DISPLAY 'BCSVGEN: BCIMSLON 3 BCSV-CHA records written'. * * ---- 3 x IMS_BCSV-NUM records (BCSVNMD schema data) ---- * (29-byte NUMD payload; WS-IMS-DATA(30:16) remains spaces) MOVE 65 TO WS-IMS-LL. MOVE 'BCSV-NUM' TO WS-IMS-SEGNAM. MOVE SPACES TO WS-IMS-DATA. * Record 1: small positive values MOVE 1 TO NMD-UINT5. MOVE 1 TO NMD-SINT5. MOVE 1.01 TO NMD-UDEC72. MOVE 1.01 TO NMD-SDEC72. SET NMD-DIGIT-ONE TO TRUE. MOVE BCSV-NUMD-REC TO WS-IMS-DATA. WRITE BCIMSLON-REC FROM WS-IMS-BUF. * Record 2: typical values, signed negative MOVE 12345 TO NMD-UINT5. MOVE -12345 TO NMD-SINT5. MOVE 1234567.89 TO NMD-UDEC72. MOVE -1234567.89 TO NMD-SDEC72. MOVE 5 TO NMD-DIGIT. MOVE BCSV-NUMD-REC TO WS-IMS-DATA. WRITE BCIMSLON-REC FROM WS-IMS-BUF. * Record 3: maximum values MOVE 99999 TO NMD-UINT5. MOVE 99999 TO NMD-SINT5. MOVE 9999999.99 TO NMD-UDEC72. MOVE 9999999.99 TO NMD-SDEC72. SET NMD-DIGIT-NINE TO TRUE. MOVE BCSV-NUMD-REC TO WS-IMS-DATA. WRITE BCIMSLON-REC FROM WS-IMS-BUF. DISPLAY 'BCSVGEN: BCIMSLON 3 BCSV-NUM records written'. * * ---- 1 x IMS EOF sentinel record (PCF=X'00') ----------- * No data rows match this record; IMS_EOF drain catches it. MOVE 65 TO WS-IMS-LL. MOVE X'00' TO WS-IMS-PCF. MOVE SPACES TO WS-IMS-SEGNAM. MOVE SPACES TO WS-IMS-DATA. WRITE BCIMSLON-REC FROM WS-IMS-BUF. DISPLAY 'BCSVGEN: BCIMSLON 1 EOF record written'. * *------------------------------------------------------------ * WRITE-IMS-SHRT-RECS * IMS DFSURGU0 SHORT IBM format records (VB, LRECL=49). * 3 x 49-byte: BCSVCHA schema data (4B prefix + 45B payload). * 3 x 33-byte: BCSVNMD schema data (4B prefix + 29B payload). * 1 x 4-byte: EOF sentinel (LL=4, ZZ=0, no data payload). * * Because SHORT format carries no SEGNAM field, row specs are * discriminated by fixlen only. The IMS_EOF drain row catches * the 4-byte sentinel (no data row has fixlen=4). *------------------------------------------------------------ WRITE-IMS-SHRT-RECS. * Initialize constant prefix fields for both data buffers MOVE ZEROS TO WS-SHRT-CHA-ZZ WS-SHRT-NMD-ZZ WS-SHRT-EOF-ZZ. * * ---- 3 x 49-byte records (BCSVCHA schema, LL=49) ---- MOVE 49 TO WS-SHRT-CHA-LL. * Record 1: typical alpha values MOVE SPACES TO BCSV-CHAR-REC. MOVE 'ABCDEFGHIJ' TO CHA-ALPHA-X10. MOVE 'KLMNOPQRSTUVWXYZAB' TO CHA-ALPHA-X20. MOVE 'ALPHABETIC' TO CHA-ALPHA-A10. SET CHA-STATUS-OPEN TO TRUE. SET CHA-FLAG-ON TO TRUE. MOVE BCSV-CHAR-REC TO WS-SHRT-CHA-DATA. WRITE BCIMSSHR-CHA-REC FROM WS-SHRT-CHA. * Record 2: digit string, STATUS=CLOSED, FLAG=OFF MOVE SPACES TO BCSV-CHAR-REC. MOVE '0123456789' TO CHA-ALPHA-X10. MOVE 'TRAILING SPACES ' TO CHA-ALPHA-X20. MOVE 'ABCDEFGHIJ' TO CHA-ALPHA-A10. SET CHA-STATUS-CLOS TO TRUE. SET CHA-FLAG-OFF TO TRUE. MOVE BCSV-CHAR-REC TO WS-SHRT-CHA-DATA. WRITE BCIMSSHR-CHA-REC FROM WS-SHRT-CHA. * Record 3: STATUS=HOLD, FLAG=ON MOVE SPACES TO BCSV-CHAR-REC. MOVE 'LAST ' TO CHA-ALPHA-X10. MOVE 'TWENTIETH RECORD ' TO CHA-ALPHA-X20. MOVE 'ZZZZZZZZZZ' TO CHA-ALPHA-A10. SET CHA-STATUS-HOLD TO TRUE. SET CHA-FLAG-ON TO TRUE. MOVE BCSV-CHAR-REC TO WS-SHRT-CHA-DATA. WRITE BCIMSSHR-CHA-REC FROM WS-SHRT-CHA. DISPLAY 'BCSVGEN: BCIMSSHR 3 BCSVCHA records written'. * * ---- 3 x 33-byte records (BCSVNMD schema, LL=33) ---- MOVE 33 TO WS-SHRT-NMD-LL. * Record 1: small positive values MOVE 1 TO NMD-UINT5. MOVE 1 TO NMD-SINT5. MOVE 1.01 TO NMD-UDEC72. MOVE 1.01 TO NMD-SDEC72. SET NMD-DIGIT-ONE TO TRUE. MOVE BCSV-NUMD-REC TO WS-SHRT-NMD-DATA. WRITE BCIMSSHR-NMD-REC FROM WS-SHRT-NMD. * Record 2: typical values, signed negative MOVE 12345 TO NMD-UINT5. MOVE -12345 TO NMD-SINT5. MOVE 1234567.89 TO NMD-UDEC72. MOVE -1234567.89 TO NMD-SDEC72. MOVE 5 TO NMD-DIGIT. MOVE BCSV-NUMD-REC TO WS-SHRT-NMD-DATA. WRITE BCIMSSHR-NMD-REC FROM WS-SHRT-NMD. * Record 3: maximum values MOVE 99999 TO NMD-UINT5. MOVE 99999 TO NMD-SINT5. MOVE 9999999.99 TO NMD-UDEC72. MOVE 9999999.99 TO NMD-SDEC72. SET NMD-DIGIT-NINE TO TRUE. MOVE BCSV-NUMD-REC TO WS-SHRT-NMD-DATA. WRITE BCIMSSHR-NMD-REC FROM WS-SHRT-NMD. DISPLAY 'BCSVGEN: BCIMSSHR 3 BCSVNMD records written'. * * ---- 1 x EOF sentinel (4 bytes, LL=4) ---- * No data row has fixlen=4; IMS_EOF drain catches it. MOVE 4 TO WS-SHRT-EOF-LL. WRITE BCIMSSHR-EOF-REC FROM WS-SHRT-EOF. DISPLAY 'BCSVGEN: BCIMSSHR 1 EOF record written'. * *------------------------------------------------------------ * WRITE-DFP-RECS * * Writes 3 records to BCSVDFP (FB LRECL=28). * Each record contains raw IEEE 754-2008 DPD-encoded bytes: * Offset 0 ( 4B): DFP32 (decimal32, 7 significant digits) * Offset 4 ( 8B): DFP64 (decimal64, 16 significant digits) * Offset 12 (16B): DFP128 (decimal128,34 significant digits) * * Record 1: +0 (positive zero, canonical encoding) * Record 2: +1.5 (coefficient=15, exponent=-1) * Record 3: -9.9 (coefficient=99, exponent=-1, sign=1) *------------------------------------------------------------ WRITE-DFP-RECS. * Record 1: DFP positive zero (DPD canonical encoding) * DFP32 +0 = X'22500000' * DFP64 +0 = X'2238000000000000' * DFP128 +0 = X'22080000000000000000000000000000' MOVE X'22500000' TO WS-DFP32. MOVE X'2238000000000000' TO WS-DFP64. MOVE X'22080000000000000000000000000000' TO WS-DFP128. WRITE BCSVDFP-REC FROM WS-DFP-REC. * Record 2: +1.5 = +15 x 10 hoch (-1) * DFP32 +1.5 = X'22400015' * DFP64 +1.5 = X'2234000000000015' * DFP128 +1.5 = X'2207C000000000000000000000000015' MOVE X'22400015' TO WS-DFP32. MOVE X'2234000000000015' TO WS-DFP64. MOVE X'2207C000000000000000000000000015' TO WS-DFP128. WRITE BCSVDFP-REC FROM WS-DFP-REC. * Record 3: -9.9 = -99 x 10 hoch (-1) * DFP32 -9.9 = X'A240021F' * DFP64 -9.9 = X'A23400000000021F' * DFP128 -9.9 = X'A207C00000000000000000000000021F' MOVE X'A240021F' TO WS-DFP32. MOVE X'A23400000000021F' TO WS-DFP64. MOVE X'A207C00000000000000000000000021F' TO WS-DFP128. WRITE BCSVDFP-REC FROM WS-DFP-REC. DISPLAY 'BCSVGEN: BCSVDFP 3 DFP records written'. * *------------------------------------------------------------ * WRITE-HDU-RECS * IMS HD Unload (DFSURGL0) synthetic file: 22 records. * 1 x Header (LL=48, STRUCT-CODE=X'0080') * 10 x PARTSEG (LL=80, SEG-CODE=X'0180') * 10 x SUBPART (LL=70, SEG-CODE=X'0280') * 1 x Trailer (LL=48, STRUCT-CODE=X'0098') * All data records share DB-KEY='PARTS001', SEG-PRE-LEN=X'0023', * ROOT-KEY-LEN=X'0028'. Payloads mirror the observed layout of * Paolo's customer sample IVPDB1.bin. *------------------------------------------------------------ WRITE-HDU-RECS. * Preset common prefix fields shared by all data records. MOVE LOW-VALUES TO WS-HDU-PART-PTRS WS-HDU-SUB-PTRS. MOVE 'PARTS001' TO WS-HDU-PART-DBKEY WS-HDU-SUB-DBKEY. MOVE X'0023' TO WS-HDU-PART-PRELEN WS-HDU-SUB-PRELEN. MOVE X'0028' TO WS-HDU-PART-ROOTLEN WS-HDU-SUB-ROOTLEN. * Header (STRUCT-CODE X'0080', 44B payload) MOVE LOW-VALUES TO WS-HDU-HDR-BUF. MOVE X'0080' TO WS-HDU-HDR-CODE. MOVE X'0028' TO WS-HDU-HDR-ROOTLEN. MOVE 'PARTS001' TO WS-HDU-HDR-DBKEY. WRITE BCSVHDU-HDR-REC FROM WS-HDU-HDR-BUF. * 10 PARTSEG records (SEG-CODE X'0180', 76B payload) MOVE X'0180' TO WS-HDU-PART-CODE. * Record 1 MOVE X'1001' TO WS-HDU-PART-MARKER. MOVE 'FUETTERER MARTIN ' TO WS-HDU-PART-NAME. MOVE 'IMS DB/DC ' TO WS-HDU-PART-DEPT. MOVE 571341 TO WS-HDU-PART-ID. MOVE 'A ' TO WS-HDU-PART-FLAGS. WRITE BCSVHDU-PART-REC FROM WS-HDU-PART-BUF. * Record 2 MOVE X'1002' TO WS-HDU-PART-MARKER. MOVE 'HOGNGENP MARTIN ' TO WS-HDU-PART-NAME. MOVE 'IMS DB/DC ' TO WS-HDU-PART-DEPT. MOVE 571349 TO WS-HDU-PART-ID. MOVE 'A ' TO WS-HDU-PART-FLAGS. WRITE BCSVHDU-PART-REC FROM WS-HDU-PART-BUF. * Record 3 MOVE X'1003' TO WS-HDU-PART-MARKER. MOVE 'LAST1 FIRST1 ' TO WS-HDU-PART-NAME. MOVE 'DEPT01 ' TO WS-HDU-PART-DEPT. MOVE 100001 TO WS-HDU-PART-ID. MOVE 'B ' TO WS-HDU-PART-FLAGS. WRITE BCSVHDU-PART-REC FROM WS-HDU-PART-BUF. * Record 4 MOVE X'1004' TO WS-HDU-PART-MARKER. MOVE 'LAST2 FIRST2 ' TO WS-HDU-PART-NAME. MOVE 'DEPT02 ' TO WS-HDU-PART-DEPT. MOVE 100002 TO WS-HDU-PART-ID. MOVE 'B ' TO WS-HDU-PART-FLAGS. WRITE BCSVHDU-PART-REC FROM WS-HDU-PART-BUF. * Record 5 MOVE X'1005' TO WS-HDU-PART-MARKER. MOVE 'LAST3 FIRST3 ' TO WS-HDU-PART-NAME. MOVE 'DEPT03 ' TO WS-HDU-PART-DEPT. MOVE 100003 TO WS-HDU-PART-ID. MOVE 'C ' TO WS-HDU-PART-FLAGS. WRITE BCSVHDU-PART-REC FROM WS-HDU-PART-BUF. * Record 6 MOVE X'1006' TO WS-HDU-PART-MARKER. MOVE 'PROP1 PROPA ' TO WS-HDU-PART-NAME. MOVE 'DEPT04 ' TO WS-HDU-PART-DEPT. MOVE 100004 TO WS-HDU-PART-ID. MOVE 'C ' TO WS-HDU-PART-FLAGS. WRITE BCSVHDU-PART-REC FROM WS-HDU-PART-BUF. * Record 7 MOVE X'1007' TO WS-HDU-PART-MARKER. MOVE 'RECOV1 RECOVERY ' TO WS-HDU-PART-NAME. MOVE 'DEPT05 ' TO WS-HDU-PART-DEPT. MOVE 100005 TO WS-HDU-PART-ID. MOVE 'D ' TO WS-HDU-PART-FLAGS. WRITE BCSVHDU-PART-REC FROM WS-HDU-PART-BUF. * Record 8 MOVE X'1008' TO WS-HDU-PART-MARKER. MOVE 'TEST01 TEST ' TO WS-HDU-PART-NAME. MOVE 'DEPT06 ' TO WS-HDU-PART-DEPT. MOVE 100006 TO WS-HDU-PART-ID. MOVE 'D ' TO WS-HDU-PART-FLAGS. WRITE BCSVHDU-PART-REC FROM WS-HDU-PART-BUF. * Record 9 MOVE X'1009' TO WS-HDU-PART-MARKER. MOVE 'TEST1 TESTER ' TO WS-HDU-PART-NAME. MOVE 'DEPT07 ' TO WS-HDU-PART-DEPT. MOVE 100007 TO WS-HDU-PART-ID. MOVE 'E ' TO WS-HDU-PART-FLAGS. WRITE BCSVHDU-PART-REC FROM WS-HDU-PART-BUF. * Record 10 MOVE X'100A' TO WS-HDU-PART-MARKER. MOVE 'IMSEX EXAMPLE ' TO WS-HDU-PART-NAME. MOVE 'DEPT08 ' TO WS-HDU-PART-DEPT. MOVE 100008 TO WS-HDU-PART-ID. MOVE 'E ' TO WS-HDU-PART-FLAGS. WRITE BCSVHDU-PART-REC FROM WS-HDU-PART-BUF. * 10 SUBPART records (SEG-CODE X'0280', 66B payload) MOVE X'0280' TO WS-HDU-SUB-CODE. * Record 1 MOVE X'2001' TO WS-HDU-SUB-MARKER. MOVE 'SCREW M4 ' TO WS-HDU-SUB-NAME. MOVE 000100 TO WS-HDU-SUB-QTY. MOVE 'OK ' TO WS-HDU-SUB-FLAG. WRITE BCSVHDU-SUB-REC FROM WS-HDU-SUB-BUF. * Record 2 MOVE X'2002' TO WS-HDU-SUB-MARKER. MOVE 'SCREW M5 ' TO WS-HDU-SUB-NAME. MOVE 000200 TO WS-HDU-SUB-QTY. MOVE 'OK ' TO WS-HDU-SUB-FLAG. WRITE BCSVHDU-SUB-REC FROM WS-HDU-SUB-BUF. * Record 3 MOVE X'2003' TO WS-HDU-SUB-MARKER. MOVE 'WASHER 8MM ' TO WS-HDU-SUB-NAME. MOVE 000500 TO WS-HDU-SUB-QTY. MOVE 'OK ' TO WS-HDU-SUB-FLAG. WRITE BCSVHDU-SUB-REC FROM WS-HDU-SUB-BUF. * Record 4 MOVE X'2004' TO WS-HDU-SUB-MARKER. MOVE 'NUT M4 ' TO WS-HDU-SUB-NAME. MOVE 000100 TO WS-HDU-SUB-QTY. MOVE 'OK ' TO WS-HDU-SUB-FLAG. WRITE BCSVHDU-SUB-REC FROM WS-HDU-SUB-BUF. * Record 5 MOVE X'2005' TO WS-HDU-SUB-MARKER. MOVE 'NUT M5 ' TO WS-HDU-SUB-NAME. MOVE 000200 TO WS-HDU-SUB-QTY. MOVE 'HOLD' TO WS-HDU-SUB-FLAG. WRITE BCSVHDU-SUB-REC FROM WS-HDU-SUB-BUF. * Record 6 MOVE X'2006' TO WS-HDU-SUB-MARKER. MOVE 'SPRING PLATE ' TO WS-HDU-SUB-NAME. MOVE 000050 TO WS-HDU-SUB-QTY. MOVE 'HOLD' TO WS-HDU-SUB-FLAG. WRITE BCSVHDU-SUB-REC FROM WS-HDU-SUB-BUF. * Record 7 MOVE X'2007' TO WS-HDU-SUB-MARKER. MOVE 'BEARING 608 ' TO WS-HDU-SUB-NAME. MOVE 000010 TO WS-HDU-SUB-QTY. MOVE 'OK ' TO WS-HDU-SUB-FLAG. WRITE BCSVHDU-SUB-REC FROM WS-HDU-SUB-BUF. * Record 8 MOVE X'2008' TO WS-HDU-SUB-MARKER. MOVE 'GASKET 40MM ' TO WS-HDU-SUB-NAME. MOVE 000025 TO WS-HDU-SUB-QTY. MOVE 'OK ' TO WS-HDU-SUB-FLAG. WRITE BCSVHDU-SUB-REC FROM WS-HDU-SUB-BUF. * Record 9 MOVE X'2009' TO WS-HDU-SUB-MARKER. MOVE 'O-RING 10MM ' TO WS-HDU-SUB-NAME. MOVE 000999 TO WS-HDU-SUB-QTY. MOVE 'OK ' TO WS-HDU-SUB-FLAG. WRITE BCSVHDU-SUB-REC FROM WS-HDU-SUB-BUF. * Record 10 MOVE X'200A' TO WS-HDU-SUB-MARKER. MOVE 'PIN DOWEL 6MM ' TO WS-HDU-SUB-NAME. MOVE 000300 TO WS-HDU-SUB-QTY. MOVE 'END ' TO WS-HDU-SUB-FLAG. WRITE BCSVHDU-SUB-REC FROM WS-HDU-SUB-BUF. * Trailer (STRUCT-CODE X'0098', 44B payload) MOVE LOW-VALUES TO WS-HDU-HDR-BUF. MOVE X'0098' TO WS-HDU-HDR-CODE. MOVE X'0028' TO WS-HDU-HDR-ROOTLEN. MOVE 'PARTS001' TO WS-HDU-HDR-DBKEY. WRITE BCSVHDU-HDR-REC FROM WS-HDU-HDR-BUF. DISPLAY 'BCSVGEN: BCSVHDU 22 HDU records written'. * *------------------------------------------------------------ * WRITE-DET-RECS * Three BCSV-DET-REC records (LRECL=39). PIC X content drives * type.detect() to DATE / INTEGER / FLOAT / STRING / BINARY. * DET-BIN holds non-printable raw bytes so it stays BINARY. *------------------------------------------------------------ WRITE-DET-RECS. * Record 1 MOVE SPACES TO BCSV-DET-REC. MOVE '20240101' TO DET-DATE. MOVE '000000001' TO DET-INT. MOVE '0000001.50' TO DET-FLT. MOVE 'ALPHA' TO DET-STR. MOVE X'00010203' TO DET-BIN. WRITE BCSV-DET-REC. * Record 2 MOVE SPACES TO BCSV-DET-REC. MOVE '20251231' TO DET-DATE. MOVE '123456789' TO DET-INT. MOVE '1234567.89' TO DET-FLT. MOVE 'BETA' TO DET-STR. MOVE X'FFFEFDFC' TO DET-BIN. WRITE BCSV-DET-REC. * Record 3 MOVE SPACES TO BCSV-DET-REC. MOVE '20260607' TO DET-DATE. MOVE '999999999' TO DET-INT. MOVE '0009999.99' TO DET-FLT. MOVE 'GAMMA' TO DET-STR. MOVE X'80818283' TO DET-BIN. WRITE BCSV-DET-REC. DISPLAY 'BCSVGEN: BCSVDET 3 records written'. *