mim/development/mim/vax/mimlib/itime.mud

   1 <PACKAGE "ITIME">
   2
   3 <ENTRY ITIME QTIME LTIME ETIME BTIME IDAY TIME-ZONE DAY DAY-PART TIME-PART
   4        STIME DTIME>
   5
   6 <SETG TM-SECONDS 1>
   7 <SETG TM-MICRO 2>
   8 <SETG TZ-MINUTES 1>
   9 <SETG TZ-DST 2>
  10 <MANIFEST TM-SECONDS TM-MICRO TZ-MINUTES TZ-DST>
  11
  12 <SETG DAY *200000*>
  13
  14 <SETG MONTHS '["JAN" "FEB" "MAR" "APR" "MAY" "JUN" "JUL"
  15                "AUG" "SEP" "OCT" "NOV" "DEC"]>
  16 <GDECL (MONTHS) <VECTOR [REST STRING]>>
  17 <SETG TIME-STRING <ISTRING 22 !\ >>
  18 <GDECL (TIME-STRING) STRING>
  19
  20 <DEFINE DTIME ("OPT" (F <ITIME>) (DS ,TIME-STRING) "AUX" (DL ,TIME-LIST) L T S)
  21         #DECL ((F) <OR FIX FALSE> (DS) STRING (DL) !<LIST [2 LIST] STRING>
  22                (L) !<LIST [3 FIX]> (T) FIX (S) STRING)
  23         <COND (<NOT .F> <SET F <ITIME>>)>
  24         <COND (<G=? <LENGTH .DS> 22>
  25                <SET DS <REST .DS <- <LENGTH .DS> 22>>>
  26                <LTIME .F .DL>
  27                <SET L <1 .DL>>
  28                <SET T <3 .L>>
  29                <1 .DS <CHTYPE <+ </ .T 10> %<ASCII !\0>> CHARACTER>>
  30                <2 .DS <CHTYPE <+ <MOD .T 10> %<ASCII !\0>> CHARACTER>>
  31                <3 .DS !\ >
  32                <SET S <NTH ,MONTHS <2 .L>>>
  33                <4 .DS <1 .S>>
  34                <5 .DS <2 .S>>
  35                <6 .DS <3 .S>>
  36                <7 .DS !\ >
  37                <SET T <1 .L>>
  38                <8 .DS <CHTYPE <+ </ .T 10> %<ASCII !\0>> CHARACTER>>
  39                <9 .DS <CHTYPE <+ <MOD .T 10> %<ASCII !\0>> CHARACTER>>
  40                <10 .DS !\ >
  41                <SET L <2 .DL>>
  42                <SET T <1 .L>>
  43                <11 .DS <CHTYPE <+ </ .T 10> %<ASCII !\0>> CHARACTER>>
  44                <12 .DS <CHTYPE <+ <MOD .T 10> %<ASCII !\0>> CHARACTER>>
  45                <13 .DS !\:>
  46                <SET T <2 .L>>
  47                <14 .DS <CHTYPE <+ </ .T 10> %<ASCII !\0>> CHARACTER>>
  48                <15 .DS <CHTYPE <+ <MOD .T 10> %<ASCII !\0>> CHARACTER>>
  49                <16 .DS !\:>
  50                <SET T <3 .L>>
  51                <17 .DS <CHTYPE <+ </ .T 10> %<ASCII !\0>> CHARACTER>>
  52                <18 .DS <CHTYPE <+ <MOD .T 10> %<ASCII !\0>> CHARACTER>>
  53                <19 .DS !\ >
  54                <SET S <3 .DL>>
  55                <20 .DS <1 .S>>
  56                <21 .DS <2 .S>>
  57                <22 .DS <3 .S>>
  58                .DS)>>
  59
  60 <DEFINE DAY-PART (DT "OPT" D)
  61         #DECL ((DT D) FIX)
  62         <COND (<NOT <ASSIGNED? D>> <LHW .DT>)
  63               (ELSE <ORB <LSH .D 16> <ANDB .DT *177777*>>)>>
  64
  65 <DEFINE TIME-PART (DT "OPT" T)
  66         #DECL ((DT T) FIX)
  67         <COND (<NOT <ASSIGNED? T>> <ANDB .DT *177777*>)
  68               (ELSE <ORB <ANDB .DT *37777600000*> <ANDB .T *177777*>>)>>
  69
  70 <SETG TIME-LIST ((0 0 0) (0 0 0) "EST")>
  71 <GDECL (TIME-LIST) <LIST LIST LIST STRING>>
  72
  73 <DEFINE LTIME ("OPTIONAL" (FF <ITIME>) (LST ,TIME-LIST))
  74         #DECL ((VALUE LST) <LIST [2 LIST] STRING>
  75                (FF) <OR FIX UVECTOR>)
  76         <COND (<TYPE? .FF UVECTOR>
  77                <ETIME <1 .FF> <2 .FF> .LST>)
  78               (ELSE <ETIME .FF>)>>
  79
  80 <DEFINE ETIME ("OPTIONAL" (FF <ITIME>) Z (LST ,TIME-LIST)
  81                "AUX" F S D LY? Y M (DATE <1 .LST>) (TIME <2 .LST>))
  82         #DECL ((VALUE LST) <LIST [2 LIST] STRING> (F D S Y M Z) FIX
  83                (FF) <OR FIX UVECTOR> (LY?) <OR ATOM FALSE>
  84                (DATE TIME) <LIST [3 FIX]>)
  85         <SET F <COND (<TYPE? .FF FIX> .FF) (ELSE <1 .FF>)>>
  86         <PUT .LST
  87              3
  88              <COND (<ASSIGNED? Z> <TIME-ZONE .Z>)
  89                    (<TYPE? .FF FIX>
  90                     <TIME-ZONE <SET Z <TIME-ZONE <> .FF>>>)
  91                    (ELSE <TIME-ZONE <SET Z <2 .FF>> <1 .FF>>)>>
  92         <COND (<NOT <0? <ANDB .Z *200000*>>>
  93                <SET Z <- .Z 1>>)>
  94         <SET F <- .F <* <ANDB .Z *77*> </ ,DAY 24>>>>
  95         <SET D <+ <DAY-PART .F> 366 365>>
  96         <SET Y <+ 68 <* 4 </ .D <+ 366 365 365 365>>>>>
  97         <SET D <MOD .D <+ 366 365 365 365>>>
  98         <COND (<SET LY? <L? <SET D <- .D 366>> 0>> <SET D <+ .D 366>>)
  99               (<AND <SET Y <+ .Y 1>> <L? <SET D <- .D 365>> 0>>
 100                <SET D <+ .D 365>>)
 101               (<AND <SET Y <+ .Y 1>> <L? <SET D <- .D 365>> 0>>
 102                <SET D <+ .D 365>>)
 103               (ELSE <SET Y <+ .Y 1>>)>
 104         <PUT .DATE 1 .Y>
 105         <SET M 1>
 106         <MAPF <>
 107               <FUNCTION (N)
 108                    #DECL ((N) FIX)
 109                    <COND (<AND .LY? <==? .N 28>> <SET N 29>)>
 110                    <COND (<L? <- .D .N> 0>
 111                           <PUT .DATE 2 .M>
 112                           <PUT .DATE 3 <+ 1 .D>>
 113                           <MAPLEAVE>)
 114                          (ELSE <SET D <- .D .N>> <SET M <+ .M 1>>)>>
 115               '![31 28 31 30 31 30 31 31 30 31 30 31!]>
 116         <SET S <QTIME <TIME-PART .F>>>
 117         <PUT .TIME 1 </ .S 3600>>
 118         <SET S <MOD .S 3600>>
 119         <PUT .TIME 2 </ .S 60>>
 120         <PUT .TIME 3 <MOD .S 60>>
 121         .LST>
 122
 123 \\f
 124
 125 <DEFINE TIME-ZONE ("OPTIONAL" (Z <>) TIM
 126                    "AUX" (ZL ,ZONELIST) ZS IZ (UV ,ZONE-UV))
 127         #DECL ((Z) <OR FIX STRING FALSE> (ZL) VECTOR (IZ) FIX
 128                (ZS) <OR FALSE VECTOR>
 129                (UV) <UVECTOR [3 FIX]>)
 130         <COND (<OR <NOT .Z> <NOT <ASSIGNED? TIM>>>
 131                <DO-FTIME .UV>
 132                <SET IZ </ <TZ-MINUTES .UV> 60>>
 133                <COND (<NOT <ASSIGNED? TIM>>
 134                       <SET TIM <ITIME>>)>)>
 135         <COND (<AND <G? <TZ-DST .UV> 0> <IN-DST? .TIM .IZ>>
 136                <SET IZ <ORB .IZ *200000*>>)>
 137         <COND (<NOT .Z> .IZ)
 138               (<TYPE? .Z FIX>
 139                <COND (<SET ZS <MEMQ .Z .ZL>> <1 <BACK .ZS>>)
 140                      (ELSE .IZ)>)
 141               (<SET ZS <MEMBER .Z .ZL>> <2 .ZS>)
 142               (ELSE #FALSE ("Unknown time zone"))>>
 143
 144 "IN-DST? - are we in daylight savings time"
 145
 146 <DEFINE IN-DST? (F Z "AUX" Y M D LY? DOW)
 147         #DECL ((F Z Y M D DOW) FIX)
 148         <SET F <- .F <+ <* <ANDB .Z *77*> 2> </ ,DAY 24>>>>
 149         <SET D <+ <LHW .F> 366 365>>
 150         <SET Y <+ 68 <* 4 </ .D <+ 366 365 365 365>>>>>
 151         <SET D <MOD .D <+ 366 365 365 365>>>
 152         <COND (<SET LY? <L? <SET D <- .D 366>> 0>> <SET D <+ .D 366>>)
 153               (<AND <SET Y <+ .Y 1>> <L? <SET D <- .D 365>> 0>>
 154                <SET D <+ .D 365>>)
 155               (<AND <SET Y <+ .Y 1>> <L? <SET D <- .D 365>> 0>>
 156                <SET D <+ .D 365>>)
 157               (ELSE <SET Y <+ .Y 1>>)>
 158         <SET M 1>
 159         <MAPF <>
 160               <FUNCTION (N)
 161                    #DECL ((N) FIX)
 162                    <COND (<AND .LY? <==? .N 28>> <SET N 29>)>
 163                    <COND (<L? <- .D .N> 0>
 164                           <SET D <+ 1 .D>>
 165                           <MAPLEAVE>)
 166                          (ELSE <SET D <- .D .N>> <SET M <+ .M 1>>)>>
 167               '![31 28 31 30 31 30 31 31 30 31 30 31!]>
 168         <COND (<AND <G? .M 4> <L? .M 10>> T)
 169               (<OR <==? .M 4> <==? .M 10>>
 170                <SET DOW <IDAY .F>>
 171                <SET DOW
 172                     <COND (<==? .DOW 6> -7)
 173                           (T <- .DOW 6>)>>
 174                <COND (<==? .M 4>
 175                       <L? <+ 30 .DOW> .D>)
 176                      (<==? .M 10>
 177                       <G? <+ 31 .DOW> .D>)>)>>
 178
 179 <DEFINE DO-FTIME (UV)
 180         <CALL SYSCALL GETTIMEOFDAY ,TIME-UV .UV>>
 181
 182 <DEFINE DO-TIME () <CALL SYSCALL GETTIMEOFDAY ,TIME-UV ,ZONE-UV>>
 183
 184 <SETG TIME-UV <UVECTOR 0 0>>
 185 <SETG ZONE-UV <UVECTOR 0 0>>
 186 <GDECL (TIME-UV ZONE-UV) UVECTOR>
 187
 188 <SETG ZONELIST
 189       '["EST" 5 "EDT" *200005*
 190         "CST" 6 "CDT" *200006*
 191         "MST" 7 "MDT" *200007*
 192         "PST" 8 "PDT" *200010*
 193         "YST" 9 "YDT" *200011*
 194         "HST" 10 "HDT" *200012*
 195         "BST" 11 "BDT" *200013*
 196         "AST" 4 "ADT" *200004*
 197         "NST" 3
 198         "GMT" 0]>
 199
 200 <GDECL (ZONELIST) <VECTOR [REST STRING FIX]>>
 201
 202 \\f
 203
 204 <DEFINE BTIME ("OPTIONAL" (Y 0) (M 1) (D 1) (HH 0) (MM 0) (SS 0)
 205                "AUX" S (LOSSAGE ,LOSSAGE) Z)
 206         #DECL ((VALUE Y M D HH MM SS Z) FIX (LOSSAGE) <UVECTOR [REST FIX]>)
 207         <COND (<L? .Y 0>
 208                <DO-TIME>
 209                <SET S <TM-SECONDS ,TIME-UV>>
 210                <SET Y </ .S %<* 365 24 60 60>>>)
 211               (<G=? .Y 1970> <SET Y <- .Y 1970>>)
 212               (<G=? .Y 70> <SET Y <- .Y 70>>)>
 213         <SET D
 214              <+ <* .Y 365>
 215                 </ <+ .Y 1> 4>
 216                 <COND (<AND <0? <MOD <+ .Y 2> 4>> <G? .M 2>> 1)
 217                       (ELSE 0)>
 218                 <NTH .LOSSAGE .M>
 219                 .D
 220                 -1>>
 221         <SET HH <+ .HH <SET Z <ANDB <TIME-ZONE> 63>>>>
 222         <SET HH <- .HH <LHW .Z>>>
 223         <ORB <LSH .D 16> <STIME <+ .SS <* .MM 60> <* .HH 3600>>>>>
 224
 225 <SETG LOSSAGE '![0 31 59 90 120 151 181 212 243 273 304 334]>
 226
 227 \\f
 228
 229 <DEFINE ITIME ("AUX" S)
 230         #DECL ((S) FIX)
 231         <DO-TIME>
 232         <SET S <TM-SECONDS ,TIME-UV>>
 233         <ORB <LSH </ .S %<* 24 60 60>> 16>
 234              <STIME <MOD .S %<* 24 60 60>>>>>
 235
 236 "STIME - convert seconds to fraction of day"
 237
 238 <DEFINE STIME (T)
 239         #DECL ((T) FIX)
 240         <ANDB <FIX </ <* <FLOAT .T> *200000*> %<* 24 3600>>>
 241               *177777*>>
 242
 243 "QTIME - convert fraction of day to seconds"
 244
 245 <DEFINE QTIME (T)
 246         #DECL ((T) FIX)
 247         <FIX </ <* <FLOAT <ANDB .T *177777*>> %<* 24 3600>>
 248                 *200000*>>>
 249
 250 "IDAY - day of week, MON=0, SUN=6"
 251
 252 <DEFINE IDAY ("OPTIONAL" (T <ITIME>))
 253         #DECL ((T) FIX)
 254         <MOD <+ <LHW .T> 3> 7>>
 255
 256 <ENDPACKAGE>