Calendrical Calculations

This is G o o g l e's cache of http://home.earthlink.net/~neilbawd/calencal.html.
G o o g l e's cache is the snapshot that we took of the page as we crawled the web.
The page may have changed since that time. Click here for the current page without highlighting.
To link to or bookmark this page, use the following url: http://www.google.com/search?q=cache:Wu7B5W0oyPgC:home.earthlink.net/~neilbawd/calencal.html+&hl=en&ie=UTF-8

Google is not affiliated with the authors of this page nor responsible for its content.

Calendrical Calculations - Arithmetical

Wil Baden 1999-09-11 2001-01-15

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*                                                           *
*   Gregorian, Julian, ISO, Islamic, and Hebrew Calendars   *
*                                                           *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Forth versions of several calendrical functions.

Calendrical Calculations, Dershowitz and Reingold

Environmental dependency on 32 bit arithmetic.

TEXT

'th-Weekday */_ */_MOD /_ /_MOD Advent BCE Birkath-Ha-Hama CALENDAR CE Christmas Day-Number Day-of-Week-from-Fixed Daylight-Savings-End Daylight-Savings-Start Days-Remaining Days-in-Hebrew-Year Easter Eastern-Orthodox-Christmas Election-Day Epiphany FIRST Fixed-from-Gregorian Fixed-from-Hebrew Fixed-from-ISO Fixed-from-Islamic Fixed-from-JD Fixed-from-Julian Gregorian-Date-Difference Gregorian-Epoch Gregorian-Leap-Year? Gregorian-Year-from-Fixed Gregorian-from-Fixed Hebrew-Birthday Hebrew-Calendar-Elapsed-Days Hebrew-Epoch Hebrew-Leap-Year? Hebrew-New-Year-Delay Hebrew-from-Fixed ISO-from-Fixed Independence-Day Islamic-Epoch Islamic-from-Fixed JD-Start JD-from-Moment Julian-Epoch Julian-Leap-Year? Julian-from-Fixed Julian-in-Gregorian LAST Labor-Day Last-Day-of-Hebrew-Month Last-Month-of-Hebrew-Year Long-Heshvan? Memorial-Day Moment-from-JD Nicaean-Rule-Easter Omer Passover Pentecost Purim Sh-Ela Short-Kislev? Ta-Anith-Esther Thanksgiving Tisha-B-Av Weekday-After Weekday-Before Weekday-Nearest Weekday-on-or-After Weekday-on-or-Before Yahrzeit Yom-Ha-Zikaron Yom-Kippur _MOD

Needed from Tool Belt

THIRD FOURTH ANDIF

Operators for Floored Arithmetic

From Forth Standard Annex, A.6.1.1561.

/_MOD ( dividend divisor -- remainder quotient ): /MOD with floored arithmetic.
/_ ( dividend divisor -- quotient ): / with floored arithmetic.
_MOD ( dividend divisor -- remainder ): MOD with floored arithmetic.
*/_MOD ( amount multiplier divisor -- remainder quotient ): */MOD with floored arithmetic.
*/_ ( amount multiplier divisor -- quotient ): */ with floored arithmetic.

Program Text 1

: /_MOD ( dividend divisor -- remainder quotient ) >R S>D R> FM/MOD ; : /_ ( dividend divisor -- quotient ) /_MOD NIP ; : _MOD ( dividend divisor -- remainder ) /_MOD DROP ; : */_MOD ( amount multiplier divisor -- remainder quotient ) >R M* R> FM/MOD ; : */_ ( amount multiplier divisor -- quotient ) */_MOD NIP ;

SUN MON TUE WED THU FRI SAT: IDs for day of week. {0...6}
JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC: IDs for months of Julian/Gregorian calendar. {1...12}
Day-of-Week-from-Fixed ( fixed-date -- day-of-week ): The ID of the day of the week of date {0...6}

Program Text 2

0 DUP CONSTANT SUN 1+ DUP CONSTANT MON 1+ DUP CONSTANT TUE 1+ DUP CONSTANT WED 1+ DUP CONSTANT THU 1+ DUP CONSTANT FRI 1+ DUP CONSTANT SAT DROP 1 DUP CONSTANT JAN 1+ DUP CONSTANT FEB 1+ DUP CONSTANT MAR 1+ DUP CONSTANT APR 1+ DUP CONSTANT MAY 1+ DUP CONSTANT JUN 1+ DUP CONSTANT JUL 1+ DUP CONSTANT AUG 1+ DUP CONSTANT SEP 1+ DUP CONSTANT OCT 1+ DUP CONSTANT NOV 1+ DUP CONSTANT DEC DROP : Day-of-Week-from-Fixed ( fixed-date -- day-of-week ) 7 _MOD ;

JD-Start ( F: -- x ): Fixed time x of start of julian day numbers.
Moment-from-JD ( F: julian-day-number -- moment ): Fixed time moment of astronomical julian-day-number.
Fixed-from-JD ( F: julian-day-number -- )( -- fixed-date ): fixed-date of astronomical julian-day-number.
JD-from-Moment ( F: moment -- julian-day-number ): Astronomical julian-day-number of fixed moment moment.

Program Text 3

-1721424.5E0 FCONSTANT JD-Start : Moment-from-JD ( F: julian-day-number -- moment ) JD-Start F+ ; : Fixed-from-JD ( F: julian-day-number -- )( -- fixed-date ) Moment-from-JD FLOOR F>D D>S ; : JD-from-Moment ( F: moment -- julian-day-number ) JD-START F- ;

Gregorian Calendar

Gregorian-Epoch ( -- fixed-date ): fixed-date at start of the (proleptic) Gregorian calendar.
Gregorian-Leap-Year? ( gregorian-year -- flag ): True if gregorian-year is a leap year in the Gregorian calendar
Day-Number ( month day year -- +n ): Day number in year of Gregorian date.
Fixed-from-Gregorian ( month day year -- fixed-date ): fixed-date equivalent to the Gregorian date.
Gregorian-Year-from-Fixed ( fixed-date -- gregorian-year ): The gregorian-year corresponding to the fixed-date.
Gregorian-from-Fixed ( fixed-date -- gregorian-date . . ): Gregorian month day year corresponding to fixed-date.
CALENDAR ( fixed-date -- ): Display month calendar from fixed-date. The fixed date will be flagged. (Added by Wil Baden.)

Program Text 4

1 CONSTANT Gregorian-Epoch : Gregorian-Leap-Year? ( gregorian-year -- flag ) DUP 4 _MOD 0= ( gregorian-year flag) OVER 100 _MOD 0= NOT AND SWAP 400 _MOD 0= OR ( flag) ; : Day-Number ( month day year -- day-of-year ) >R SWAP ( day month)( R: year) DUP >R ( R: year month) 367 * 362 - 12 / + ( day-of-year) R> 2 > IF \ Adjust for MAR..DEC. ( R: year) R@ Gregorian-Leap-Year? IF 1- ELSE 2 - THEN THEN R> DROP ; : Fixed-from-Gregorian ( month day year -- fixed-date ) DUP 1- >R ( R: previous-year) Day-Number ( day-of-year) R@ 4 /_ + R@ 100 /_ - R@ 400 /_ + R> 365 * + ; : Gregorian-Year-from-Fixed ( fixed-date -- gregorian-year ) Gregorian-Epoch - ( d0) 146097 /_MOD ( d1 n400) 400 * SWAP ( year d1) 36524 /_MOD ( year d2 n100) DUP >R ( year d2 n100)( R: n100) 100 * ROT + SWAP ( year d2) 1461 /_MOD ( year d3 n4) 4 * ROT + SWAP ( year d3) 365 /_ ( year n1) DUP >R ( year n1)( R: n100 n1) + ( year) R> 4 = R> 4 = OR NOT IF 1+ THEN ; : Gregorian-from-Fixed ( fixed-date -- month day year ) DUP Gregorian-Year-from-Fixed >R ( R: year) DUP JAN 1 R@ Fixed-from-Gregorian - ( date prior-days) OVER MAR 1 R@ Fixed-from-Gregorian < NOT IF R@ Gregorian-Leap-Year? IF 1+ ELSE 2 + THEN THEN 12 * 373 + 367 / >R ( date)( R: year month) 2R@ 1 ROT Fixed-from-Gregorian - 1+ ( day) R> SWAP R> ( month day year) ; : CALENDAR ( fixed -- ) DUP Gregorian-from-Fixed NIP ( fixed month year) CR 8 SPACES OVER 1- 3 * CHARS S" JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC" DROP + 3 TYPE SPACE DUP . CR 2DUP >R 1+ 1 R> Fixed-from-Gregorian >R 1 SWAP Fixed-from-Gregorian ( fixed first-of-month) DUP Day-of-Week-from-Fixed 4 * SPACES R> OVER - 1+ 1 DO I 2 .R 2DUP = IF ." * " ELSE 2 SPACES THEN 1+ DUP Day-of-Week-from-Fixed 0= IF CR THEN LOOP Day-of-Week-from-Fixed IF CR THEN DROP ; : CAL ( month day year -- ) Fixed-from-Gregorian Calendar ;

Gregorian-Date-Difference ( greg-date-1 . . greg-date-2 . . -- n ): Number of days from Gregorian date greg-date-1 until greg-date-1.
Days-Remaining ( gregorian-date . . -- +n ): Days remaining in year after Gregorian date gregorian-date.

Program Text 5

: Gregorian-Date-Difference ( g-date-1 . . g-date-2 . . -- n ) Fixed-from-Gregorian >R Fixed-from-Gregorian R> SWAP - ; : Days-Remaining ( month day year -- n ) DUP DEC 31 ROT Gregorian-Date-Difference ;

Kday has been changed to Weekday.

Nth-Kday has been changed to 'th-Weekday.

Weekday-on-or-Before ( fixed-date-1 weekday -- fixed-date-2 ): fixed-date-2 of the weekday on or before fixed-date-1. weekday=0 means Sunday, weekday=1 means Monday, and so on.
Weekday-on-or-After ( fixed-date-1 weekday -- fixed-date-2 ): fixed-date of the weekday on or after fixed-date. weekday=0 means Sunday, weekday=1 means Monday, and so on.
Weekday-Nearest ( fixed-date-1 weekday -- fixed-date-2 ): fixed-date of the weekday nearest fixed-date. weekday=0 means Sunday, weekday=1 means Monday, and so on.
Weekday-After ( fixed-date-1 weekday -- fixed-date-2 ): fixed-date of the weekday after fixed-date. weekday=0 means Sunday, weekday=1 means Monday, and so on.
Weekday-Before ( fixed-date-1 weekday -- fixed-date-2 ): fixed-date of the weekday before fixed-date. weekday=0 means Sunday, weekday=1 means Monday, and so on.
'th-Weekday ( n weekday month day year -- fixed-date ): fixed-date of n'th weekday after month day year. If n>0, return the n'th weekday on or after the date. If n<0, return the n'th weekday on or before the date. A weekday of 0 means Sunday, 1 means Monday, and so on.
FIRST ( -- n ): Index for selecting a weekday.
LAST ( -- n ): Index for selecting a weekday.

Program Text 6

: Weekday-on-or-Before ( date k -- date' ) OVER SWAP - Day-of-Week-from-Fixed - ; : Weekday-on-or-After ( date k -- date' ) SWAP 6 + SWAP Weekday-on-or-Before ; : Weekday-Nearest ( date k -- date' ) SWAP 3 + SWAP Weekday-on-or-Before ; : Weekday-After ( date k -- date' ) SWAP 7 + SWAP Weekday-on-or-Before ; : Weekday-Before ( date k -- date' ) SWAP 1- SWAP Weekday-on-or-Before ; : 'th-Weekday ( n k month day year -- date ) Fixed-from-Gregorian ( n k date) SWAP ROT >R ( date k)( R: n) R@ 0< IF Weekday-After ELSE Weekday-Before THEN ( date) R> 7 * + ; 1 CONSTANT FIRST -1 CONSTANT LAST

"Holidays"

Independence-Day ( gregorian-year -- fixed-date ): fixed-date of American Independence Day in gregorian-year.
Labor-Day ( gregorian-year -- fixed-date ): fixed-date of American Labor Day in gregorian-year--the first Monday in September.
Memorial-Day ( gregorian-year -- fixed-date ): fixed-date of American Memorial Day in Gregorian year--the last Monday in May.
Election-Day ( gregorian-year -- fixed-date ): fixed-date of American Election Day in Gregorian year--the Tuesday after the first Monday in November.
Daylight-Savings-Start ( gregorian-year -- fixed-date ): fixed-date of the start of American daylight savings time in gregorian-year--the first Sunday in April.
Daylight-Savings-End ( gregorian-year -- fixed-date ): fixed-date of the end of American daylight savings time in gregorian-year--the last Sunday in October.
Thanksgiving ( gregorian-year -- fixed-date ): fixed-date of Christmas in gregorian-year.
Christmas ( gregorian-year -- fixed-date ): fixed-date of Christmas in gregorian-year.
Advent ( gregorian-year -- fixed-date ): fixed-date of Advent in gregorian-year.
Epiphany ( gregorian-year -- fixed-date ): fixed-date of Epiphany in gregorian-year.

Program Text 7

: Independence-Day ( greg-year -- fixed-date ) JUL 4 ROT Fixed-from-Gregorian ; : Labor-Day ( year -- fixed-date ) >R FIRST MON SEP 1 R> 'th-Weekday ; : Memorial-Day ( year -- fixed-date ) >R LAST MON MAY 31 R> 'th-Weekday ; : Election-Day ( year -- fixed-date ) >R FIRST TUE NOV 2 R> 'th-Weekday ; : Daylight-Savings-Start ( year -- fixed-date ) >R FIRST SUN APR 1 R> 'th-Weekday ; : Daylight-Savings-End ( year -- fixed-date ) >R LAST SUN OCT 31 R> 'th-Weekday ; : Thanksgiving ( year -- fixed-date ) >R 4 THU NOV 1 R> 'th-Weekday ; : Christmas ( year -- fixed-date ) DEC 25 ROT Fixed-from-Gregorian ; : Advent ( year -- fixed-date ) NOV 30 ROT Fixed-from-Gregorian SUN Weekday-Nearest ; : Epiphany ( year -- fixed-date ) 1- Christmas 12 + ;

ISO Calendar

Fixed-from-ISO ( week day year -- fixed-date ): fixed-date equivalent to ISO (week day year).
ISO-from-Fixed ( fixed-date -- week day year ): ISO (week day year) corresponding to the fixed-date.

Program Text 8

: Fixed-from-ISO ( week day year -- fixed-date ) >R ( week day)( R: year) SWAP SUN DEC 28 R> 1- ( day week sun month day year) 'th-Weekday + ; : ISO-from-Fixed ( fixed-date -- week day year ) DUP >R ( R: date ) 3 - Gregorian-Year-from-Fixed ( approx) 1 1 THIRD 1+ Fixed-from-ISO R@ > NOT - ( year) 1 1 THIRD Fixed-from-ISO R@ SWAP - 7 /_ 1+ ( year week) R> 1- 7 _MOD 1+ ( year week day) ROT ( week day year) ;

Julian Calendar

Julian-Epoch ( fixed-date ): fixed-date of start of the Julian calendar.
BCE ( standard-year -- julian-year ): Negative value to indicate a BCE Julian year.
CE ( standard-year -- julian-year ): Positive value to indicate a CE Julian year.
Julian-Leap-Year? ( julian-year -- flag ): True if year is a leap year on the Julian calendar.
Fixed-from-Julian ( julian-date -- fixed-date ): fixed-date equivalent to the Julian date.
Julian-from-Fixed ( fixed-date -- julian-date ): Julian (month day year) corresponding to fixed-date.

Program Text 9

DEC 30 0 Fixed-from-Gregorian CONSTANT Julian-Epoch : Julian-Leap-Year? ( j-year -- flag ) DUP >R 4 _MOD R> 0> IF 0 ELSE 3 THEN = ; : Fixed-from-Julian ( month day year -- fixed-date ) >R SWAP ( day month)( R: year) DUP >R 367 * 362 - 12 / + ( day)( R: year month) R> 2 > IF ( day)( R: year) R@ Julian-Leap-Year? IF 1- ELSE 2 - THEN THEN Julian-Epoch + 1- R> DUP 0< - 1- DUP >R 365 * + R> 4 /_ + ; : Julian-from-Fixed ( fixed-date -- month day year ) DUP Julian-Epoch - 4 * 1464 + 1461 /_ ( date approx) DUP 0> NOT + >R ( date)( R: year) DUP JAN 1 R@ Fixed-from-Julian - ( date prior-days) OVER MAR 1 R@ Fixed-from-Julian < NOT IF R@ Julian-Leap-Year? IF 1+ ELSE 2 + THEN THEN 12 * 373 + 367 /_ ( date month) SWAP OVER 1 R@ Fixed-from-Julian - 1+ ( month day) R> ( month day year) ;

Ecclesiastical Calendars

Nicaean-Rule-Easter ( julian-year -- fixed-date ): fixed-date of Easter in positive Julian year, according to the rule of the Council of Nicaea.
Easter ( gregorian-year -- fixed-date ): fixed-date of Easter in gregorian-year.
Pentecost ( gregorian-year -- fixed-date ): fixed-date of Pentecost in gregorian-year.
Julian-in-Gregorian ( j-month j-day greg-year -- list-of-fixed-dates ): The list of the fixed-dates of Julian month, day that occur in gregorian-year.
Eastern-Orthodox-Christmas ( gregorian-year -- list-of-fixed-dates ): List of zero or one fixed-dates of Eastern Orthodox Christmas in gregorian-year.

Program Text 10

: Nicaean-Rule-Easter ( j-year -- date ) DUP >R ( R: j-year) 19 MOD 11 * 14 + 30 MOD ( shifted-epact) APR 19 R> Fixed-from-Julian SWAP - ( paschal-moon) SUN Weekday-After ; : Easter ( greg-year -- date ) DUP >R ( R: greg-year) 100 / 1+ ( century) R@ 19 MOD 11 * 14 + ( century shifted-epact) OVER 3 * 4 / - SWAP 8 * 5 + 25 / + ( shifted-epact) 30 MOD DUP 0= IF 1+ ELSE DUP 1 = 10 R@ 19 MOD < AND IF 1+ THEN THEN ( adjusted-epact) APR 19 R> Fixed-from-Gregorian SWAP - ( paschal-moon) SUN Weekday-After ; : Pentecost ( greg-year -- date ) Easter 49 + ; : Ash-Wednesday ( greg-year -- date ) Easter 46 - ;

Islamic Calendar

Islamic-Epoch ( -- fixed-date ): fixed-date of start of the Islamic calendar.
Fixed-from-Islamic ( islamic-date -- fixed-date ): fixed-date equivalent to Islamic date.
Islamic-from-Fixed ( fixed-date -- islamic-date ): Islamic date (month day year) corresponding to fixed-date.

Program Text 11

JUL 16 622 Fixed-from-Julian CONSTANT Islamic-Epoch : Fixed-from-Islamic ( month day year -- fixed ) >R SWAP ( day month)( R: year) 1- 295 * 5 + 10 /_ + R@ 1- 354 * + R> 11 * 3 + 30 /_ + Islamic-Epoch + 1- ; : Islamic-from-Fixed ( fixed -- month day year ) DUP Islamic-Epoch - 30 * 10646 + 10631 /_ >R ( R: year) DUP 29 - 1 1 R@ Fixed-from-Islamic - 2* 59 /_MOD SWAP IF 1+ THEN 1+ 12 MIN ( date month) SWAP OVER 1 R@ Fixed-from-Islamic - 1+ ( month day) R> ( month day year) ;

Hebrew Calendar

Hebrew-Epoch ( -- fixed-date ): fixed-date of start of the Hebrew calendar, that is, Tishri 1, 1 AM.
Hebrew-Leap-Year? ( hebrew-year -- flag ): True if year is a leap year on Hebrew calendar.
Last-Month-of-Hebrew-Year ( hebrew-year -- hebrew-month ): Last month of Hebrew year.
Long-Heshvan? ( hebrew-year -- flag ): True if Heshvan is long in Hebrew year.
Short-Kislev? ( hebrew-year -- flag ): True if Kislev is short in Hebrew year.
Last-Day-of-Hebrew-Month ( hebrew-month hebrew-year -- hebrew-day ): Last day of month in Hebrew year.
Hebrew-Calendar-Elapsed-Days ( hebrew-year -- n ): Number of days elapsed from the (Sunday) noon prior to the epoch of the Hebrew calendar to the mean conjunction (molad) of Tishri of Hebrew year h-year, or one day later.
Hebrew-New-Year-Delay ( hebrew-year -- [0,1,2] ): Delays to start of Hebrew year to keep ordinary year in range 353-356 and leap year in range 383-386.
Days-in-Hebrew-Year ( hebrew-year -- [353,354,355,383,384,385] ): Number of days in Hebrew year. Calls Fixed-from-Hebrew for value that does not in turn require Days-in-Hebrew-Year.

Program Text 12

OCT 7 -3761 Fixed-from-Julian CONSTANT Hebrew-Epoch : Hebrew-Leap-Year? 7 * 1+ 19 _MOD 7 < ; : Last-Month-of-Hebrew-Year Hebrew-Leap-Year? IF 13 ELSE 12 THEN ; : Hebrew-Calendar-Elapsed-Days ( h-year -- day ) 235 * 234 - 19 /_ ( months-elapsed) DUP 13753 * 12084 + ( month-elapsed parts-elapsed) 25920 /_ SWAP 29 * + ( day) DUP 1+ 3 * 7 _MOD 3 < - ; : Hebrew-New-Year-Delay ( h-year -- n ) DUP 1- Hebrew-Calendar-Elapsed-Days ( year ny0) OVER Hebrew-Calendar-Elapsed-Days ( year ny0 ny1) ROT 1+ Hebrew-Calendar-Elapsed-Days ( ny0 ny1 ny2) OVER - 356 = IF 2DROP 2 ELSE SWAP - 382 = IF 1 ELSE 0 THEN THEN ; DEFER Fixed-from-Hebrew ( month day year -- date ) : Days-in-Hebrew-Year ( h-year -- days ) >R 7 1 R@ 1+ Fixed-from-Hebrew 7 1 R> Fixed-from-Hebrew - ; : Long-Heshvan? ( h-year -- flag ) Days-in-Hebrew-Year 10 MOD 5 = ; : Short-Kislev? ( h-year -- flag ) Days-in-Hebrew-Year 10 MOD 3 = ; : Last-Day-of-Hebrew-Month ( month year -- day ) \ Bits 2 4 6 10 13 OVER 1 SWAP LSHIFT [ 2 BASE ! ] 10010001010100 [ DECIMAL ] AND IF 2DROP 29 EXIT THEN OVER 12 = IF DUP Hebrew-Leap-Year? NOT IF 2DROP 29 EXIT THEN THEN OVER 8 = IF DUP Long-Heshvan? NOT IF 2DROP 29 EXIT THEN THEN OVER 9 = IF DUP Short-Kislev? IF 2DROP 29 EXIT THEN THEN 2DROP 30 ;

Fixed-from-Hebrew ( hebrew-date -- fixed-date ): fixed-date from Hebrew date. This function is designed so that it works for Hebrew dates month, day, year even if the month has fewer than day days--in that case the function returns the (day-1)st day after month 1, year. This property is required by the functions hebrew-birthday and yahrzeit.
Hebrew-from-Fixed ( fixed-date -- hebrew-date ): Hebrew (month day year) corresponding to fixed-date. The fraction can be approximated by 365.25.

Program Text 13

: (Fixed-from-Hebrew) ( month day year -- date ) Hebrew-Epoch ( month day year date) OVER Hebrew-Calendar-Elapsed-Days + OVER Hebrew-New-Year-Delay + THIRD + 1 - FOURTH 7 < IF OVER Last-Month-of-Hebrew-Year 1+ 7 DO OVER I SWAP Last-Day-of-Hebrew-Month + LOOP FOURTH 1 ?DO OVER I SWAP Last-Day-of-Hebrew-Month + LOOP ELSE FOURTH 7 ?DO OVER I SWAP Last-Day-of-Hebrew-Month + LOOP THEN NIP NIP NIP ; ' (Fixed-from-Hebrew) IS Fixed-from-Hebrew : Hebrew-from-Fixed ( date -- month day year ) DUP >R ( R: date) Hebrew-Epoch - 98496 35975351 */_ ( approx) BEGIN 7 1 THIRD Fixed-from-Hebrew R@ > NOT WHILE 1+ REPEAT 1- >R ( )( R: date year) 2R@ 1 1 ROT Fixed-from-Hebrew < IF 7 ELSE 1 THEN ( start) BEGIN DUP DUP R@ Last-Day-of-Hebrew-Month R@ Fixed-from-Hebrew 2R@ DROP < WHILE 1+ REPEAT ( month) DUP 1 R@ Fixed-from-Hebrew 2R@ DROP SWAP - 1+ ( month day) R> ( month day year) R> DROP ;

Hebrew Holidays and Fast Days

Yom-Kippur ( gregorian-year -- fixed-date ): fixed-date of Yom Kippur occurring in gregorian-year.
Passover ( gregorian-year -- fixed-date ): fixed-date of Passover occurring in gregorian-year.
Omer ( fixed-date -- omer-count ): Number of elapsed weeks and days in the omer at date. Returns bogus if that date does not fall during the omer.
Purim ( gregorian-year -- fixed-date ): fixed-date of Purim occurring in gregorian-year.
Ta-Anith-Esther ( gregorian-year -- fixed-date ): fixed-date of Ta'anith Esther occurring in gregorian-year.
Tisha-B-Av ( gregorian-year -- fixed-date ): fixed-date of Tisha B'Av occurring in Gregorianyear.
Birkath-Ha-Hama ( gregorian-year -- list-of-fixed-dates ): List of fixed-date of Birkath HaHama occurring in gregorian-year, if it occurs.
Sh-Ela ( gregorian-year -- fixed-date ): fixed-date of Sh'ela occurring in gregorian-year.
Yom-Ha-Zikaron ( gregorian-year -- fixed-date ): fixed-date of Yom HaZikaron occurring in gregorian-year.

Program Text 14

: Yom-Kippur ( gregorian-year -- fixed-date ) 7 10 ROT Hebrew-Epoch Gregorian-Year-from-Fixed - 1+ Fixed-from-Hebrew ( date) ; : Rosh-Hashanah ( gregorian-year -- fixed-date ) 7 1 ROT Hebrew-Epoch Gregorian-Year-from-Fixed - 1+ Fixed-from-Hebrew ; : Passover ( gregorian-year -- fixed-date ) 1 15 ROT Hebrew-Epoch Gregorian-Year-from-Fixed - Fixed-from-Hebrew ; : Purim ( gregorian-year -- fixed-date ) Hebrew-Epoch Gregorian-Year-from-Fixed - ( h-year) DUP Last-Month-of-Hebrew-Year ( h-year month) 14 ROT ( month day year) Fixed-from-Hebrew ( date) ; : Esther ( gregorian-year -- fixed-date ) Purim DUP Day-of-Week-from-Fixed SUN = IF 3 - ELSE 1- THEN ; : Yom-Hashoah ( gregorian-year -- fixed-date ) 1 27 ROT Hebrew-Epoch Gregorian-Year-from-Fixed - Fixed-from-Hebrew ( date) ; : Hanukkah ( gregorian-year -- fixed-date ) 9 25 ROT Hebrew-Epoch Gregorian-Year-from-Fixed - 1+ Fixed-from-Hebrew ( date) ;

Days of Personal Interest

Hebrew-Birthday ( hebrew-birthdate . . hebrew-year -- fixed-date ): fixed-date of the anniversary of hebrew-birthdate occurring in hebrew-year. This function assumes that the function Fixed-from-Hebrew works for Hebrew month day year even if the month has fewer than day days--in that case the function returns the (day-1)st day after month 1 year.
Yahrzeit ( hebrew-deathdate . . hebrew-year -- fixed-date ): fixed-date of the anniversary of hebrew-deathdate occurring in hebrew-year. This function assumes that the function Fixed-from-Hebrew works for Hebrew month day year even if the month has fewer than day days--in that case the function returns the (day-1)st day after month 1 year.

Program Text 15

: Hebrew-Birthday ( b-month b-day b-year h-year -- date ) >R ( b-month b-day b-year)( R: h-year) THIRD SWAP Last-Month-of-Hebrew-Year = IF ( month day) R@ Last-Month-of-Hebrew-Year OVER R> ELSE 2DUP R> THEN Fixed-from-Hebrew NIP NIP ; : Yahrzeit ( death-month death-day death-year h-year -- date ) >R ( death-month death-day death-year)( R: h-year) THIRD 8 = ANDIF OVER 30 = ANDIF DUP 1- Long-Heshvan? NOT THEN THEN IF 3DROP 9 1 R> Fixed-from-Hebrew 1- EXIT THEN THIRD 9 = ANDIF OVER 30 = ANDIF DUP 1+ Short-Kislev? THEN THEN IF 3DROP 10 1 R> Fixed-from-Hebrew 1- EXIT THEN THIRD 13 = IF DROP NIP R@ Last-Month-of-Hebrew-Year SWAP R> Fixed-from-Hebrew EXIT THEN THIRD 12 = ANDIF OVER 30 = ANDIF R@ Hebrew-Leap-Year? NOT THEN THEN IF 3DROP 11 30 R> Fixed-from-Hebrew EXIT THEN DROP R> Fixed-from-Hebrew ;

Go back to Neil Bawd's home page.