M-Code Routines for Hypercomplex Numbers

Overview
 

 1°)  Norm & Inverse of a Quaternion
 2°)  Square of a Quaternion
 3°)  Square-Root of a Quaternion
 4°)  Product of 2 Quaternions
 5°)  Termination Criterion for Quaternionic Series
 6°)  Non-Merged Functions

   a)  2 M-Code Subroutines GETRG# & VALID?
   b)  Storing & Recalling the Stack
   c)  Termination Criterion for Quaternionic Series (II)
 

-The focal programs that are listed in "Quaternions for the HP-41" allow to perform the main operations on quaternions.
-They are, however, relatively slow and M-Code routines may improve their speed.

-I've used simplified mnemonics.
-For example, C=X instead of the more rigorous  READ3 (X)
 

Warning:
 

-There is no check for alpha data, but the existence of the required data registers - if any - is tested.
 

1°)  Norm & Inverse of a Quaternion
 

091   "Q"
013   "S"
002   "B"
001   "A"
288   SETF 7
02B   JNC+05
091   "Q"
02F   "/"
031   "1"
284   CLRF 7
2A0   SETDEC
0F8   C=X
128   L=C
10E   A=C ALL
135    C=
060   A*C
070   N=C ALL
0B8  C=Y
10E  A=C ALL
135    C=
060   A*C
0B0   C=N ALL
025    C=
060   AB+C
070   N=C ALL
078   C=Z
10E   A=C ALL
135    C=
060   A*C
0B0   C=N ALL
025    C=
060   AB+C
070   N=C ALL
046   C
270   =
038   T
10E   A=C ALL
135    C=
060   A*C
0B0   C=N ALL
025    C=
060   AB+C
28C   ?FSET 7
02B   JNC+05
305   C=
060   sqrt(AB)
0E8   X=C
3E0   RTN
2BE   C= -C
070   N=C ALL
046   C
270   =
038   T
10E   A=C ALL
0B0   C=N ALL
261   C=
060   A/C
028   T=C
078   C=Z
10E   A=C ALL
0B0   C=N ALL
261   C=
060   A/C
068   Z=C
0B8  C=Y
10E   A=C ALL
0B0   C=N ALL
261   C=
060   A/C
0A8  Y=C
0F8   C=X
2BE   C= -C
10E   A=C ALL
0B0   C=N ALL
261   C=
060   A/C
0E8   X=C
3E0   RTN

 ( 78  lines )
 
 

  with    q = x + y i + z j + t k  ,   1/q = x' + y' i + z' j + t' k   and   Abs(q) = | q | = ( x² + y² + z² + t² ) ^1/2
 

2°)  Square of a Quaternion
 

0B2   "2"
01E   "^"
011   "Q"
2A0  SETDEC
0F8   C=X
128   L=C
10E   A=C ALL
135    C=
060   A*C
2BE  C= -C
070   N=C ALL
0B8   C=Y
10E   A=C ALL
135    C=
060   A*C
0B0  C=N ALL
025   C=
060   AB+C
070   N=C ALL
078   C=Z
10E   A=C ALL
135    C=
060   A*C
0B0  C=N ALL
025   C=
060   AB+C
070   N=C ALL
046   C
270   =
038   T
10E   A=C ALL
135    C=
060   A*C
0B0   C=N ALL
025    C=
060   AB+C
2BE   C= -C
0E8   X=C
138   C=L
10E   A=C ALL
01D   C=
060   A+C
070   N=C ALL
0B8  C=Y
13D   C=
060   AB*C
0A8  Y=C
0B0   C=N ALL
10E   A=C ALL
078   C=Z
135    C=
060   A*C
068   Z=C
0B0   C=N ALL
10E   A=C ALL
046   C
270   =
038   T
135    C=
060   A*C
028   T=C
3E0   RTN

( 62  lines )
 
 

  with    q = x + y i + z j + t k  and   q² = x' + y' i + z' j + t' k
 

3°)  Square-Root of a Quaternion
 

091   "Q"
014   "T"
012   "R"
011   "Q"
013   "S"
2A0   SETDEC
046   C
270   =
038   T
10E   A=C ALL
135    C=
060   A*C
070   N=C ALL
078   C=Z
10E   A=C ALL
135    C=
060   A*C
0B0   C=N ALL
025   C=
060   AB+C
070   N=C ALL
0B8  C=Y
10E   A=C ALL
135    C=
060   A*C
0B0   C=N ALL
025   C=
060   AB+C
070   N=C ALL
0F8  C=X
128  L=C
10E   A=C ALL
135    C=
060   A*C
0B0   C=N ALL
025   C=
060   AB+C
2EE  ?C#0 ALL
3A0  ?NC RTN
305    C=
060   sqrt(AB)
138   C=L
05E   C=| C |
025   C=
060   AB+C
0E8  X=C
04E   C
35C  =
090   2
269   C=
060   AB/C
138   C=L
2FE   ?C#0 MS
027   JC+04
305   C=
060   sqrt(AB)
06B  JNC+13d
0B0  C=N ALL
10E  A=C ALL
04E   C
35C  =
090   2
261   C=
060   A/C
0F8   C=X
269   C=
060   AB/C
305   C=
060   sqrt(AB)
0E8   X=C
2EE  ?C#0 ALL
03F  JC+07
138  C=L
2BE  C=-C
2F9  C=
061   sqrt(C)
0A8  Y=C
3E0   RTN
10E   A=C ALL
01D  C=
060   A+C
070   N=C ALL
046   C
270   =
038   T
10E   A=C ALL
0B0   C=N ALL
261   C=
060   A/C
028   T=C
078   C=Z
10E   A=C ALL
0B0   C=N ALL
261   C=
060   A/C
068   Z=C
0B8   C=Y
10E   A=C ALL
0B0   C=N ALL
261   C=
060   A/C
0A8  Y=C
3E0   RTN

( 103  lines )
 
 

  with    q = x + y i + z j + t k  and   q^1/2 = x' + y' i + z' j + t' k
 

4°)  Product of 2 Quaternions
 

-Like with the focal program "Q*Q", the quaternions must be stored in R01 to R04 and R05 to R08 respectively.
 

091   "Q"
02A  "*"
011   "Q"
378   C=c
03C   RCR 3
106   A=C S&X
130   LDI S&X
008   008
146   A=A+C S&X
130   LDI S&X
200   200h=512d                         ( correct value for an HP41CV/CX or an HP41C with a Quadmemory module )
306   ?A<C S&X
381   goto
00A  NONEXISTENT                If SIZE < 009 , NONEXISTENT is displayed.
066   A<>B S&X
130   LDI S&X
009   009
0A6  A<>C S&X
0E6   B<>C S&X    loop            This loop stores the contents of registers R01 thru R08
270   RAMSLCT                        into registers Y X L M N O P Q which are easier to handle.
266   C=C-1 S&X
0E6   B<>C S&X
038   READATA
0AE  A<>C ALL
270   RAMSLCT
266   C=C-1 S&X
0AE  A<>C ALL
2F0   WRITDATA
130   LDI S&X
001   001
306   ?A<C S&X
39B  JNC-13d        if not carry goto loop
2A0  SETDEC
0B8   C=Y
10E   A=C ALL
278   C=Q
135   C=
060   A*C
070   N=C ALL
1B8   C=N
10E   A=C ALL
178   C=M
135   C=
060   A*C
0B0  C=N ALL
025   C=
060   AB+C
070   N=C ALL
0F8   C=X
10E   A=C ALL
238   C=P
135   C=
060   A*C
0B0   C=N ALL
025   C=
060   AB+C
070   N=C ALL
1F8   C=O
2BE   C=-C
10E   A=C ALL
138   C=L
135   C=
060   A*C
0B0   C=N ALL
025   C=
060   AB+C
028   T=C
0B8   C=Y
10E   A=C ALL
238   C=P
135   C=
060   A*C
070   N=C ALL
1B8   C=N
10E   A=C ALL
138   C=L
135   C=
060   A*C
0B0  C=N ALL
025   C=
060   AB+C
070   N=C ALL
1F8   C=O
10E   A=C ALL
178   C=M
135   C=
060   A*C
0B0  C=N ALL
025   C=
060   AB+C
070   N=C ALL
0F8   C=X
2BE  C=-C
10E   A=C ALL
278   C=Q
135   C=
060   A*C
0B0  C=N ALL
025   C=
060   AB+C
068   Z=C
0B8  C=Y
10E  A=C ALL
1F8  C=O
135  C=
060  A*C
070  N=C ALL
1B8  C=N
10E  A=C ALL
0F8  C=X
135  C=
060  A*C
0B0  C=N ALL
025  C=
060  AB+C
070  N=C ALL
138  C=L
10E  A=C ALL
278  C=Q
135   C=
060   A*C
0B0  C=N ALL
025   C=
060   AB+C
070   N=C ALL
238   C=P
2BE  C=-C
10E  A=C ALL
178  C=M
135   C=
060   A*C
0B0  C=N ALL
025   C=
060   AB+C
10E   A=C ALL
0B8   C=Y
2BE   C=-C
0AE   A<>C ALL
0A8   Y=C
1B8   C=N
135   C=
060   A*C
070   N=C ALL
0F8  C=X
10E  A=C ALL
1F8  C=O
135   C=
060   A*C
0B0  C=N ALL
025   C=
060   AB+C
070   N=C ALL
138   C=L
10E   A=C ALL
238   C=P
135   C=
060   A*C
0B0  C=N ALL
025   C=
060   AB+C
070   N=C ALL
178   C=M
10E   A=C ALL
278   C=Q
135   C=
060   A*C
0B0  C=N ALL
025   C=
060   AB+C
2BE  C=-C
0E8   X=C
345   goto
042   CLA               the alpha "register" is cleared

( 173  lines )
 
 

  with    q.q' = x + y i + z j + t k   provided  q is stored in R01 thru R04 & q' is stored in R05 thru R08 ( R00 is unused )
 

5°)  Termination Criterion for Quaternionic Series
 

-When computing an "infinte" series of hypercomplex numbers, we usually stop the loop when 2 consecutive partial sums are equal.
-This requires many bytes and moreover, it is slow !
-The following routine takes the quaternion  u_k in registers L ( not X ) , Y , Z , T  and the adress of the first register Rnn that contains the partial sum in X-register.
-The partial sum is incremented by u_k and it returns 0 if and only if 2 consecutive sums are equal.
-So, in a program, if the loop begins with  LBL 01  and if, for example, the partial sums are stored in R11 to R14, it will be used like this:

   LBL 01  ....  calculation of  u_x u_y u_z u_t  in registers X , Y , Z , T  ...   SIGN   CLX   11   DSQ   X#0?   GTO 01
 

091   "Q"
04E   "S"
004   "D"
0F8   C=X
38D   converts an integer
008    into hexa in C S&X
106   A=C S&X
378   C=c
03C   RCR 3
206   C=A+C S&X
05A  C=0 M
01C  PT=3
0D0  LD@PT- 3            stores 3 in the mantissa field of register C
070   N=C ALL
106   A=C S&X
130   LDI S&X
1FD  509d                      ( correct value for an HP41CV/CX or an HP41C with a Quadmemory module )
306   ?A<C S&X
381   goto
00A  NONEXISTENT    If register Rnn+3 does not exist , NONEXISTENT is displayed.
138   C=L
0E8   X=C
04E   C=0 ALL
128   L=C
0B0  C=N ALL
070   N=C ALL    loop
03C  RCR 3
270   RAMSLCT
038   READATA
10E   A=C ALL
0B0  C=N ALL
270   RAMSLCT
038   READATA
2A0  SETDEC
01D  C=
060   A+C
10E   A=C
0B0   C=N ALL
038   READATA
2BE  C= -C
0AE  A<>C ALL
2F0   WRITDATA
01D   C=
060   A+C
05E   C= | C |
10E   A=C ALL
046   C=0 S&X
270   RAMSLCT
138   C= L
01D  C=
060   A+C
128   L=C
260   SETHEX
0B0  C=N ALL
226   C=C+1 S&X
27A  C=C-1 M
30B  JNC-31d                 if not carry goto loop
138   C=L
0E8   X=C
3E0   RTN

( 60  lines )
 
 

  with    u_k = x + y i + z j + t k   and  SUM_k u_k  is stored in Rnn , Rnn+1 , Rnn+2 , Rnn+3
 

6°)  Non-Merged Functions
 

-Instead of storing x in L-register and placing the address of the first register in X,
 we can also use the so-called "non-merged functions" - 2 lines in a program -
 where the second line specifies the address of the first register.
-Thus x doen't have to be stored in L-register !
 

     a)  2 M-Code Subroutines
 

-The first routine ( GETRG# ) gets the address nn of the register from the line that just follows the non-merged function in a focal program
  and places the result ( binary ) in A S&X.
-The second routine simply checks that register Rnn+3 exists.

-Many thanks to Ángel Martin who sent me GETRG#
 

1A0  A=B=C=0              GETRG#               Written by William Wilder
158   M=C ALL
141   ?NCXQ                  get
0A4   2950                       PC
01D   ?NCXQ                 get
0B4   2D07                      nxtbyte
056    C=0 XS
2E6    ?C#0 S&X
3E3    JNC -04
39C   PT=0
06E   A<>B ALL
106   A=C S&X
130   LDI S&X
01A  26d
306   ?A<C S&X
06B  JNC+13d
042   C=0 @PT
306   ?A<C S&X
057   JC+10d
1D8  C<>M ALL
2FC  RCR 13
0A2  A<>C @PT
1D8  C<>M ALL
019   ?NCXQ                 nbytab
0B4   2D06
17E   A=A+1 S&X
056   C=0 XS
373   JNC -18d
06E   A<>B ALL
31D  .NCXQ
0A4   29C7
346   ?A#0 S&X
0BD  ?CXQ                   put
08D   232F                    PC X
198   C=M ALL
05A  C=0 M
3E1   ?NCXQ              -> binary
008   02F8
106   A=C S&X
3E0   RTN

( 40 lines )
 

046   C=0 S&X                  VALID?
270   RAMSLCT
378   C=c
03C  RCR 3
146   A=A+C S&X
130   LDI S&X
1FD  509d                         ( correct value for an HP41CV/CX or an HP41C with a Quadmemory module )
306   ?A<C S&X
381   goto
00A  NONEXISTENT
3E0  RTN

( 11 lines )
 

-If theses routines are, for example, coded from @EFC0 to @EFF2

     ?NCXQ  GETR#  =  ?NCXQ  EFC0   =   301  3BC

 and    ?NCXQ  VALID?  =  ?NCXQ  EFE8 =  3A1  3BC
 

     b)  Storing & Recalling the Stack
 

091   "Q"
00F   "O"
014   "T"
013   "S"
284   CLRF 7
033   JNC+06
091   "Q"
00C  "L"
003   "C"
012   "R"
288   SETF 7
04C  ?FSET 4
01F   JC+03
2CC  ?FSET 13
01B   JNC+03
301   ?NCXQ                               Change these 4 words if you have loaded GETR# and VALID? in another area
3BC  EFC0      =   GETR#
3A1  ?NCXQ
3BC  EFE8      =    VALID?
130   LDI S&X
004   004
266   C=C-1 S&X
360   ?C RTN
28C  ?FSET 7
013   JNC+02
0A6  A<>C S&X
270   RAMSLCT
0E6   B<>C S&X
038   READATA
0AE  A<>C ALL
270   RAMSLCT
0AE  A<>C ALL
2F0   WRITDATA
0E6   B<>C S&X
28C  ?FSET 7
013   JNC+02
0A6  A<>C S&X
166   A=A+1 S&X
37B  JNC-17d

( 39 lines )
 

-So, if you want to store a quaternion - that is in the stack - into registers R21 thru R24, simply write in a ( focal ) program:

   STOQ
   21

-Likewise, to recall this quaternion in the stack:

   RCLQ
   21
 

     c)  Termination Criterion for Quaternionic Series (II)
 

-GETRG# & VALID?  simplify this routine.
 

091   "Q"
04E   "S"
004   "D"
04C  ?FSET 4
01F   JC+03
2CC  ?FSET 13
01B   JNC+03
301   ?NCXQ                               Change these 4 words if you have loaded GETR# and VALID? in another area
3BC  EFC0      =   GETR#
3A1  ?NCXQ
3BC  EFE8      =    VALID?
04E  C=0 ALL
128   L=C
0A6  A<>C S&X
01C  PT=3
0D0  LD@PT- 3
070   N=C ALL    loop
03C  RCR 3
270   RAMSLCT
038   READATA
10E   A=C ALL
0B0  C=N ALL
270   RAMSLCT
038   READATA
2A0  SETDEC
01D  C=
060   A+C
10E   A=C
0B0   C=N ALL
038   READATA
2BE  C= -C
0AE  A<>C ALL
2F0   WRITDATA
01D   C=
060   A+C
05E   C= | C |
10E   A=C ALL
046   C=0 S&X
270   RAMSLCT
138   C= L
01D  C=
060   A+C
128   L=C
260   SETHEX
0B0  C=N ALL
226   C=C+1 S&X
27A  C=C-1 M
30B  JNC-31d                 if not carry goto loop
138   C=L
10E   A=C ALL
0F8   C=X
128   L=C
0AE  A<>C ALL
0E8   X=C
3E0   RTN

( 55  lines )
 
 

  with    u_k = x + y i + z j + t k   and  SUM_k u_k  is stored in Rnn , Rnn+1 , Rnn+2 , Rnn+3

-Now, in a program, if the loop begins with  LBL 01  and if, for example, the partial sums are stored in R11 to R14, it will be used like this:

   LBL 01  ....  calculation of  u_x u_y u_z u_t  in registers X , Y , Z , T  ...    DSQ   11   X#0?   GTO 01

  which is both easier and more natural.
 

Example:    May be an example is not unuseful...

-Compute  S(q) = 1 + q + q² + q³ + ................ + qⁿ + ...................   for  | q |  <  1
 

 01  LBL "TEST"
 02  STOQ
 03  5
 04  CLST
 05  SIGN
 06  STOQ
 07  1
 08  STOQ
 09  9
 10  LBL 01
 11  Q*Q
 12  STOQ
 13  1
 14  DSQ
 15  9
 16  X#0?
 17  GTO 01
 18  RCLQ
 19  9
 20  END

( 37 bytes / SIZE 013 )

-With  q = 0.1 + 0.2 i + 0.3 j + 0.4 k

  0.4  ENTER^
  0.3  ENTER^
  0.2  ENTER^
  0.1  XEQ "TEST"  >>>>   0.818181818                      ---Execution time = 43s---
                                RDN   0.181818182
                                RDN   0.272727273
                                RDN   0.363636364

-Thus,  S( 0.1 + 0.2 i + 0.3 j + 0.4 k ) = ( 9 + 2 i + 3 j + 4 k ) / 11  which could be obtained directly since  S(q) = 1/(1-q)
 

Notes:

-In this example, the result is also in registers R09 thru R12.
-R01 to R04 = qⁿ , R05 to R08 = q

-With the version of DSQ that is listed in paragraph 5, replace lines 14-15 by  SIGN   CLX  9   DSQ