(IN-PACKAGE "RTL") (INCLUDE-BOOK "rtl/rel11/lib/rac" :DIR :SYSTEM) (SET-IGNORE-OK T) (SET-IRRELEVANT-FORMALS-OK T) (DEFUND LUNATION NIL (AS 'PART 793 (AS 'HOUR 12 (AS 'DAY 29 NIL)))) (DEFUND BEHARAD NIL (AS 'PART 204 (AS 'HOUR 5 (AS 'DAY 2 NIL)))) (DEFUND YEARBOUND NIL 100000) (DEFUND HEBREWBIRTHDAY NIL (AS 'YEAR 5709 (AS 'MONTH 2 (AS 'DAY 14 NIL)))) (DEFUND DAYOFWEEK (DAY) (REM DAY 7)) (DEFUND ADDTIME (X Y) (LET* ((SUM NIL) (SUMPARTS (+ (AG 'PART X) (AG 'PART Y))) (SUM (AS 'PART (REM SUMPARTS 1080) SUM)) (SUMHOURS (+ (+ (AG 'HOUR X) (AG 'HOUR Y)) (FL (/ SUMPARTS 1080)))) (SUM (AS 'HOUR (REM SUMHOURS 24) SUM))) (AS 'DAY (+ (+ (AG 'DAY X) (AG 'DAY Y)) (FL (/ SUMHOURS 24))) SUM))) (DEFUND MULTIME (M X) (LET* ((PROD NIL) (PRODPARTS (* M (AG 'PART X))) (PROD (AS 'PART (REM PRODPARTS 1080) PROD)) (PRODHOURS (+ (* M (AG 'HOUR X)) (FL (/ PRODPARTS 1080)))) (PROD (AS 'HOUR (REM PRODHOURS 24) PROD))) (AS 'DAY (+ (* M (AG 'DAY X)) (FL (/ PRODHOURS 24))) PROD))) (DEFUND EARLIER (X H P) (LOGIOR1 (LOG< (AG 'HOUR X) H) (LOGAND1 (LOG= (AG 'HOUR X) H) (LOG< (AG 'PART X) P)))) (DEFUND LEAP (YEAR) (LET ((M (REM YEAR 19))) (LOGIOR1 (LOGIOR1 (LOGIOR1 (LOGIOR1 (LOGIOR1 (LOGIOR1 (LOG= M 0) (LOG= M 3)) (LOG= M 6)) (LOG= M 8)) (LOG= M 11)) (LOG= M 14)) (LOG= M 17)))) (DEFUND COMMON (YEAR) (LOGNOT1 (LEAP YEAR))) (DEFUND MONTHSINYEAR (YEAR) (IF1 (LEAP YEAR) 13 12)) (DEFUND MOLAD-LOOP-0 (Y YEAR PRIORMONTHS) (DECLARE (XARGS :MEASURE (NFIX (- YEAR Y)))) (IF (AND (INTEGERP Y) (INTEGERP YEAR) (< Y YEAR)) (LET ((PRIORMONTHS (+ PRIORMONTHS (MONTHSINYEAR Y)))) (MOLAD-LOOP-0 (+ Y 1) YEAR PRIORMONTHS)) PRIORMONTHS)) (DEFUND MOLAD (YEAR) (LET* ((PRIORMONTHS 0) (PRIORMONTHS (MOLAD-LOOP-0 1 YEAR PRIORMONTHS))) (ADDTIME (BEHARAD) (MULTIME PRIORMONTHS (LUNATION))))) (DEFUND DELAYEDMOLAD (YEAR) (LET ((SIXHOURS (AS 'PART 0 (AS 'HOUR 6 (AS 'DAY 0 NIL))))) (ADDTIME (MOLAD YEAR) SIXHOURS))) (DEFUND ROSHHASHANAH (YEAR) (LET* ((DM (DELAYEDMOLAD YEAR)) (DAY (AG 'DAY DM)) (DW (DAYOFWEEK DAY))) (IF1 (LOGIOR1 (LOGIOR1 (LOG= DW 1) (LOG= DW 4)) (LOG= DW 6)) (+ DAY 1) (IF1 (LOGAND1 (LOGAND1 (LOG= DW 3) (LOGNOT1 (EARLIER DM 15 204))) (LOGNOT1 (LEAP YEAR))) (+ DAY 2) (IF1 (LOGAND1 (LOGAND1 (LOG= DW 2) (LOGNOT1 (EARLIER DM 21 589))) (LEAP (- YEAR 1))) (+ DAY 1) DAY))))) (DEFUND YEARLENGTH (YEAR) (- (ROSHHASHANAH (+ YEAR 1)) (ROSHHASHANAH YEAR))) (DEFUND MONTHLENGTH (MONTH YEARLEN) (LET ((MONLEN 0)) (CASE MONTH (2 (IF1 (LOGIOR1 (LOG= YEARLEN 355) (LOG= YEARLEN 385)) 30 29)) (3 (IF1 (LOGIOR1 (LOG= YEARLEN 353) (LOG= YEARLEN 383)) 29 30)) (T (IF1 (LOG= (REM MONTH 2) 0) 29 30))))) (DEFUND MONTHLYMOLAD (MONTH YEAR) (LET* ((PRIORMONTHS 0) (PRIORMONTHS (IF1 (LOGAND1 (LEAP YEAR) (LOG>= MONTH 6)) (IF1 (LOG= MONTH 13) 5 MONTH) (- MONTH 1)))) (ADDTIME (MOLAD YEAR) (MULTIME PRIORMONTHS (LUNATION))))) (DEFUND H2A-LOOP-0 (M DATE PRIORDAYS) (DECLARE (XARGS :MEASURE (NFIX (- (AG 'MONTH DATE) M)))) (IF (AND (INTEGERP M) (INTEGERP (AG 'MONTH DATE)) (AND (< M (AG 'MONTH DATE)) (OR (< M 6) (NOT (EQL (AG 'MONTH DATE) 13))))) (LET ((PRIORDAYS (+ PRIORDAYS (MONTHLENGTH M (YEARLENGTH (AG 'YEAR DATE)))))) (H2A-LOOP-0 (+ M 1) DATE PRIORDAYS)) PRIORDAYS)) (DEFUND H2A (DATE) (LET* ((PRIORDAYS 0) (PRIORDAYS (H2A-LOOP-0 1 DATE PRIORDAYS)) (PRIORDAYS (IF1 (LOGAND1 (LOGAND1 (LEAP (AG 'YEAR DATE)) (LOG>= (AG 'MONTH DATE) 6)) (LOG<> (AG 'MONTH DATE) 13)) (+ PRIORDAYS 30) PRIORDAYS))) (+ (+ (- (ROSHHASHANAH (AG 'YEAR DATE)) 1) PRIORDAYS) (AG 'DAY DATE)))) (DEFUND A2H-LOOP-0 (MONTH YEARLEN D) (DECLARE (XARGS :MEASURE (NFIX (- 12 MONTH)))) (IF (AND (INTEGERP MONTH) (AND (< MONTH 12) (> D (MONTHLENGTH MONTH YEARLEN)))) (LET ((D (- D (MONTHLENGTH MONTH YEARLEN)))) (A2H-LOOP-0 (+ MONTH 1) YEARLEN D)) (MV MONTH D))) (DEFUND A2H-LOOP-1 (MONTH YEARLEN D) (DECLARE (XARGS :MEASURE (NFIX (- (1+ 5) MONTH)))) (IF (AND (INTEGERP MONTH) (AND (<= MONTH 5) (> D (MONTHLENGTH MONTH YEARLEN)))) (LET ((D (- D (MONTHLENGTH MONTH YEARLEN)))) (A2H-LOOP-1 (+ MONTH 1) YEARLEN D)) (MV MONTH D))) (DEFUND A2H-LOOP-2 (YEAR D) (DECLARE (XARGS :MEASURE (NFIX (- (YEARBOUND) YEAR)))) (IF (AND (INTEGERP YEAR) (INTEGERP (YEARBOUND)) (AND (< YEAR (YEARBOUND)) (> D (YEARLENGTH YEAR)))) (LET ((D (- D (YEARLENGTH YEAR)))) (A2H-LOOP-2 (+ YEAR 1) D)) (MV YEAR D))) (DEFUND A2H (D) (LET ((HDATE NIL) (D (- D 1)) (YEAR 0)) (MV-LET (YEAR D) (A2H-LOOP-2 1 D) (LET ((HDATE (AS 'YEAR YEAR HDATE)) (MONTH 0) (YEARLEN (YEARLENGTH YEAR))) (MV-LET (MONTH D) (A2H-LOOP-1 1 YEARLEN D) (MV-LET (D MONTH) (IF1 (LOG<= MONTH 5) (MV D MONTH) (IF1 (LOGAND1 (LEAP YEAR) (LOG<= D 30)) (MV D 13) (LET ((D (IF1 (LEAP YEAR) (- D 30) D))) (MV-LET (MONTH D) (A2H-LOOP-0 6 YEARLEN D) (MV D MONTH))))) (LET ((HDATE (AS 'MONTH MONTH HDATE))) (AS 'DAY D HDATE)))))))) (DEFUND GREGORIANLEAP (YEAR) (LOGAND1 (LOG= (REM YEAR 4) 0) (LOGIOR1 (LOG= (REM YEAR 400) 0) (LOG<> (REM YEAR 100) 0)))) (DEFUND GREGORIANMONTHLENGTH (MONTH YEAR) (IF1 (LOGIOR1 (LOGIOR1 (LOGIOR1 (LOG= MONTH 9) (LOG= MONTH 4)) (LOG= MONTH 6)) (LOG= MONTH 11)) 30 (IF1 (LOG= MONTH 2) (IF1 (GREGORIANLEAP YEAR) 29 28) 31))) (DEFUND GREGORIANYEARLENGTH (YEAR) (IF1 (GREGORIANLEAP YEAR) 366 365)) (DEFUND G2A-LOOP-0 (MONTH DATE YEAR D) (DECLARE (XARGS :MEASURE (NFIX (- (1+ 12) MONTH)))) (IF (AND (INTEGERP MONTH) (AND (<= MONTH 12) (< MONTH (AG 'MONTH DATE)))) (LET ((D (+ D (GREGORIANMONTHLENGTH MONTH YEAR)))) (G2A-LOOP-0 (+ MONTH 1) DATE YEAR D)) (MV MONTH D))) (DEFUND G2A-LOOP-1 (YEAR DATE D) (DECLARE (XARGS :MEASURE (NFIX (- (YEARBOUND) YEAR)))) (IF (AND (INTEGERP YEAR) (INTEGERP (YEARBOUND)) (AND (< YEAR (YEARBOUND)) (< YEAR (AG 'YEAR DATE)))) (LET ((D (+ D (GREGORIANYEARLENGTH YEAR)))) (G2A-LOOP-1 (+ YEAR 1) DATE D)) (MV YEAR D))) (DEFUND G2A (DATE) (LET ((D -249) (YEAR 0)) (MV-LET (YEAR D) (G2A-LOOP-1 -3760 DATE D) (LET ((MONTH 0)) (MV-LET (MONTH D) (G2A-LOOP-0 1 DATE YEAR D) (+ D (AG 'DAY DATE))))))) (DEFUND A2G-LOOP-0 (MONTH YEAR D) (DECLARE (XARGS :MEASURE (NFIX (- (1+ 12) MONTH)))) (IF (AND (INTEGERP MONTH) (AND (<= MONTH 12) (> D (GREGORIANMONTHLENGTH MONTH YEAR)))) (LET ((D (- D (GREGORIANMONTHLENGTH MONTH YEAR)))) (A2G-LOOP-0 (+ MONTH 1) YEAR D)) (MV MONTH D))) (DEFUND A2G-LOOP-1 (YEAR D) (DECLARE (XARGS :MEASURE (NFIX (- (YEARBOUND) YEAR)))) (IF (AND (INTEGERP YEAR) (INTEGERP (YEARBOUND)) (AND (< YEAR (YEARBOUND)) (> D (GREGORIANYEARLENGTH YEAR)))) (LET ((D (- D (GREGORIANYEARLENGTH YEAR)))) (A2G-LOOP-1 (+ YEAR 1) D)) (MV YEAR D))) (DEFUND A2G (D) (LET ((GDATE NIL) (D (+ D 249)) (YEAR 0)) (MV-LET (YEAR D) (A2G-LOOP-1 -3760 D) (LET ((GDATE (AS 'YEAR YEAR GDATE)) (MONTH 0)) (MV-LET (MONTH D) (A2G-LOOP-0 1 YEAR D) (LET ((GDATE (AS 'MONTH MONTH GDATE))) (AS 'DAY D GDATE))))))) (DEFUND H2G (DATE) (A2G (H2A DATE))) (DEFUND G2H (DATE) (A2H (G2A DATE)))