List Commands Library for 50g

[Joe Horn]

The algorithm used by the 50g's SORT command was mentioned above in this discussion. For what it's worth, here's the listing of SORT from the original HP-48G/GX operating system source code. The code remained the same in the 49G, 49G+, and 50g.

Code:

**miscdoc+*******************************************^******
************************************************************
**
** File:    AUFRList.s Version 1.11, 05/06/93
** Machine: Alcuin
**
************************************************************
**+miscdoc**************************************************

*************************************************************
*************************************************************
* SORT
* 
* Sorts the elements of a list in ascending order.  
* Uses code developed by Joe Horn and released to the public domain.
*
* Input:  {}
*
* Output: {}'
*
*************************************************************
*************************************************************
ASSEMBLE
        CON(1)  (nonALG)+0*(hasHELP)+0*(hasALIAS)+0*(hasPDATA)
RPL
xNAME SORT
:: CK1&Dispatch list dosort
;

NULLNAME dosort
:: :: UseHidden{}:
      :: SWAP NotIDorLAM? ITE FalseFalse TrueTrue 4ROLL
     3NULLLAM{} BIND ( 3: lam? 2: id/lam? 1:n )
     2GETLAM IT {id}>{$} 1GETLAM 
     #1+_ONE_DO (DO)
        1GETLAM ROLL ZERO INDEX@
        BEGIN ?ATTNQUIT
           2DUP SWAP#- #2/ DUP#0<>
        WHILE
           OVERSWAP #-DUP #4+PICK 5PICK 
CODE
    C=PC
sort1    LA(5)    (sort2)-(sort1)
    A=A+C    A
    PC=(A)
ENDCODE
               %1 %= ( will be skipped if args are reals )
           ITE ROTDROPSWAP SWAPDROP
        REPEAT
        ROT2DROP UNROLL
         LOOP 2GETLAM IT {$}>{id} 1GETABND
      ;
      COLA 
   ;
LOCALNAME sort2
   :: CK&DISPATCH1 2REAL 
CODE
    D0=D0+    5    skip %1
    D0=D0+    5    skip %=
        LA(5)    =%>
        PC=(A)        go do %>
ENDCODE
                   2STR STR>STR
                   # 000BB HXS>HXS
                   # 000EE UM>?
                   # 000E1 UM>?
                   # 0001E UM>?
                   # 00066 :: ID>$ SWAP ID>$ SWAP STR>STR ;
                   # 00077 :: ID>$ SWAP ID>$ SWAP STR>STR ;
                   2LIST 
      :: DUPLENCOMP #0=case SETSIZEERR CARCOMP
         SWAP DUPLENCOMP #0=case SETSIZEERR CARCOMP SWAP
         COLA
CODE
    C=PC
sort3    LA(5)    (sort2)-(sort3)
    A=A+C    A
    PC=(A)
ENDCODE
      ;
   ; 
;