Sort (List sorts...) 
Author Message
 Sort (List sorts...)

A while ago there was a question about sorting.  Here's a
subroutine (written here at UCLA) which was placed on one of the
MVS tapes a while ago (CBT?).  The version here has been updated
to XA by the addition of AMODE/RMODE statements.

There are two parts to this, the MACRO used to generate a DSECT
by the caller (and used in the code too) and the actual sort routine.
Note that this sort routine works by "merging" lists.  This is
*fast*.  Even worst case is fast (and worst case for a merge sort
is MUCH faster than "quicksort"s worst case).

So folks, I don't want to see any more bubble sorts out there...

PS: OACREGS is the obvious register equates...

         MACRO                                                          00010000
&LABEL   OACLSORT &DSECT=YES,&PREFIX=LS#,&DOC=NO                        00020000
         LCLC  &LAB,&P                                                  00030000
         AIF   ('&DOC' EQ 'NO').NODOC                                   00040000
* --------------------------------------------------------------------- 00050000
*                                                                       00060000
*   LSORT - LIST SORT (IN STORAGE)                                      00070000
*                                                                       00080000
*  OAC LIST SORT ROUTINE PARAMETER LIST (INCORE SORT)                   00090000
*                                                                       00100000

*                                                                       00120000
*  EXIT: R15 = RETURN CODE (CC SET)                                     00130000
*               0 - RECORDS SORTED (INPLACE)                            00140000
*               4 - WORK AREA TOO SMALL                                 00150000
*                                                                       00160000
*  THE WORK AREA REQUIRED IS >= 256 BYTES.                              00170000
*                                                                       00180000
*     COMPARE ROUTINE CALLED WITH:  R15 - ENTRY POINT                   00190000
*                                   R14 - RETURN ADDRESS                00200000



*                                   R3  - COMPARE ROUTINE PARM          00240000
*                                                                       00250000
*  CONDITION CODE RETURNED FROM COMPARE ROUTINE DETERMINES ORDER,       00260000
*    IF HIGH THEN ELEMENT (R1) WILL APPEAR AFTER (R2),                  00270000
*    IF LOW  THEN ELEMENT (R1) WILL APPEAR BEFORE (R2),                 00280000
*    ELSE ORDER OF RECORDS IS UNDEFINED.                                00290000
*                                                                       00300000
*   THE COMPARE ROUTINE MUST RESTORE *ALL* THE REGISTERS R0-R15.        00310000
*                                                                       00320000
*---------------------------------------------------------------------- 00330000
.NODOC   ANOP                                                           0034000
&P       SETC  '&PREFIX'(1,3)     SET MAX PREFIX                        00350000
&LAB     SETC  '&P'               SET DEFAULT LABEL                     00360000
         AIF   ('&LABEL' EQ '').CK#DS BIF NO USER LABEL                 00370000
&LAB     SETC  '&LABEL'           SET USER'S LABEL                      00380000
.CK#DS   AIF   ('&DSECT' EQ 'YES').DSECT BIF DSECT GENERATION           0039000
&LAB     DC    0D'0'              OACLSORT PARAMETER LIST               00400000
         AGO   .GEN               BIF TO GENERATE DATA                  00410000
.DSECT   ANOP                     GENERATE DSECT HERE                   0042000
&LAB     DSECT ,                  OACLSORT PARAMETER LIST               00430000
.GEN     ANOP                                                           0044000

&P.LNKOF DC    F'0'               OFFSET OF LINK TO NEXT RECORD         00460000

&P.CMPPM DC    A(0)               PARM FOR COMPARE ROUTINE              00480000

&P.WRKLN DC    F'0'               LENGTH OF WORK AREA    (>= 256)       00500000
         AIF   ('&DSECT' NE 'YES').MEND                                 00510001
&P.L     EQU   *-&LAB             LENGTH OF PARAMETER LIST              00520000
.MEND    MEND                                                           0053000

//CSYSMASA JOB ,'OACLSORT',MSGCLASS=A,COND=(0,NE)                       00000100
/*ROUTE PRINT WYLBUR                                                    00000200
//ASM EXEC ASMHCL,PARM.LKED='RENT,REUS,LIST,LET,NCAL'                   00000300
//ASM.SYSLIB DD                                                         00000400
//           DD                                                         00000500
//           DD DISP=SHR,DSN=SYS5.MSSMAC                                00000600
         TITLE 'OACLSORT -- OAC LIST SORT SUBROUTINE'                   00000700
OACLSORT CSECT ,                                                        00000800
OACLSORT RMODE ANY                                                      00000900
OACLSORT AMODE ANY                                                      00001000
*---------------------------------------------------------------------* 00001100
*                                                                     * 00001200
*  OACLSORT -- UCLA/OAC LIST SORT SUBROUTINE                          * 00001300
*                                                                     * 00001400


*        R14 - RETURN ADDRESS                                         * 00001700

*                                                                     * 00001900
*  SEE OACLSORT MACRO FOR COMPARE ROUTINE INTERFACE DESCRIPTION.      * 00002000
*                                                                     * 00002100
*---------------------------------------------------------------------* 00002200
         SPACE 1                                                        00002300
         OACLSORT DOC=YES                                               00002400
         SPACE 1                                                        00002500
W#       DSECT ,                  WORK AREA DSECT                       00002600
W#SAVE   DC    18F'0'             COMPARE ROUTINE SAVEAREA              00002700
W#HEAD0  DC    A(0)               LIST HEAD 0                           00002800
W#HEAD1  DC    A(0)               LIST HEAD 1                           00002900
W#L      EQU   *-W#               LENGTH OF OACLSORT WORK AREA          00003000
         SPACE 1                                                        00003100
OACLSORT CSECT ,                                                        00003200
         STM   R14,R12,12(R13)                                          00003300
         LR    R12,R15                                                  00003400
         OACUSING OACLSORT,R12                                          00003500

         OACUSING LS#,R11                                               00003700
         CLC   LS#WRKLN,=A(W#L)   WORK AREA LONG ENOUGH?                00003800
         BL    RET4                                                     00003900

         OACUSING W#,R10                                                00004100
         ST    R13,W#SAVE+4                                             00004200
         LA    R13,W#SAVE                                               00004300
         SPACE 1                                                        00004400

         L     R3,LS#CMPPM        COMPARE ROUTINE PARM                  00004600
         L     R9,LS#LNKOF        OFFSET OF LINK FIELD IN RECORDS       00004700
         SR    R0,R0              CONSTANT OF ZERO                      00004800
         SPACE 1                                                        00004900
* REGISTER USAGE:                                                       00005000
*                                                                       00005100
*  R0  - ZERO       (CONSTANT)                                          00005200
*  R1  - PARM FOR COMPARE ROUTINE / WORK                                00005300
*  R2  - PARM FOR COMPARE ROUTINE / WORK                                00005400
*  R3  - COMPARE ROUTINE PARM                                           00005500
*  R4  -                                                                00005600
*  R5  -                                                                00005700
*  R6  -                                                                00005800
*  R7  -                                                                00005900
*  R8  -                                                                00006000
*  R9  - LINK OFFSET IN RECORDS                                         00006100




*  R14 - WORK / LINK                                                    00006600

*                                                                       00006800
         SPACE 1                                                        00006900
* SPLIT REGISTER USAGE:                                                 00007000
*  R1  - NEW ELEMENT PTR (TOP OF INPUT LIST)                            00007100
*  R2  - OLD ELEMENT PTR (BOTTOM OF ONE OUTPUT LIST - CURRENT)          00007200

         L     R1,LS#LSTHD        GET ORIG LIST (OR 0)                  00007400
         N     R1,=X'7FFFFFFF'    ANY ORIG LIST?                        00007500
         BZ    RET0               BIF NULL LIST, DONE                   00007600
         SPACE 1                                                        00007700
* EMPTY BOTH OUTPUT LISTS                                               00007800
SPLIT    ST    R0,W#HEAD0                                               00007900
         ST    R0,W#HEAD1                                               00008000
* INIT OUTPUT PTRS (R2, R4)                                             00008100
         LA    R2,W#HEAD0                                               00008200
         SR    R2,R9              - LINK OFFSET                         00008300
         LA    R4,W#HEAD1                                               00008400
         SR    R4,R9              - LINK OFFSET                         00008500
* ADD RECORD AT END OF OUTPUT                                           00008600
SPLITADD O     R1,0(R9,R2)        ADD TO END OF CURRENT OUTPUT LIST     00008700
         ST    R1,0(R9,R2)         WITH FLAG                            00008800
         LR    R2,R1              NEW END OF CHAIN                      00008900

         ST    R0,0(R9,R2)        FORCE IS END OF LIST                  00009100
         SPACE 1                                                        00009200
* OUTPUT A SEQUENCE TO (R2) FROM (R1)                                   00009300
         N     R1,=X'7FFFFFFF'    ANY MORE ON INPUT LIST?               00009400
         BZ    MERGE              BIF NONE LEFT, SPLIT COMPLETE         00009500
         BALR  R14,R15            COMPARE PREV TO NEW (HIGH IF R1 HIGH) 00009600
         BNL   SPLITADD           BIF SAME SEQ, JUST ADD TO CURRENT SEQ 00009700
* NEWSEQ - SWAP OUTPUT PTRS                                             00009800
         L     R14,=X'80000000'   END OF SEQUENCE FLAG                  00009900
         ST    R14,0(R9,R2)        MARK END OF PREV SEQUENCE            00010000
         XR    R2,R4              MAKE OTHER OUTPUT                     00010100
         XR    R4,R2               THE CURRENT OUTPUT                   00010200
         XR    R2,R4                                                    00010300
         B     SPLITADD           AND GO ADD ELEMENT TO NEW CUR OUTPUT  00010400
         SPACE 1                                                        00010500
* MERGE REGISTER USAGE:                                                 00010600
*  R1  - INPUT LIST PTR                                                 00010700
*  R2  - INPUT LIST PTR                                                 00010800
*  R4  - 0TH OUTPUT LIST BOTTOM PTR                                     00010900
*  R5  - 1ST OUTPUT LIST BOTTOM PTR                                     00011000
* NOW MERGE HEAD0/1 LISTS                                               00011100
         SPACE 1                                                        00011200
* MERGE TO SETS OF STRINGS                                              00011300
MERGE    L     R1,W#HEAD0                                               00011400
         L     R2,W#HEAD1                                               00011500
         LR    R14,R2                                                   00011600
         N     R14,=X'7FFFFFFF'   TWO LISTS TO MERGE?                   00011700
         BZ    RET0               BIF SORT DONE                         00011800

         SR    R4,R9              - OFFSET                              00012000

         SR    R5,R9              - OFFSET                              00012200
         ST    R0,W#HEAD0         INIT LIST EMPTY                       00012300
         ST    R0,W#HEAD1         INIT LIST EMPTY                       00012400
         SPACE 1                                                        00012500
MERGELP  LTR   R1,R1              SOURCE 0 HAVE ELEMENT?                00012600
         BNP   MERGEC0            BIF NO SRC 0 ELEMENT                  00012700
         LTR   R2,R2              SOURCE 1 HAVE ELEMENT?                00012800
         BNP   MERGEC1            BIF NO SRC 1 ELEMENT                  00012900
MERGECMP BALR  R14,R15            FIND LOWEST                           00013000
         BNH   MERGEADD           BIF (R1) <= (R2), USE (R1) ELEMENT    00013100
MERGESWP XR    R1,R2                                                    00013200
         XR    R2,R1                                                    00013300
         XR    R1,R2                                                    00013400
MERGEADD N     R1,=X'7FFFFFFF'    ADD TO END OF NEW LIST                00013500
         O     R1,0(R9,R4)          WITH PREVOUS EOD OF STRING          00013600
         ST    R1,0(R9,R4)            FLAG                              00013700
         LR    R4,R1              IS LAST ON LIST                       00013800
         L     R1,0(R9,R1)        NEXT ON THIS LIST TO MERGE            00013900
         ST    R0,0(R9,R4)        ZERO LINK PTR                         00014000
         B     MERGELP                                                  00014100
         SPACE 1                                                        00014200
* END OF STRING ON INPUT 0 (OR END OF 0)                                00014300
MERGEC0  LTR   R2,R2              ANY LEFT ON INPUT 1?                  00014400
         BP    MERGESWP           BIF SOME LEFT ON 1, GO ADD            00014500
         B     MERGEEOS                                                 00014600
         SPACE 1                                                        00014700
* END OF STRING ON INPUT 1 (OR END OF 1)                                00014800
MERGEC1  LTR   R1,R1              ANY LEFT ON INPUT 0?                  00014900
         BP    MERGEADD           BIF SOME LEFT ON 1, GO ADD            00015000
         SPACE 1                                                        00015100
** END OF BOTH INPUT STRINGS (END OFF OUTPUT CURRENT OUTPUT STRING)     00015200
MERGEEOS L     R14,=X'80000000'   FLAG END OF OUTPUT STRING             00015300
         ST    R14,0(R9,R4)                                             00015400
         XR    R4,R5                AND SWAP OUTPUT PTRS                00015500
         XR    R5,R4                                                    00015600
         XR    R4,R5                                                    00015700
** CHECK IF BOTH END OF LIST                                            00015800
         N     R1,=X'7FFFFFFF'                                          00015900
         N     R2,=X'7FFFFFFF'                                          00016000
         LR    R14,R1             TEST IF ANY INPUT LEFT                00016100
         OR    R14,R2              ON ANY INPUT LIST                    00016200
         BNZ   MERGELP            BIF STILL HAVE INPUT LEFT, GO MERGE   00016300
* MERGE DONE AT THIS POINT...                                           00016400
         ST    R0,0(R9,R5)        CLR INCASE SORT DONE (CLR HIGH BIT)   00016500
         B     MERGE              CONTINUE SORT...                      00016600
         SPACE 1                                                        00016700
RET0     ST    R1,LS#LSTHD        RETURN SORTED LIST                    00016800
         SR    R15,R15              AND RETURN CODE ZERO                00016900
         L     R13,4(,R13)        RESTORE ORIG R13                      00017000
RET      L     R14,12(,R13)                                             00017100
         LM    R0,R12,12+8+4*R0(R13)                                    00017200
         LTR   R15,R15                                                  00017300
         BR    R14                                                      00017400
         SPACE 1                                                        00017500
RET4     LA    R15,4              RETURN CODE 4                         00017600
         B     RET                                                      00017700
         SPACE 1                                                        00017800
         OACREGS ,                                                      00017900
         END                                                            00018000
//LKED.SYSLMOD DD DISP=SHR,DSN=SYS5.MSSLOAD,SPACE=,UNIT=                00018100
//LKED.SYSIN   DD *                                                     00018200
   ENTRY OACLSORT                                                       00018300
   IDENTIFY OACLSORT('CS02290')                                         00018400
   NAME OACLSOR$(R)                                                     00018500
//                                                                      00018600
//C   EXEC PGM=COMPARE,                                                 00018700
//  PARM='OACLSOR$(OACLSORT),OACLSORT(OACLSORT)'                        00018800
//STEPLIB  DD DISP=SHR,DSN=SYS5.MSSLOAD                                 00018900
//SYSPRINT DD SYSOUT=*                                                  00019000
//I1       DD DISP=(SHR,PASS),DSN=&&GOSET                               00019100
//I2       DD DISP=SHR,DSN=SYS5.MSSLOAD                                 00019200



Mon, 19 Apr 1993 00:24:00 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. UNIX sort exponents (bc|sort)

2. Binary Sort/Merge Sort in awk

3. ANN: New release of S.C.A. Micro Templates (Browse Header Sort and Reverse Sort Template)

4. Sort of Sorts

5. All Sorts of Sorts

6. All Sorts of Sorts

7. All Sorts of Sorts

8. All Sorts of Sorts

9. Sorting a list of lists.

10. operator - on list should be O(n) on sorted lists

11. Straight Insertion Sort and Binary Insertion Sort

12. Bubble sort/Selection sort help neded.

 

 
Powered by phpBB® Forum Software