1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
;;; -*- Mode: Lisp; speed-hacked-p: t -*-
;;; $Id: lookup-tables.lisp,v 1.4 2001/11/12 19:48:20 jesse Exp $
;;;
;;; Copyright (c) 2000, 2001 onShore Development, Inc.
;;;
;;; Local time to Gregorian time date conversion table.
(in-package :local-time)
(defvar *lt-conversion-table* nil)
(defun build-conversion-tables ()
(declare (optimize (speed 1)
(safety 3)))
(flet ((ymdw-to-lt-entry (year month day dow)
(let ((elt 0))
(declare (type fixnum elt))
(setf (ldb (byte 10 0) elt) year
(ldb (byte 4 10) elt) month
(ldb (byte 5 14) elt) day
(ldb (byte 3 19) elt) dow)
elt)))
(let ((table (make-array *days-per-lt-cycle*
:element-type 'fixnum))
(year 0)
(month 3)
(day 1)
(dow 3))
(declare (type fixnum year month day dow))
(let ((dim (days-in-month month year :careful nil)))
(declare (type fixnum dim))
(dotimes (index *days-per-lt-cycle*)
(setf (aref table index)
(ymdw-to-lt-entry year month day dow))
(incf day)
(when (< dim day)
(setf day 1)
(incf month)
(when (< 12 month)
(setf month 1)
(incf year))
(setf dim (days-in-month month year :careful nil)))
(incf dow)
(when (= dow 7)
(setq dow 0))))
(setf *lt-conversion-table* table)))
t)
(eval-when (:load-toplevel)
(build-conversion-tables))
(defun lt-entry-to-ymdw (elt)
(declare (type fixnum elt))
(values (ldb (byte 10 0) elt)
(ldb (byte 4 10) elt)
(ldb (byte 5 14) elt)
(ldb (byte 3 19) elt)))
(defun lt-entry (index)
(aref *lt-conversion-table* index))
|