*        Mertens function - 01/05/2023
MERTENS  CSECT
         USING  MERTENS,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
         LA     R0,1               1
         STH    R0,MM              m(1)=1
         LA     R6,2               i=2
       DO WHILE=(CH,R6,LE,=AL2(NN)) do i=2 to n
         LR     R1,R6                i
         SLA    R1,1                 *2 (H)
         LA     R0,1                 1
         STH    R0,MM-2(R1)          m(i)=1
         LA     R7,2                 j=2
       DO WHILE=(CR,R7,LE,R6)        do j=2 to i
         LR     R4,R6                  i
         SRDA   R4,32                  ~
         LR     R1,R7                  j
         DR     R4,R1                  i/j
         LR     R8,R5                  d=i/j
         LR     R4,R6                  i
         SLA    R4,1                   *2 (H)
         LH     R2,MM-2(R4)            m(i)
         LR     R1,R8                  d
         SLA    R1,1                   *2 (H)
         LH     R3,MM-2(R1)            m(d)
         SR     R2,R3                  m(i)-m(d)
         STH    R2,MM-2(R4)            m(i)=m(i)-m(d)
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         XPRNT  =C'the first 99 Mertens numbers are:',34  print buffer
         LA     R9,PG              @buffer=pg
         MVC    PG,=CL80' '        clean buffer
         MVC    0(3,R9),=CL3' '    output '   '
         LA     R9,3(R9)           @buffer+=3
         LA     R7,9               j=9
         LA     R6,1               i=1
       DO WHILE=(CH,R6,LE,=AL2(99)) do i=1 to 99
         LR     R1,R6                i
         SLA    R1,1                 *2 (H)
         LH     R2,MM-2(R1)          m(i)
         XDECO  R2,XDEC              edit m(i)
         MVC    0(3,R9),XDEC+9       output m(i)
         LA     R9,3(R9)             @buffer+=3
         BCTR   R7,0                 j=j-1
       IF   LTR,R7,Z,R7 THEN         if j=0 then do;
         LA     R7,10                  j=10
         XPRNT  PG,L'PG                print buffer
         LA     R9,PG                  @buffer=pg
       ENDIF    ,                    endif
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         SR     R10,R10            zero=0
         SR     R11,R11            cross=0
         LA     R6,1               i=2
       DO WHILE=(CH,R6,LE,=AL2(NN)) do i=2 to n
         LR     R1,R6                i
         SLA    R1,1                 *2 (H)
         LH     R2,MM-2(R1)          m(i)
       IF   LTR,R2,Z,R2 THEN         if m(i)=0 then
         LA     R10,1(R10)             zero=zero+1
         LR     R1,R6                  i
         BCTR   R1,0                   i-1
         SLA    R1,1                   *2 (H)
         LH     R2,MM-2(R1)            m(i-1)
       IF   LTR,R2,NZ,R2 THEN          if m(i-1)^=0 then
         LA     R11,1(R11)               cross=cross+1
       ENDIF    ,                      endif
       ENDIF    ,                    endif
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         MVC    PG,=CL80' '        clean buffer
         MVC    PG(13),=C'm(i) is zero '
         XDECO  R10,XDEC           edit zero
         MVC    PG+13(2),XDEC+10   output zero
         MVC    PG+15(7),=C' times.'
         XPRNT  PG,L'PG            print buffer
         MVC    PGI,=H'0'
         MVC    PG,=CL80' '        clean buffer
         MVC    PG(18),=C'm(i) crosses zero '
         XDECO  R11,XDEC           edit cross
         MVC    PG+18(2),XDEC+10   output cross
         MVC    PG+20(7),=C' times.'
         XPRNT  PG,L'PG            print buffer
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling save
NN       EQU    1000               n
PG       DS     CL80               buffer
PGI      DC     H'0'               buffer index
XDEC     DS     CL12               temp for xdeci xdeco
MM       DS     (NN)H              m
         REGEQU
         END    MERTENS