MVS38J

Sorting in MVS38J

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. Most sorting requirements are satisfied by executing a SORT/MERGE utility job step in a batch environment to order a set of data before applying a processing or reporting activity. Also, the IBM S360 SORT/Merge product can also be invoked from higher-level languages such as COBOL!

As users of MVS38J, in most cases, if not all, sorting functions consist of ordering a set of data without any filtering or data modification. Typically, comprised of reading an entire INPUT data file, creating an OUTPUT data file duplicating the input data sorted by a specified criteria.

The sort/merge product provides exit processing that facilitates calling external programs at various points of the sorting phases such as inspection and conditional processing of sort input and/or sort output records.  For more details, refer to GC28-6543-5 IBM System/360 Operating System Sort/Merge manual which can be searched for on the Internet.

This post will illustrate cross-language usage of a simple SORT task using the same logical solution written in four different languages – SORT JCL, COBOL SORT, PL/I SORT and Assembler (BAL) SORT. 

SORT Task Problem Statement:
o Sort and print all records
o Sort in ascending NAME sequence

Note: The 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 provides COBOL ANSI v2 , PL/I F v5.5 and Assembler (IFOX00) compilers will be utilized for this demonstration.

The Data

The manufactured data contains 5 records 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

HERC01.SORTS00.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

Sort JCL

The below MVS Sort utility JOB uses SORTIN DD as file input from HERC01.TEST.CNTL(SORTD00) and creates an output file referenced by DD SORTOUT (output directed to printer, SYSOUT=*) with sorting order specified via DD SYSIN (SORT FIELDS=(8,27,A),FORMAT=CH).

HERC01.SORTS00.CNTL(SORTJCL)
0        1         2         3         4         5         6         7         8
1...+....0....+....0....+....0....+....0....+....0....+....0....+....0....+....0
//HERC01C  JOB (SYS),'JCL SORT',                 <-- Review and Modify
//             CLASS=A,MSGCLASS=A,               <-- Review and Modify
//             MSGLEVEL=(1,1),NOTIFY=HERC01      <-- Review and Modify
//* -------------------------------------------------------*
//* *  SORT utility to create a sorted file in name        *
//* *  sequence from an input file.                        *
//* *  Uses SORTIN and SORTOUT.                            *
//* -------------------------------------------------------*
//STEP010  EXEC PGM=SORT,PARM='MSG=AP'
//SORTLIB  DD DISP=SHR,DSN=SYS1.SORTLIB                      
//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.SORTS00.CNTL(SORTD00),DISP=SHR
//SYSPRINT DD SYSOUT=*                          
//SYSOUT   DD SYSOUT=*                          
//SORTOUT  DD SYSOUT=*,DCB=(BLKSIZE=80,RECFM=F) 
//SYSIN    DD *                                    
 SORT FIELDS=(8,27,A),FORMAT=CH             
 RECORD TYPE=F,LENGTH=(80)
/*
//                             

–  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 sort an INPUT file (IN-FILE, DD=CARDIN) producing an OUTPUT file (OUT-FILE, DD=PRTOUT) with sort order declared within the SORT verb. After the SORT completes, the return code is interrogated and appropriate message is displayed on the CONSOLE via the DISPLAY statement.

HERC01.SORTS00.CNTL(SORTCOB)                                                    
0        1         2         3         4         5         6         7         8
1...+....0....+....0....+....0....+....0....+....0....+....0....+....0....+....0
//HERC01C  JOB (001),'COB SORT',                 <-- 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 print a sorted file
                               in name sequence from an input file.
       
                               The SORT operation is performed via
                               the SORT COBOL verb with USING and     
                               GIVING 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  FILLER              PIC X(80).                                   
            
       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).
       EJECT
       PROCEDURE DIVISION.

       0000-MAINLINE.
        
      ******************************************************
      * INVOKE SORT                                        *
      ******************************************************
           SORT SORT-FILE
                ON ASCENDING KEY SRT-NAME
                USING  IN-FILE               
                GIVING OUT-FILE.
                 
      ******************************************************
      * 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.
            
      ******************************************************
      * RETURN TO CALLER                                   *
      ******************************************************
           GOBACK.  
/*    
//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.SORTS00.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, IHESRTA, to sort an INPUT file (DD=SORTIN) producing an OUTPUT file (DD=SORTOUT). The sort order is within a PARM address list in the IHESRTA CALL statement. After the sort, the return code is interrogated and appropriate completion message is printed to DD=SYSPRINT via the PUT statement.

HERC01.SORTS00.CNTL(SORTPLI)                                          
0        1         2         3         4         5         6         7         8
1...+....0....+....0....+....0....+....0....+....0....+....0....+....0....+....0
//HERC01C  JOB (001),'PLI SORT',                 <-- 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           */
   /*                                                           */
   /* Purpose: This program makes use of the PL/I SORT          */
   /*          interface feature via the IHESTRA entry point    */
   /*          using SORTIN and SORTOUT.                        */
   /*                                                           */
   /* 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 IHESRTA ENTRY (CHAR(32), /* SORT FIELDS */
                         CHAR(27), /* RECORD TYPE */
                         FIXED BINARY(31,0),
                         FIXED BINARY(31,0));
   /*************************************************************/
   /* Declare Others...                                         */
   /*************************************************************/
      DCL SORT_RC        FIXED BINARY(31,0);
           
   /*************************************************************/
   /* Invoke OS Sort                                            */
   /*************************************************************/
      CALL IHESRTA (' SORT FIELDS=(8,27,A),FORMAT=CH ',
                    ' RECORD TYPE=F,LENGTH=(80) ',
                    55000,
                    SORT_RC);
                     
   /*************************************************************/
   /* Check SORT return code                                    */
   /*************************************************************/
      IF SORT_RC = 0 THEN DO;
        PUT FILE(SYSPRINT)                                      
            SKIP EDIT ('SORT Completed Successfully')(A);
      END;
      ELSE DO;
        PUT FILE(SYSPRINT)                                      
            SKIP EDIT ('SORT Error-- RC=', SORT_RC)(A);
      END;
         
   /*************************************************************/
   /* 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.SORTIN   DD DSN=HERC01.SORTS00.CNTL(SORTD00),DISP=SHR
//GO.SYSPRINT DD SYSOUT=*      
//GO.SYSOUT   DD SYSOUT=*      
//GO.SORTOUT  DD SYSOUT=*,DCB=(RECFM=FB,LRECL=80,BLKSIZE=4000)
//

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 from the Assembler program using an INPUT file (DD=SORTIN) and producing an OUTPUT file (DD=SORTOUT). The sort order is specified in a Parameter Address List (SORTPAL) whose address is loaded into Register 1 before the LINK EP=SORT statement. After the sort, the return code is interrogated and appropriate completion message is printed to DD=PRTOUT via the PUT statement in the WRITEREC subroutine.

HERC01.SORTS00.CNTL(SORTBAL)                                          
0        1         2         3         4         5         6         7         8
1...+....0....+....0....+....0....+....0....+....0....+....0....+....0....+....0
//HERC01C  JOB (001),'BAL SORT',                 <-- 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
*
*  Purpose: This program invokes the SORT product to print        
*           a sorted file in name sequence from an input file.
*                             
*           The SORT operation is performed via the LINK macro
*           using a parmlist as specifed by the SORT product.
*                             
*           Uses SORTIN and SORTOUT.
*                                                                   
*  Disclaimer: <DSCLAIMR>
*  ===================================================================
*                                                                               
*     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   * 
         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'BYEMSG),BYEMSG 
         BAL   R14,WRITEREC                Print Done msg             
         CLOSE (PRTOUT)                    Close Printer
*     * /********************************************************/
*     * /* 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: 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: Working Storage                            '   
*     * /********************************************************/
*     * /* Working Storage                                      */
*     * /********************************************************/
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
R14SAVE  DC    F'0'                        R14 Hold Area
CLRBUFF  MVC   1(0,R8),0(R8)               EX MVC to clear buffer
         EJECT
*     * /********************************************************/
*     * /* Print Buffer                                         */
*     * /********************************************************/
PRTLINE  DC    CL080' '                    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   
         EJECT
*     * /********************************************************/
*     * /* DCB PRTOUT                                           */
*     * /********************************************************/
PRTOUT   DCB   DDNAME=PRTOUT,MACRF=PM,DSORG=PS,DEVD=DA,RECFM=FBA,      X
               LRECL=80,BLKSIZE=4000
         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(0)                        E15 addr or ZEROS
         DC    A(0)                        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                                               */
*     * /********************************************************/
         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.SORTIN   DD DSN=HERC01.SORTS00.CNTL(SORTD00),DISP=SHR
//GO.SORTOUT  DD SYSOUT=*,DCB=(RECFM=FB,LRECL=080,BLKSIZE=4000)
//

Software Disclosure

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 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 SORTS0',          <-- 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=SORTS00.V1R0M00.TAPE,DISP=OLD,                                
//             VOL=SER=VS1000,LABEL=(1,SL),                  
//             UNIT=480                          <-- Review and Modify   
//SYSUT2   DD  DSN=HERC01.SORTS00.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 JOB sets 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, your overall technical knowledge base will be enriched, thus increasing the amount of experience and reference you apply to your IT programming practices and/or interests as a MVS38J hobbyist, career-driven IT individual or where ever your IT focus target lands.

Enjoy!
Larry Belmontes

Tagged

2 thoughts on “Sorting in MVS38J

Leave a Reply

Your email address will not be published. Required fields are marked *


CAPTCHA Image
Reload Image

This site uses Akismet to reduce spam. Learn how your comment data is processed.