[ over 3 < if [ 1 - ]
    dup 4 / over +
    over 100 / -
    swap 400 / +
    swap 1 -
    [ table
      0 3 2 5 0 3
      5 1 4 6 2 4 ]
    + + 7 mod ]                     is dayofweek ( day month year --> weekday )

  [ 1 -
    [ table
      $ "January"   $ "February"
      $ "March"     $ "April"
      $ "May"       $ "June"
      $ "July"      $ "August"
      $ "September" $ "October"
      $ "November"  $ "December" ]
    do ]                            is monthname (   monthnumber --> $        )

  [] [] temp put
  201 times
    [ true temp put
      i^ 1900 +
      ' [ 1 3 5 7 8 10 12 ]
      witheach
        [ 2dup swap
          1 unrot dayofweek
          5 = iff
            [ false temp replace
              over join nested
              swap dip join ]
          else drop ]
      temp take iff
        [ temp take
          swap join
          temp put ]
      else drop ]
  temp take swap
  say "There are "
  dup size echo
  say " months with five weekends."
  cr cr
  5 split swap
  say "Five weekends: "
  witheach
    [ do swap
      monthname echo$
      sp echo
      i if say ", " ]
  cr say "               ..."
  cr space 15 of echo$
  -5 split nip
  witheach
    [ do swap
      monthname echo$
      sp echo
      i if say ", " ]
  cr cr
  say "Years without five weekends: "
  witheach
    [ echo
      i if say ", "
      i^ 8 mod 7 = if
        [ cr space 29 of echo$ ] ]