*        Factorions                26/04/2020
FACTORIO CSECT
         USING  FACTORIO,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         XR     R4,R4              ~
         LA     R5,1               f=1
         LA     R3,FACT+4          @fact(1)
         LA     R6,1               i=1
       DO WHILE=(C,R6,LE,=A(NN2))  do i=1 to nn2
         MR     R4,R6                fact(i-1)*i
         ST     R5,0(R3)             fact(i)=fact(i-1)*i
         LA     R3,4(R3)             @fact(i+1)
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         LA     R7,NN1             base=nn1
       DO WHILE=(C,R7,LE,=A(NN2))  do base=nn1 to nn2
	     MVC    PG,PGX               init buffer
         LA     R3,PG+6              @buffer
         XDECO  R7,XDEC              edit base
         MVC    PG+5(2),XDEC+10      output base
         LA     R3,PG+10             @buffer
         LA     R6,1                 i=1
       DO WHILE=(C,R6,LE,LIM)        do i=1 to lim
         LA     R9,0                   s=0
         LR     R8,R6                  t=i
       DO WHILE=(C,R8,NE,=F'0')        while t<>0
         XR     R4,R4                    ~
         LR     R5,R8                    t
         DR     R4,R7                    r5=t/base; r4=d=(t mod base)
         LR     R1,R4                    d
         SLA    R1,2                     ~
         L      R2,FACT(R1)              fact(d)
         AR     R9,R2                    s=s+fact(d)
         LR     R8,R5                    t=t/base
       ENDDO    ,                      endwhile
       IF    CR,R9,EQ,R6 THEN          if s=i then
         XDECO  R6,XDEC                  edit i
         MVC    0(6,R3),XDEC+6           output i
         LA     R3,7(R3)                 @buffer
       ENDIF    ,                      endif
         LA     R6,1(R6)               i++
       ENDDO    ,                    enddo i
         XPRNT  PG,L'PG              print buffer
         LA     R7,1(R7)             base++
       ENDDO    ,                  enddo base
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling save
NN1      EQU    9                  nn1=9
NN2      EQU    12                 nn2=12
LIM      DC     f'1499999'         lim=1499999
FACT     DC     (NN2+1)F'1'        fact(0:12)
PG       DS     CL80               buffer
PGX      DC     CL80'Base .. : '   buffer init
XDEC     DS     CL12               temp fo xdeco
         REGEQU
         END    FACTORIO