(50g) Factorisation without Time Limit

[Gerald H]

A programme to factorize integers based on the built in FACTORS programme but without a time limit.

For integer input the programme lists factors & respective powers beginning with the SMALLEST factor & provides some commentary to the process of factorisation.

Code:


FACTORS

::
  CK1&Dispatch
  # FF
  ::
    ID x080
    {}N
  ;
;

x07E

::
  FPTR 6 D8
  FPTR 6 F9
  casedrop
  {}N
  FPTR 6 CC
  ITE
  FPTR 6 CD
  ::
    DUPDUP
    FPTR 6 F1
    DUPLEN$
    #>$
    BIGDISPROW4
    BIGDISPROW3
    ID x085
    case
    ONE{}N
    NULL{}
    NULL{}
    Z0_
    DUPDUP
    DUPDUP
    #ZERO#ONE
    BINT0
    BINT10
    '
    NULLLAM
    BINT12
    NDUPN
    DOBIND
    BEGIN
    7GETLAM
    12GETLAM
    FPTR 6 DD
    7PUTLAM
    Z1_
    6PUTLAM
    BEGIN
    BINT0
    4PUTLAM
    7GETLAM
    8PUTLAM
    Z3_
    7GETLAM
    DUP
    12GETLAM
    3GETLAM
    FPTR 6 D0
    7PUTLAM
    BEGIN
    2GETLAM
    #1+
    2PUTLAM
    7GETLAM
    5PUTLAM
    1GETLAM
    3GETLAM
    4GETLAM
    #-
    #MIN
    ZERO_DO
    Z3_
    7GETLAM
    DUP
    12GETLAM
    BINT0
    FPTR 6 D0
    7PUTLAM
    Z0_
    7GETLAM
    8GETLAM
    FPTR 6 115
    6GETLAM
    12GETLAM
    BINT0
    FPTR 6 D0
    6PUTLAM
    LOOP
    6GETLAM
    12GETLAM
    FPTR 6 2B7
    9PUTLAM
    4GETLAM
    1GETLAM
    #+DUP
    4PUTLAM
    3GETLAM
    #<
    9GETLAM
    FPTR 6 FA
    AND
    NOT_UNTIL
    3GETLAM
    #2*
    3PUTLAM
    9GETLAM
    FPTR 6 FA
    NOT_UNTIL
    9GETLAM
    12GETLAM
    EQUAL
    IT
    ::
      BEGIN
      Z3_
      5GETLAM
      DUP
      12GETLAM
      BINT0
      FPTR 6 D0
      DUP
      5PUTLAM
      8GETLAM
      FPTR 6 115
      12GETLAM
      FPTR 6 2B7
      DUP
      9PUTLAM
      FPTR 6 FA
      NOT_UNTIL
    ;
    9GETLAM
    FPTR 6 FA
    ITE
    ::
      10GETLAM
      INNERCOMP
      11GETLAM
      INNERCOMP
      top&
      12GETLAM
      SWP1+
      {}N
      10PUTLAM
      TRUE
    ;
    ::
      9GETLAM
      12GETLAM
      OVER
      FPTR 6 11B
      2DUP
      FPTR 6 107
      ?SKIP
      SWAP
      11GETLAM
      INNERCOMP
      #2+
      {}N
      11PUTLAM
      BEGIN
      ::
        11GETLAM
        DUPNULLCOMP?
        casedrop
        TrueTrue
        INNERCOMP
        #1-{}N
        11PUTLAM
        FPTR 6 CC
        case
        ::
          FPTR 6 CD
          10GETLAM
          &COMP
          10PUTLAM
          FALSE
        ;
        DUPDUP
        FPTR 6 F1
        DUPLEN$
        #>$
        BIGDISPROW4
        BIGDISPROW3
        ID x085
        case
        ::
          10GETLAM
          INNERCOMP
          #1+
          {}N
          10PUTLAM
          FALSE
        ;
        12PUTLAM
        FALSETRUE
      ;
      UNTIL
    ;
    UNTIL
    10GETLAM
    ABND
    ID x093
  ;
  INNERCOMP
  top&
  {}N
;

x07F

::
  ZEROSWAP
  DUPDUP
  >R
  CARCOMP
  %0
  ROT
  LENCOMP
  ZERO_DO
  RSWAP
  'R
  RSWAP
  3PICKOVER
  EQUAL
  FPTR 6 4D0
  LOOP
  ROT
  #2+
  get1
  NOT?SEMI
  Z-1_
  %1
  ROT
  #2+
;

x080

::
  DUP
  ::
    FPTR 6 FB
    NOTcase
    ID x07E
    {
      ZINT -1
    }
    TOTEMPOB
    SWAP
    FPTR 6 4FC
    FPTR 6 F9
    caseDROP
    ID x07E
    &COMP
  ;
  ID x07F
;

x085

::
  DUP
  LENHXS
  NULL{}
  BINT6
  ROT
  BINT16
  #/
  SWAPDROP
  DIFF_OR_ZERO_
  ZERO_DO
  CLKTICKS
  HXS>#
  BEGIN
  #1+
  BINT2
  #MAX
  2DUPSWAP
  matchob?
  NOT_UNTIL
  3UNROLL
  >TCOMP
  UNROTDUP
  FPTR 6 EE
  INDEX@
  #>$
  >TAG
  DO>STR
  DispCoord1
  ID x088
  ITE
  ExitAtLOOP
  SWAP
  LOOP
  DROP
  TYPEZINT?
;

x088

::
  FPTR 6 EE
  OVER
  Z1_
  FPTR 6 115
  FPTR 6 D6
  4UNROLL
  DUPUNROT
  4PICK
  FPTR 6 DB
  3PICK
  FPTR 6 D9
  DUP
  FPTR 6 50B
  FPTR 6 FA
  case2drop
  SWAPDROPFALSE_
  3PICK
  Z1_
  FPTR 6 115
  3UNROLL
  TRUE
  6UNROLL
  5ROLL
  ZERO_DO
  ::
    DUP
    Z-1_
    EQUALcase
    ::
      5ROLLDROP
      FALSE
      5UNROLL
      ExitAtLOOP
    ;
    DUP
    Z1_
    EQUALcase
    ExitAtLOOP
    DUP
    5PICK
    FPTR 6 3C7
    SWAPDUP
    FPTR 6 118
    SWAP
  ;
  LOOP
  3DROP
  SWAP
;

x093

CODE 008EB 8FB976084A73415238D341508DAA56087A6F85A706124F50CCD206B8008FB9760D230F74514​4D818FAE13313114016E1321008F7986314213016479414931101331C41451C414174701657D6142​572F14B47F507DF477507A154A47C407A964F3714006118818FAE10807818F2E16A70774B18DF663​0773034202008DBD66275206C1F1101311CE143174147134EAF417414703200411813418E142818F​09EA34E4A2014416414001143130349E5501428A20016434B2130D51428A0008F910301428A00003​8F2D760071348D94150D58F60860818FA5400ED400068F8DA600703AD1D58151C434B2130D7CD400​1361341451C41451CA8F910301468A7CD174811D903CC101119D7142131147135147D534CF8208A5​70133D817434CFA208A531D214FE6133CACA53C13314016FCF52B119D718F1461351C41478A500CF​59E3447A208A160D4036C7F796033920DA000001001A000C2A20821009C100D8000416204F100392​009700084E2064100E610056000D6E2023100A510015000000000713418E16E1468AA001648A6FE1​46132130CA101164146132130CA102164146132C20603152715772294270A4C019329230594C312E​90A0090C4001ABEAB5B2AB21B30019521194870B5A01B5201200317815B61CB15B517E153325305B​0A93C50A9026A0C47025B9881C0114216414717421D58B6D023D88B24022819F1CDCDCD41414A14F​9E6001611719627E0314A16114F171D121AE59E6DC23AE89E23C225EB0D0D0114F25A90A6E4F41C1​15B523A9025A6E4B317315B3AE0A6E6B2014725A90818FA649117015B5CE4D017315B3CECE480173​14B91C00E401142CC136C21361524147CE133CA13315749C2009C667948D0132133132DE8B6008B2​C5818FA54F480D0F6D5CD4E118F15271CF15779F6009725E2103D2809132EA133EA1301531156199​6009926020032103143137CEC21351534818F842430D90C31A0EF01C015B09081F25B92D6A9A9480​0B9801AF0E403D8CD16514218513111A7F82158516FCD53E03D8D3818F39819F18AD2F8B30011806​D6CE132D5818F9C53211007EA500818FA91340614216414656D130102D5F2C210B0681DF1C01317D​A1521152715771517154707137136067C81573152715771517154707137067E61421152715771517​1547071370615270713607061360615072515211CF15719926F99690793154E07136137062515711​6F15219926F99690711154E132078B642130135152715771517154707061360650904D707818F290​611AD5E3F711BE2F68B760DCDF141174145DCDF6F9E03818FAF40018FAD2154516FD6CE061361341​351CF2515210407CE49C16F17FA981521990BE0699490745043D136134062515671537150718F1CF​1537996FE1547992907F1055D07609F2515211571996009124003165146185136D71751471C51370​61197B2007135DB1344000D50016A14218A17A1471CA8BE000181B3D8CD818FA9109400110131174​146D7136068F91030DB136EB111818F0FEA1014558FC07600713416FCD55C34B2130145174110133​130174147068F127621101303447A2014416407144030702