* SORT-RELEASE ROUTINE                                  HEADER  C:RLSE  0001.000
*                                                                       0002.000
*              SORT-RELEASE ROUTINE                                     0003.000
*                                                                       0004.000
         M.PGM     C:RLSE,MPX-32,3.6.1,00                               0005.000
*                                                                       0006.000
* SET UP COMPOSITE KEY AREA                                             0007.000
*                                                                       0008.000
*    CALLING SEQUENCE                                                   0009.000
*        BL    C:RLSE                                                   0010.000
*        AC    FIT            FILE IDENTIFICATION TABLE ADDRS           0011.000
*        AC    SCB            ADDRESS OF SORT CONTROL BLOCK             0012.000
*        AC    JET            JET RETURN ENTRY                          0013.000
*        AC    SIT0           SEGMENT RETURN                            0014.000
*        AC    SIT1                                                     0015.000
*                                                                       0016.000
*                                                                       0017.000
         DEF   C:RLSE                                                   0018.000
         EXT   CR.CVNB                                                  0019.000
         EXT   CR.CVPB                                                  0020.000
         M.REQS                                                         0021.000
DD.A     EQU   0              0 - ASCENDING KEYS,  1 - DESCENDING KEYS  0022.000
DD.LEN   EQU   1H                                                       0023.000
DD.PTR   EQU   1W                                                       0024.000
PKEYLIST EQU   21W                                                      0025.000
PKEYAREA EQU   5W                                                       0026.000
SCBRTN   EQU   20W                                                      0027.000
SCBCSQ   EQU   22W                                                      0028.000
         COBOLDAT                                                       0029.000
*                                                                       0030.000
* INTERNAL DATA                                                         0031.000
*                                                                       0032.000
         ORG       WORKAREA+16D                                         0033.000
RET      RES   1W                                                       0034.000
CSQTBL   RES   1W                                                       0035.000
DUMDD    RES   2W                                                       0036.000
DUMDDS   RES   2W                                                       0037.000
KEYAREA  RES   1W                                                       0038.000
KEYLIST  RES   1W                                                       0039.000
NOKEYS   RES   1W                                                       0040.000
TEMP     RES   2W                                                       0041.000
         REL                                                            0042.000
*                                                                       0043.000
* GET ARGUMENTS                                                         0044.000
*                                                                       0045.000
C:RLSE   EQU       $                                                    0046.000
         ABR   R0,29          SKIP PAST FIT ARG                         0047.000
         LOAD  2              R1->SCB, R2->JET                          0048.000
         LW    R7,SCBCSQ,X1                                             0049.000
         STW   R7,CSQTBL                                                0050.000
         TRR   R0,R3                                                    0051.000
         ABR   R0,28                                                    0052.000
         STW   R0,RET         SAVE RETURN ADDRESS                       0053.000
         LW    R4,0,X3                                                  0054.000
         BNZ   RLS020                                                   0055.000
         LW    R5,1W,X3                                                 0056.000
         BZ    RLS030                                                   0057.000
RLS020   EQU   $                                                        0058.000
         STW   R4,0,X2        JET <- SIT0,SIT1                          0059.000
         LW    R5,1W,X3                                                 0060.000
         STW   R5,1W,X2                                                 0061.000
         BU    RLS100                                                   0062.000
RLS030   EQU   $                                                        0063.000
         LW    R4,=X'0000FFFF'  JET <- NORMAL RETURN                    0064.000
         STW   R4,0,X2                                                  0065.000
         TRR   R0,R4                                                    0066.000
         ABR   R4,28          SKIP PAST SRTXIT                          0067.000
         STW   R4,1W,X2                                                 0068.000
RLS100   EQU   $                                                        0069.000
         LW    R2,PKEYAREA,X1                                           0070.000
         LW    R1,PKEYLIST,X1                                           0071.000
         STW   R2,KEYAREA                                               0072.000
         LW    R3,=A(TEMP)                                              0073.000
         STW   R3,DUMDD+1W                                              0074.000
         LW    R7,0,X1                                                  0075.000
         ADI   R1,1W                                                    0076.000
*                                                                       0077.000
* MOVE EACH KEY TO COMPOSITE KEY AREA                                   0078.000
*                                                                       0079.000
KEYLOOP  STW   R7,NOKEYS      SAVE NUMBER OF KEYS LEFT TO MOVE          0080.000
         STW   R1,KEYLIST     SAVE POINTER TO NEXT KEY                  0081.000
         TBM   15,0,X1                                                  0082.000
         TBM   14,0,X1                                                  0083.000
         BCT   1,NUMERIC      TEST TYPE NUMERIC OR PACKED               0084.000
         BCF   2,ALPHA                                                  0085.000
         BU    BINNUM                                                   0086.000
*                                                                       0087.000
*    CONVERT DECIMAL KEY TO BINARY                                      0088.000
*                                                                       0089.000
NUMERIC  EQU   $                                                        0090.000
         LW    R2,1W,X1                                                 0091.000
         STW   R2,DUMDDS+1W                                             0092.000
         LW    R2,0,X1                                                  0093.000
         ANMW  R2,=X'7FFCFFFF'                                          0094.000
         SBR   R2,0                                                     0095.000
         STW   R2,DUMDDS                                                0096.000
         STW   R2,DUMDD                                                 0097.000
         LW    R2,=A(DUMDD)                                             0098.000
         TBM   15,0,X1        TEST NUMERIC VS PACKED                    0099.000
         BCF   SET,PACKED                                               0100.000
         LW    R1,=A(DUMDDS)                                            0101.000
         BL    CR.CVNB                                                  0102.000
         BU    LDR1                                                     0103.000
PACKED   LW    R1,=A(DUMDDS)                                            0104.000
         BL    CR.CVPB                                                  0105.000
LDR1     LW    R1,=A(DUMDD)                                             0106.000
*                                                                       0107.000
*    ADD BIAS AND DETERMINE ACTUAL LENGTH OF NUMBER                     0108.000
*                                                                       0109.000
BINNUM   EQU       $                                                    0110.000
         BL        ADDBIAS                                              0111.000
         LH    R6,DD.LEN,X1   GET NUMBER OF DIGITS IN NUMBER            0112.000
         LI    R7,-2                                                    0113.000
         CI    R6,4           IF R6 < 5                                 0114.000
         BLE   MOVKEY            THEN LET R7 = -2                       0115.000
         CI    R6,9           IF R6 < 10                                0116.000
         BLE   WORD              THEN LET R7 = -4                       0117.000
         ADI   R7,-4             ELSE LET R7 = -8                       0118.000
WORD     ADI   R7,-2                                                    0119.000
         BU    MOVKEY                                                   0120.000
*                                                                       0121.000
* SET UP ALPHANUMERIC KEY                                               0122.000
*                                                                       0123.000
ALPHA    LNH   R7,DD.LEN,X1   GET LENGTH IN R7                          0124.000
         LW    R2,DD.PTR,X1   GET POINTER TO SOURCE DATA IN R2          0125.000
*                                                                       0126.000
*    MOVE KEY TO COMPOSITE KEY AREA                                     0127.000
*                                                                       0128.000
MOVKEY   LI    R4,0                                                     0129.000
         LW    R1,KEYLIST                                               0130.000
         TBM   DD.A,0,X1                                                0131.000
         BNS   $+2W                                                     0132.000
         LI    R4,X'FF'                                                 0133.000
         LW    R6,CSQTBL      TEST FOR COLLATING ORDER                  0134.000
         BZ    MOVLP2                                                   0135.000
         TBM   15,0,X1                                                  0136.000
         TBM   14,0,X1                                                  0137.000
         BCT   SET,MOVLP2       RESEQUENCE ONLY IF TYPE IS ALPHA        0138.000
         BCT   2,MOVLP2                                                 0139.000
         LW    R1,KEYAREA                                               0140.000
MOVLOOP  TRR   6,3                                                      0141.000
         LB    R5,0,X2                                                  0142.000
         ADR   R5,R3                                                    0143.000
         LB    R5,0,X3                                                  0144.000
         EOR   R4,R5                                                    0145.000
         STB   R5,0,X1                                                  0146.000
         ABR   R1,31                                                    0147.000
         ABR   R2,31                                                    0148.000
         BIB   R7,MOVLOOP                                               0149.000
         BU    ENDLOOP                                                  0150.000
MOVLP2   LW    R1,KEYAREA                                               0151.000
MOVLOOP2 LB    R5,0,X2                                                  0152.000
         EOR   R4,R5                                                    0153.000
         STB   R5,0,X1                                                  0154.000
         ABR   R1,31                                                    0155.000
         ABR   R2,31                                                    0156.000
         BIB   R7,MOVLOOP2                                              0157.000
ENDLOOP  STW   R1,KEYAREA                                               0158.000
         LW    R1,KEYLIST                                               0159.000
         TBM       15,0,X1                                              0160.000
         BNS       SVKEYPT                                              0161.000
         TBM       14,0,X1                                              0162.000
         BS        SVKEYPT                                              0163.000
         BL        ADDBIAS                                              0164.000
SVKEYPT  EQU       $                                                    0165.000
         ADI   R1,2W                                                    0166.000
         LW    R7,NOKEYS                                                0167.000
         SUI   R7,1                                                     0168.000
         BP    KEYLOOP                                                  0169.000
         BU    *RET                                                     0170.000
*                                                                       0171.000
* ADD BIAS TO BINARY NUMBER                                             0172.000
ADDBIAS  EQU       $                                                    0173.000
         LW        R2,DD.PTR,X1                                         0174.000
         LI        R4,X'0080'                                           0175.000
         EOMB      R4,0,X2                                              0176.000
         STB       R4,0,X2                                              0177.000
         TRSW      R0                                                   0178.000
         END                                                            0179.000
