(loader '((title |date.lo|)))
(if (not (>= (version) 15.2)) (progn (error 'load 'erricf 'date)))
(defvar #:sys-package:colon 'date)
(add-feature 'date)
(loader'((entry week-day-number subr1)
(push a1)
(jcall datep)
(bfnil a1 102)
(mov (& 0) a3)
(mov 'errbpa a2)
(mov 'week-day-number a1)
(jcall error)
102
(hpxmov (& 0) '0 a4)
(hpxmov (& 0) '1 a3)
(hpxmov (& 0) '2 a2)
(push '5)
(push (@ 103))
(push (& 1))
(push a4)
(mov a4 a1)
(call leap-number)
(push a1)
(mov (& 5) a1)
(call year-day-number)
(push a1)
(mov '4 a4)
(jmp +)
103
(eval ())
(mov a1 (& 0))
(mov '7 a2)
(jcall modulo)
(mov a1 (& 0))
(cabne a1 '0 104)
(mov '7 a1)
(adjstk '2)
(return)
104
(adjstk '2)
(return)
))
(loader'((entry year-day-number subr1)
(push a1)
(jcall datep)
(bfnil a1 102)
(mov (& 0) a3)
(mov 'errbpa a2)
(mov 'year-day-number a1)
(jcall error)
102
(hpxmov (& 0) '0 a4)
(hpxmov (& 0) '1 a3)
(hpxmov (& 0) '2 a2)
(push a2)
(push a3)
(push a4)
(push (@ 105))
(push a3)
(push '1)
(mov '2 a4)
(jmp >)
105
(eval ())
(btnil a1 104)
(mov (& 1) a1)
(jcall 1-)
(push '1)
(push a1)
106
(push (@ 108))
(push (& 2))
(push (& 2))
(mov '2 a4)
(jmp <=)
108
(eval ())
(btnil a1 107)
(push (@ 109))
(push (& 5))
(mov (& 4) a2)
(mov (& 3) a1)
(call month-length)
(push a1)
(mov '2 a4)
(jmp +)
109
(eval ())
(mov a1 (& 4))
(push (@ 110))
(push (& 2))
(push '1)
(mov '2 a4)
(jmp +)
110
(eval ())
(mov a1 (& 1))
(bra 106)
107
(adjstk '2)
104
(mov (& 2) a1)
(adjstk '4)
(return)
))
(loader'((entry month-length subr2)
(push a2)
(push a1)
(push (@ 101))
(mov (cvalq month-lengths) a2)
(jcall cassq)
(push a1)
(cabne (& 2) '2 102)
(mov (& 3) a1)
(call leap-year-p)
(btnil a1 102)
(mov '1 a4)
(bra 103)
102
(mov '0 a4)
103
(push a4)
(mov '2 a4)
(jmp +)
101
(eval ())
(adjstk '2)
(return)
))
(loader'((entry leap-year-p subr1)
(push a1)
(mov '4 a2)
(jcall modulo)
(cabne a1 '0 101)
(mov '100 a2)
(mov (& 0) a1)
(jcall modulo)
(cabne a1 '0 103)
(mov '400 a2)
(mov (& 0) a1)
(jcall modulo)
(mov '0 a2)
(adjstk '1)
(jmp eq)
103
(mov 't a1)
(adjstk '1)
(return)
101
(mov nil a1)
(adjstk '1)
(return)
))
(loader'((entry leap-number subr1)
(push a1)
(push (@ 103))
(push a1)
(push '0)
(mov '2 a4)
(jmp >)
103
(eval ())
(btnil a1 101)
(mov (& 0) a1)
(jcall 1-)
(mov a1 a4)
(bra 102)
101
(mov (& 0) a4)
102
(push a4)
(push (@ 104))
(quo '4 a4)
(push a4)
(push (@ 105))
(mov (& 3) a4)
(quo '100 a4)
(push a4)
(mov '1 a4)
(jmp -)
105
(eval ())
(push a1)
(mov (& 3) a4)
(quo '400 a4)
(push a4)
(push (@ 108))
(push (& 6))
(push '0)
(mov '2 a4)
(jmp >)
108
(eval ())
(btnil a1 106)
(mov '1 a3)
(bra 107)
106
(mov '0 a3)
107
(push a3)
(mov '4 a4)
(jmp +)
104
(eval ())
(adjstk '2)
(return)
))
(if (not (getdef 'create-date)) (progn (defstruct date year month day hour minute second msecond week-day)))
(loader'((fentry create-date subr0)
(entry create-date subr0)
(jcall date)
(push a1)
(push (@ 101))
(push a1)
(push 'date)
(mov '2 a4)
(jmp typevector)
101
(eval ())
(hpxmov (& 0) '0 a4)
(btfix a4 103)
(mov (& 0) a3)
(mov '"mauvaise annee" a2)
(mov 'date a1)
(jcall error)
103
(hpxmov (& 0) '1 a4)
(bffix a4 106)
(push (@ 107))
(hpxmov (& 1) '1 a4)
(push a4)
(push '1)
(mov '2 a4)
(jmp <)
107
(eval ())
(bfnil a1 106)
(push (@ 108))
(hpxmov (& 1) '1 a4)
(push a4)
(push '12)
(mov '2 a4)
(jmp >)
108
(eval ())
(btnil a1 105)
106
(mov (& 0) a3)
(mov '"mauvais mois" a2)
(mov 'date a1)
(jcall error)
105
(hpxmov (& 0) '2 a4)
(bffix a4 111)
(push (@ 112))
(hpxmov (& 1) '2 a4)
(push a4)
(push '1)
(mov '2 a4)
(jmp <)
112
(eval ())
(bfnil a1 111)
(push (@ 113))
(hpxmov (& 1) '2 a4)
(push a4)
(push '31)
(mov '2 a4)
(jmp >)
113
(eval ())
(btnil a1 110)
111
(mov (& 0) a3)
(mov '"mauvais jour" a2)
(mov 'date a1)
(jcall error)
110
(hpxmov (& 0) '3 a4)
(bffix a4 116)
(push (@ 117))
(hpxmov (& 1) '3 a4)
(push a4)
(push '0)
(mov '2 a4)
(jmp <)
117
(eval ())
(bfnil a1 116)
(push (@ 118))
(hpxmov (& 1) '3 a4)
(push a4)
(push '23)
(mov '2 a4)
(jmp >)
118
(eval ())
(btnil a1 115)
116
(mov (& 0) a3)
(mov '"mauvaise heure" a2)
(mov 'date a1)
(jcall error)
115
(hpxmov (& 0) '4 a4)
(bffix a4 121)
(push (@ 122))
(hpxmov (& 1) '4 a4)
(push a4)
(push '0)
(mov '2 a4)
(jmp <)
122
(eval ())
(bfnil a1 121)
(push (@ 123))
(hpxmov (& 1) '4 a4)
(push a4)
(push '59)
(mov '2 a4)
(jmp >)
123
(eval ())
(btnil a1 120)
121
(mov (& 0) a3)
(mov '"mauvaise minute" a2)
(mov 'date a1)
(jcall error)
120
(hpxmov (& 0) '5 a4)
(bfnil a4 125)
(hpmovx '0 (& 0) '5)
125
(hpxmov (& 0) '5 a4)
(bffix a4 128)
(push (@ 129))
(hpxmov (& 1) '5 a4)
(push a4)
(push '0)
(mov '2 a4)
(jmp <)
129
(eval ())
(bfnil a1 128)
(push (@ 130))
(hpxmov (& 1) '5 a4)
(push a4)
(push '59)
(mov '2 a4)
(jmp >)
130
(eval ())
(btnil a1 127)
128
(mov (& 0) a3)
(mov '"mauvaise seconde" a2)
(mov 'date a1)
(jcall error)
127
(hpxmov (& 0) '6 a4)
(bfnil a4 132)
(hpmovx '0 (& 0) '6)
132
(hpxmov (& 0) '6 a4)
(bffix a4 135)
(push (@ 136))
(hpxmov (& 1) '6 a4)
(push a4)
(push '0)
(mov '2 a4)
(jmp <)
136
(eval ())
(bfnil a1 135)
(push (@ 137))
(hpxmov (& 1) '6 a4)
(push a4)
(push '999)
(mov '2 a4)
(jmp >)
137
(eval ())
(btnil a1 134)
135
(mov (& 0) a3)
(mov '"mauvaise mseconde" a2)
(mov 'date a1)
(jcall error)
134
(hpxmov (& 0) '7 a4)
(bfnil a4 139)
(mov (& 0) a1)
(call week-day-number)
(hpmovx a1 (& 0) '7)
139
(hpxmov (& 0) '7 a4)
(bffix a4 142)
(push (@ 143))
(hpxmov (& 1) '7 a4)
(push a4)
(push '1)
(mov '2 a4)
(jmp <)
143
(eval ())
(bfnil a1 142)
(push (@ 144))
(hpxmov (& 1) '7 a4)
(push a4)
(push '7)
(mov '2 a4)
(jmp >)
144
(eval ())
(btnil a1 141)
142
(mov (& 0) a3)
(mov '"mauvaise week-day" a2)
(mov 'date a1)
(jcall error)
141
(mov (& 0) a1)
(adjstk '1)
(return)
))
(loader'((fentry #:date:prin subr1)
(entry #:date:prin subr1)
(btnil (cvalq #:system:print-for-read) 101)
(push nil)
(push (cvalq #:system:print-for-read))
(mov (& 1) (cvalq #:system:print-for-read))
(push '1)
(push '(#:system:print-for-read))
(push 'lambda)
(push llink)
(push dlink)
(push cbindn)
(stack dlink)
(push (@ 103))
(push '"#:date:#[")
(hpxmov a1 '0 a4)
(push a4)
(push '" ")
(hpxmov a1 '1 a4)
(push a4)
(push '" ")
(hpxmov a1 '2 a4)
(push a4)
(push '" ")
(hpxmov a1 '3 a4)
(push a4)
(push '" ")
(hpxmov a1 '4 a4)
(push a4)
(push '" ")
(hpxmov a1 '5 a4)
(push a4)
(push '" ")
(hpxmov a1 '6 a4)
(push a4)
(push '" ")
(hpxmov a1 '7 a4)
(push a4)
(push '"]")
(mov '17 a4)
(jmp prin)
103
(eval ())
(mov (& 1) dlink)
(mov (& 6) (cvalq #:system:print-for-read))
(adjstk '8)
(return)
101
(push (@ 104))
(jcall short-string-date)
(push a1)
(mov '1 a4)
(jmp prin)
104
(eval ())
(return)
))
(defvar short-month-names '((1 . "janv") (2 . "fevr") (3 . "mars") (4 . "avr") (5 . "mai") (6 . "juin") (7 . "juil") (8 . "aout") (9 . "sept") (10 . "oct") (11 . "nov") (12 . "dec")))
(defvar short-day-names '((1 . "lun") (2 . "mar") (3 . "mer") (4 . "jeu") (5 . "ven") (6 . "sam") (7 . "dim")))
(defvar month-lengths '((1 . 31) (2 . 28) (3 . 31) (4 . 30) (5 . 31) (6 . 30) (7 . 31) (8 . 31) (9 . 30) (10 . 31) (11 . 30) (12 . 31)))
(loader'((fentry short-string-date subr1)
(entry short-string-date subr1)
(push a1)
(jcall datep)
(bfnil a1 102)
(mov (& 0) a3)
(mov 'errbpa a2)
(mov 'short-string-date a1)
(jcall error)
102
(hpxmov (& 0) '0 a1)
(mov '100 a2)
(jcall modulo)
(push a1)
(hpxmov (& 1) '1 a1)
(mov (cvalq short-month-names) a2)
(jcall cassq)
(push a1)
(hpxmov (& 2) '2 a4)
(push a4)
(hpxmov (& 3) '3 a3)
(push a3)
(hpxmov (& 4) '4 a2)
(push a2)
(hpxmov (& 5) '5 a4)
(push a4)
(hpxmov (& 6) '7 a1)
(mov (cvalq short-day-names) a2)
(jcall cassq)
(push a1)
(mov '32 a2)
(mov '24 a1)
(jcall makestring)
(push a1)
(push (@ 103))
(push a1)
(push '0)
(push (& 4))
(push '0)
(mov '4 a4)
(jmp bltstring)
103
(eval ())
(push (@ 104))
(push (& 1))
(push (@ 105))
(push '6)
(mov (& 9) a1)
(jcall slength)
(push a1)
(mov '2 a4)
(jmp -)
105
(eval ())
(push a1)
(push (& 8))
(push '0)
(mov '4 a4)
(jmp bltstring)
104
(eval ())
(push (@ 106))
(push (& 1))
(push '7)
(push (& 9))
(push '0)
(mov '4 a4)
(jmp bltstring)
106
(eval ())
(push (@ 107))
(push (& 1))
(push (@ 108))
(push '14)
(mov (& 11) a1)
(jcall slength)
(push a1)
(mov '2 a4)
(jmp -)
108
(eval ())
(push a1)
(push (& 10))
(push '0)
(mov '4 a4)
(jmp bltstring)
107
(eval ())
(push (@ 109))
(push (& 1))
(push '15)
(push '"00:00:00")
(push '0)
(mov '4 a4)
(jmp bltstring)
109
(eval ())
(push (@ 110))
(push (& 1))
(push (@ 111))
(push '17)
(mov (& 8) a1)
(jcall slength)
(push a1)
(mov '2 a4)
(jmp -)
111
(eval ())
(push a1)
(push (& 7))
(push '0)
(mov '4 a4)
(jmp bltstring)
110
(eval ())
(push (@ 112))
(push (& 1))
(push (@ 113))
(push '20)
(mov (& 7) a1)
(jcall slength)
(push a1)
(mov '2 a4)
(jmp -)
113
(eval ())
(push a1)
(push (& 6))
(push '0)
(mov '4 a4)
(jmp bltstring)
112
(eval ())
(push (@ 114))
(push (& 1))
(push (@ 115))
(push '23)
(mov (& 6) a1)
(jcall slength)
(push a1)
(mov '2 a4)
(jmp -)
115
(eval ())
(push a1)
(push (& 5))
(push '0)
(mov '4 a4)
(jmp bltstring)
114
(eval ())
(mov (& 0) a1)
(adjstk '9)
(return)
))
(loader'((fentry datep subr1)
(entry datep subr1)
(push a1)
(jcall vectorp)
(btnil a1 101)
(push (@ 102))
(push (& 1))
(mov '1 a4)
(jmp typevector)
102
(eval ())
(mov 'date a2)
(adjstk '1)
(jmp eq)
101
(adjstk '1)
(return)
))
(loader '((end)))