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: /
 
 

01  LBL "LCL"  02  SIGN  03  CLX  04  LBL 01  05  STO IND L  06  ISG L  07  GTO 01  08  END

 
   ( 19 bytes )
 
 

STACK	INPUTS	OUTPUTS
X	bbb.eee(ii)	/

 
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: /
 
 

01  LBL "LCO"  02  ENTER^  03  SIGN  04  ST- L  05  LBL 01  06  ISG L  07  CLX  08  CLX  09  RCL IND Z  10  STO IND L  11  ISG Z  12  GTO 01  13  X<> L  14   E3  15  /  16  +  17  END

 
   ( 33 bytes )
 
 

STACK	INPUTS	OUTPUTS
Y	bbb.eee(ii)	/
X	BBB	BBB.EEE

 
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: /
 
 

01  LBL "LSWAP"  02  SIGN  03  LBL 01  04  CLX  05  RCL IND L  06  X<> IND Y  07  STO IND L  08  ISG Y  09  CLX  10  ISG L  11  GTO 01  12  END

 
   ( 27 bytes )
 
 

STACK	INPUTS	OUTPUTS
T	T	T
Z	Z	Z
Y	bbb.eee(ii)1	/
X	bbb.eee(ii)2	/

-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
 
 

STACK	INPUTS	OUTPUTS
T	T	T
Z	Z	T
Y	bbb.eee(ii)	Z
X	+/- BBB	BBB.EEE(ii)
L	L	+/- BBB

 
-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: /
 
 

01  LBL "L123"  02  SIGN  03  LBL 01  04  CLX  05  RCL IND Z  06  X<> IND Y  07  X<> IND L  08  STO IND Z  09  ISG Z  10  CLX  11  ISG Y  12  CLX  13  ISG L  14  GTO 01  15  END

 
   ( 32 bytes )
 
 

STACK	INPUTS	OUTPUTS
T	T	T
Z	bbb.eee(ii)1	/
Y	bbb.eee(ii)2	/
X	bbb.eee(ii)3	/

-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: /
 
 

01  LBL "RVL"  02  ENTER^  03  FRC  04   E3  05  *  06  LBL 01  07  RCL IND Y  08  X<> IND Y  09  STO IND Z  10  RDN  11  ISG Y  12  DSE X  13  X>Y?  14  GTO 01  15  END

 
  ( 30 bytes )
 
 

STACK	INPUT	OUTPUT
X	bbb.eee	/

 
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: /
 
 

01  LBL "LDL" 02  RCL Y 03  X<>Y 04  LBL 01 05  RCL IND Y 06  X=Y? 07  GTO 00

08  RDN 09  ISG Y 10  GTO 01       11  X<> Z 12  RTN 13  LBL 00 14  R^

15  R^ 16  ENTER^ 17  ISG Y 18  X<0? 19  GTO 00       20  LBL 02 21  RCL IND Y

22  STO IND Y 23  RDN 24  ISG X 25  ISG Y 26  GTO 02 27  LBL 00 28 X<> Z

29   E-3 30  - 31  END

 
    ( 55 bytes )
 
 

STACK	INPUTS	OUTPUTS
Y	bbb.eee	/
X	x	bbb.eee'

 
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: /
 
 

01  LBL "INTER" 02  STO M 03  STO N 04  RDN 05  STO Z 06  DSE N 07  LBL 01

08  CLX 09  RCL IND Y   10  RCL Z 11  SIGN 12  LBL 02 13  CLX 14  RCL IND L

15  X=Y? 16  GTO 03         17  ISG L 18  GTO 02 19  GTO 04 20  LBL 03 21  ISG N

22  LBL 03 23  STO IND N   24  LBL 04 25  RDN 26  ISG Y 27  GTO 01 28  RCL N

29   E3 30  / 31  RCL M          32  + 33  CLA 34  END

 
   ( 62 bytes )
 
 

STACK	INPUTS	OUTPUTS
Z	bbb.eee1	/
Y	bbb.eee2	/
X	BBB	BBB.EEE

 
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 )
 
 

01  LBL "UNION" 02  X<>Y 03  STO N 04  RDN 05  XEQ "LCO" 06  STO M 07  LASTX

08   E3 09  * 10  LBL 01 11  RCL IND N    12  RCL M 13  SIGN 14  LBL 02

15  CLX 16  RCL IND L    17  X=Y? 18  GTO 03 19  ISG L 20  GTO 02 21  ISG Z

22  CLX 23  RDN 24  STO IND Y    25   E-3 26  ST+ M 27  LBL 03 28  X<> Z

29  ISG N 30  GTO 01           31  X<> M 32  CLA 33  END

 
   ( 65 bytes )
 
 

STACK	INPUTS	OUTPUTS
Z	bbb.eee1	/
Y	bbb.eee2	/
X	BBB	BBB.EEE

 
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 )