Miscellaneous Short Routines for the HP-41

Overview
 

 1°)  Clearing a Block of Registers
 2°)  Copying a List
 3°)  Block Exchange
 4°)  A M-Code Routine ( HP-41CX )
 5°)  Circular Permutation of 3 Blocks
 6°)  Reversion of a List
 7°)  Deleting an Element from a List
 8°)  Intersection of 2 Sets
 9°)  Union of 2 Sets
 

-The following programs perform basic operations on blocks of registers.
 

1°) Clearing a Block of Registers
 

-This routine replaces CLRGX if you don't have an HP-41CX
 

Data Registers:   Only those of the array
Flags: /
Subroutines: /
 
 

 
   ( 19 bytes )
 
 

 
Example:   To clear registers  R10  R12  R14  R16 ,    10.01602   XEQ "LCL"
 

-If  ii = 1 ,  ii can be omitted
 

2°) Copying a List
 

-This program moves a list of elements ( control number bbb.eee ) to another address BBB.
-The blocks of registers cannot overlap, unless  BBB <= bbb
 

Data Registers:   Only those of the 2 Lists
Flags: /
Subroutines: /
 
 

 
   ( 33 bytes )
 
 

 
Example:     {  2  5  7  1  6  }  =  {  R10  R11  R12  R13  R14 }.  Move these numbers into registers R07  R08 ..... R11

   10.014   ENTER^
       7        XEQ "LCO"  >>>   7.011

-This program may improved so that it also works if  bbb < BBB <= eee.
  cf for instance references [1] & [2]
-The control number BBB.EEE is correct only if ii = 0.
 

3°) Block Exchange
 

Data Registers:   Only those of the 2 Lists
Flags: /
Subroutines: /
 
 

 
   ( 27 bytes )
 
 

-Registers Z and T are saved.

Example:

-You want to swap the contents of registers  R01  R02  R03  R04
                      with  the contents of registers  R14  R16  R18  R20

    1.004     ENTER^
 14.02002  XEQ "LSWAP"  >>>>  /
 

-In reference 2, Philippe Descamps and Jean-Jacques Dhenin give a trick to stop the routine when the smallest block has been exchanged:
-Replace line 09 by   FS? 30   RTN
 

4°)  An M-Code Routine ( HP-41CX )
 

-"LCO" uses an entry point in block 3 ( address 3EC4h ) that performs REGMOVE if CPU-flag 4 is clear and REGSWAP if CPU-flag 4 is set.
-The HP-41 checks that the required registers do exist and displays "NON EXISTENT" otherwise.
-Unlike the 2 routines listed above, the registers must be contiguous.
 

08F   "O"
003   "C"
00C  "L"
0B8   READ 2(Y)
10E   A=C ALL
0F8   READ 3(X)
355   ?NCXQ        checks for alpha data,
050   14D5            xeq  A<>C  and SETDEC
088   SETF 5             C
0ED  ?NCXQ            =
064   193B              int(C)
070   N=C ALL
0B8   READ 2(Y)
084   CLRF 5             C
0ED  ?NCXQ            =
064   193B              frc(C)
226   C=C+1 S&X
226   C=C+1 S&X
226   C=C+1 S&X
10E   A=C ALL
0B0  C=N ALL
2BE  C=-C-1 MS      C=-C
01D  ?CXQ               C=
061   1807                A+C
0A8  WRIT 2(Y)
10E   A=C ALL
0F8   READ 3(X)
128   WRIT 4(L)        do not key in this word if you don't want to save +/- BBB in L-register
044   CLRF 4
2FE   ?C#0 MS
013   JNC +02
048   SETF 4              CPU-flag 4 is set if  BBB < 0
05E   C=0 MS            C= | C |
0E8   WRIT 3(X)
01D  ?NCXQ               C=
060   1807                  A+C
266   C=C-1 S&X
266   C=C-1 S&X
266   C=C-1 S&X
10E   A=C ALL
0F8   READ 3(X)
01D  ?NCXQ               C=
060   1807                  A+C
10E   A=C ALL
0B8   READ 2(Y)
0AE  A<>C ALL
0A8  WRIT 2(Y)
04E   C=0 ALL             C
35C  PT=12                  =
050   LD@PT- 1           1
01D  ?NCXQ               C=
060   1807                  A+C
266   C=C-1 S&X
266   C=C-1 S&X
266   C=C-1 S&X
10E   A=C ALL
0F8   READ 3(X)
01D  ?NCXQ               C=
060   1807                  A+C
266   C=C-1 S&X
266   C=C-1 S&X
266   C=C-1 S&X
10E   A=C ALL
0B0  C=N ALL
01D  ?NCXQ               C=
060   1807                  A+C
0E8   WRIT 3(X)
311   ?NCXQ             This address is correct for an HP-41 CX but not for an HP-41C with an X-Functions module.
0F8   3EC4                 It can surely be replaced by another one if you have an X-Functions module but I do not know it.
3A5  ?NCXQ             ?ncxq
050   14E9                  RDN
078   READ 1(Z)
028   WRIT 0(T)
3C1  ?NCGO              the 4 subroutine-levels have been used, so we cannot use  3E0  RTN  to end the routine properly.
002   00F0                  It must be replaced by the 2 words  3C1  002
 
 

 
-The increment ii is not taken into account, except that it also appears in the X-output
-So "LCO" can be used to move or swap matrices: X-output = control number of the second matrix with ii = number of rows.

-Choose a positive X-input  BBB to move a block of registers
-Choose a negative X-input  -BBB to swap 2 blocks of registers
 

5°) Circular Permutation of 3 Blocks
 

Data Registers:   Only those of the 3 Lists
Flags: /
Subroutines: /
 
 

 
   ( 32 bytes )
 
 

-T-register is saved.
-The order of the permutation is  1 -> 2 -> 3 -> 1

Example:

   { R01  R02  R03  R04 } = { 2  4  1  8 }
   { R11  R12  R13  R14 } = { 7  1  9  3 }
   { R21  R22  R23  R24 } = { 5  3  2  6 }

  1.004   ENTER^
 11.014  ENTER^
 21.024  XEQ "L123"  >>>>  ( 6 )  and now,

   { R01  R02  R03  R04 } = { 5  3  2  6 }
   { R11  R12  R13  R14 } = { 2  4  1  8 }
   { R21  R22  R23  R24 } = { 7  1  9  3 }
 

6°) Reversion of a List
 

Data Registers:   Only those of the list
Flags: /
Subroutines: /
 
 

 
  ( 30 bytes )
 
 

 
Example:          { R01  R02  R03  R04 } = { 2  4  1  8 }

  1.004   XEQ "RVL"  >>>>  ( 2 )   and   { R01  R02  R03  R04 } = { 8  1  4  2 }
 

7°) Deleting an Element from a List
 

Data Registers:   Only those of the list
Flags: /
Subroutines: /
 
 

 
    ( 55 bytes )
 
 

 
Example:     Delete  7  from the list    { R10  R11  R12 } = { 3  7  2 }

   10.012  ENTER^
        7      XEQ "LDL"  >>>>  10.011    and    { R10  R11 } = { 3  2 }

-If x is not in the list, the list is unchanged and bbb.eee' = bbb.eee
-If x is the unique element ( eee = bbb ), eee' = bbb-1
-"LDL" only deletes the first element equal to x.
-If you want to delete all the elements equal to x, execute "LDL" recursively until bbb.eee' = bbb.eee or eee' = bbb-1
 

8°) Intersection of 2 Sets
 

-We seek the elements that are common to 2 given non-empty sets.
 

Data Registers:   Only those of the 3 sets
Flags: /
Subroutines: /
 
 

 
   ( 62 bytes )
 
 

 
Example:

      { R01  R02  R03  R04 }      =   { 2  4  1  8 }     =  A
  { R11  R12  R13  R14  R15 } = { 4  9  2  10  8 } =  B

-If you choose  BBB = 21

  1.004   ENTER^
 11.015  ENTER^
    21      XEQ "INTER"  >>>  21.023      and   { R21  R22  R23 } = { 2  4  8 } = A Ç B

-We assume that each element appears only once in the set.
-If the intersection is the empty set,  EEE = BBB - 1 ( with BBB = 21,  X-Output would be 21.020 )
 

9°) Union of 2 Sets
 

Data Registers:   Only those of the 3 sets
Flags: /
Subroutine:   "LCO"  ( cf § 2 )
 
 

 
   ( 65 bytes )
 
 

 
Example:

        { R01  R02  R03  R04 }    =    { 2  4  1  8 }    = A
   { R11  R12  R13  R14  R15 } = { 4  9  2  10  8 } = B

-If you choose  BBB = 21

  1.004   ENTER^
 11.015  ENTER^
    21      XEQ "UNION"  >>>  21.026      and   { R21  R22  R23  R24  R25  R26 } = { 2  4  1  8  9  10 } = A È B

-We assume that each element appears only once in the set.
 

References:

[1]  PPC ROM user's manual
[2]  Philippe Descamps & Jean-Jacques Dhenin , "Programmer HP-41" - PSI - ISBN 2-86595-056-5  ( in French )