SRTTST: PROCEDURE OPTIONS (MAIN)
$             OPT P,MEM
!
!       THIS IS THE TEST PROGRAM FOR THE MPL VERSION
!           OF A MODIFIED SHELL SORT. AT THE REVISION LEVEL
!           OF THE CURRENT COMPILER THE PROGRAM REQUIRES HEX
!           28C BYTES OF MEMORY FOR THE SORT SUB.
!
!       WRITTEN BY JOEL BONEY FOR MOTOROLA INC. JAN 76.
!
!
!       THE TEST PROGRAM TAKES 75 MSEC TO SORT THE BUFFER
!           THIS IS QUITE AWHILE.  TIME COULD BE SAVED BY
!           USING THE PTR MODE.
!
!
!       DUE TO THE FACT THAT REVISIONS MAY OCCUR TO THE
!           MPL COMPILER IT WILL BE NECESSARY FOR THE
!           USER TO GET THE ASSEMBLY LISTING TO BE ABLE
!           TO SIMULATE THIS TEST.
!
!-------------------------------
!       THIS PROCEDURE TESTS THE CORE SORT (CSORT)
!       SUBROUTINE.
               DECLARE SIZE BINARY (1)  INITIAL (14)    !BUFFER SIZE
               DECLARE ESIZE BINARY (1) INITIAL(2)       !ENTRY SIZE
               DECLARE SFLAG                            !SORTED FLAG
               DECLARE SBUF(14) BINARY (2) INITIAL (17,21,13,8,500,
               23,16,12,0,-5,73,62,1,28)                !TEST BUFFER
!       EXECUTABLE COST
START:
               CALL CSORT (SIZE,ESIZE,SFLAG)
               IF SFLAG EQ 0 THEN GO TO BAD
               CALL CSORT (SIZE,ESIZE,SFLAG)            !ALREADY SORTED
               IF SFLAG NE 0 THEN GO TO BAD2
OKAY:     GO TO OKAY
!      HERE WHEN UNSORTED DATA WAS NOT SORTED
BAD:       GO TO BAD
!      HERE WHEN SORTED DATA WAS SORTED
BAD2:     GO TO BAD2
               END SRTTST

$PAGE
CSORT:  PROCEDURE (BUFSIZ,ENSIZ,IFLAG)
!
!       BINARY (2) CORE SORT
!
!       THIS SUBROUTINE SORTS A CORE BUFFER STORED IN ARRAY
!       NAMED SBUF OF LENGTH BUFSIZ AND ENTRY SIZE ENSIZ.
!       BUFSIZ MUST BE LESS THAN 256
!       SBUF CAN BE BINARY (1) OR (2).
!       ENTRIES ARE CONSIDERED TO BE MULTIPLE PRECISION
!       NUMBERS OR ASCII STRINGS AND ARE SORTED FROM
!       MSB TO LSB
!
!
!       BUFSIZ=CORE BUFFER SIZE (BINARY (1))
!       ENSIZ= SIZE OF EACH INDIVIDUAL ENTRY (BINARY (1))
!       IFLAG= SET TO NON ZERO IF SOMETHING WAS SORTED
!              SET TO 0 IF NO SORT RESULTED
!
!       JOEL BONEY FOR MOTOROLA INC. JAN 76
!
               DECLARE M,NO,IFLAG,K,J,I,II,IIM,NUM,LOCFLG
               DECLARE CTR,PTR1,PTR2,BUFSIZ,ENSIZ,LENSIZ
               DECLARE ITEMP BINARY (2)
!EXECUTABLECODE
CSRTA:   M=BUFSIZ/ENSIZ              !ENTRIES/ BUFFER
               NO=M                        !UNCHANGING COPY OF M
               LOCFLG=0                    !USE A LOCAL FLAG FOR SPEED
               LENSIZ=ENSIZ
!START OF BIG SORT LOOP
BIGLOP: M=M%-1;                     !DIVIDE M BY 2
               IF M EQ 0 THEN GO TO OUT
               K=NO-M                      !NBR OF VALUES NOT IN M AREA
CAT:       DO J=1 TO K                 !COMPARE M VALUES TO ALL K'S
                                           !AND ORDER
                 I=J                       !INIT INDEX
CKREST:   II=(I-1)*LENSIZ+1         !CALCULATE ARRAY SUBSCRIPT
                 IIM=(I+M-1)*LENSIZ+1      !OTHER IS M AWAY
CSRTB:   DO NUM=1 TO LENSIZ          !COMPARE ALL CHARS
                   PTR1=II+NUM-1
                   PTR2=IIM+NUM-1
                   IF SBUF (PTR1)<SBUF(PTR2) THEN GO TO SKIP
                   IF SBUF (PTR1)>SBUF(PTR2) THEN GO TO SWAP
                 END CSRTB
SWAP:       LOCFLG=LOCFLG+1           !SET SORTED FLAG
CSRTC:     DO CTR=1 TO LENSIZ        !SWAP THE ENTRIES
                   ITEMP=SBUF(II)          !SAVE FIRST
                   SBUF(II)=SBUF(IIM)      !MOVE 2ND TO 1ST
                   SBUF(IIM)=ITEMP         !MOVE FIRST TO 2ND
                   II=II+1
                   IIM=IIM+1
                 END CSRTC
                 I=I-M                    !DO WE NEED TO GO BACK UP
                IF I GE 1 THEN GO TO CKREST !CHECK WITH ONES ABOVE
SKIP:   END CAT                             !NO, DO NEXT ENTRY
             GO TO BIGLOP                  !DO NEXT ITERATIOON
OUT:      IFLAG=LOCFLG               !COPY LOCAL FLAG TO GLOBAL
              RETURN
              END CSORT