PRINT NOGEN
SSSORT   CSECT
 TITLE 'BUBBLE SORT ROUTINE'
***********************************************************************
*  PGM: SSSORT                                                        *
*  AUTHOR: RUSSELL SNYDER                                             *
*  INSTALLATION: FIRST CITY BANK DALLAS                               *
*  VERSION: 12/19/90                                                  *
*  PGM DESCRIPTION: SORT A TABLE IN CORE, GIVEN 1ST AND LAST TABLE    *
*                   ENTRIES AND TABLE ENTRY LENGTH.                   *
*                                                                     *
*             CALL  SSSORT(TABLE,TABLEND,LENGTH)                      *
*                                                                     *
*  LENGTH     DC    F'5'      ENTRY LENGTH                            *
*  TABLE      DS    100CL5    FIRST ENTRY                             *
*  TABLEEND   EQU   *-5       LAST ENTRY                              *
*                                                                     *
***********************************************************************
         EJECT
         DS    0H                    * GENERAL REGISTER EQUATES
R0       EQU   00                      * STANDARD IBM USAGE
R1       EQU   01                      * STANDARD IBM USAGE
R2       EQU   02                      *
R3       EQU   03                      *
R4       EQU   04                      *
R5       EQU   05                      *
R6       EQU   06                      *
R7       EQU   07                      *
R8       EQU   08                      *
R9       EQU   09                      *
R10      EQU   10                      *
R11      EQU   11                      *
R12      EQU   12                      *
R13      EQU   13                      * FORWARD/BACK SAVE AREA CHAIN
R14      EQU   14                      * STANDARD IBM USAGE
R15      EQU   15                      * STANDARD IBM USAGE
         DS    0H                    * MISC REGISTER EQUATES
BASE     EQU   03                      * BASE REGISTER
ENTRY    EQU   04                      * TBL ENTRY TO BE SORTED
LENGTH   EQU   05                      * TABLE ENTRY LENGTH
ELENGTH  EQU   06                      * EXEC ENTRY LENGTH
BEGIN    EQU   07                      * TABLE BEGIN ADDR
NXTENTRY EQU   08                      * NXT TBL ENTRY TO BE SORTED
END      EQU   09                      * TABLE END ADDR
         EJECT
SSSORT   CSECT                      ** ESTABLISH ADDRESSABILITY
         STM   R14,R12,12(R13)         * SAVE CALLERS REGISTERS
         LR    BASE,R15                * PUT ENTRY POINT IN BASE REG.
         USING SSSORT,BASE             * DECLARE CSECT ADDRESSABILITY
         ST    R13,SAVEAREA+4          * SAVE ADDR OF CALLERS SAVE AREA
         LA    R13,SAVEAREA            * LOAD ADDRESS OF OUR SAVE AREA
         SPACE 2
SORT00   DS    0H                   ** GET  PASSED PARAMETERS
         L     ENTRY,0(R1)             * ADDR(1ST TABLE ENTRY)
         L     BEGIN,0(R1)             * ADDR(1ST TABLE ENTRY)
         L     END,4(R1)               * ADDR(LAST TABLE ENTRY)
         BCTR  END,0
         L     LENGTH,8(R1)            * ADRR(TBL ENTRY LENGTH)
         L     LENGTH,0(LENGTH)        * TABLE ENTRY LENGTH
         LR    ELENGTH,LENGTH          * SET EXE LENGTH
         BCTR  ELENGTH,0               *   = (ENTRY LENGTH - 1)
         SPACE 2
SORT01   DS    0H                    * SORT LOOP
         LA    NXTENTRY,0(LENGTH,ENTRY) * A(OF NEXT RECORD)
         EX    ELENGTH,COMPARE         * Q - IN SEQUENCE ?
         BH    SORT02                  * N- GO SWAP THEM
         LA    ENTRY,0(LENGTH,ENTRY)   * Y- NEXT RECORD
         CR    ENTRY,END               * Q- LAST ENTRY?
         BNL   SORT03                  * Y- END SORT ROUTINE
         B     SORT01                  * N- SORT SOME MORE
         SPACE 2
SORT02   DS    0H                    * SWAP TWO ENTRIES
         EX    ELENGTH,SWAP1           * SWAP 1,2
         EX    ELENGTH,SWAP2           * SWAP 2,1
         EX    ELENGTH,SWAP1           * SWAP 1,2
         CR    ENTRY,BEGIN             * Q- 1ST PAIR IN TABLE
         BE    SORT01                  * Y- NO NEED TO BACK UP
         SLR   ENTRY,LENGTH            * N- BACK UP AND
         B     SORT01                  *    RECHECK SEQUENCE
         SPACE 2
SORT03   DS    0H                    * SORT ROUTINE EXIT
         L     R13,SAVEAREA+4          * ADDRESS OF CALLERS SAVEAREA
         LM    R14,R12,12(R13)         * RESTORE CALLERS REGISTERS
         SR    R15,R15                 * SET RETURN CODE
         BR    R14                     * RETURN TO CALLER
         SPACE 2
         DS    0H                    * EXECUTE INSTRUCTIONS
COMPARE  CLC   0(0,ENTRY),0(NXTENTRY)  * Q- ENTRIES IN SEQUENCE?
SWAP1    XC    0(0,NXTENTRY),0(ENTRY)  * REVERSE
SWAP2    XC    0(0,ENTRY),0(NXTENTRY)  * REVERSE
         EJECT
         DS    0H                    * CONSTANTS AND LITERALS USED HERE
         DROP  BASE                    * RELEASE BASE REGISTER
         LTORG ,                       * BUILD LITERAL POOL
         SPACE 2
SAVEAREA DC    18F'0'                * REGISTER SAVE AREA
         END