TITLE 'BSORT.MLC - BOUBLE SORT FOR INTEGER ARRAY'
* PROGRAM = BOSRT.MLC
* AUTHOR  - DON HIGGINS
* DATE    - 12/12/97
* REF     - WWW.Z390.ORG MAINFRAME ASSEMBLER CODING CONTEST
* REMARKS - THIS IS WORST CASE EXAMPLE TO BE IMPROVED UPON
P4DSH1   ZMFACC CODE,START,NAME='Don Higgins'
         COPY  ASMMSP  COPY STRUCTURED PROGRAMMING MACROS
         CALL  BSORTINT,(TABLE,TABLE_END)
         ZMFACC CODE,END
         ZMFACC INPUT,START
         ZMFACC OUTPUT,START
TABLE    DC    20A(TABLE_END-*)
TABLE_END EQU *
         ZMFACC INPUT,END
         ZMFACC OUTPUT,END
*
* SORT TABLE OF INTEGERS - ARGS = ADDR AND LENGTH OF TABLE IN BYTES
*
BSORTINT SUBENTRY
         LM    R3,R4,0(R1)  R3=ADDRESS OF TABLE
         LR    R5,R3        R5=NEXT COMPARE           
         LR    R6,R4  
         AHI   R6,-4        R6=LAST ENTRY TO BE COMPARED
         DO    WHILE=(CR,R5,LT,R6)
               LM  R0,R1,0(R5)     FETCH TWO WORDS TO COMPARE
               IF  (CR,R0,GT,R1)   COMPARE TWO WORDS
                   MVI SWAP,TRUE   AT LEAST ONE SWAP ON THIS PASS
                   LR  R2,R0
                   STM R1,R2,0(R5) STORE TWO WORDS REVERSED
               ENDIF
               AHI R5,4            INCREMENT TO NEXT COMPARE
               IF  (CR,R5,GE,R6)   ARE WE AT END OF PASS
                   IF (CLI,SWAP,EQ,TRUE) WAS THERE A SWAP
                      MVI SWAP,FALSE RESET SWAP FLAG
                      LR  R5,R3      RESET NEXT COMP FOR NEXT PASS
                      AHI R6,-4      SKIP LAST COMPARE ALREADY  SORTED
                  ENDIF
               ENDIF
         ENDDO
         SUBEXIT
SWAP     DC    AL1(FALSE)
TRUE     EQU   1
FALSE    EQU   0
         END