(35S, 42S) Lowest integer factor

[r. pienne]

Here's a little slow'n'simple routine I wrote for both the HP 35s and Free42, to return the lowest factor from an integer >2, or display "prime" if it is prime.

The argument is taken from the stack and is not validated. Stack is preserved and LastX gets set; named variables are preserved except as stated; numbered registers are not preserved.

35s version
-----------
Affects variables I,J,R. The subroutines in LBL Z are general-purpose state-save/restore routines.

Code:


      LBL F                                (LN=117 CK=706F)
      XEQ Z002                             save state
      STO R    
      2 / FP x!=0? GTO F012                argument is even?
      2 STO R GTO F034                     yes: return 2
F012  RCL R SQRT STO J                     sqrt(arg) -> var J
      1 STO I                              initialise iterator -> var I
F017  2 STO+I                              increment iterator by 2
      RCL J RCL I x<=y? GTO F027           iterator > sqrt?
      SF10 EQN "PRIME" PSE GTO F034        yes: display "prime", return arg
F027  RCL R RCL I RMDR x!=0? GTO F017      if not divisible try next iteration
      RCL I STO R                          is divisible: return iterator
F034  XEQ Z046 x<>R                        restore state
      RTN

      LBL Z
                                           ##### save state #####    
Z002  STO J                                save X in J
      R↓ 0 STO I R↓ RCL J STO (I)          save X in R0
      R↓ 1 STO I R↓ STO (I)                save Y in R1
      R↓ 2 STO I R↓ STO (I)                save Z in R2
      R↓ 3 STO I R↓ STO (I)                save T in R3
      14 STO I 0 FS? 10 1 STO (I)          save F10 in R14
      15 STO I STO (I)                     save non-zero (top-of-memory marker) in R15
      3 STO I RCL (I)                      restore T from R3
      2 STO I R↓ RCL (I)                   restore Z from R2
      1 STO I R↓ RCL (I)                   restore Y from R1
      RCL J                                restore X from J
      RTN
                                           ##### restore state #####    
Z046  CF10 14 STO I RCL(I) x!=0? SF10      restore F10 from R14
      0 STO I 0 RCL(I) +                   set lastx
      3 STO I RCL(I)                       recall T from R3
      2 STO I R↓ RCL(I)                    recall Z from R2
      1 STO I R↓ RCL(I)                    recall Y from R1
      0 STO I R↓ RCL(I)                    recall X from R0
      RTN

Free42 version
--------------
Subroutines Z1 and Z2 are general-purpose state-save/restore routines.

Code:


FACT  LBL "FACT"                           (88 bytes)
      XEQ "Z1"                             save state
      STO 21
      2 / FP x!=0? GTO A                   argument is even?
      2 STO 21 GTO E                       yes: return 2
A     LBL A RCL 21 SQRT STO 22             sqrt(arg) -> R22
      1 STO 20                             initialise iterator -> R20
B     LBL B 2 STO+20                       increment iterator by 2
      RCL 22 RCL 20 x<=y? GTO C            iterator > sqrt?
      "PRIME" AVIEW GTO E                  yes: display "prime", return arg
C     LBL C RCL 21 RCL 20 MOD x!=0? GTO B  if not divisible try next iteration
      RCL 20 STO 21                        is divisible: return iterator
E     LBL E XEQ "Z2" x<>21                 restore state
      RTN    

Z1    LBL "Z1"                             ##### save state #####
      STO 00                               save X
      R↓ STO 01                            save Y
      R↓ STO 02                            save Z
      R↓ STO 03                            save T
      R↓
      RTN    

Z2    LBL "Z2"                             ##### restore state #####    
      0 RCL 00 +                           set lastx
      RCL 03                               recall T
      RCL 02                               recall Z
      RCL 01                               recall Y
      RCL 00                               recall X
      RTN

Any probs, let us know.

R.

(Edit on 2014-08-03: improved description, 35s code)