*        Semiprime                 14/03/2017
SEMIPRIM CSECT
         USING  SEMIPRIM,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R10,PG             pgi=0
         LA     R8,0               m=0
         L      R6,=F'2'           i=2
       DO WHILE=(C,R6,LE,=F'100')  do i=2 to 100
         ST     R6,N                 n=i
         LA     R9,0                 f=0
         LA     R7,2                 j=2
LOOPJ    EQU    *                    do j=2 while f<2 and j*j<=n
         C      R9,=F'2'               if f<2
         BNL    EXITJ                  then exit do j
         LR     R5,R7                  j
         MR     R4,R7                  *j
         C      R5,N                   if j*j<=n
         BH     EXITJ                  then exit do j
LOOPK    EQU    *                      do while n mod j=0
         L      R4,N                     n
         SRDA   R4,32                    ~
         DR     R4,R7                    /j
         LTR    R4,R4                    if n mod <>0
         BNZ    EXITK                    then exit do j
         ST     R5,N                     n=n/j
         LA     R9,1(R9)                 f=f+1
         B      LOOPK                  enddo k
EXITK    LA     R7,1(R7)               j++
         B      LOOPJ                enddo j
EXITJ    L      R4,N                 n
       IF C,R4,GT,=F'1' THEN         if n>1 then
         LA     R2,1                   g=1
       ELSE     ,                    else
         LA     R2,0                   g=0
       ENDIF    ,                    endif
         AR     R2,R9                +f
       IF C,R2,EQ,=F'2' THEN         if f+(n>1)=2 then
         XDECO  R6,XDEC                edit i
         MVC    0(5,R10),XDEC+7        output i
         LA     R10,5(R10)             pgi=pgi+10
         LA     R8,1(R8)               m=m+1
         LR     R4,R8                  m
         SRDA   R4,32                  ~
         D      R4,=F'16'              m/16
       IF LTR,R4,Z,R4 THEN             if m mod 16=0 then
         XPRNT  PG,L'PG                  print buffer
         MVC    PG,=CL80' '              clear buffer
         LA     R10,PG                   pgi=0
       ENDIF    ,                      endif
       ENDIF    ,                    endif
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         XPRNT  PG,L'PG            print buffer
         MVC    PG,=CL80'..... semiprimes'  init buffer
         XDECO  R8,XDEC            edit m
         MVC    PG(5),XDEC+7       output m
         XPRNT  PG,L'PG            print buffer
         L      R13,4(0,R13)       restore previous savearea pointer
         LM     R14,R12,12(R13)    restore previous context
         XR     R15,R15            rc=0
         BR     R14                exit
N        DS     F                  n
PG       DC     CL80' '            buffer
XDEC     DS     CL12               temp
         YREGS
         END    SEMIPRIM