Retro1.org codex

*DECK NDLSST
      PROC NDLSST(TABLE,FRST$WORD,BIT$POS,MASK,ENT$SZ,NUM$ENT); 
      BEGIN 
*IF,DEF,IMS 
# 
**    NDL$SST - SHELL SORT TABLE. 
* 
*     D.K. ENDO    81/11/10 
* 
*     THIS PROCEDURE USES SHELL-S METHOD FOR SORTING A TABLE. (SEE CACM 
*     VOL. 6 NUMBER 5  MAY 1963,  PAGE 209) 
* 
*     PROC NDL$SST(TABLE,FRST$WORD,BIT$POS,MASK,ENT$SZ,NUM$ENT) 
* 
*     ENTRY        TABLE = TABLE TO BE SORTED.
*                  FRST$WORD = FIRST WORD IN TABLE TO BEGIN SORT. 
*                  BIT$POS = BEGINNING BIT POSITION OF MASK.
*                  MASK = LENGTH OF MASK IN NUMBER OF BITS. 
*                  ENT$SZ = ENTRY SIZE IN CP WORDS. 
*                  NUM$ENT = NUMBER OF ENTRIES TO BE SORTED.
* 
*     EXIT         TABLE = TABLE SORTED IN ASCENDING ORDER. 
* 
*     METHOD
* 
*     FOR I=1 STEP I UNTIL NUM$ENT, 
*       GAP = 2 * I - 1 
*     FOR GAP=GAP/2 WHILE M NQ ZERO,
*       K = NUM$ENT - GAP.
*       FOR J=1 STEP 1 UNTIL K, 
*         FOR I=J STEP -GAP UNTIL ONE,
*           IF ENTRY[I+GAP] LESS THAN ENTRY[I], 
*             EXCHANGE THE TWO ENTRIES. 
* 
*     THE FIRST LOOP DETERMINES GAP AS THE CLOSEST POWER OF TWO TO THE
*     ENTRY COUNT, MINUS ONE.  THE SECOND LOOP CONTROLS THE GAP BETWEEN 
*     COMPARED ELEMENTS. INITIALLY GAP/2, IT SHRINKS BY A FACTOR OF TWO 
*     EACH PASS UNTIL IT BECOMES ZERO. THE THIRD LOOP COMPARES ELEMENTS 
*     SEPARATED BY GAP. THE FOURTH LOOP EXCHANGES ANY THAT ARE OUT OF 
*     ORDER.
* 
# 
*ENDIF
      ITEM FRST$WORD;        # FIRST WORD TO BE SORTED                 #
      ITEM BIT$POS;          # BEGINNING BIT POSITION OF MASK          #
      ITEM MASK;             # LENGTH OF MASK IN NUMBER OF BITS        #
      ITEM ENT$SZ;           # LENGTH OF EACH ENTRY IN CP WORDS        #
      ITEM NUM$ENT;          # NUMBER OF ENTRIES IN TABLE              #
      ARRAY TABLE[0:0] S(1);# TABLE TO BE SORTED                       #
        BEGIN 
        ITEM TBL$WORD (0,0,60); 
        END 
#                                                                      #
      ITEM GAP;              # NUMBER OF ENTRIES BETWEEN THE TWO       #
                             #   ELEMENTS BEING COMPARED               #
      ITEM I;                # POINTER TO THE 1ST OF THE 2 ELEMENTS TO #
                             #   BE COMPARED                           #
      ITEM J;                # USED TO INITIALIZE -I-                  #
      ITEM K;                # LAST VALUE FOR -I- BEFORE NEXT PASS     #
      ITEM L;                # USED FOR STEPPING THRU THE EXCHANGE OF  #
                             #   EACH WORD IN THE ENTRY                #
      CONTROL EJECT;
#                                                                      #
#                            SHELL SORT CODE BEGINS HERE               #
#                                                                      #
      GAP = 0;               # INITIALIZE GAP VALUE                    #
      FOR I=1 STEP I WHILE I LQ NUM$ENT DO
        BEGIN                # GAP = THE CLOSEST POWER OF TWO TO THE   #
        GAP = (2 * I) - 1;   #   ENTRY COUNT, MINUS 1                  #
        END 
 
                             # DIVIDE THE GAP BY TWO FOR EACH PASS     #
      FOR GAP = GAP/2 WHILE GAP NQ 0 DO 
        BEGIN 
 
                             #CALCULATE POSITION OF LAST ELMT MINUS GAP#
        K = FRST$WORD + (NUM$ENT -(GAP + 1)) * ENT$SZ;
 
                             # BEGINNING W/1ST ELMT INCR TO NEXT ONE   #
        FOR J=FRST$WORD STEP ENT$SZ UNTIL K DO
          BEGIN 
 
                             # BEGINNING W/-J- COMPARE ELEMENT ABOVE   #
          FOR I=J STEP -(GAP * ENT$SZ) WHILE I GQ FRST$WORD DO
            BEGIN 
 
                             # IF 2ND ELEMENT IS LESS THAN 1ST,        #
                             #   THEN EXCHANGE THEM                    #
            IF B<BIT$POS,MASK>TBL$WORD[I + (GAP * ENT$SZ)] LS 
               B<BIT$POS,MASK>TBL$WORD[I] 
            THEN
              BEGIN 
 
                             # EXCHANGE THE ENTRY WORD BY WORD         #
              FOR L=0 STEP 1 UNTIL ENT$SZ-1 DO
                BEGIN 
 
                TBL$WORD[I + (GAP * ENT$SZ) + L] == TBL$WORD[I + L];
                END 
              END 
            END 
          END 
        GAP = GAP/2;         # DIVIDE THE GAP BY TWO                   #
        END 
      RETURN;                # **** RETURN ****                        #
      END # NDLSST #
      TERM