NewList PFs.l()
Procedure Primfaktoren(Zahl.l)
  Protected Tmp.l, StartTime.l, a.l, OK.l
  StartTime.l = GetTickCount_()
  Tmp.l = Zahl
  Repeat
    a.l = 2
    OK.l = #False
    Repeat
      If Tmp - Tmp / a * a = 0
        OK = AddElement(PFs())
        PFs() = a
        Tmp = Tmp / a
      EndIf
      a + 1
    Until OK
  Until Tmp = 1
  ProcedureReturn GetTickCount_() - StartTime
EndProcedure

NewList Ts.l()
Procedure.l Teiler()
  StartTime.l = GetTickCount_()         ;Zeit
  
  Structure PFa                        ;Structure
    PF.l
    Bit.l
  EndStructure
  
  MaxPFs.l = CountList(PFs())           ;Array
  If MaxPFs = 0 : ProcedureReturn : EndIf
  Dim PFa.PFa(MaxPFs - 1)
  
  ResetList(PFs())                      ;Array füllen
  c = 0
  While NextElement(Pfs())
    PFa(c)\PF = PFs()
    c + 1
  Wend
  
  Quit.l = #False                       ;ausrechnen
  d.l
  Repeat
    PFa(0)\Bit + 1              ;Bitweisen addieren
    s.s = ""
    For a.l = 0 To MaxPFs - 1
      If PFa(a)\Bit = 2
        If a = MaxPFs - 1
          Quit = #True
        Else
          PFa(a)\Bit = 0
          PFa(a + 1)\Bit + 1
        EndIf
      EndIf
    Next
    
    If Quit = #False            ;Multiplizeren
      Erg.l = 1
      For a.l = 0 To MaxPFs - 1
        If PFa(a)\Bit : Erg = Erg * PFa(a)\PF : EndIf
      Next
      
      OK.l = #True
      ResetList(Ts())
      While NextElement(Ts()) And OK
        If Ts() = Erg : OK = #False : EndIf
      Wend
      If OK
        LastElement(Ts())
        AddElement(Ts())
        Ts() = Erg
      EndIf
    EndIf
    d + 1
  Until Quit
  
  ProcedureReturn GetTickCount_() - StartTime
EndProcedure


For Zahl.l = 2 To 10000000
  ClearList(PFs())
  ClearList(Ts())
  PFZeit.l = Primfaktoren(Zahl)
;  Debug "jup"
  TZeit.l = Teiler()
  If PFZeit + TZeit > 100 : Debug Zahl : EndIf
Next
 
; ExecutableFormat=Windows
; EOF