# hp41programs

Quat-MCodeRoutines

# 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 )

 STACK INPUTS 1/Q-OUTPUTS ABSQ-OUTPUT T t t' t Z z z' z Y y y' y X x x' Abs(q) L / x x

with    q = x + y i + z j + t k  ,   1/q = x' + y' i + z' j + t' k   and   Abs(q) = | q | = ( x2 + y2 + z2 + t2 ) 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 )

 STACK INPUTS OUTPUTS T t t' Z z z' Y y y' X x x' L / x

with    q = x + y i + z j + t k  and   q2 = 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 )

 STACK INPUTS OUTPUTS T t t' Z z z' Y y y' X x x' L / x

with    q = x + y i + z j + t k  and   q1/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
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 )

 STACK INPUTS OUTPUTS T / t Z / z Y / y X / x

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  uk 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 uk 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  ux uy uz ut  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
10E   A=C ALL
0B0  C=N ALL
270   RAMSLCT
2A0  SETDEC
01D  C=
060   A+C
10E   A=C
0B0   C=N ALL
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 )

 STACK INPUTS OUTPUTS T t t Z z z Y y y X nn 0 or not L x ( 0 or not )

with    uk = x + y i + z j + t k   and  SUMk uk  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
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
10E   A=C ALL
0B0  C=N ALL
270   RAMSLCT
2A0  SETDEC
01D  C=
060   A+C
10E   A=C
0B0   C=N ALL
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 )

 STACK INPUTS OUTPUTS T t t Z z z Y y y X x 0 or not L / x

with    uk = x + y i + z j + t k   and  SUMk uk  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  ux uy uz ut  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 + q2 + q3 + ................ + qn + ...................   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 = qn , R05 to R08 = q

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