(50G) Elliptic Curve Integer Factorization Programme

[Gerald H]

While I am convinced that people are not supposed to live more than 50 years I'm still jogging on at the age of 62, so I decided to write a large(ish) programme.

The programme ecm takes a composite integer as input & returns a factor, found through the elliptic curve factorzing method.

ecm, while itself a short programme, has several sub-programmes integral to its functioning, as is my heart to my body, which qualify ecm to receive the attribute large

Code:


ecm

::
  CK1&Dispatch
  # FF
  ::
    ID x00E
    Z100_
    ID x00D
  ;
;

x008

::
  BINT0
  4UNROLL
  '
  NULLLAM
  BINT5
  NDUPN
  DOBIND
  NULL{}
  3GETLAM
  Z1_
  FPTR2 ^QSub
  FPTR2 ^Z>R
  % 999999999999.
  %MIN
  %RAN
  %*
  %IP
  FPTR2 ^R>Z
  1GETLAM
  FPTR2 ^Z2BIN
  ZERO_DO
  INDEX@
  DUP
  BINT80h
  #/
  #1+
  #>$
  "Mul #: "
  SWAP&$
  BIGDISPROW2
  DROP
  FPTR2 ^#>Z
  DUP
  ZINT 128
  FPTR2 ^QAdd
  1GETLAM
  FPTR2 ^ZNMin
  DUP4PUTLAM
  ID x00A
  5GETLAM
  3UNROLL
  2GETLAM
  3GETLAM
  ID x009
  IT
  ::
    ExitAtLOOP
    DUP
    Z1_
    Z>
    OVER
    3GETLAM
    Z<
    AND
    NOT?SEMI
    5GETLAM
    2GETLAM
    4GETLAM
    BINT3
    {}N
    SWAP
  ;
  BINT80h
  +LOOP
  ABND
  OVER
  NULLCOMP?
  case2drop
  Z0_
  ROTDROP
;

x009

::
  ROT
  FPTR2 ^DupQIsZero?
  case
  ::
    4UNROLL3DROP
    TRUE
  ;
  FPTR2 ^Z>ZH
  5UNROLL
  3PICK
  Z1_
  5PICK
  DUPDUP
  FPTR2 ^RMULText
  8PICK
  FPTR2 ^RADDext
  FPTR2 ^RMULText
  5ROLL
  FPTR2 ^RADDext
  4PICK
  FPTR2 ^ZMod
  DUP
  5PICK
  ID x00F
  ROTDUP
  FPTR2 ^ZIsOne?
  NOTcase
  ::
    10UNROLL
    BINT9
    NDROP
    TRUE
  ;
  2DROP
  '
  NULLLAM
  BINT7
  NDUPN
  DOBIND
  FALSE
  SWAP
  FPTR2 ^ZBits
  ONE_DO
  ::
    3GETLAM
    DUP
    FPTR2 ^QAdd
    5GETLAM
    ID x00F
    ROTDUP
    FPTR2 ^ZIsOne?
    NOTcase
    ::
      5UNROLL
      3DROPTRUE_
      ExitAtLOOP
    ;
    2DROP
    Z3_
    6GETLAM
    FPTR2 ^ZSQ_
    FPTR2 ^RMULText
    7GETLAM
    FPTR2 ^QAdd
    1GETLAM
    FPTR2 ^QMul
    FPTR2 ^QMul
    5GETLAM
    FPTR2 ^ZMod
    DUP
    FPTR2 ^ZSQ_
    2GETLAM
    FPTR2 ^QMul
    6GETLAM
    DUP
    FPTR2 ^QAdd
    FPTR2 ^QSub
    5GETLAM
    FPTR2 ^ZMod
    6GETLAM
    OVER
    6PUTLAM
    FPTR2 ^RSUBext
    FPTR2 ^QMul
    3GETLAM
    FPTR2 ^RNEGext
    FPTR2 ^SWAPRSUB
    5GETLAM
    FPTR2 ^ZMod
    3PUTLAM
    ISTOP-INDEX
    #1-
    FPTR2 ^ZBit?
    NOT?SEMI
    6GETLAM
    4GETLAM
    FPTR2 ^QSub
    5GETLAM
    ID x00F
    ROTDUP
    FPTR2 ^ZIsOne?
    NOTcase
    ::
      5UNROLL
      3DROPTRUE_
      ExitAtLOOP
    ;
    2DROP
    Z-1_
    3GETLAM
    Z1_
    FPTR2 ^QSub
    ROT
    FPTR2 ^QMul
    5GETLAM
    FPTR2 ^ZMod
    DUPDUP
    FPTR2 ^QMul
    2GETLAM
    FPTR2 ^QMul
    6GETLAM
    FPTR2 ^QSub
    4GETLAM
    FPTR2 ^QSub
    5GETLAM
    FPTR2 ^ZMod
    DUP
    6PUTLAM
    4GETLAM
    FPTR2 ^QSub
    FPTR2 ^QMul
    FPTR2 ^QSub
    5GETLAM
    FPTR2 ^ZMod
    3PUTLAM
  ;
  LOOP
  SWAPDROPDUP
  ?SKIP
  ::
    6GETLAM
    SWAP
  ;
  ABND
;

x00A

::
  Z1_
  OVER
  ID x00C
  4PICK
  ID x00C
  Z1_
  FPTR2 ^QAdd
  Z2_
  FPTR2 ^ZNMax
  ::
    BEGIN
    2DUP
    Z<
    case
    COLA_EVAL
    ::
      DUP
      4ROLL
      FPTR2 ^RMULText
      3UNROLL
      Z1_
      FPTR2 ^RADDext
    ;
    AGAIN
  ;
  2DROP
  SWAPROT
  Z2_
  FPTR2 ^ZNMax
  ::
    BEGIN
    FPTR2 ^Prime+
    2DUP
    Z<
    case
    COLA_EVAL
    ::
      DUP
      4ROLL
      FPTR2 ^RMULText
      3UNROLL
    ;
    AGAIN
  ;
  2DROP
;

x00B

::
  %ABS
  %3
  %MAX
  %LN
  DUP
  %LN
  %*
  %SQRT
  %EXP
;

x00C

::
  DUP
  Z2_
  Z<
  ?SEMI
  Z2_
  OVER
  FPTR2 ^Z>ZH
  FPTR2 ^ZBits
  SWAPDROP
  #2/
  #1+
  FPTR2 ^RP#
  ZEROSWAP
  BEGIN
  SWAPDROPDUP
  3PICKOVER
  FPTR2 ^ZDIVext
  DROP
  FPTR2 ^QAdd
  Z2_
  FPTR2 ^ZDIVext
  DROP
  2DUP
  Z>
  NOT_UNTIL
  DROPSWAPDROP
;

x00D

::
  FPTR2 ^3LAMBIND
  Z0_
  1GETLAM
  FPTR2 ^Z2BIN
  #1+_ONE_DO
  "Curve #: "
  INDEX@
  #>$
  &$
  BIGDISPROW3
  3GETLAM
  BINT2
  ZERO_DO
  %RAN
  % 999999999999.
  %*
  %IP
  FPTR2 ^R>Z
  OVER
  FPTR2 ^ZMod
  SWAPLOOP
  3UNROLL
  ZINT 27
  OVER
  BINT2
  FPTR2 ^RP#
  FPTR2 ^QMul
  Z4_
  4PICK
  BINT3
  FPTR2 ^RP#
  FPTR2 ^RMULText
  FPTR2 ^QAdd
  4PICK
  FPTR2 ^ZGcd
  FPTR2 ^DupZIsOne?
  ITE
  ::
    DROPSWAP
    3UNROLL
    2GETLAM
    ID x008
    DUP
    Z1_
    Z>
    OVER
    3GETLAM
    Z<
    ANDcase
    ExitAtLOOP
    DROP
  ;
  ::
    ROTROT2DROP
    ExitAtLOOP
  ;
  LOOP
  ABND
  FPTR2 ^DupQIsZero?
  ?SEMI
  ROTDROP
;

x00E

::
  DUP
  FPTR2 ^Z>R
  ID x00B
  %2
  %SQRT
  %NROOT
  %CEIL
  FPTR2 ^R>Z
;

x00F

::
  BINT0
  3UNROLL
  BEGIN
  ROT#1+UNROT
  DUPUNROT
  FPTR2 ^ZDIVext
  SWAP
  4UNROLLDUP
  Z0_
  EQUAL
  UNTIL
  DROP
  ZINT1_0_
  4ROLL
  ZERO_DO
  DUPUNROT
  5ROLL
  FPTR2 ^QMul
  FPTR2 ^QSub
  LOOP
  3PICK
  FPTR2 ^ZIsNeg?
  NOT?SEMI
  BINT3
  ZERO_DO
  ROT
  FPTR 6 4FB
  LOOP
;