Overview
The OS/VS2 MVS38J file sorting function is provided by the IBM S360 SORT/MERGE product included in the public domain version of the MVS38J Operating System.
The sort/merge product provides exit processing that facilitates calling external user programs at various points within the sort/merge phases such as SORT INPUT PHASE (e.g. add/change/delete input records) or MERGE OUTPUT PHASE (e.g. add/change/delete output records). For more details on Sort/Merge, refer to GC28-6543-5 IBM System/360 Operating System Sort/Merge manual which can be searched for on the Internet.
This post will exploit the use of controlling sort input and sort output processing using four different languages – JCL SORT, COBOL SORT, PL/I SORT and Assembler (BAL) SORT.
SORT Task Problem Statement:
o Sort non-deferred status records only
o ‘Pretty-Print’ sorted records to printer
o Sort in ascending NAME sequence
Note: The IBM MVS38J public domain legacy 24-bit OS is pre-Y2K and does not provide enriched functionality such as current-day hardware, utilities, compilers and/or OS’s. MVS38J OS language compilers utilized by this learning demonstration include OS COBOL ANSI v2 , OS PL/I F v5.5 and Assembler (IFOX00).
The Data
The manufactured data contains 7 records (two are deferred status) which will serve as the input file to the SORT examples.
Col 01-07 07 bytes ID Number Col 08-34 27 bytes Name Col 35-52 18 bytes Address Col 53-73 21 bytes City ST Col 74-78 05 bytes Postal Code Col 80-80 01 bytes Processing Status (D=Deferred) HERC01.SORTS01.CNTL(SORTD00) 0 1 2 3 4 5 6 7 8 1...+....0....+....0....+....0....+....0....+....0....+....0....+....0....+....0 4298102Fred Flint 123 Rock St AnyPlace, TX 12345 8732903I Am Blu 8923 Yellow Ln Shade of Green, CA 09902 7639021Road Racer 3 Fast Ln Race Track, IN 83001 0043222Z80 CPU 8 Bits Dr Early PC, CA 09888 0000001Drop Me 0 Record St No Where, NV 00100 D 0000101Drop Me Too 7 Noname Rd You Know, OH 03125 D 9932909I Am Neu 29 Main St New Wood, KS 30044
JCL Sort
The below MVS Sort JOB uses SORTIN DD as file input from HERC01.TEST.CNTL(SORTD00). Each input record is passed to exit E15 to determine if input record is returned or discarded to/from the sort program.
After sorting completes, each sorted record is passed to exit E35 to be ‘pretty-printed’ (formatted and printed) to DD PRTOUT. Additionally, the sorted record is returned to the sort and written to DD SORTOUT (note the commented B E35DEL instruction in exit E35). Alternatively, the B E35DEL instruction can be uncommented resulting in NO records being written to DD SORTOUT (output directed to printer, SYSOUT=*).
Sort control information is provided via DD SYSIN which includes sorting information and exit module names:
SORT FIELDS=(8,27,A),FORMAT=CH
RECORD TYPE=F,LENGTH=(80)
MODS E15=(E15,2000,EXITLIB,N),E35=(E35,2000,EXITLIB,N)
HERC01.SORTS01.CNTL(SORTJCL) 0 1 2 3 4 5 6 7 8 1...+....0....+....0....+....0....+....0....+....0....+....0....+....0....+....0 //HERC01C JOB (SYS),'JCL SORT2', <-- Review and Modify // CLASS=A,MSGCLASS=A, <-- Review and Modify // MSGLEVEL=(1,1),NOTIFY=HERC01 <-- Review and Modify //* -------------------------------------------------------* //* * SORT utility using exit programs to: * //* * 1) Conditionally filter input records passed to * //* * SORT before starting sorting phase (E15). * //* * 2) After sorting phase, 'pretty-print' sorted * //* * records onto printer (E35). * //* * Uses SORTIN and PRTOUT including E15 and E35 exits. * //* -------------------------------------------------------* //E15 EXEC ASMFCL,PARM.ASM='TERM,LIST,OBJ' //SYSPUNCH DD DUMMY //SYSPRINT DD SYSOUT=* //SYSTERM DD SYSOUT=* //ASM.SYSIN DD * TITLE 'CDPSE15: SORT E15 Exit -- Filter Record' * * Program: CDPSE15 * * Author : Larry Belmontes * https://www.shareabitofit.net/Sorting-in-MVS38J---part-ii * * Purpose: This program receives control for EXIT 15 * * * Disclaimer: * =================================================================== * * No guarantee; No warranty; Install / Use at your own risk. * * This software is provided "AS IS" and without any expressed * or implied warranties, including, without limitation, the * implied warranties of merchantability and fitness for a * particular purpose. * * The author requests keeping authors name intact in any * modified versions. * * In addition, the author requests submissions regarding any * code modifications / enhancements and/or associated comments * for consideration into a subsequent release (giving credit * to contributor(s)) thus, improving overall functionality * benefiting the MVS 3.8J hobbyist public domain community. * * =================================================================== * * EJECT * +------+----------------------------------------------------------+ * | REG | | * |USAGE | DESCRIPTION | * +------+----------------------------------------------------------+ * | R13 | Calling program registers (R14-R12) upon entry | * | R14 | Calling program return address upon entry | * | R15 | Called program entry address upon entry | * | R1 | Called program parms starting address | * +------+----------------------------------------------------------+ * | R0 | Working Register | * | R1 | Address of SORT Parameter Address area | * | R2 | Working Register | * | R3 | Sort Record DSECT | * | R4 | Working Register | * | R5 | Working Register | * | R6 | Working Register | * | R7 | Working Register | * | R8 | Working Register | * | R9 | Working Register | * | R10 | Working Register | * | R11 | Working Register | * | R12 | Base Register | * | R13 | Working Register | * | R14 | Working Register | * +------+----------------------------------------------------------+ * | R15 | Return Code upon exit | * | | RC=0 NO ACTION, KEEP RECORD | * | | RC=4 DELETE RECORD | * | | RC=8 DO NOT RETURN (END OF FILE INPUT) | * +------+----------------------------------------------------------+ EJECT E15 CSECT Entry Point used by SORT * * /********************************************************/ * * /* Entry: Save registers, set addressability */ * * /********************************************************/ STM R14,R12,12(R13) Save registers in HSA LR R12,R15 Load base (R12) w R15 USING E15,R12 Tell Assembler, myBase ST R13,SAVEAREA+4 Chain SORT-E15 LA R15,SAVEAREA R15=Addr of my Savearea ST R15,8(R13) Chain E15-SORT LA R13,SAVEAREA R13=Addr of my Savearea L R3,0(R1) R3=Addr of Sort parm area * 1st addr is SORT Record USING SRTREC,R3 Tell Assembler, SORT REC LTR R3,R3 End of Data? BZ E15EOF Yes, Sort EOF * No, continue... * * /********************************************************/ * * /* Check whether to delete or keep sort record */ * * /********************************************************/ CLI SRTSTAT,C'D' Bypass Record? BE E15DEL Yes, delete record B E15OK No, keep record * * /********************************************************/ * * /* Tell SORT to keep record RC=00 */ * * /********************************************************/ E15OK EQU * L R13,SAVEAREA+4 R13=Addr of SORT Savearea ST R3,24(R13) Save R3 in SORT Savearea R1 * R1-addr of SORT REC RETURN (14,12),RC=0 Keep SORT record * * /********************************************************/ * * /* Tell SORT to delete record RC=04 */ * * /********************************************************/ E15DEL EQU * L R13,SAVEAREA+4 R13=Addr of SORT Savearea RETURN (14,12),RC=4 Delete SORT record * * /********************************************************/ * * /* Tell SORT to quit calling us, at SORT EOF RC=08 */ * * /********************************************************/ E15EOF EQU * L R13,SAVEAREA+4 Addr of Sort savearea RETURN (14,12),RC=8 Done... TITLE 'CDPSE15: Working Storage ' * * /********************************************************/ * * /* Data Areas */ * * /********************************************************/ SAVEAREA DC 18F'0' my Save Area * +00 A(savearea of current CSECT) * +04 A(savearea of calling CSECT) * +08 A(savearea of called CSECT) * +12 R14 * +16 R15 * +20 R0 * +24 R1 * +28 R2 * +32 R3 * +36 R4 * +40 R5 * +44 R6 * +48 R7 * +52 R8 * +56 R9 * +60 R10 * +64 R11 * +68 R12 TITLE 'CDPSE15: DSECT Area ' * * /********************************************************/ * * /* DSECTs */ * * /********************************************************/ SRTREC DSECT Sort Record SRTID DS CL07 ID SRTNAME DS CL27 Name SRTADDR DS CL18 Address SRTCST DS CL21 City State SRTZIP DS CL05 Zip Code DS CL01 SRTSTAT DS CL01 Status EJECT * * /********************************************************/ * * /* Register Equates */ * * /********************************************************/ R0 EQU 0 R R1 EQU 1 E R2 EQU 2 G R3 EQU 3 I R4 EQU 4 S R5 EQU 5 T R6 EQU 6 E R7 EQU 7 R R8 EQU 8 R9 EQU 9 E R10 EQU 10 Q R11 EQU 11 U R12 EQU 12 A R13 EQU 13 T R14 EQU 14 E R15 EQU 15 S END E15 /* //LKED.SYSLMOD DD DSN=&&SRTEXIT,DISP=(NEW,PASS), // SPACE=(TRK,(10,5,1)),UNIT=SYSALLDA //LKED.SYSIN DD * NAME E15(R) //* //E35 EXEC ASMFCL,PARM.ASM='TERM,LIST,OBJ' //SYSPUNCH DD DUMMY //SYSPRINT DD SYSOUT=* //SYSTERM DD SYSOUT=* //ASM.SYSIN DD * TITLE 'CDPSE35: SORT E35 Exit -- Process Record' * * Program: CDPSE35 * * Author : Larry Belmontes * https://www.shareabitofit.net/Sorting-in-MVS38J---part-ii * * Purpose: This program receives control for EXIT 35 * * * Disclaimer: * =================================================================== * * No guarantee; No warranty; Install / Use at your own risk. * * This software is provided "AS IS" and without any expressed * or implied warranties, including, without limitation, the * implied warranties of merchantability and fitness for a * particular purpose. * * The author requests keeping authors name intact in any * modified versions. * * In addition, the author requests submissions regarding any * code modifications / enhancements and/or associated comments * for consideration into a subsequent release (giving credit * to contributor(s)) thus, improving overall functionality * benefiting the MVS 3.8J hobbyist public domain community. * * =================================================================== * * EJECT * +------+----------------------------------------------------------+ * | REG | | * |USAGE | DESCRIPTION | * +------+----------------------------------------------------------+ * | R13 | Calling program registers (R14-R12) upon entry | * | R14 | Calling program return address upon entry | * | R15 | Called program entry address upon entry | * | R1 | Called program parms starting address | * +------+----------------------------------------------------------+ * | R0 | Working Register | * | R1 | Address of SORT Parameter Address area | * | R2 | Working Register | * | R3 | Sort Record DSECT | * | R4 | Working Register | * | R5 | Working Register | * | R6 | Working Register | * | R7 | Printer DCB | * | R8 | Printer Buffer | * | R9 | Working Register | * | R10 | Printer Buffer Length | * | R11 | Working Register | * | R12 | Base Register | * | R13 | Working Register | * | R14 | Working Register | * +------+----------------------------------------------------------+ * | R15 | Return Code upon exit | * | | RC=0 NO ACTION | * | | RC=4 DELETE | * | | RC=8 DO NOT RETURN | * | | RC=12 INSERT | * +------+----------------------------------------------------------+ EJECT E35 CSECT Entry Point used by SORT * * /********************************************************/ * * /* Entry: Save registers, set addressability */ * * /********************************************************/ STM R14,R12,12(R13) Save registers in HSA LR R12,R15 Load base (R12) w R15 USING E35,R12 Tell Assembler, myBase ST R13,SAVEAREA+4 SORT-E35 chain LR R2,R13 LA R13,SAVEAREA Point to my Save Area ST R13,8(R2) E35-SORT chain USING SRTREC,R3 Tell Assembler, SORT REC L R3,0(R1) R3=Addr of Sort parm area * 1st addr is SORT Record * 2nd addr is OUTPUT Rcd * 3rd seq check switch * * /********************************************************/ * * /* Open Printer and print headings if NOT open */ * * /********************************************************/ TM PRTOUT+(DCBOFLGS-IHADCB),DCBOFOPN Is PRTOUT open? BO PRTOBYPS Yes, bypass Open OPEN (PRTOUT,(OUTPUT)) No, Open Printer PRTHDG EQU * MVI PRTLINE,C'1' Print at top of page LA R7,PRTOUT R7=Addr PRTOUT LA R8,PRTLINE R8=Addr PRTLINE LA R10,PRTLINEL R10=Length of PRTLINE MVC PRTLINE+01(HEAD1L),HEAD1 BAL R14,WRITEREC Print Report Heading PRTCHDGS EQU * MVI PRTLINE,C'0' Double space LA R7,PRTOUT R7=Addr PRTOUT LA R8,PRTLINE R8=Addr PRTLINE LA R10,PRTLINEL R10=Length of PRTLINE MVC PRTLINE+01(COLHDG1L),COLHDG1 BAL R14,WRITEREC Print COL Heading EJECT PRTOBYPS EQU * * * /********************************************************/ * * /* SORT EOF? */ * * /********************************************************/ LTR R3,R3 End of Data? BZ E35EOF Yes, Sort EOF PRTRCDDT EQU * No, print record... MVC PRTID(L'SRTID),SRTID MVC PRTNAME(L'SRTNAME),SRTNAME MVC PRTADDR(L'SRTADDR),SRTADDR MVC PRTCST(L'SRTCST),SRTCST MVC PRTZIP(L'SRTZIP),SRTZIP MVC PRTSTAT(L'SRTSTAT),SRTSTAT PRTCOLHD EQU * MVI PRTLINE,C' ' Single space LA R7,PRTOUT R7=Addr PRTOUT LA R8,PRTLINE R8=Addr PRTLINE LA R10,PRTLINEL R10=Length of PRTLINE MVC PRTLINE+01(PRTRECL),PRTREC BAL R14,WRITEREC Print SORT record * * /********************************************************/ * * /* Discard current record, return to SORT */ * * /********************************************************/ **** B E35DEL Discard record * * /********************************************************/ * * /* Tell SORT to write record to SORTOUT RC=00 */ * * /********************************************************/ E35OK EQU * No, keep record L R13,SAVEAREA+4 R13=Addr of SORT Savearea ST R3,24(R13) Save R3 in SORT Savearea R1 RETURN (14,12),RC=0 Keep SORT record * * /********************************************************/ * * /* Tell SORT to delete record RC=04 */ * * /********************************************************/ E35DEL EQU * L R13,SAVEAREA+4 R13=Addr of SORT Savearea RETURN (14,12),RC=4 Delete SORT record * * /********************************************************/ * * /* Tell SORT to quit calling us, at SORT EOF RC=08 */ * * /********************************************************/ E35EOF EQU * CLOSE PRTOUT Close Printer L R13,SAVEAREA+4 R13=Addr of SORT Savearea RETURN (14,12),RC=8 Done... TITLE 'CDPSE35: Subroutines ' * * /********************************************************/ * * /* Subroutine: Write a record (R14) */ * * /* - R7 Printer DCB */ * * /* - R8 Printer Buffer */ * * /* - R10 Printer Buffer Length */ * * /********************************************************/ WRITEREC DS 0H ST R14,R14SAVE Save R14 PUT (R7),(R8) Write to printer MVI 0(R8),C' ' Blank in pos 1 of prt buffer BCTR R10,0 Buffer Length BCTR R10,0 EX R10,CLRBUFF Initialize Buffer area LA R10,2(R10) Restore Original Length L R14,R14SAVE Restore R14 BR R14 Return to caller TITLE 'CDPSE35: Working Storage ' * * /********************************************************/ * * /* Data Areas */ * * /********************************************************/ SAVEAREA DC 18F'0' my Save Area R14SAVE DC F'0' R14 Hold Area CLRBUFF MVC 1(0,R8),0(R8) EX MVC to clear buffer PRTLINE DC CL120' ' Print Line PRTLINEL EQU *-PRTLINE HEAD1 DC C' Report of SORTED data using MVS SORT' HEAD1L EQU *-HEAD1 COLHDG1 DC CL10'ID Number' DC CL30'Person Name' DC CL20'Address' DC CL25'City State' DC CL09'ZipCode' DC CL06'Status' COLHDG1L EQU *-COLHDG1 PRTREC EQU * PRTID DC CL10' ' PRTNAME DC CL30' ' PRTADDR DC CL20' ' PRTCST DC CL25' ' PRTZIP DC CL09' ' PRTSTAT DC CL06' ' PRTRECL EQU *-PRTREC * * /********************************************************/ * * /* DCBs */ * * /********************************************************/ PRTOUT DCB DDNAME=PRTOUT,MACRF=PM,DSORG=PS,DEVD=DA,RECFM=FBA, X LRECL=120,BLKSIZE=3600 TITLE 'CDPSE35: DSECT Area ' * * /********************************************************/ * * /* DSECTs */ * * /********************************************************/ DCBD DSORG=PS,DEVD=DA EJECT SRTREC DSECT Sort Record SRTID DS CL07 SRTNAME DS CL27 SRTADDR DS CL18 SRTCST DS CL21 SRTZIP DS CL05 DS CL01 SRTSTAT DS CL01 EJECT R0 EQU 0 R R1 EQU 1 E R2 EQU 2 G R3 EQU 3 I R4 EQU 4 S R5 EQU 5 T R6 EQU 6 E R7 EQU 7 R R8 EQU 8 R9 EQU 9 E R10 EQU 10 Q R11 EQU 11 U R12 EQU 12 A R13 EQU 13 T R14 EQU 14 E R15 EQU 15 S END E35 /* //LKED.SYSLMOD DD DSN=&&SRTEXIT,DISP=(OLD,PASS) //* SPACE=(TRK,(10,5,1)),UNIT=SYSALLDA //LKED.SYSIN DD * NAME E35(R) //* //STEP010 EXEC PGM=SORT,PARM='MSG=AP' //SORTLIB DD DISP=SHR,DSN=SYS1.SORTLIB //EXITLIB DD DSN=&&SRTEXIT,DISP=(OLD,DELETE) //SORTWK01 DD UNIT=2314,SPACE=(CYL,(5,5)) //SORTWK02 DD UNIT=2314,SPACE=(CYL,(5,5)) //SORTWK03 DD UNIT=2314,SPACE=(CYL,(5,5)) //SORTWK04 DD UNIT=2314,SPACE=(CYL,(5,5)) //SORTWK05 DD UNIT=2314,SPACE=(CYL,(5,5)) //SORTWK06 DD UNIT=2314,SPACE=(CYL,(5,5)) //SORTIN DD DSN=HERC01.SORTS01.CNTL(SORTD00),DISP=SHR //SYSPRINT DD SYSOUT=* //SYSOUT DD SYSOUT=* //PRTOUT DD SYSOUT=* //SORTOUT DD SYSOUT=*,DCB=(BLKSIZE=80,RECFM=F) //SYSIN DD * SORT FIELDS=(8,27,A),FORMAT=CH RECORD TYPE=F,LENGTH=(80) MODS E15=(E15,2000,EXITLIB,N),E35=(E35,2000,EXITLIB,N) /* //
– SORTWORK and SORTWKnn DDs require 2314 DASD device types for this version of the SORT product.
COBOL Sort
The COBOL program, CDPSRTC, uses the SORT statement to invoke the sort/merge product. Sorting control field is SRT-NAME in ASCENDING order. The INPUT PROCEDURE (receives control before sorting data) reads input records from DD CARDIN and determines whether to RELEASE non-deferred records to the sort. The OUTPUT PROCEDURE (receives control after sorting) reads sorted records, via the RETURN statement, formats and prints records to DD PRTOUT. After the SORT completes, the return code is interrogated and appropriate messages are displayed on the CONSOLE via the DISPLAY statement.
For more details using COBOL on MVS38J, refer to GC28-6399-2 IBM OS Full American National Standard COBOL Compiler and Library Programmer’s Guide which can be searched for on the Internet.
HERC01.SORTS01.CNTL(SORTCOB) 0 1 2 3 4 5 6 7 8 1...+....0....+....0....+....0....+....0....+....0....+....0....+....0....+....0 //HERC01C JOB (001),'COB SORT2', <-- Review and Modify // CLASS=A,MSGCLASS=A, <-- Review and Modify // MSGLEVEL=(1,1),NOTIFY=HERC01 <-- Review and Modify //STEP01 EXEC COBUCLG,CPARM1='LIST,LOAD,NODECK,PMAP,DMAP' //COB.SYSLIB DD DSN=HERC01.TEST.CNTL,DISP=SHR //COB.SYSPUNCH DD DUMMY //COB.SYSIN DD * IDENTIFICATION DIVISION. PROGRAM-ID. CDPSRTC. AUTHOR. Larry Belmontes. REMARKS. This program invokes the SORT product to conditionally pass input records to the SORT and subsequently 'pretty-print' sorted records onto printer. The SORT operation is performed via the SORT COBOL verb with INPUT PROCEDURE and OUTPUT PROCEDURE options. Uses CARDIN and PRTOUT as SORTIN and SORTOUT, respectively. https://www.shareabitofit.net/Sorting-in-MVS38J */ */ */ Disclaimer: */ ----------- */ No guarantee; No warranty; Install / Use at your own risk.*/ */ This software is provided “AS IS” and without any */ expressed or implied warranties, including, without */ limitation, the implied warranties of merchantability */ and fitness for a particular purpose. */ */ The author requests keeping authors name intact in any */ modified versions. */ */ In addition, the author requests submissions regarding */ any code modifications / enhancements and/or associated */ comments for consideration into a subsequent release */ (giving credit to contributor(s)) thus, improving overall */ functionality benefiting the MVS 3.8J hobbyist public */ domain community. */ EJECT ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. IBM-4341. OBJECT-COMPUTER. IBM-4341. INPUT-OUTPUT SECTION. FILE-CONTROL. * SELECT IN-FILE ASSIGN TO UT-2314-S-CARDIN. SELECT SORT-FILE ASSIGN TO UT-2314-S-SORTWORK. SELECT OUT-FILE ASSIGN TO UR-1403-S-PRTOUT. * EJECT DATA DIVISION. FILE SECTION. FD IN-FILE RECORDING MODE IS F RECORD CONTAINS 080 CHARACTERS BLOCK CONTAINS 000 CHARACTERS LABEL RECORDS ARE STANDARD DATA RECORD IS IN-REC. 01 IN-REC. 05 IN-ID PIC 9(07). 05 IN-NAME PIC X(27). 05 IN-ADDRESS PIC X(18). 05 IN-CITY-ST PIC X(21). 05 IN-POSTALCD PIC X(05). 05 FILLER PIC X(01). 05 IN-STATUSCD PIC X(01). SD SORT-FILE DATA RECORD IS SORT-REC. 01 SORT-REC. 05 SRT-ID PIC 9(07). 05 SRT-NAME PIC X(27). 05 SRT-ADDRESS PIC X(18). 05 SRT-CITY-ST PIC X(21). 05 SRT-POSTALCD PIC X(05). 05 FILLER PIC X(01). 05 SRT-STATUSCD PIC X(01). FD OUT-FILE RECORDING MODE IS F RECORD CONTAINS 132 CHARACTERS LABEL RECORDS ARE OMITTED DATA RECORD IS OUT-REC. 01 OUT-REC. 05 FILLER PIC X(132). EJECT WORKING-STORAGE SECTION. 01 WS-RC PIC 9(04). 01 WS-RCD-READ PIC 9(05) VALUE ZEROS. 01 WS-RCD-DELETED PIC 9(05) VALUE ZEROS. 01 WS-RCD-PRINTED PIC 9(05) VALUE ZEROS. 01 WS-INPUTDATA PIC X(01) VALUE 'N'. 88 NO-MORE-INPUT VALUE 'Y'. 01 WS-SORTDATA PIC X(01) VALUE 'N'. 88 NO-MORE-SORTDATA VALUE 'Y'. 01 WS-RPT-HEADING. 05 FILLER PIC X(79) VALUE ' Report of SORTED data using COBOL'. 01 WS-RPT-COL-HEADING. 05 FILLER PIC X(10) VALUE 'ID Number'. 05 FILLER PIC X(30) VALUE 'Person Name'. 05 FILLER PIC X(20) VALUE 'Address'. 05 FILLER PIC X(25) VALUE 'City State'. 05 FILLER PIC X(09) VALUE 'ZipCode'. 05 FILLER PIC X(06) VALUE 'Status'. 01 WS-RPT-COL-DETAIL. 05 RPT-ID PIC X(10). 05 RPT-NAME PIC X(30). 05 RPT-ADDRESS PIC X(20). 05 RPT-CITY-ST PIC X(25). 05 RPT-POSTALCD PIC X(09). 05 RPT-STATUSCD PIC X(06). EJECT PROCEDURE DIVISION. 0000-MAINLINE. ****************************************************** * INVOKE SORT * ****************************************************** SORT SORT-FILE ON ASCENDING KEY SRT-NAME INPUT PROCEDURE 1000-SORT-INPUT OUTPUT PROCEDURE 2000-SORT-REPORT. ****************************************************** * CHECK SORT RETURN CODE * ****************************************************** IF RETURN-CODE = 0 DISPLAY 'SORT Completed Successfully' UPON CONSOLE ELSE MOVE RETURN-CODE TO WS-RC DISPLAY 'SORT Error-- RC=', WS-RC UPON CONSOLE. ****************************************************** * DISPLAY STATISTICS * ****************************************************** DISPLAY 'Records: Read-', WS-RCD-READ, ', Deleted-', WS-RCD-DELETED, ', Printed-', WS-RCD-PRINTED UPON CONSOLE. ****************************************************** * RETURN TO CALLER * ****************************************************** GOBACK. EJECT ****************************************************** * FILTER SORT INPUT * ****************************************************** 1000-SORT-INPUT SECTION. OPEN INPUT IN-FILE. PERFORM 1010-READ-INPUT THRU 1010-READ-INPUT-EXIT. PERFORM 1020-PROCESS-INPUT THRU 1020-PROCESS-INPUT-EXIT UNTIL NO-MORE-INPUT. CLOSE IN-FILE. ****************************************************** * PRINT SORTED DATA * ****************************************************** 2000-SORT-REPORT SECTION. OPEN OUTPUT OUT-FILE. WRITE OUT-REC FROM WS-RPT-HEADING. MOVE SPACES TO OUT-REC. WRITE OUT-REC. WRITE OUT-REC FROM WS-RPT-COL-HEADING. PERFORM 2010-READ-SORT THRU 2010-READ-SORT-EXIT. PERFORM 2020-PROCESS-SORT THRU 2020-PROCESS-SORT-EXIT UNTIL NO-MORE-SORTDATA. CLOSE OUT-FILE. EJECT ****************************************************** * SUBROUTINES * ****************************************************** Z000-SUBROUTINE SECTION. ****************************************************** * READ CARDIN RECORD * ****************************************************** 1010-READ-INPUT. READ IN-FILE AT END MOVE 'Y' TO WS-INPUTDATA. 1010-READ-INPUT-EXIT. EXIT. ****************************************************** * CHECK CARDIN AND PASS TO SORT * ****************************************************** 1020-PROCESS-INPUT. ADD 1 TO WS-RCD-READ. IF IN-STATUSCD = 'D' ADD 1 TO WS-RCD-DELETED ELSE RELEASE SORT-REC FROM IN-REC. PERFORM 1010-READ-INPUT THRU 1010-READ-INPUT-EXIT. 1020-PROCESS-INPUT-EXIT. EXIT. EJECT ****************************************************** * READ SORTED RECORD * ****************************************************** 2010-READ-SORT. RETURN SORT-FILE AT END MOVE 'Y' TO WS-SORTDATA. 2010-READ-SORT-EXIT. EXIT. ****************************************************** * 'PRETTY-PRINT' SORTED RECORD * ****************************************************** 2020-PROCESS-SORT. MOVE SRT-ID TO RPT-ID. MOVE SRT-NAME TO RPT-NAME. MOVE SRT-ADDRESS TO RPT-ADDRESS. MOVE SRT-CITY-ST TO RPT-CITY-ST. MOVE SRT-POSTALCD TO RPT-POSTALCD. MOVE SRT-STATUSCD TO RPT-STATUSCD. WRITE OUT-REC FROM WS-RPT-COL-DETAIL. ADD 1 TO WS-RCD-PRINTED. PERFORM 2010-READ-SORT THRU 2010-READ-SORT-EXIT. 2020-PROCESS-SORT-EXIT. EXIT. Z000-SUBROUTINE-EXIT. EXIT. /* //GO.SORTLIB DD DSNAME=SYS1.SORTLIB,DISP=SHR //GO.SORTWORK DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK01 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK02 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK03 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK04 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK05 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK06 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.CARDIN DD DSN=HERC01.SORTS01.CNTL(SORTD00),DISP=SHR //GO.SYSPRINT DD SYSOUT=* //GO.SYSOUT DD SYSOUT=* //GO.PRTOUT DD SYSOUT=* //
PL/I Sort
The PL/I program, CDPSRTP, uses the PL/I SORT entry point, IHESRTD which contains two entry points in the CALL parameter list representing E15 and E35 user exits. Entry FILTER_INPUT (receives control before sorting) reads input records from DD CARDIN and determines whether to pass non-deferred records to the sort by returning a value of 12 in the return code via IHESARC(12). Entry REPORT_SORTED (receives control after sorting) formats and prints each sorted record to DD PRTOUT.
After the sort completes, the return code is interrogated and appropriate completion and record counts messages are displayed on the console via the DISPLAY statement.
For more details using PL/I on MVS38J, refer to GC28-6594-7 IBM System/360 Operating System PL/I (F) Programmer’s Guide which can be searched for on the Internet.
HERC01.SORTS01.CNTL(SORTPLI) 0 1 2 3 4 5 6 7 8 1...+....0....+....0....+....0....+....0....+....0....+....0....+....0....+....0 //HERC01C JOB (001),'PLI SORT2', <-- Review and Modify // CLASS=A,MSGCLASS=A, <-- Review and Modify // MSGLEVEL=(1,1),NOTIFY=HERC01 <-- Review and Modify //STEP01 EXEC PL1LFCLG, // REGION.PL1L=256K, // PARM.PL1L='L,E,A,X,M,S2,NT', // PARM.LKED='XREF,LIST' //PL1L.SYSIN DD * /*************************************************************/ /* */ /* Program: CDPSRTP */ /* */ /* Author: Larry Belmontes */ /* https://www.shareabitofit.net/Sorting-in-MVS38J---part-ii */ /* */ /* Purpose: This program makes use of the PL/I SORT */ /* interface feature via the IHESTRD entry point */ /* to conditionally filter input (CARDIN) records */ /* passed to the SORT and subsequently */ /* 'pretty-print' sorted records onto */ /* printer (PRTOUT). */ /* */ /* SORTIN and SORTOUT are not used due to use */ /* of input and output procedures (sort exits) */ /* allowing external handling of sort input and */ /* sort output processing. */ /* */ /* Disclaimer: */ /* ----------- */ /* No guarantee; No warranty; Install / Use at your own risk.*/ /* */ /* This software is provided “AS IS” and without any */ /* expressed or implied warranties, including, without */ /* limitation, the implied warranties of merchantability */ /* and fitness for a particular purpose. */ /* */ /* The author requests keeping authors name intact in any */ /* modified versions. */ /* */ /* In addition, the author requests submissions regarding */ /* any code modifications / enhancements and/or associated */ /* comments for consideration into a subsequent release */ /* (giving credit to contributor(s)) thus, improving overall */ /* functionality benefiting the MVS 3.8J hobbyist public */ /* domain community. */ /* */ /*************************************************************/ CDPSRTP: PROC OPTIONS (MAIN); /*************************************************************/ /* Declare OS SORT Entry Points */ /*************************************************************/ DCL IHESRTD ENTRY (CHAR(32), /* SORT FIELDS */ CHAR(27), /* RECORD TYPE */ FIXED BINARY(31,0), FIXED BINARY(31,0), ENTRY, ENTRY); DCL IHESARC ENTRY (FIXED BINARY(31,0)); /*************************************************************/ /* Declare SORT PROCEDURE Entry Points */ /*************************************************************/ DCL FILTER_INPUT ENTRY RETURNS(CHAR(80)); DCL REPORT_SORTED ENTRY; /*************************************************************/ /* Declare Others... */ /*************************************************************/ DCL SORT_RC FIXED BINARY(31,0); DCL RED_RCD_CNT STATIC INIT(0); DCL DEL_RCD_CNT STATIC INIT(0); DCL PRT_RCD_CNT STATIC INIT(0); DCL X_1ST_TIME CHAR(01) INIT('N'); DCL DISPLAY_LINE_AREA CHAR(20); DCL 1 DISPLAY_LINE DEFINED DISPLAY_LINE_AREA, 2 DISPLAY_STR CHAR(16), 2 DISPLAY_NUMB PIC'9999'; DCL DISPLAY_LINE_AREA2 CHAR(48) DEFINED DISPLAY_LINE2; DCL 1 DISPLAY_LINE2, 2 FILLER1 CHAR(13) INIT('Records Read-'), 2 DISPLAY_RED PIC'99999', 2 FILLER2 CHAR(10) INIT(', Deleted-'), 2 DISPLAY_DEL PIC'99999', 2 FILLER3 CHAR(10) INIT(', Printed-'), 2 DISPLAY_PRT PIC'99999'; /*************************************************************/ /* Invoke OS Sort */ /*************************************************************/ CALL IHESRTD (' SORT FIELDS=(8,27,A),FORMAT=CH ', ' RECORD TYPE=F,LENGTH=(80) ', 25000, SORT_RC, FILTER_INPUT, REPORT_SORTED); /*************************************************************/ /* Check SORT return code */ /*************************************************************/ IF SORT_RC = 0 THEN DO; DISPLAY ('SORT Completed Successfully'); END; ELSE DO; DISPLAY_STR = 'SORT Error-- RC='; DISPLAY_NUMB = SORT_RC; DISPLAY (DISPLAY_LINE_AREA); END; CALL IHESARC(00); /* Reset Return Code */ /*************************************************************/ /* Display record counts */ /*************************************************************/ DISPLAY_RED = RED_RCD_CNT; DISPLAY_DEL = DEL_RCD_CNT; DISPLAY_PRT = PRT_RCD_CNT; DISPLAY (DISPLAY_LINE_AREA2); CLOSE FILE(PRTOUT); /*************************************************************/ /* Sort Input Procedure:FILTER_INPUT */ /*************************************************************/ FILTER_INPUT: PROC RETURNS(CHAR(80)); /***************************************************/ /* CARDIN INPUT FILE DD */ /***************************************************/ DCL CARDIN FILE RECORD INPUT; ON ENDFILE(CARDIN) BEGIN; CALL IHESARC(8); /* END OF SORT INPUT */ GOTO FILTER_INPUT_E; END; /***************************************************/ /* CARDIN RECORD LAYOUT */ /***************************************************/ DCL IN_REC_AREA CHAR(80); DCL 1 IN_REC DEFINED IN_REC_AREA, 2 IN_ID CHAR(07), 2 IN_NAME CHAR(27), 2 IN_ADDRESS CHAR(18), 2 IN_CITY_ST CHAR(21), 2 IN_POSTALCD CHAR(05), 2 FILLER CHAR(01), 2 IN_STATUSCD CHAR(01); READ_CARD: READ FILE (CARDIN) INTO (IN_REC_AREA); RED_RCD_CNT = RED_RCD_CNT + 1; /*************************************************/ /* Bypass Records where STATUS = 'D' */ /*************************************************/ IF IN_STATUSCD = 'D' THEN DO; DEL_RCD_CNT = DEL_RCD_CNT + 1; GOTO READ_CARD; END; ELSE DO; CALL IHESARC(12); /* INSERT RCD TO SORT */ RETURN (IN_REC_AREA); END; FILTER_INPUT_E: END FILTER_INPUT; /*************************************************************/ /* Sort Report Procedure:REPORT_SORTED */ /*************************************************************/ REPORT_SORTED: PROC (SRT_REC_AREA); /***************************************************/ /* PRTOUT OUTPUT FILE DD */ /***************************************************/ DCL PRTOUT FILE RECORD OUTPUT ENV(CTLASA F(101)); DCL PRT_REC_AREA CHAR(101); DCL 1 PRT_REC DEFINED PRT_REC_AREA, 2 PRT_CC CHAR(1), 2 PRT_REC_DATA, 3 PRT_ID CHAR(10), 3 PRT_NAME CHAR(30), 3 PRT_ADDRESS CHAR(20), 3 PRT_CITY_ST CHAR(25), 3 PRT_POSTALCD CHAR(08), 3 FILLER CHAR(01), 3 PRT_STATUSCD CHAR(06); DCL 1 PHD_RPT_HEADING, 2 PHD_CC CHAR(1) INIT('1'), 2 PHD_RPT_HEADING_DATA, 3 PHD_ID CHAR(100) INIT(' Report of SORTED data using PL/I'); DCL 1 PHD_COL_HEADING, 2 PHD_CC CHAR(1) INIT('0'), 2 PHD_COL_HEADING_DATA, 3 PHD_ID CHAR(10) INIT('ID Number'), 3 PHD_NAME CHAR(30) INIT('Person Name'), 3 PHD_ADDRESS CHAR(20) INIT('Address'), 3 PHD_CITY_ST CHAR(25) INIT('City State'), 3 PHD_POSTALCD CHAR(09) INIT('ZipCode'), 3 PHD_STATUSCD CHAR(06) INIT('Status'); /***************************************************/ /* SORT RECORD LAYOUT */ /***************************************************/ DCL SRT_REC_AREA CHAR(80); DCL 1 SRT_REC DEFINED SRT_REC_AREA, 2 SRT_ID CHAR(07), 2 SRT_NAME CHAR(27), 2 SRT_ADDRESS CHAR(18), 2 SRT_CITY_ST CHAR(21), 2 SRT_POSTALCD CHAR(05), 2 FILLER CHAR(01), 2 SRT_STATUSCD CHAR(01); DCL RCD CHAR(80); /***************************************************/ /* Print HEADINGS 1st Time Only */ /***************************************************/ IF X_1ST_TIME = 'N' THEN DO; X_1ST_TIME = 'Y'; OPEN FILE(PRTOUT); WRITE FILE(PRTOUT) FROM(PHD_RPT_HEADING); WRITE FILE(PRTOUT) FROM(PHD_COL_HEADING); END; /***************************************************/ /* Print Sort Record data */ /***************************************************/ PRT_CC = ' '; /* Single-space page control */ PRT_REC_DATA = SRT_REC; WRITE FILE(PRTOUT) FROM(PRT_REC_AREA); PRT_RCD_CNT = PRT_RCD_CNT + 1; /***************************************************/ /* Get next sort record */ /***************************************************/ CALL IHESARC(04); RETURN; REPORT_SORTED_E: END REPORT_SORTED; /*************************************************************/ /* Done: Return to OS */ /*************************************************************/ END CDPSRTP; /* //LKED.SYSLMOD DD DSNAME=&&GOSET(GO),DISP=(MOD,PASS), // UNIT=SYSALLDA,SPACE=(1024,(70,30,5),RLSE) //GO.SORTLIB DD DSNAME=SYS1.SORTLIB,DISP=SHR //GO.SORTWORK DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK01 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK02 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK03 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK04 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK05 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK06 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.CARDIN DD DSN=HERC01.SORTS01.CNTL(SORTD00),DISP=SHR //GO.SYSPRINT DD SYSOUT=* //GO.SYSOUT DD SYSOUT=* //GO.PRTOUT DD SYSOUT=* //
Assembler SORT
The Assembler program, CDPSRTB, is more detail-oriented and verbose, in comparison to COBOL or PL/I, by nature. The LINK macro invokes the SORT program. The sorting control information including E15 and E35 exit names are specified in a Parameter Address List (SORTPAL) whose address is loaded into Register 1 before the LINK EP=SORT statement.
Entry E15 receives control (before sorting data) iteratively until RC=8 is returned to the sort program to stop.
E15 reads input records from DD CARDIN and determines whether to pass non-deferred records to the sort by returning RC=12 or bypass the input record. When CARDIN reaches EOF, RC=08 is returned to the sort program to signal termination of file input.
Entry E35 receives control (after sorting data) for every sorted record.
E35 formats and prints sorted record to DD PRETYPRT. RC=04 is returned to the sort program to fetch the next sorted record. At EOF, RC=08 is returned to the sort program to signal termination.
After the sort program terminates and returns control to CDPSRTB, the sort return code is interrogated and appropriate completion messages are printed to DD=PRTOUT via the PUT statement in the WRITEREC subroutine.
HERC01.SORTS01.CNTL(SORTBAL) 0 1 2 3 4 5 6 7 8 1...+....0....+....0....+....0....+....0....+....0....+....0....+....0....+....0 //HERC01C JOB (001),'BAL SORT2', <-- Review and Modify // CLASS=A,MSGCLASS=A, <-- Review and Modify // MSGLEVEL=(1,1),NOTIFY=HERC01 <-- Review and Modify //ASM1 EXEC ASMFCLG,PARM.ASM='TERM,LIST,OBJ' //SYSPUNCH DD DUMMY //SYSPRINT DD SYSOUT=* //SYSTERM DD SYSOUT=* //ASM.SYSIN DD * TITLE 'CDPSRTB: Invoke SORT from BAL' * * Program: CDPSRTB * * Author : Larry Belmontes * https://www.shareabitofit.net/Sorting-in-MVS38J---part-ii * * Purpose: This program invokes the SORT product to conditionally * pass input records to the SORT and subsequently * 'pretty-print' sorted records onto printer. * * The SORT operation is performed via the LINK macro * using a parmlist as specifed by the SORT product. * Sort exit E15 is used to conditionally pass input * records to the SORT. Sort exit E35 is used to * 'pretty-print' sorted records onto printer. * Both exits are local in one program - one CSECT. * * Uses CARDIN and PRETYPRT as SORTIN and SORTOUT, * respectively. * * Disclaimer: * =================================================================== * * No guarantee; No warranty; Install / Use at your own risk. * * This software is provided "AS IS" and without any expressed * or implied warranties, including, without limitation, the * implied warranties of merchantability and fitness for a * particular purpose. * * The author requests keeping authors name intact in any * modified versions. * * In addition, the author requests submissions regarding any * code modifications / enhancements and/or associated comments * for consideration into a subsequent release (giving credit * to contributor(s)) thus, improving overall functionality * benefiting the MVS 3.8J hobbyist public domain community. * * =================================================================== * * EJECT * +------+----------------------------------------------------------+ * | REG | | * |USAGE | DESCRIPTION | * +------+----------------------------------------------------------+ * | R13 | Calling program registers (R14-R12) upon entry | * | R14 | Calling program return address upon entry | * | R15 | Called program entry address upon entry | * | R1 | Called program parms starting address | * +------+----------------------------------------------------------+ * | R0 | Working Register | * | R1 | Working Register | * | R2 | Return code hold, used to set R15 on return to caller | * | R3 | Working Register | * | R4 | Working Register | * | R5 | Working Register | * | R6 | Working Register | * | R7 | Printer DCB | * | R8 | Printer BUFFER | * | R9 | Working Register | * | R10 | Printer BUFFER Length | * | R11 | Working Register | * | R12 | Base Register | * | R13 | Working Register | * | R14 | Used by BAL subroutines | * +------+----------------------------------------------------------+ * | R15 | Return Code upon exit | * +------+----------------------------------------------------------+ EJECT CDPSRTB CSECT * * /********************************************************/ * * /* Save registers and set addressability */ * * /********************************************************/ STM R14,R12,12(R13) Save registers in HSA LR R12,R15 Load base (R12) w R15 USING CDPSRTB,R12 Tell Assembler, myBase ST R13,SAVEAREA+4 Chain OS-CDPSRTB LA R15,SAVEAREA R15=Addr my Savearea ST R15,8(R13) Chain CDPSRTB-OS LA R13,SAVEAREA R13=Addr my Savearea SR R2,R2 Clear R2, return code usage * * /********************************************************/ * * /* Open printer PRTOUT */ * * /********************************************************/ OPEN (PRTOUT,(OUTPUT)) Open Printer TM PRTOUT+(DCBOFLGS-IHADCB),DCBOFOPN OPEN OK? BO PRTOK Yes, continue * No, error w OPEN, issue WTO MVC WTOLINE(OPENERRL),OPENERR MVC WTOLINE+22(8),=CL8'PRTOUT' Move DDNAME BAL R14,WRITETO WTO message LA R2,12 Return Code = 12 B RETURNE Return to caller * * /********************************************************/ * * /* Print status report headings */ * * /********************************************************/ PRTOK EQU * MVI PRTLINE,C'1' Print at top of page LA R7,PRTOUT R7=Addr PRTOUT LA R8,PRTLINE R8=Addr PRTLINE LA R10,PRTLINEL R10=Length of PRTLINE MVC PRTLINE+33(HEAD1L),HEAD1 BAL R14,WRITEREC Print Heading MVC PRTLINE+01(L'CALLSRT),CALLSRT BAL R14,WRITEREC Print calling sort msg EJECT * * /********************************************************/ * * /* Invoke SORT */ * * /********************************************************/ LINKSORT EQU * STM R14,R12,SAB4SORT+12 Save myRegs for sort exits * ..before invoking SORT LA R1,SORTPAL Load Sort Parm List LINK EP=SORT Call SORT LR R2,R15 Save SORT return code LTR R15,R15 SORT RC=0? BNZ SORTBAD No, branch to SORTBAD SORTOK EQU * Yes. MVC PRTLINE+01(L'SORTYES),SORTYES BAL R14,WRITEREC Print successful msg B DONE SORTBAD EQU * MVC PRTLINE+01(L'SORTERR),SORTERR BAL R14,WRITEREC Print sort error msg B DONE EJECT * * /********************************************************/ * * /* Wrap up */ * * /********************************************************/ DONE EQU * Done... MVC PRTLINE+01(L'CNTMSG),CNTMSG UNPK PRTLINE+15(5),RCDCNT(3) Unpack Records Read OI PRTLINE+19,X'F0' UNPK PRTLINE+32(5),DELCNT(3) Unpack Records Deleted OI PRTLINE+36,X'F0' UNPK PRTLINE+47(5),PRTCNT(3) Unpack Records Printed OI PRTLINE+51,X'F0' BAL R14,WRITEREC Print Rcd Cnt msg MVC PRTLINE+01(L'BYEMSG),BYEMSG BAL R14,WRITEREC Print Done msg CLOSE (PRTOUT) Close Printer CLOSE (CARDIN) Close Sort input file * * /********************************************************/ * * /* Restore savearea and return to caller */ * * /********************************************************/ RETURNE EQU * L R13,4(R13) R13=Caller's save area L R14,12(R13) R14=Caller's return addr LR R15,R2 R15=R2 for return code LM R0,R12,20(R13) R0-R12=Caller's R0-R12 BR R14 Return to caller TITLE 'CDPSRTB: Subroutines ' * * /********************************************************/ * * /* Subroutine: Read a record (R14) */ * * /* - R7 CARDIN DCB */ * * /* - R1 Record Buffer */ * * /********************************************************/ READREC DS 0H ST R14,R14SAVE Save R14 GET (R7) Read a record L R14,R14SAVE Restore R14 BR R14 Return to caller * * /********************************************************/ * * /* Subroutine: Write a record (R14) */ * * /* - R7 Printer DCB */ * * /* - R8 Printer Buffer */ * * /* - R10 Printer Buffer Length */ * * /********************************************************/ WRITEREC DS 0H ST R14,R14SAVE Save R14 PUT (R7),(R8) Write to printer MVI 0(R8),C' ' Blank in pos 1 of prt buffer BCTR R10,0 Buffer Length BCTR R10,0 EX R10,CLRBUFF Initialize Buffer area LA R10,2(R10) Restore Original Length L R14,R14SAVE Restore R14 BR R14 Return to caller * * /********************************************************/ * * /* Subroutine: Write to Operator Console (R14) */ * * /********************************************************/ WRITETO EQU * ST R14,R14SAVE Save R14 WTO MF=(E,WTODATA) MVI WTOLINE,C' ' Init pos 1 of WTO text msg MVC WTOLINE+1(WTOLINEL-1),WTOLINE Init remaining of buffer L R14,R14SAVE LOAD RETURN ADDRESS BR R14 RETURN TITLE 'CDPSRTB: E15 Exit - CARDIN Read/Check/SORT insert ' DROP R12 Drop R12 USING *,R15 Tell Assembler, EP from SORT * * /********************************************************/ * * /* E15 Entry Point from SORT */ * * /********************************************************/ E15 EQU * STM R14,R12,12(R13) Save registers in HSA ST R13,SA4EXITS+4 Chain SORT-E15 LA R2,SA4EXITS R2=Addr my Savearea ST R2,8(R13) Chain E15-SORT LA R13,SA4EXITS R13=Addr my Savearea LM R2,R12,SAB4SORT+28 Restore myRegs DROP R15 Drop R15 USING CDPSRTB,R12 Tell Assembler, myBase USING SRTREC,R1 Tell Assembler, SRTREC LA R7,CARDIN R7=Addr CARDIN DCB * * /********************************************************/ * * /* Open input CARDIN */ * * /********************************************************/ OPEN (CARDIN,(INPUT)) Open Sort input file TM CARDIN+(DCBOFLGS-IHADCB),DCBOFOPN OPEN OK? BO READINP Yes, continue * No, error w OPEN, issue WTO MVC WTOLINE(OPENERRL),OPENERR MVC WTOLINE+22(8),=CL8'CARDIN' Move DDNAME BAL R14,WRITETO WTO message B E15EOF Terminate SORT input * * /********************************************************/ * * /* Read input data from CARDIN */ * * /********************************************************/ READINP EQU * BAL R14,READREC Get a record AP RCDCNT,=P'1' Accum RCDCNT * * /********************************************************/ * * /* Check whether to delete or keep sort record */ * * /********************************************************/ CLI SRTSTAT,C'D' Bypass Record? BNE E15INS No, insert record to SORT AP DELCNT,=P'1' Yes, accum DELCNT B READINP .. and read another record EJECT * * /********************************************************/ * * /* Tell SORT to quit calling us, at SORT EOF RC=08 */ * * /********************************************************/ E15EOF EQU * LA R15,8 R15=8, Done... B E15XIT * * /********************************************************/ * * /* Tell SORT to insert record RC=12 */ * * /********************************************************/ E15INS EQU * LA R15,12 R15=12, Insert SORT record LA R1,SRTREC R1=Addr of SORT REC B E15XIT * * /********************************************************/ * * /* E15 Exit Point */ * * /********************************************************/ E15XIT EQU * L R13,4(R13) R13=SORT Savearea L R14,12(R13) R14=SORT return address * -->>>> R15=Initialized before here L R0,20(R13) R0=SORT R0 * -->>>> R1=Initialized before here LM R2,R12,28(R13) R2-R12=SORT R2-12 BR R14 Return to SORT TITLE 'CDPSRTB: E35 Exit - Read and pretty-print SORT data ' DROP R12 Drop R12 USING *,R15 Tell Assembler, EP from SORT * * /********************************************************/ * * /* E35 Entry Point from SORT */ * * /********************************************************/ E35 EQU * STM R14,R12,12(R13) Save registers in HSA ST R13,SA4EXITS+4 Chain SORT-E35 LA R2,SA4EXITS R2=Addr my Savearea ST R2,8(R13) Chain E35-SORT LA R13,SA4EXITS R13=Addr my Savearea LM R2,R12,SAB4SORT+28 Restore myRegs DROP R15 Drop R15 USING CDPSRTB,R12 Tell Assembler, myBase USING SRTREC,R3 Tell Assembler, SORT REC L R3,0(R1) R3=Addr of Sort parm area * 1st addr is SORT Record * 2nd addr is OUTPUT Rcd * 3rd seq check switch * * /********************************************************/ * * /* Open Printer PRETYPRT and print headings, if not open*/ * * /********************************************************/ TM PRETYPRT+(DCBOFLGS-IHADCB),DCBOFOPN Is PRETYPRT open? BO PRTOBYPS Yes, bypass Open OPEN (PRETYPRT,(OUTPUT)) No, Open Printer PRTHDG EQU * MVI PRTLINE,C'1' Print at top of page LA R7,PRETYPRT R7=Addr PRETYPRT LA R8,PRTLINE R8=Addr PRTLINE LA R10,PRTLINEL R10=Length of PRTLINE MVC PRTLINE+01(HEAD2L),HEAD2 BAL R14,WRITEREC Print Report Heading PRTCHDGS EQU * MVI PRTLINE,C'0' Double space LA R7,PRETYPRT R7=Addr PRETYPRT LA R8,PRTLINE R8=Addr PRTLINE LA R10,PRTLINEL R10=Length of PRTLINE MVC PRTLINE+01(COLHDG1L),COLHDG1 BAL R14,WRITEREC Print COL Heading EJECT PRTOBYPS EQU * * * /********************************************************/ * * /* Print SORT detail data */ * * /********************************************************/ LTR R3,R3 End of Data? BZ E35EOF Yes, Sort EOF PRTRCDDT EQU * No, print record... MVC PRTID(L'SRTID),SRTID MVC PRTNAME(L'SRTNAME),SRTNAME MVC PRTADDR(L'SRTADDR),SRTADDR MVC PRTCST(L'SRTCST),SRTCST MVC PRTZIP(L'SRTZIP),SRTZIP MVC PRTSTAT(L'SRTSTAT),SRTSTAT PRTCOLHD EQU * MVI PRTLINE,C' ' Single space LA R7,PRETYPRT R7=Addr PRETYPRT LA R8,PRTLINE R8=Addr PRTLINE LA R10,PRTLINEL R10=Length of PRTLINE MVC PRTLINE+01(PRTRECL),PRTREC BAL R14,WRITEREC Print SORT record AP PRTCNT,=P'1' Accum PRTCNT * * /********************************************************/ * * /* Tell SORT to get next sorted record RC=04 */ * * /********************************************************/ E35GETN EQU * L R13,SA4EXITS+4 R13=SORT Savearea RETURN (14,12),RC=4 Delete SORT record * * /********************************************************/ * * /* Tell SORT to quit calling us, at SORT EOF RC=08 */ * * /********************************************************/ E35EOF EQU * CLOSE PRETYPRT Close Printer L R13,SA4EXITS+4 R13=SORT Savearea RETURN (14,12),RC=8 Done... TITLE 'CDPSRTB: Working Storage ' * * /********************************************************/ * * /* Working Storage */ * * /********************************************************/ SAVEAREA DC 18F'0' my Save Area SAB4SORT DC 18F'0' Save Area before sort link SA4EXITS DC 18F'0' Save Area for exits * +00 A(savearea of current CSECT) * +04 A(savearea of calling CSECT) * +08 A(savearea of called CSECT) * +12 R14 * +16 R15 * +20 R0 * +24 R1 * +28 R2 * +32 R3 * +36 R4 * +40 R5 * +44 R6 * +48 R7 * +52 R8 * +56 R9 * +60 R10 * +64 R11 * +68 R12 R14SAVE DC F'0' R14 Hold Area CLRBUFF MVC 1(0,R8),0(R8) EX MVC to clear buffer EJECT * * /********************************************************/ * * /* Print Buffer */ * * /********************************************************/ PRTLINE DC CL120' ' Print Line PRTLINEL EQU *-PRTLINE * * /********************************************************/ * * /* WTO Data Line */ * * /********************************************************/ DS 0H WTODATA EQU * WTO Block DC H'84' Length of message DC H'00' WTOLINE DC CL080' ' WTO Text Line WTOLINEL EQU *-WTOLINE * * /********************************************************/ * * /* Sort status reporting lines */ * * /********************************************************/ OPENERR DC C'OPEN ERROR ON DDNAME ''XXXXXXXX'' - TERMINATING' OPENERRL EQU *-OPENERR HEAD1 DC C'BALSORT Program' HEAD1L EQU *-HEAD1 CALLSRT DC C'Calling SORT...' CALLSRTL EQU *-CALLSRT SORTYES DC C'SORT Call Successful!!' SORTYESL EQU *-SORTYES SORTERR DC C'SORT Error, terminating' SORTERRL EQU *-SORTERR BYEMSG DC C'Done...' BYEMSGL EQU *-BYEMSG CNTMSG DC C'Records: Read-nnnnn, Discarded-nnnnn, Printed-nnnnn' CNTMSGL EQU *-CNTMSG RCDCNT DC PL3'0' Input Record Count DELCNT DC PL3'0' Deleted Input Record Count PRTCNT DC PL3'0' Print Record Count * * /********************************************************/ * * /* Sort Data Record reporting lines */ * * /********************************************************/ HEAD2 EQU * Sorted Data Report Heading DC C' Report of SORTED data using MVS SORT' HEAD2L EQU *-HEAD2 Length of HEAD2 COLHDG1 EQU * Sorted Data Column Heading DC CL10'ID Number' DC CL30'Person Name' DC CL20'Address' DC CL25'City State' DC CL09'ZipCode' DC CL06'Status' COLHDG1L EQU *-COLHDG1 Length of COLHDG1 PRTREC EQU * Sorted Data Column Details PRTID DC CL10' ' PRTNAME DC CL30' ' PRTADDR DC CL20' ' PRTCST DC CL25' ' PRTZIP DC CL09' ' PRTSTAT DC CL06' ' PRTRECL EQU *-PRTREC Length of PRTREC EJECT * * /********************************************************/ * * /* DCB PRTOUT */ * * /********************************************************/ PRTOUT DCB DDNAME=PRTOUT,MACRF=PM,DSORG=PS,DEVD=DA,RECFM=FBA, X LRECL=80,BLKSIZE=4000 EJECT * * /********************************************************/ * * /* DCB CARDIN */ * * /********************************************************/ CARDIN DCB DDNAME=CARDIN,MACRF=GL,DSORG=PS,DEVD=DA,EODAD=E15EOF EJECT * * /********************************************************/ * * /* DCB PRETYPRT */ * * /********************************************************/ PRETYPRT DCB DDNAME=PRETYPRT,MACRF=PM,DSORG=PS,DEVD=DA,RECFM=FBA, X LRECL=120,BLKSIZE=3600 EJECT * * /********************************************************/ * * /* Sort Parms */ * * /********************************************************/ SORTPAL DC X'80',AL3(SORTPRM) CNOP 2,4 SORTPRM DC AL2(SORTPRME-SORTPRMB) SORTPRMB DC A(SORTB) Start addr of SORT stmt DC A(SORTE) End addr of SORT stmt DC A(RECORDB) Start addr of RECORD stmt DC A(RECORDE) End addr of RECORD stmt DC A(E15) E15 addr or ZEROS DC A(E35) E35 addr or ZEROS DC X'FF',C' AP' All msgs printed on printer SORTPRME DS 0H SORTB DC C' SORT FIELDS=(8,27,A),FORMAT=CH' SORTE DC C' ' RECORDB DC C' RECORD TYPE=F,LENGTH=(80)' RECORDE DC C' ' EJECT * * /********************************************************/ * * /* Literal Pool */ * * /********************************************************/ LTORG TITLE 'CDPSRTB: DSECT Area ' * * /********************************************************/ * * /* DSECTs */ * * /********************************************************/ SRTREC DSECT Sort Record SRTID DS CL07 ID SRTNAME DS CL27 Name SRTADDR DS CL18 Address SRTCST DS CL21 City State SRTZIP DS CL05 Zip Code DS CL01 SRTSTAT DS CL01 Status EJECT DCBD DSORG=PS,DEVD=DA EJECT * * /********************************************************/ * * /* Register Equates */ * * /********************************************************/ R0 EQU 0 R R1 EQU 1 E R2 EQU 2 G R3 EQU 3 I R4 EQU 4 S R5 EQU 5 T R6 EQU 6 E R7 EQU 7 R R8 EQU 8 R9 EQU 9 E R10 EQU 10 Q R11 EQU 11 U R12 EQU 12 A R13 EQU 13 T R14 EQU 14 E R15 EQU 15 S END CDPSRTB /* //GO.SORTLIB DD DSNAME=SYS1.SORTLIB,DISP=SHR //GO.SORTWORK DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK01 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK02 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK03 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK04 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK05 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SORTWK06 DD UNIT=2314,SPACE=(CYL,(5,5)) //GO.SYSPRINT DD SYSOUT=* //GO.SYSOUT DD SYSOUT=* //GO.PRTOUT DD SYSOUT=* //GO.CARDIN DD DSN=HERC01.SORTS01.CNTL(SORTD00),DISP=SHR //GO.PRETYPRT DD SYSOUT=* //
Software Disclosure
This software is provided “AS IS” and without any expressed or implied warranties, including, without limitation, the implied warranties of merchantability and fitness for a particular purpose.
The author requests keeping authors name intact to any modified versions.
In addition, the author requests readers to submit any code modifications / enhancements and associated comments for consideration into a subsequent release (giving credit to contributors) thus, improving overall functionality benefiting the MVS 3.8J hobbyist public domain community.
Download
Click here to download a ZIP file containing installation JCL, text (.TXT) files and HET (Hercules Emulated Tape) file which includes sort data and programs with compile-link-go JCL .
Once the ZIP file is downloaded and extracted, use the following JCL to load the HET tape to your MVS38J system.
//$INST01 JOB (SYS),'Load HET SORTS1', <-- Review and Modify // CLASS=A,MSGCLASS=A, <-- Review and Modify // MSGLEVEL=(1,1) <-- Review and Modify //* -------------------------------------------------------* //* * Sorting in MVS38J / Hercules * //* * * //* * JOB: $INST01 * //* * Load CNTL data set from distribution tape * //* -------------------------------------------------------* //STEP001 EXEC PGM=IEBCOPY //SYSPRINT DD SYSOUT=* //SYSUT1 DD DSN=SORTS01.V1R0M00.TAPE,DISP=OLD, // VOL=SER=VS1000,LABEL=(1,SL), // UNIT=480 <-- Review and Modify //SYSUT2 DD DSN=HERC01.SORTS01.CNTL, // DISP=(,CATLG),DCB=(RECFM=FB,LRECL=80,BLKSIZE=19040), // SPACE=(TRK,(100,10,10)), // UNIT=3350,VOL=SER=PUB000 <-- Review and Modify //SYSIN DD DUMMY /* //
Upon completion of download and installation, review / modify / run the four sort sample programs (SORTBAL, SORTCOB, SORTJCL, SORTPLI)!
In Closing
All sort programs were developed and tested successfully on MVS38J TK3 running under the Hercules 3.13 emulator and MVS38J TK4- Update 8 running under the Hercules 4.00 emulator. Both Hercules emulators run on MS Windows 10 Professional.
After downloading, reviewing and executing the above sorting examples, I hope your technical ‘know-how’ is augmented incrementally, thus increasing overall IT experience and reference that you apply as a MVS38J hobbyist!
Please use the comment box below or the contact us link on the menu bar to communicate any suggestions, improvements, corrections or issues.
Thanks!
Larry Belmontes