*        Five weekends             31/05/2016
FIVEWEEK CSECT
         USING  FIVEWEEK,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         "
         ST     R15,8(R13)         "
         LR     R13,R15            "
         LM     R10,R11,=AL8(0)    nko=0; nok=0
         LH     R6,Y1              y=y1
LOOPY    CH     R6,Y2              do y=y1 to y2
         BH     ELOOPY
         MVI    YF,X'00'           yf=0
         LA     R7,1               im=1
LOOPIM   C      R7,=F'7'           do im=1 to 7
         BH     ELOOPIM
         LR     R1,R7              im
         SLA    R1,1               *2 (H)
         LH     R2,ML-2(R1)        ml(im)
         ST     R2,M               m=ml(im)
         MVC    D,=F'1'            d=1
         L      R4,M               m
         C      R4,=F'2'           if m<=2
         BH     MSUP2
         L      R8,M               m
         LA     R8,12(R8)          mw=m+12
         LR     R9,R6              y
         BCTR   R9,0               yw=y-1
         B      EMSUP2
MSUP2    L      R8,M               mw=m
         LR     R9,R6              yw=y
EMSUP2   LR     R4,R9              ym
         SRDA   R4,32              .
         D      R4,=F'100'         yw/100
         ST     R5,J               j=yw/100
         ST     R4,K               k=yw//100
         LR     R4,R8              mw
         LA     R4,1(R4)           mw+1
         MH     R4,=H'26'          (mw+1)*26
         SRDA   R4,32              .
         D      R4,=F'10'          (mw+1)*26/10
         LR     R2,R5              "
         A      R2,D               d
         A      R2,K               d+k
         L      R3,K               k
         SRA    R3,2               k/4
         AR     R2,R3              (mw+1)*26/10+k/4
         L      R3,J               j
         SRA    R3,2               j/4
         AR     R2,R3              (mw+1)*26/10+k/4+j/4
         LA     R5,5               5
         M      R4,J               5*j
         AR     R2,R5              (mw+1)*26/10+k/4+j/4
         SRDA   R2,32              .
         D      R2,=F'7'           (d+(mw+1)*26/10+k+k/4+j/4+5*j)/7
         C      R2,=F'6'           if dow=friday
         BNE    NOFRIDAY
         XDECO  R6,XDEC            y
         MVC    PG+0(4),XDEC+8     output y
         LR     R1,R7              im
         MH     R1,=H'3'           *3
         LA     R14,MN-3(R1)       @mn(im)
         MVC    PG+5(3),0(R14)     output mn(im)
         XPRNT  PG,8               print buffer
         LA     R11,1(R11)         nok=nok+1
         MVI    YF,X'01'           yf=1
NOFRIDAY LA     R7,1(R7)           im=im+1
         B      LOOPIM
ELOOPIM  L      R4,YF              yf
         CLI    YF,X'00'           if yf=0
         BNE    EYFNE0
         LA     R10,1(R10)         nko=nko+1
EYFNE0   LA     R6,1(R6)           y=y+1
         B      LOOPY
ELOOPY   XDECO  R11,XDEC           nok
         MVC    PG+0(4),XDEC+8     output nok
         MVC    PG+4(12),=C' occurrences'
         XPRNT  PG,80              print buffer
         XDECO  R10,XDEC           nko
         MVC    PG+0(4),XDEC+8     output nko
         MVC    PG+4(33),=C' years with no five weekend month'
         XPRNT  PG,80              print buffer
         L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    "
         XR     R15,R15            "
         BR     R14                exit
Y1       DC     H'1900'            year start
Y2       DC     H'2100'            year stop
ML       DC     H'1',H'3',H'5',H'7',H'8',H'10',H'12'
MN       DC     C'jan',C'mar',C'may',C'jul',C'aug',C'oct',C'dec'
YF       DS     X                  year flag
M        DS     F                  month
D        DS     F                  day
J        DS     F                  j=yw/100
K        DS     F                  j=mod(yw,100)
PG       DC     CL80'....-'        buffer
XDEC     DS     CL12               temp for XDECO
         YREGS
         END    FIVEWEEK