COMPILATION LISTING OF SEGMENT date_time_ Compiled by: Multics PL/I Compiler, Release 32f, of October 9, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 11/11/89 1011.8 mst Sat Options: optimize map 1 /****^ ****************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright (c) 1986 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* * Copyright (c) 1972 by Massachusetts Institute of * 9* * Technology and Honeywell Information Systems, Inc. * 10* * * 11* ****************************************************** */ 12 13 /**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16 */ 14 /**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo */ 15 /**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend */ 16 /**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt */ 17 18 /* ***********************************+************************************* */ 19 /* All error table declarations, and (begin proc end) lines are marked with */ 20 /* "<##>". This is to aid in gleaning the information needed for proper */ 21 /* return code documentation. */ 22 /* ***********************************+************************************* */ 23 /* */ 24 /* Name: date_time_ */ 25 /* */ 26 /* The date_time_ system is a utility which encodes, decodes, */ 27 /* adjusts, or formats a Multics standard calendar clock value. The */ 28 /* clock reading is assumed to be in microseconds relative to */ 29 /* 1901-01-01 0:00 gmt. The ASCII times involved may be one of */ 30 /* several languages and in a choice of time zones around the world. */ 31 /* */ 32 /* ***********************************+************************************* */ 33 34 35 /* ***********************************+************************************* */ 36 /* */ 37 /* Status */ 38 /* */ 39 /* 0) Created: Jun, 1978 by J Falksen */ 40 /* a) based on old date_time_ and decode_clock_value_ */ 41 /* 1) Extended: Dec, 1978 by Gary Dixon */ 42 /* Added ability to handle wide range of dates */ 43 /* 2) Extended: Apr, 1983 by jaf */ 44 /* updating to ioa_-like $format controls */ 45 /* 3) Changed: Apr, 1984 by jaf */ 46 /* enclosed code for each entrypoint in a BEGIN block. delete all */ 47 /* first-level declarations of error codes. This forces each block */ 48 /* to declare the codes it needs. This may make it possible to find */ 49 /* out the list of error codes each entry might return. */ 50 /* 4) Changed: Nov, 1984 by jaf */ 51 /* change time_offset.dw into time_offset.dw.(flag val) */ 52 /* added $format_max_length */ 53 /* */ 54 /* ***********************************+************************************* */ 55 56 57 /****^ HISTORY COMMENTS: 58* 1) change(86-08-15,GDixon), approve(86-09-04,MCR7532), 59* audit(86-09-05,Martinson), install(86-09-16,MR12.0-1159): 60* Fix stringsize error. Change date_time_$format, $format_max_length and 61* $valid_format to report location in error within the original time_format 62* string (with keywords unexpanded), rather than within the expanded 63* time_format string. (phx19124) 64* 2) change(86-08-16,GDixon), approve(86-09-04,MCR7532), 65* audit(86-09-05,Martinson), install(86-09-16,MR12.0-1159): 66* Correct problem which causes time_format "^za, ^dn" to be rejected. 67* Problem stems from z a and comma all being interpreted as picture chars. 68* Therefore, the "za" sequences needs to be special-cased. (date_time 30) 69* 3) change(88-05-29,GDixon), approve(88-06-15,MCR7918), 70* audit(88-07-28,Lippard), install(88-08-02,MR12.2-1075): 71* A) Correct bug in applying year offset from a leap_day 72* (02/29/). (date_time 31, phx21107) 73* END HISTORY COMMENTS */ 74 75 76 /* ***********************************+************************************* */ 77 /* @@@@@@ ext proc .. date_time_ */ 78 /* */ 79 /* ENTRY: date_time_ */ 80 /* */ 81 /* The date_time_ subroutine converts a system clock value to ASCII */ 82 /* representation. It will be in terms of the process default */ 83 /* language and zone. */ 84 /* */ 85 /* USAGE: */ 86 /* dcl date_time_ entry (fixed bin (71), char (*)); */ 87 /* call date_time_ (clock, str); */ 88 /* */ 89 /* ARGUMENTS: */ 90 /* clock (input) */ 91 /* is the clock value to be formatted */ 92 /* str (output) */ 93 /* is the resultant character string. */ 94 /* */ 95 /* NOTES: */ 96 /* The format string which produces the resultant string is: */ 97 /* "^my/^dm/^yc ^Hd^99v.9MH ^za ^da" */ 98 /* which produces strings like this: */ 99 /* 07/14/83 1435.4 mst Thu */ 100 /* See Multics Programmers' Reference Manual for a description of */ 101 /* acceptable strings. */ 102 /* */ 103 /* The ASCII representation of time, which date_time_ attempts to */ 104 /* return in string, is 24 characters long. If string is declared */ 105 /* by the caller with a length of N and N is less than 24, then only */ 106 /* the first N characters are returned. If N is greater than 24, */ 107 /* then the result is returned padded on the right with spaces. */ 108 /* */ 109 /* If clock is not a valid date, "01/01/01 0000.0 gmt Tue" is */ 110 /* returned. */ 111 /* */ 112 /* ***********************************+************************************* */ 113 114 date_time_: proc (clock_value, str); 115 116 /* format: off */ 117 dcl ( 118 clock_value fixed bin (71), /* standard clock value [In]*/ 119 str char (*) /* return string [Out]*/ 120 ) parm; /* format: on */ 121 122 temp_clock = clock_value; 123 go to date_time_rtn; /* go join up with fstime code */ 124 /* @@"END" date_time_ */ 125 /* Background: */ 126 /* */ 127 /* The Julian calendar is used for dates from 1/1/0001 to 10/04/1582. This */ 128 /* calendar has the same year/month/day structure as the Gregorian calendar */ 129 /* (the calendar we use now), except that every fourth year is a leap year, */ 130 /* including centential years. */ 131 /* */ 132 /* In 1582, Pope Gregory XIII reformed the Julian calendar. The Julian */ 133 /* calendar year of 365.25 days was too long. The correct tropical (solar) */ 134 /* year is 365.242199 days long. By 1582, the error in the Julian calendar */ 135 /* of 11 minutes, 14 seconds per year had caused the calendar date to be */ 136 /* ten days earlier than it should have been. Pope Gregory corrected this */ 137 /* discrepancy be decreeing that the day following October 4, 1582 would be */ 138 /* October 15, 1582. Thus, the year 1582 had only 355 days. He then */ 139 /* reformed the year calculation to avoid discrepancies in the future by */ 140 /* removing 3 intercalary (leap) days every 400 years. The pope decreed */ 141 /* that centential years would not be leap years unless they were 0 mod */ 142 /* 400. The reformed calendar is called the Gregorian calendar. */ 143 144 /* The dates from October 5, 1582 to October 14, 1582 do not exist. */ 145 /* The year 1582 presents a bit of a mess it terms of day-in-week, date, */ 146 /* and day-in-year. This is what it looks like: */ 147 /* */ 148 /* day-in-week: |Mon... Thu| |Fri ... Fri| |Sat ... */ 149 /* day-in-year: |001... 277| |278 ... 355|10 day gap|001 ... */ 150 /* date: |1/1...10/4|10 day gap|10/15...12/31| |1/1 ... */ 151 /* |<--------------1582--------------->| |<--1583-- */ 152 /* */ 153 /* The Gregorian calendar is used for dates from 10/15/1582 to 12/31/9999. */ 154 /* This calendar has a leap year every 4 years, except: leap year omitted */ 155 /* when mod(year,100) = 0 but included when mod(year,400) = 0. */ 156 /* */ 157 /* The lower limit on dates of Jan 1, 0001 AD was picked: to avoid */ 158 /* complexities of dates Before Christ; because there was no stable */ 159 /* calendar system prior to 4 AD anyway. The upper limit on date of */ 160 /* Dec 31, 9999 was chosen to limit year numbers to 4 digits. */ 161 /* */ 162 /* ***********************************+************************************* */ 163 164 /* ***********************************+************************************* */ 165 /* */ 166 /* The leap year device is used to adjust the calendar year to match the */ 167 /* astronomical year. Every year divisible by 4 is a leap year except when */ 168 /* it's divisible by 100 but not 400. The action of these 3 conditions */ 169 /* results in 3 numeric cycles. Here is the derivation of the lengths of */ 170 /* each of the cycles: */ 171 /* */ 172 /* 4 * 365 + 1 = 1461 days in 4-yr cycle */ 173 /* 25 * 1461 - 1 = 36524 days in 100-yr cycle */ 174 /* 4 * 36524 + 1 = 146097 days in 400-yr cycle */ 175 /* */ 176 /* Plus we need to know this: */ 177 dcl microseconds_per_day init (86400000000) /* 24*60*60*1e6 */ 178 fixed bin (71) int static options (constant); 179 180 /* */ 181 /* The base values used for the calendar work are the Julian values: */ 182 /* 0001 --> yc = 1 (year in calendar) */ 183 /* 0001-01-01 --> dc = 1 (day in calendar) */ 184 /* 0001-01-01m --> Uc = 0 (microsecond in calendar) */ 185 /* The Julian calendar has but a single cycle which works directly on this */ 186 /* base. The number of microseconds of 1582-10-04 23:59:59.999999 +1 must */ 187 /* equal the number of microseconds of 1582-10-15 00:00:00.000000. The 1st */ 188 /* is the last Julian Usec, the 2nd is the first Gregorian one. The Julian */ 189 /* method calculates out 577737 days for 1582-10-04, while the Gregorian */ 190 /* method calculates out 577735 days for 1582-10-15. So when Gregorian work */ 191 /* is done, 2 days are subtracted in order to get to the base point of its */ 192 /* 3 cycles. */ 193 /* */ 194 /* Consider these several quantities: */ 195 196 /* [ 1] Days from 0001-01-01 thru 1582-10-04. */ 197 /* #units days/unit days years */ 198 /* 4-yr cycles: 395 * 1461 -> 577095 -> 1580 */ 199 /* excess years: 1 * 365 -> 365 -> 1 */ 200 /* days in year: 277 */ 201 /* TOTALS: (Julian) 577737 1581 */ 202 /* 49,916,476,800 seconds. */ 203 204 /* ** 1582-10-04 Julian is the same as 1582-10-14 Gregorian */ 205 /* ** i.e. 1 day beyond either is 1582-10-15 */ 206 /* */ 207 /* [ 2] Days from 0001-01-01 thru 1582-10-14. */ 208 /* #units days/unit days years */ 209 /* 400-yr cycles: 3 * 146097 -> 438291 -> 1200 */ 210 /* 100-yr cycles: 3 * 36524 -> 109572 -> 300 */ 211 /* 4-yr cycles: 20 * 1461 -> 29220 -> 80 */ 212 /* excess years: 1 * 365 -> 365 -> 1 */ 213 /* days in year: 287 */ 214 /* TOTALS: (Gregorian) 577735 1581 */ 215 /* 49,916,304,000 seconds. */ 216 217 /* [ 3] Days from 0001-01-01 thru 1900-12-31. */ 218 /* #units days/unit days years */ 219 /* 400-yr cycles: 4 * 146097 -> 584388 -> 1600 */ 220 /* 100-yr cycles: 2 * 36524 -> 73048 -> 200 */ 221 /* 4-yr cycles: 24 * 1461 -> 35064 -> 96 */ 222 /* excess years: 3 * 365 -> 1095 -> 3 */ 223 /* days in year: 365 */ 224 /* TOTALS: (Gregorian) 693960 1899 */ 225 /* 59,958,144,000 seconds. */ 226 227 /* [ 4] Days from 0001-01-01 thru 9999-12-31. */ 228 /* #units days/unit days years */ 229 /* 400-yr cycles: 24 * 146097 -> 3506328 -> 9600 */ 230 /* 100-yr cycles: 3 * 36524 -> 109572 -> 300 */ 231 /* 4-yr cycles: 24 * 1461 -> 35064 -> 96 */ 232 /* excess years: 2 * 365 -> 730 -> 2 */ 233 /* days in year: 365 */ 234 /* TOTALS: (Gregorian) 3652059 9998 */ 235 /* 315,537,897,600 seconds. */ 236 237 /* [ 5] Days from 0001-01-01 thru 1900-12-31. */ 238 /* [ 3] 693960 */ 239 /* - [ 2] 577735 */ 240 /* + [ 1] 577737 */ 241 /* 693962 59,958,316,800 seconds. **/ 242 /* */ 243 /* Since the Multics clock has zero => 1901-01-01, above is the number of */ 244 /* microseconds to subtract to give the clock reading of 0001-01-01 as */ 245 /* the Gregorian algorithm goes. */ 246 247 /* [ 6] Days from 0001-01-01 thru 9999-12-31. */ 248 /* [ 4] 3652059 */ 249 /* - [ 2] 577735 */ 250 /* + [ 1] 577737 */ 251 /* = 3652061 315,538,070,400 seconds. */ 252 /* */ 253 /* This is the maximum allowable value of the virtual clock in the */ 254 /* interval to be covered. */ 255 /* ***********************************+************************************* */ 256 /* So we must adjust Multics clock (base 1901-01-01m) */ 257 /* to the virtual clock (base 0001-01-01m) */ 258 /* And then partition into calendar ranges. */ 259 /* ***********************************+************************************* */ 260 dcl ( 261 begin_Gregorian init (049916476800e6), /* 1582-10-15 m */ 262 begin_Special init (059958316800e6), /* 1901-01-01 m */ 263 end_Special init (066238214400e6), /* 2100-01-01 m */ 264 M_vc_adjust init (059958316800e6), /* 1901-01-01 m */ 265 max_vc_value init (315538070400e6) /* 9999-12-31 23:59:59.999999 */ 266 ) fixed bin (71) int static options(constant); 267 /* @@@@@@ ext proc .. format */ 268 /* ***********************************+************************************* */ 269 /* */ 270 /* ENTRY: date_time_$format */ 271 /* This entry does a generalized formatting of a Multics standard */ 272 /* calendar clock value. A format string is supplied which */ 273 /* describes the layout and content of the desired result. The zone */ 274 /* and/or language in which the result is to be displayed may be */ 275 /* specified. */ 276 /* */ 277 /* USAGE: */ 278 /* dcl date_time_$format entry(char (*), fixed bin (71), char */ 279 /* (*), char (*)) returns char (250) var; */ 280 /* result = date_time_$format (format, clock, zone, lang); */ 281 /* */ 282 /* ARGUMENTS: */ 283 /* format (input) */ 284 /* either a keyword, or an ioa-like control string describing the */ 285 /* desired result in terms of literal characters and date/time */ 286 /* selectors. */ 287 /* clock (input) */ 288 /* a clock value to be displayed */ 289 /* zone (input) */ 290 /* the short name of the zone in which output time value is */ 291 /* expressed. "system_zone" means use the system default zone. */ 292 /* "" means use the per-process default zone. */ 293 /* lang (input) */ 294 /* the language in which month names, day names and time zones */ 295 /* are expressed. "system_lang" means use the system default */ 296 /* time language. "" means use per-process default time lan- */ 297 /* guage. */ 298 /* result (output) */ 299 /* is the string which is the result of the conversion. */ 300 /* */ 301 /* NOTES: */ 302 /* The control string to date_time_$format is either a keyword or a */ 303 /* character string consisting of text and/or selectors. The */ 304 /* selectors are always identified by a leading circumflex character */ 305 /* (^). There are 2 types of selectors; ^, which allows a */ 306 /* keyword to be imbedded within a format, and the general form ^XX. */ 307 /* XX is a 2 letter code which specifies what information is wanted. */ 308 /* An optional PL/I picture specification may be placed between the */ 309 /* ^ and XX if the default form is not adequate. If the control */ 310 /* string does not contain any circumflex characters, it must then */ 311 /* be one of the known set of keywords. See Multics Programmers' */ 312 /* Reference Manual for a description of acceptable strings. */ 313 /* */ 314 /* Each selector is introduced by a "^", ended with a 2-letter specifier, */ 315 /* and may have a picture specification in between. Because of minute/month */ 316 /* ambiguity, all time selectors are capitals. */ 317 /* */ 318 /* */ 319 /* The selectors of numeric data are made up of 2 letters taken from */ 320 /* this sequence: */ 321 /* c y m w d H M S U */ 322 /* These are calendar, year, month, week, day, Hour, Minute, Second, */ 323 /* and microsecond. All 81 combinations are not, however, valid. */ 324 /* The form can generally be read as "unit of unit". The first unit */ 325 /* must always be smaller than the second one. In trying to keep */ 326 /* the specifiers reasonably mneumonic (in English) there is a */ 327 /* problem. Both month and minute begin with an "m". To that end, */ 328 /* all date values are used as lower case letters while all time */ 329 /* values are in upper case. */ 330 /* */ 331 /* It proves difficult to try to handle all the forms needed without */ 332 /* any glitches. "hd" is Hour in Day and is thus 24-hour time. */ 333 /* This is not always what is wanted. "Hh" is chosen as Hour in */ 334 /* half-day to get the 12-hour form of time. To go along with this */ 335 /* there is "mi" for Meridiem Indicator. This gives "A" or "P" to */ 336 /* make up AM or PM. This does not give "AM" or "PM" because ANSI */ 337 /* standards specify that time be given as "3P", not "3PM". The */ 338 /* user who wants the M will just add it, i.e. "^miM". */ 339 /* */ 340 /* This table shows the complete set of control codes. The row */ 341 /* specifies what unit is wanted, the column specifies within what */ 342 /* other unit, i.e. ^Sy is "Seconds of Year". */ 343 /* DATE/TIME SELECTORS */ 344 /* | of | of | of | of | of | of | of | of | */ 345 /* |calen-|year |month |week | day |hour |minute|second| */ 346 /* _______| dar | | | | | | | | */ 347 /* micro- +------+------+------+------+------+------+------+------+ */ 348 /* second | ^Uc | ^Uy | ^Um | ^Uw | ^Ud | ^UH | ^UM | ^US | */ 349 /* +------+------+------+------+------+------+------+------+ */ 350 /* second | ^Sc | ^Sy | ^Sm | ^Sw | ^Sd | ^SH | ^SM | */ 351 /* +------+------+------+------+------+------+------+ */ 352 /* minute | ^Mc | ^My | ^Mm | ^Mw | ^Md | ^MH | */ 353 /* +------+------+------+------+------+------+ */ 354 /* hour | ^Hc | ^Hy | ^Hm | ^Hw | ^Hd | */ 355 /* +------+------+------+------+------+ */ 356 /* day | ^dc | ^dy | ^dm | ^dw | month day zone */ 357 /* +------+------+------+------+ +------+------+------+ */ 358 /* month | | ^my | name | ^mn | ^dn | ^zn | */ 359 /* +------+------+ +------+------+------+ */ 360 /* year | ^yc | abbrev | ^ma | ^da | ^za | */ 361 /* +------+ +------+------+------+ */ 362 /* | ^Hh | <-hour of half-day differential | ^zd | */ 363 /* +------+ (12 hour form) +------+ */ 364 /* | ^mi | <-meridiem indicator */ 365 /* +------+ */ 366 /* | ^fw | <-fiscal week (form: yyyyww) */ 367 /* +------+ */ 368 /* | ^fi | <-fiscal indicator ^fi^fw => FW318 */ 369 /* +------+ */ 370 371 /* The optional picture is an enhanced PL/I picture. In addition to the */ 372 /* normal characters, "X", "O" & "Z" are also available. Due to a conflict */ 373 /* with selectors (and it isn't very useful in this application) the */ 374 /* letters "dy" will give errors. */ 375 376 /* "X" represents an optional character position in the displayed value. */ 377 /* The character position is omitted if there is no corresponding */ 378 /* character in the value being displayed. They must appear as the */ 379 /* rightmost character positions in the picture specification, since */ 380 /* this is the position in which nonsignificant spaces can occupy. */ 381 /* This causes a selective ltrim operation on the displayed value. */ 382 /* A selective trim means not all characters are removed, only up to the */ 383 /* number specified. */ 384 385 /* "O" represents a truncated digit in the displayed value. This allows a */ 386 /* user to specify OO99 to get the year in century or OOO9 to get the */ 387 /* year in decade. "O"s may appear anywhere in a picture specification. */ 388 /* They are processed as "9" characters and the corresponding characters */ 389 /* in the result are dropped. */ 390 391 /* "Z" represents a decimal digit in the displayed value. Nonsignificant */ 392 /* zeros to the left of the decimal point are omitted from the displayed */ 393 /* value when they occupy a "Z" digit position. Nonsignificant zeros to */ 394 /* the right of the decimal point are omitted from the displayed value */ 395 /* when they occupy a "Z" digit position. "Z" characters must appear as */ 396 /* the leftmost or rightmost digit positions in a picture specification, */ 397 /* since these are the positions which nonsignificant zeros can occupy. */ 398 /* This causes a selective ltrim or rtrim (of zero) operation on the */ 399 /* displayed value. */ 400 /* This is a comparison of the characters which make up pictures with the */ 401 /* characters which make up selectors: */ 402 /* "alphabet" list of characters for reference */ 403 /* "enhanced" enhanced picture characters */ 404 /* "selector1" selector characters which appear 1st in pair */ 405 /* "selector2" selector characters which appear 2nd in pair */ 406 /* "excluded" regular picture characters excluded thru conflict */ 407 /* */ 408 /* alphabet ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz */ 409 /* selector1 .......H....M.....S.U..... ...d.f......m...........yz */ 410 /* selector2 .......H....M.....S....... a.cd...hi...mn........w.y */ 411 /* enhanced ..............O........X.Z abcdef....k.......s..v.xyz9.,-+/ */ 412 /* excluded ..............................d....................y....... */ 413 /* **** Special casing allows f and z to be picture characters even though */ 414 /* they are selector1 characters. */ 415 /* ***********************************+************************************* */ 416 format: entry (format, clock_value, zone, language) returns (char (250)var); 417 418 /* format: off */ 419 dcl ( 420 format char (*), /* ctl str specifying output [In]*/ 421 /*clock_value fixed bin (71) /* standard clock value [In]*/ 422 zone char (*), /* specify output in this zone [In]*/ 423 language char (*) /* specify output in this lang [In]*/ 424 ) parm; /* format: on */ 425 426 temp_clock = clock_value; 427 428 format_rtn: begin; /* <<##>> */ 429 dcl ( 430 error_table_$dt_unknown_time_language, /* <##> */ 431 error_table_$unknown_zone /* <##> */ 432 ) fixed bin (35) ext static; 433 dcl sub_err_ entry() options(variable); 434 435 testing_format, format_max = "0"b; 436 errloc, errlocad.n, lcode = 0; /* assume no errors. */ 437 lformat = format; /* copy in his format string */ 438 if (time_defaults_$zone_delta = -1) 439 then call date_time_$set_time_defaults; 440 lang_index = get_word_index ((language), Language_table); 441 if lang_index < 1 442 then do; 443 lcode = binary (error_table_$dt_unknown_time_language); 444 signal_sub_err_: 445 call sub_err_ (lcode, "date_time_$format", ACTION_CANT_RESTART, 446 null (), 0, "^[ 447 Format is: ""^a""^[ (^a) 448 error at: ^vx^^^vx^^^;^3s 449 error at: ^vx^^^]^]", 450 (errloc > 0), format, 451 (format ^= lformat), lformat, errloc, 452 length(format) - errloc + length(" (") + 453 errlocad.unadjusted_errloc, 454 errloc); 455 end; 456 zone_index = get_word_index ((zone), Zone_table); 457 if zone_index < 1 458 then do; 459 if (verify (zone, "-+0123456789") ^= 0) 460 then do; 461 lcode = binary (error_table_$unknown_zone); 462 goto signal_sub_err_; 463 end; 464 zone_index = 0; 465 end; 466 call Multics_2_vc (temp_clock, (zone), zone_index, lang_index, cal_val); 467 if (lcode ^= 0) 468 then goto signal_sub_err_; 469 call do_format; 470 if (lcode ^= 0) 471 then goto signal_sub_err_; 1 1 /* BEGIN INCLUDE FILE sub_err_flags.incl.pl1 BIM 11/81 */ 1 2 /* format: style3 */ 1 3 1 4 /* These constants are to be used for the flags argument of sub_err_ */ 1 5 /* They are just "string (condition_info_header.action_flags)" */ 1 6 1 7 declare ( 1 8 ACTION_CAN_RESTART init (""b), 1 9 ACTION_CANT_RESTART init ("1"b), 1 10 ACTION_DEFAULT_RESTART 1 11 init ("01"b), 1 12 ACTION_QUIET_RESTART 1 13 init ("001"b), 1 14 ACTION_SUPPORT_SIGNAL 1 15 init ("0001"b) 1 16 ) bit (36) aligned internal static options (constant); 1 17 1 18 /* End include file */ 472 473 end format_rtn; /* <##> */ 474 return (lresult); 475 exit: /* let anybody use this to get out */ 476 return; 477 lcode_err_exit: 478 code = lcode; 479 return; /* @@END format */ 480 /* @@@@@@ ext proc .. format_max_length */ 481 /* */ 482 /* ENTRY: date_time_$format_max_length */ 483 /* */ 484 /* This entry returns the length of the biggest strings which can */ 485 /* result from the given format string. */ 486 /* */ 487 /* USAGE: */ 488 /* dcl date_time_$format_max_length entry (char (*), char (*), char (*)) */ 489 /* returns (fixed bin); */ 490 /* maxl = date_time_$format_max_length (format, zone, lang); */ 491 /* */ 492 /* ARGUMENTS: */ 493 /* format (input) */ 494 /* either a keyword, or an ioa-like control string describing the */ 495 /* desired result in terms of literal characters and date/time */ 496 /* selectors. */ 497 /* zone (input) */ 498 /* the short name of the zone in which output time value is */ 499 /* expressed. "system_zone" means use the system default zone. */ 500 /* "" means use the per-process default zone. */ 501 /* lang (input) */ 502 /* the language in which month names, day names and time zones */ 503 /* are expressed. "system_lang" means use the system default */ 504 /* time language. "" means use per-process default time lan- */ 505 /* guage. */ 506 /* maxl (output) */ 507 /* is the length of the longest string which could result */ 508 /* */ 509 /* NOTES: */ 510 /* Errors are reported in the same manner as date_time_$format. */ 511 512 format_max_length: entry (format, zone, language) returns (fixed bin); 513 514 dcl format_max bit (1); 515 516 fmt_max: begin; /* <<##>> */ 517 dcl ( 518 error_table_$dt_unknown_time_language, /* <##> */ 519 error_table_$unknown_zone /* <##> */ 520 ) fixed bin (35) ext static; 521 522 format_max = "1"b; 523 testing_format = ""b; 524 errloc, errlocad.n, lcode = 0; /* assume no errors. */ 525 lformat = format; 526 if (time_defaults_$zone_delta = -1) 527 then call date_time_$set_time_defaults; 528 lang_index = get_word_index ((language), Language_table); 529 if lang_index < 1 530 then do; 531 lcode = binary (error_table_$dt_unknown_time_language); 532 goto sub_err_return_0; 533 end; 534 zone_index = get_word_index ((zone), Zone_table); 535 if zone_index < 1 536 then do; 537 lcode = binary (error_table_$unknown_zone); 538 goto sub_err_return_0; 539 end; 540 Ptime_value = addr (decoded_clock); /* point to a structure */ 541 time_value.yc = 9999; /* plug in a funny set of values */ 542 time_value.my = 12; /* The exact values are arbitrary, */ 543 time_value.dm = 28; /* ...but they all have no leading */ 544 time_value.Hd = 12; /* ...or trailing "0"s */ 545 time_value.MH = 34; 546 time_value.SM = 56; 547 time_value.US = 987654; 548 time_value.fw = 198432; 549 time_value.dy = 365; 550 time_value.dc = 3652061; 551 time_value.Uc = 315538070399999999; 552 time_value.za = zone; 553 time_value.zone_index = zone_index; 554 time_value.leap_year = 0; 555 556 call do_format$direct; 557 if (lcode ^= 0) 558 then goto sub_err_return_0; 559 end fmt_max; 560 return (length (lresult)); 561 sub_err_return_0: begin; 562 call sub_err_ (lcode, "date_time_$format_max_length", ACTION_CANT_RESTART, 563 null (), 0, "^[ 564 Format is: ""^a""^[ (^a) 565 error at: ^vx^^^vx^^^;^3s 566 error at: ^vx^^^]^]", 567 (errloc > 0), format, 568 (format ^= lformat), lformat, errloc, 569 length(format) - errloc + length(" (") + 570 errlocad.unadjusted_errloc, 571 errloc); 572 dcl sub_err_ entry() options(variable); 2 1 /* BEGIN INCLUDE FILE sub_err_flags.incl.pl1 BIM 11/81 */ 2 2 /* format: style3 */ 2 3 2 4 /* These constants are to be used for the flags argument of sub_err_ */ 2 5 /* They are just "string (condition_info_header.action_flags)" */ 2 6 2 7 declare ( 2 8 ACTION_CAN_RESTART init (""b), 2 9 ACTION_CANT_RESTART init ("1"b), 2 10 ACTION_DEFAULT_RESTART 2 11 init ("01"b), 2 12 ACTION_QUIET_RESTART 2 13 init ("001"b), 2 14 ACTION_SUPPORT_SIGNAL 2 15 init ("0001"b) 2 16 ) bit (36) aligned internal static options (constant); 2 17 2 18 /* End include file */ 573 574 end sub_err_return_0; 575 return (0); 576 /* @@@@@@ ext proc .. valid_format */ 577 /* */ 578 /* ENTRY: date_time_$valid_format */ 579 /* */ 580 /* This entry checks the validity of a format string using precisely */ 581 /* the same tests as date_time_$format. */ 582 /* */ 583 /* USAGE: */ 584 /* dcl date_time_$valid_format entry (char (*), fixed bin, fixed */ 585 /* bin (35)); */ 586 /* call date_time_$valid_format (format, errloc, code); */ 587 /* */ 588 /* ARGUMENTS: */ 589 /* format (input) */ 590 /* either a keyword, or an ioa-like control string describing the */ 591 /* desired result in terms of literal characters and date/time */ 592 /* selectors. */ 593 /* errloc (output) */ 594 /* is the character index in the format string where the error */ 595 /* occured. This is meaningful only if it and code are both */ 596 /* non-zero. */ 597 /* code (output) */ 598 /* is a standard status code. It can have one of the following */ 599 /* values-- */ 600 /* error_table_$dt_bad_format_selector */ 601 /* error_table_$bad_conversion */ 602 /* error_table_$dt_no_format_selector */ 603 /* error_table_$picture_bad */ 604 /* error_table_$picture_scale */ 605 /* error_table_$picture_too_big */ 606 /* error_table_$size_error */ 607 /* error_table_$unimplemented_version */ 608 609 valid_format: entry (format, Aerrloc, code); 610 dcl ( 611 Aerrloc fixed bin, /* char index at error time [Out]*/ 612 code fixed bin (35) /* return code [Out]*/ 613 ) parm; 614 dcl testing_format bit (1); 615 valid_format_rtn: begin; /* <<##>> */ 616 Aerrloc, errloc, errlocad.n = 0; 617 testing_format = "1"b; 618 format_max = ""b; 619 code, lcode = 0; /* assume no errors. */ 620 /**** At this point in date_time_$format you will note that there is a check */ 621 /**** to see if defaults need to be initialized. Here it must NOT be done. */ 622 /**** This routine is designed to be able to run without the existence of */ 623 /**** time_info_. Default initialization references time_info_. */ 624 lformat = format; /* copy in his format string */ 625 lang_index = 1; 626 /**** Use a clock reading which tests all fields for their maximum width. */ 627 call Multics_2_vc ( 628 3124103399999999, /* 1999-12-31 23:59:59.999999+0930 */ 629 "+0930", 0, lang_index, cal_val); 630 if (lcode = 0) 631 then call do_format; 632 code = lcode; 633 Aerrloc = errloc; 634 return; /* @@END valid_format */ 635 end valid_format_rtn; /* <##> */ 636 /* @@@@@@ ext proc .. from_clock */ 637 /* ***********************************+************************************* */ 638 /* */ 639 /* ENTRY: date_time_$from_clock */ 640 /* */ 641 /* Given a Multics standard calendar clock value and an output time */ 642 /* zone name, return the month, day of the month, the year, the hour */ 643 /* of the day, the minute of the hour, the second of the minute, the */ 644 /* number of microseconds, the day in week, the day in year, and the */ 645 /* day in clock. The caller may specify one of the time zones in */ 646 /* the time_info_ in which the decoded clock value is to be */ 647 /* expressed, or may request that the value be expressed in one of */ 648 /* the default time zones. */ 649 /* */ 650 /* USAGE: */ 651 /* dcl date_time_$from_clock entry (fixed bin (71), char (*), */ 652 /* ptr, fixed bin (35)); */ 653 /* call date_time_$from_clock (clock, zone, addr(time_value), */ 654 /* code); */ 655 /* */ 656 /* ARGUMENTS: */ 657 /* clock (input) */ 658 /* is the clock value to be decoded. */ 659 /* zone (input) */ 660 /* the short name of the zone in which output time value is */ 661 /* expressed. "system_zone" means use the system default zone. */ 662 /* "" means use the per-process default zone. */ 663 /* time_value (output) */ 664 /* is the structure containing time parts. The structure is */ 665 /* defined in time_value.incl.pl1. */ 666 /* code (output) */ 667 /* is a standard status code. It can have one of the following */ 668 /* values-- */ 669 /* error_table_$dt_date_too_big */ 670 /* error_table_$dt_date_too_small */ 671 /* error_table_$dt_year_too_big */ 672 /* error_table_$dt_year_too_small */ 673 /* error_table_$unimplemented_version */ 674 /* error_table_$unknown_zone */ 675 /* */ 676 /* ***********************************+************************************* */ 677 from_clock: entry (clock_value, zone, APtime_value, code); 678 679 /* format: off */ 680 dcl ( 681 /*clock_value fixed bin (71) /* standard clock value [In]*/ 682 /*zone char (*) /* specify output in this zone [In]*/ 683 APtime_value ptr /* ->output structure [In]*/ 684 /*code fixed bin (35); /* standard return code [Out]*/ 685 ) parm; /* format: on */ 686 687 from_clock_rtn: begin; /* <<##>> */ 688 dcl ( 689 error_table_$unimplemented_version, /* <##> */ 690 error_table_$unknown_zone /* <##> */ 691 ) fixed bin (35) ext static; 692 693 Ptime_value = APtime_value; /* Use callers output structure. */ 694 if (time_value.version ^= Vtime_value_3) & (time_value.version ^= "3") 695 then do; 696 code = binary (error_table_$unimplemented_version); 697 return; 698 end; 699 if (time_defaults_$zone_delta = -1) 700 then call date_time_$set_time_defaults; 701 lang_index = time_defaults_$language_index; 702 zone_index = get_word_index ((zone), Zone_table); 703 if zone_index < 1 /* zone given is not in table. */ 704 then do; 705 /**** But wait! first check to see if it might be a zone differential */ 706 if (verify (zone, "-+0123456789") ^= 0) 707 then do; 708 code = binary (error_table_$unknown_zone); 709 return; 710 end; 711 zone_index = 0; 712 end; 713 call Multics_2_vc (clock_value, (zone), zone_index, lang_index, cal_val); 714 if (lcode = 0) 715 then call fromclock; 716 code = lcode; 717 return; /* @@END from_clock */ 718 end from_clock_rtn; /* <##> */ 719 /* @@@@@@ ext proc .. from_clock_interval */ 720 /* ***********************************+************************************* */ 721 /* */ 722 /* ENTRY: date_time_$from_clock_interval */ 723 /* */ 724 /* Given 2 clock values, return the number of years, months, weeks, */ 725 /* days, hours, minutes, seconds, and microseconds between them. */ 726 /* The set of units to use is specified, as well as whether any are */ 727 /* to include the fractional remainder. */ 728 /* */ 729 /* USAGE: */ 730 /* dcl date_time_$from_clock_interval entry (fixed bin (71), */ 731 /* fixed bin (71), ptr, fixed bin (35)); */ 732 /* call date_time_$from_clock_interval (clock1, clock2, addr */ 733 /* (time_offsets), code); */ 734 /* */ 735 /* ARGUMENTS: */ 736 /* clock1 (input) */ 737 /* is the base time value. The output is expressed relative to */ 738 /* this value. */ 739 /* clock2 (input) */ 740 /* is the offset time value. clock1 is in essence subtracted */ 741 /* from this value. If this value is later, all results will be */ 742 /* positive. If this value is earlier, all results will be */ 743 /* negative. */ 744 /* time_offsets (output) */ 745 /* is the structure containing resulting time values. */ 746 /* code (output) */ 747 /* is a standard status code. It can have one of the following */ 748 /* values-- */ 749 /* error_table_$dt_bad_day_of_week */ 750 /* error_table_$dt_bad_dm */ 751 /* error_table_$dt_bad_dy */ 752 /* error_table_$dt_bad_my */ 753 /* error_table_$dt_date_not_exist */ 754 /* error_table_$dt_date_too_big */ 755 /* error_table_$dt_date_too_small */ 756 /* error_table_$dt_no_interval_units */ 757 /* error_table_$dt_offset_too_big_negative */ 758 /* error_table_$dt_offset_too_big_positive */ 759 /* error_table_$dt_year_too_big */ 760 /* error_table_$dt_year_too_small */ 761 /* error_table_$unimplemented_version */ 762 /* */ 763 /* ***********************************+************************************* */ 764 from_clock_interval: entry (Aref_clock, Aoff_clock, APtime_offset, code); 765 766 /* format: off */ 767 dcl ( 768 Aref_clock fixed bin (71), /* reference time [In]*/ 769 Aoff_clock fixed bin (71), /* offset time [In]*/ 770 APtime_offset ptr /* ->output structure [In]*/ 771 /*code fixed bin (35) /* return code [Out]*/ 772 ) parm; /* format: on */ 773 774 from_clock_interval_rtn: begin; /* <<##>> */ 775 776 dcl ( 777 error_table_$dt_no_interval_units /* <##> */ 778 ) fixed bin (35) ext static; 779 780 code, lcode = 0; 781 lang_index = 1; /* force to a valid value */ 782 Ptime_offset = APtime_offset; 783 if (unspec (time_offset.flag) = ""b) 784 then do; 785 code = binary (error_table_$dt_no_interval_units); 786 return; /* gotta select SOME units */ 787 end; 788 if (time_defaults_$zone_delta = -1) 789 then call date_time_$set_time_defaults; 790 791 time_offset.val.yr, time_offset.val.mo, 792 time_offset.val.wk, time_offset.val.da, 793 time_offset.val.hr, time_offset.val.min, 794 time_offset.val.sec, time_offset.val.Usec = 0; 795 t_interval = Aoff_clock - Aref_clock; 796 if (t_interval = 0) 797 then return; /* no change */ 798 799 /* ***********************************+************************************* */ 800 /* The difference between the two values is dissected from the largest to */ 801 /* the smallest. The difference between the values is simple for Usec, */ 802 /* sec, min, hr, da, and wk. They are always fixed in size. But yr and mo */ 803 /* are not so easy. For these two, the reference value must be taken into */ 804 /* account in order to know how big they are. */ 805 /* ***********************************+************************************* */ 806 807 if (time_offset.flag.yr > 0) /* Neither of these cases is nice */ 808 | (time_offset.flag.mo > 0) 809 then do; 810 Ptime_value = addr (decoded_ref); 811 call Multics_2_vc (Aref_clock, "gmt", time_info_$gmt_zone_index, 1, ref_val); 812 cal_val = ref_val; 813 if (lcode = 0) 814 then call fromclock$no_FW; /* decode the reference value */ 815 if (lcode ^= 0) 816 then do; 817 code = lcode; 818 return; 819 end; 820 Ptime_value = addr (decoded_clock); 821 call Multics_2_vc (Aoff_clock, "gmt", time_info_$gmt_zone_index, 1, off_val); 822 cal_val = off_val; 823 if (lcode = 0) 824 then call fromclock$no_FW; /* decode the offset value */ 825 if (lcode ^= 0) 826 then do; 827 code = lcode; 828 return; 829 end; 830 Tyear = decoded_clock.yc - decoded_ref.yc; 831 Tmonth = decoded_clock.my - decoded_ref.my; 832 Tday = decoded_clock.dm - decoded_ref.dm; 833 Tusec = 834 (off_val.x + off_val.dx - (decoded_clock.dc * 864) * 100000000) 835 - (ref_val.x + ref_val.dx - (decoded_ref.dc * 864) * 100000000); 836 837 if (t_interval > 0) /* (+) interval */ 838 then do; 839 if (Tusec < 0) /* a day borrow is needed */ 840 then Tday = Tday - 1; /* ..so take one */ 841 if (Tday < 0) /* a month borrow is needed */ 842 then Tmonth = Tmonth - 1; /* ..so take one (days not worked on */ 843 /* here, only checked in order to */ 844 /* adjust the month.) */ 845 if (Tmonth < 0) /* a year borrow is needed */ 846 then do; /* ..so take one */ 847 Tyear = Tyear - 1; 848 Tmonth = Tmonth + 12; 849 end; 850 end; 851 else do; /* (-) interval */ 852 if (Tusec > 0) /* need to borrow a day? */ 853 then Tday = Tday + 1; 854 if (Tday > 0) /* need to borrow a month? */ 855 then Tmonth = Tmonth + 1; 856 if (Tmonth > 0) /* need to borrow a year? */ 857 then do; 858 Tyear = Tyear + 1; 859 Tmonth = Tmonth - 12; 860 end; 861 end; 862 unspec (auto_time_offset) = ""b; 863 auto_time_offset.version = Vtime_offset_2; 864 if (time_offset.flag.yr > 0) 865 then do; 866 time_offset.val.yr = Tyear; 867 if (Tyear ^= 0) /* don't waste my time if there is */ 868 then do; /* ..no integer portion */ 869 auto_time_offset.val.yr = Tyear; 870 auto_time_offset.flag.yr = 1; 871 cal_val = ref_val; 872 call apply_offset; 873 ref_val = cal_val; 874 if (lcode ^= 0) 875 then goto lcode_err_exit; 876 Ptime_value = addr (decoded_ref); 877 call fromclock$no_FW; /* decompose the new value */ 878 t_interval = off_val.x + off_val.dx - (ref_val.x + ref_val.dx); 879 /* figure interval left */ 880 end; 881 /**** We have now set the year value, and removed that much from reference. */ 882 if (time_offset.flag.yr = 2) 883 then do; /* they want the fraction, too */ 884 if (decoded_ref.yc = 1582) 885 then unit_size = 355; /* figure out how big the year is */ 886 else unit_size = 365 + decoded_ref.leap_year; 887 time_offset.val.yr = time_offset.val.yr 888 + make_fraction (t_interval, unit_size * microseconds_per_day); 889 end; 890 end; 891 else Tmonth = Tmonth + 12 * Tyear; 892 893 if (time_offset.flag.mo > 0) 894 then do; 895 time_offset.val.mo = Tmonth; 896 if (Tmonth ^= 0) 897 then do; 898 auto_time_offset.flag.yr = 0; 899 auto_time_offset.flag.mo = 1; 900 auto_time_offset.val.mo = Tmonth; 901 cal_val = ref_val; 902 call apply_offset; 903 ref_val = cal_val; 904 if (lcode ^= 0) 905 then goto lcode_err_exit; 906 Ptime_value = addr (decoded_ref); 907 call fromclock$no_FW; /* decompose the new value */ 908 t_interval = off_val.x + off_val.dx - (ref_val.x + ref_val.dx); 909 /* figure interval left */ 910 end; 911 /**** We have now set the month value, and removed that much from reference. */ 912 if (time_offset.flag.mo = FRACTION) 913 then do; 914 unit_size = days_in_month (decoded_ref.my); 915 if (decoded_ref.my = FEBRUARY) 916 then unit_size = unit_size + decoded_ref.leap_year; 917 time_offset.val.mo = time_offset.val.mo 918 + make_fraction (t_interval, unit_size * microseconds_per_day); 919 end; 920 end; 921 end; 922 do cur_unit = 3 to 8; 923 if (time_offset_array.flag (cur_unit) > 0) 924 then do; 925 unit_size = unit_sizes (cur_unit); 926 fb24 = divide (t_interval, unit_size, 24, 0); 927 t_interval = t_interval - fb24 * unit_size; 928 time_offset_array.val (cur_unit) = fb24; 929 if (time_offset_array.flag (cur_unit) = FRACTION) 930 then do; 931 time_offset_array.val (cur_unit) 932 = time_offset_array.val (cur_unit) 933 + make_fraction (t_interval, unit_size); 934 end; 935 end; 936 end; 937 return; /* @@END from_clock_interval */ 938 end from_clock_interval_rtn; /* <##> */ 939 /* @@@@@@ ext proc .. fstime */ 940 /* ***********************************+************************************* */ 941 /* */ 942 /* ENTRY: date_time_$fstime */ 943 /* */ 944 /* This entry performs the same function as date_time_$date_time_, */ 945 /* given a 36-bit storage system date value. */ 946 /* */ 947 /* USAGE: */ 948 /* dcl date_time_$fstime entry (bit (36) aligned, char (*)); */ 949 /* call date_time_$fstime (ssclock, str); */ 950 /* */ 951 /* ARGUMENTS: */ 952 /* ssclock (input) */ 953 /* is an internal storage system clock value. */ 954 /* str (output) */ 955 /* is the resultant character string */ 956 /* */ 957 /* ***********************************+************************************* */ 958 fstime: entry (stime, str); 959 960 /* format: off */ 961 dcl ( 962 stime bit (36) aligned /* "short" time value [In]*/ 963 /*str char (*); /* return string [Out]*/ 964 ) parm; /* format: on */ 965 966 temp_clock = 0; 967 addr (temp_clock) -> fs_time_value.time = stime; 968 969 date_time_rtn: begin; /* <<##>> */ 970 if (time_defaults_$zone_delta = -1) 971 then call date_time_$set_time_defaults; 972 lang_index = time_defaults_$language_index; 973 string (standard) = "00/00/00 0000.0 gmt Tue"; 974 Ptime_value = addr (decoded_clock); 975 time_value.version = Vtime_value_3; 976 call Multics_2_vc (temp_clock, (time_defaults_$zone_short), time_defaults_$zone_index, 977 lang_index, cal_val); 978 if (lcode = 0) 979 then call fromclock$no_FW; 980 if (lcode = 0) 981 then do; 982 standard.yy = mod (time_value.yc, 100); 983 standard.mm = time_value.my; 984 standard.dd = time_value.dm; 985 standard.HH = time_value.Hd; 986 /**** MM is pic "99.9". This statement calculates 10ths of minutes to go */ 987 /**** into this picture, while being efficient. */ 988 standard.MM = divide (time_value.MH * 60 + time_value.SM, 6, 17); 989 standard.zz = substr(time_value.za,1,length(standard.zz)); 990 standard.da = ti_day.short (lang_index, time_value.dw); 991 end; 992 str = string (standard); 993 return; 994 995 dcl 1 standard, 996 2 mm pic "99", 997 2 xx1 char (1), /* "/" */ 998 2 dd pic "99", 999 2 xx2 char (1), /* "/" */ 1000 2 yy pic "99", 1001 2 HH pic "bb99", 1002 2 MM pic "99.9b", 1003 2 zz char (4), 1004 2 da char (3); /* @@END fstime */ 1005 end date_time_rtn; /* <##> */ 1006 /* @@@@@@ ext func .. get_time_info_index */ 1007 /* ***********************************+************************************* */ 1008 /* */ 1009 /* Entry: date_time_$get_time_info_index */ 1010 /* */ 1011 /* Given a word and a table specifier, return the index that word has */ 1012 /* in that table. language and zone defaulting is handled here. */ 1013 /* */ 1014 /* Usage */ 1015 /* dcl date_time_$get_time_info_index (char (*), bit (6)) */ 1016 /* returns (fixed bin); */ 1017 /* */ 1018 /* an_index = date_time_$get_time_info_index (word, table); */ 1019 /* */ 1020 /* 1) word is the word to look for. It will be converted to a */ 1021 /* token by converting to lower-case. (In) */ 1022 /* 2) table is the identifier of the table wanted. (In) */ 1023 /* 3) an_index is the index in the specified table of the word. */ 1024 /* -1 the word was not found at all. */ 1025 /* 0 the word was found, but was not in the wanted table. */ 1026 /* */ 1027 /* *This is used by dti to look up offset and language. */ 1028 /* *This is used by tdft to look up a zone. */ 1029 /* */ 1030 /* convert_date_to_binary_ has its own version of this, both for speed and */ 1031 /* because its requirements are slightly different. When it looks up a */ 1032 /* token, it has no idea what use is intended for it. That happens later */ 1033 /* when the parsing is done. */ 1034 /* */ 1035 /* ***********************************+************************************* */ 1036 get_time_info_index: entry (Atoken, Atable) returns (fixed bin); 1037 1038 dcl Atoken char (*), /* word to look for */ 1039 Atable fixed bin; /* kind off thing it must be */ 1040 1041 return (get_word_index ((Atoken), Atable)); /* @@END get_time_info_index */ 1042 /* @@@@@@ ext proc .. hundredths */ 1043 /* ***********************************+************************************* */ 1044 /* */ 1045 /* Entry: date_time_$hundredths */ 1046 /* */ 1047 /* Given a Multics standard calendar clock value, this entry point */ 1048 /* returns a formatted date in the form */ 1049 /* "^my/^dm/^yc ^Hd^99v.99MH ^za ^da" */ 1050 /* For the meaning of this string, see date_time_$format information below. */ 1051 /* */ 1052 /* Usage */ 1053 /* */ 1054 /* dcl date_time_$hundredths entry(fixed bin(71),char(*)); */ 1055 /* */ 1056 /* call date_time_$hundredths (clock,str); */ 1057 /* */ 1058 /* 1) clock is the clock value to be formatted (In) */ 1059 /* 2) str is the resultant character string (Out) */ 1060 /* */ 1061 /* ***********************************+************************************* */ 1062 hundredths: entry (clock_value, str); 1063 1064 /* format: off */ 1065 /*clock_value fixed bin (71) /* standard clock value [In]*/ 1066 /*str char (*) /* return string [Out]*/ 1067 /* format: on */ 1068 hundredths_rtn: begin; /* <<##>> */ 1069 testing_format, format_max = "0"b; 1070 temp_clock = clock_value; 1071 lformat = "^my/^dm/^yc ^Hd^99v.99MH ^xxxxza^xxxda"; 1072 1073 if (time_defaults_$zone_delta = -1) 1074 then call date_time_$set_time_defaults; 1075 lang_index = time_defaults_$language_index; 1076 call Multics_2_vc (temp_clock, (time_defaults_$zone_short), time_defaults_$zone_index, 1077 lang_index, cal_val); 1078 if (lcode = 0) 1079 then call do_format; 1080 str = lresult; 1081 return; /* @@END hundredths */ 1082 end hundredths_rtn; /* <##> */ 1083 1084 /* @@@@@@ ext proc .. offset_to_clock */ 1085 /* ***********************************+************************************* */ 1086 /* */ 1087 /* ENTRY: date_time_$offset_to_clock */ 1088 /* */ 1089 /* This entry point creates a new Multics clock value by adjusting */ 1090 /* an input clock value to a specified day-of-week and then adding */ 1091 /* relative date/time offsets. The relative date/time values */ 1092 /* include a year offset, month offset, week offset, day offset, */ 1093 /* hour offset, minute offset, second offset, and microsecond */ 1094 /* offset. Any of these values may be zero (no offset from input */ 1095 /* clock value) or negative (backwards offset from input clock */ 1096 /* value). In addition, an input time zone is specified. */ 1097 /* */ 1098 /* USAGE: */ 1099 /* dcl date_time_$offset_to_clock entry (ptr, fixed bin (71), */ 1100 /* char (*), fixed bin (71), fixed bin (35)); */ 1101 /* call date_time_$offset_to_clock (addr(time_offsets), clock_in, */ 1102 /* zone, clock, code); */ 1103 /* */ 1104 /* ARGUMENTS: */ 1105 /* time_offset (input) */ 1106 /* is the structure containing time offsets to be aplied. */ 1107 /* Structure is defined in time_offsets.incl.pl1 */ 1108 /* clock_in (input) */ 1109 /* is the clock value to which offsets are applied */ 1110 /* zone (input) */ 1111 /* is the zone in which clock_in is to be interpreted */ 1112 /* clock (output) */ 1113 /* is the resulting clock value */ 1114 /* code (output) */ 1115 /* is a standard status code. It can have one of the following */ 1116 /* values-- */ 1117 /* error_table_$dt_bad_day_of_week */ 1118 /* error_table_$dt_bad_dm */ 1119 /* error_table_$dt_bad_dy */ 1120 /* error_table_$dt_bad_my */ 1121 /* error_table_$dt_date_not_exist */ 1122 /* error_table_$dt_date_too_big */ 1123 /* error_table_$dt_date_too_small */ 1124 /* error_table_$dt_offset_too_big_negative */ 1125 /* error_table_$dt_offset_too_big_positive */ 1126 /* error_table_$dt_year_too_big */ 1127 /* error_table_$dt_year_too_small */ 1128 /* error_table_$unimplemented_version */ 1129 /* */ 1130 /* NOTES: */ 1131 /* */ 1132 /* The order of applying these offsets can affect the resultant */ 1133 /* clock value. In all cases, the order required by convert_- */ 1134 /* date_to_binary_ has been used. The order is as follows: */ 1135 /* */ 1136 /* 1) decode the input clock value into absolute date/time values */ 1137 /* specified in terms of the input time zone. This zone may */ 1138 /* affect the day-of-week represented by the input clock value, */ 1139 /* and hence, may affect any day-of-week offset adjustment. */ 1140 /* 2) apply any day-of-week offset by adding/subtracting days */ 1141 /* to/from the absolute date until the day-of-week represented */ 1142 /* by the decoded clock value equals the specified day-of-week. */ 1143 /* 3) apply any year offset to the decoded clock value. If */ 1144 /* applying the year offset results in a non-existant date, */ 1145 /* then use the previous existing day, e.g. "1583-10-10 -1yr" */ 1146 /* would yield 1582-10-04. */ 1147 /* 4) apply any month offset to the decoded clock value. If */ 1148 /* applying the month offset results in a non-existent date, */ 1149 /* then use the last day of the month (taking leap years into */ 1150 /* account), e.g. "Jan 31 3 months" would yield April 31. */ 1151 /* instead. */ 1152 /* 5) apply the day offset, hour offset, minute offset, second */ 1153 /* offset, and microsecond offset. */ 1154 /* 6) encode the resultant absolute date/time specification into */ 1155 /* the output clock value. */ 1156 /* */ 1157 /* ***********************************+************************************* */ 1158 offset_to_clock: entry (APtime_offset, clock_in_value, zone, clock_value, code); 1159 1160 /* format: off */ 1161 dcl ( 1162 /*APtime_offset ptr /* ->input structure [In]*/ 1163 clock_in_value fixed bin (71) /* clock value [In]*/ 1164 /*zone char (*) /* for clock_in_value [In]*/ 1165 /*clock_value fixed bin (71) /* adjusted clock value [Out]*/ 1166 /*code fixed bin (35) /* standard return code [Out]*/ 1167 ) parm; /* format: on */ 1168 1169 /* ***********************************+************************************* */ 1170 /* Adjust a given clock value by applying a given set of offsets */ 1171 /* */ 1172 /* Begin by decoding input clock value into month, day, year, etc. */ 1173 /* Then add offset input arguments to these decoded values. Finally, */ 1174 /* encode the sums. */ 1175 /* */ 1176 /* ***********************************+************************************* */ 1177 1178 offset_to_clock_rtn: begin; /* <<##>> */ 1179 dcl ( 1180 error_table_$unimplemented_version /* <##> */ 1181 ) fixed bin (35) ext static; 1182 1183 code, lcode = 0; 1184 Ptime_offset = APtime_offset; 1185 if time_offset.version ^= Vtime_offset_2 1186 then do; 1187 code = binary (error_table_$unimplemented_version); 1188 return; 1189 end; 1190 auto_time_offset = time_offset; /* we want to modify structure */ 1191 call Multics_2_vc (clock_in_value, (zone), 1192 get_word_index ((zone), Zone_table), 1, cal_val); 1193 if (lcode = 0) 1194 then call apply_offset; 1195 if (lcode = 0) 1196 then call vc_2_Multics (cal_val, clock_value); 1197 code = lcode; 1198 return; /* @@END offset_to_clock */ 1199 end offset_to_clock_rtn; /* <##> */ 1200 /* @@@@@@ ext func .. decimal_date_time_ */ 1201 /* ***********************************+************************************* */ 1202 /* ***********************************+************************************* */ 1203 decimal_date_time_: entry (clock_value, str); 1204 ddt_sw = "1"b; 1205 goto request_id_rtn; 1206 1207 dcl ddt_sw bit (1); 1208 /* @@@@@@ ext func .. request_id_ */ 1209 /* ***********************************+************************************* */ 1210 /* */ 1211 /* ENTRY: date_time_$request_id_ */ 1212 /* */ 1213 /* Given a Multics standard clock value, this entry point returns a */ 1214 /* char(19) formatted date (expressed in GMT) in the form */ 1215 /* "^yc^my^dm^Hd^MH^99.999999UM" (e.g. 830718105806.808512). This */ 1216 /* is a request id as used by ear and eor. */ 1217 /* */ 1218 /* USAGE: */ 1219 /* dcl date_time_$request_id_ entry(fixed bin (71)) returns (char */ 1220 /* (19)); */ 1221 /* result = date_time_$request_id_ (clock); */ 1222 /* */ 1223 /* ARGUMENTS: */ 1224 /* clock (input) */ 1225 /* is the clock value to be formatted */ 1226 /* result (output) */ 1227 /* is the resultant character string */ 1228 /* */ 1229 /* ***********************************+************************************* */ 1230 1231 request_id_: entry (clock_value) returns (char (19)); 1232 1233 /* format: off */ 1234 /*clock_value fixed bin (71); /* standard clock value [In]*/ 1235 /* format: on */ 1236 1237 ddt_sw = "0"b; 1238 request_id_rtn: begin; /* <<##>> */ 1239 lcode = 0; 1240 Ptime_value = addr (decoded_clock); 1241 if (time_defaults_$zone_delta = -1) 1242 then call date_time_$set_time_defaults; 1243 lang_index = time_defaults_$language_index; 1244 call Multics_2_vc (clock_value, "gmt", time_info_$gmt_zone_index, 1245 lang_index, cal_val); 1246 if (lcode = 0) 1247 then call fromclock$no_FW; 1248 if (lcode ^= 0) 1249 then string (rqid) = "0000000000000000000"; 1250 else do; 1251 pic4 = time_value.yc; 1252 rqid.yc = substr (pic4, 3, 2); 1253 rqid.my = time_value.my; 1254 rqid.dm = time_value.dm; 1255 rqid.Hd = time_value.Hd; 1256 rqid.MH = time_value.MH; 1257 rqid.SM = time_value.SM; 1258 rqid.US = time_value.US; 1259 end; 1260 end request_id_rtn; 1261 if ^ddt_sw 1262 then return (string (rqid)); 1263 str = string (rqid); 1264 return; 1265 1266 dcl 1 rqid, 1267 2 yc char (2), 1268 2 (my, dm, Hd, MH, SM) pic "99", 1269 2 US pic ".999999"; /* @@END request_id_ */ 1270 /* <##> */ 1271 /* @@@@@@ ext proc .. set_lang */ 1272 /* ***********************************+************************************* */ 1273 /* */ 1274 /* ENTRY: date_time_$set_lang */ 1275 /* */ 1276 /* This entry sets or resets the user's default time language. */ 1277 /* */ 1278 /* USAGE: */ 1279 /* dcl date_time_$set_lang entry(char (*), fixed bin (35)); */ 1280 /* call date_time_$set_lang (lang, code); */ 1281 /* */ 1282 /* ARGUMENTS: */ 1283 /* lang (input) */ 1284 /* the language which is to be made current. "system_lang" means */ 1285 /* use the system default time language. */ 1286 /* code (output) */ 1287 /* is a standard status code. It can have one of the following */ 1288 /* values-- */ 1289 /* error_table_$dt_unknown_time_language */ 1290 /* */ 1291 /* ***********************************+************************************* */ 1292 /* ------------------------------------------------------------------------- */ 1293 /* Note that this setting does not affect lower rings. */ 1294 /* ------------------------------------------------------------------------- */ 1295 set_lang: entry (new_str, code); 1296 1297 /* format: off */ 1298 dcl new_str char (*); /* candidate language name [In]*/ 1299 /*code fixed bin (35); /* error code [Out]*/ 1300 /* format: on */ 1301 set_lang_rtn: begin; /* <<##>> */ 1302 dcl ( 1303 error_table_$dt_unknown_time_language /* <##> */ 1304 ) fixed bin (35) ext static; 1305 1306 if (time_defaults_$zone_delta = -1) 1307 then call date_time_$set_time_defaults; 1308 code = 0; 1309 if new_str = "" /* Reset to system default time */ 1310 | new_str = "system_lang" /* language. */ 1311 then do; 1312 time_defaults_$language_index, lang_index 1313 = time_info_$default_language_index; 1314 time_defaults_$language = ti_language.name (lang_index, lang_index); 1315 end; 1316 else do; 1317 /**** Convert user-supplied lang name to index. */ 1318 lang_index = get_word_index ((new_str), Language_table); 1319 if lang_index < 1 /* Name not found in */ 1320 /* time_info_$language_names? */ 1321 then code = binary (error_table_$dt_unknown_time_language); 1322 else do; 1323 time_defaults_$language 1324 = ti_language.name (lang_index, lang_index); 1325 time_defaults_$language_index = lang_index; 1326 end; 1327 end; 1328 return; /* @@END set_lang */ 1329 end set_lang_rtn; /* <##> */ 1330 /* @@@@@@ ext proc .. set_time_defaults */ 1331 /* ***********************************+************************************* */ 1332 /* ***********************************+************************************* */ 1333 /* ------------------------------------------------------------------------- */ 1334 /* Note that this setting does not effect lower rings. */ 1335 /* ------------------------------------------------------------------------- */ 1336 set_time_defaults: entry; 1337 1338 set_time_defaults_rtn: begin; /* <<##>> */ 1339 dcl ( 1340 error_table_$unimplemented_version /* <##> */ 1341 ) fixed bin (35) ext static; 1342 1343 if time_info_$version ^= Vtime_info_2 /* Make sure we know format of */ 1344 then do; /* time_info_. */ 1345 call com_err_ (error_table_$unimplemented_version, 1346 "date_time_$set_time_defaults", 1347 "^/Version ^a of the time_info_ is not supported.", 1348 time_info_$version); 1349 return; 1350 end; 1351 /**** Set process default formats */ 1352 time_defaults_$date_time = ti_keyword.str (site_date_time); 1353 time_defaults_$date = ti_keyword.str (site_date); 1354 time_defaults_$time = ti_keyword.str (site_time); 1355 1356 1357 /**** Set default time language. */ 1358 time_defaults_$language_index, lang_index 1359 = time_info_$default_language_index; 1360 time_defaults_$language = ti_language.name (lang_index, lang_index); 1361 1362 /**** Set default time zone. These are the situations where this routine */ 1363 /**** will be called. */ 1364 /**** 1) scs_and_init_clocks initializes sys_info_$time_zone (and then comes */ 1365 /**** back later under some condition). If $zone_index <1 it CRASHes. */ 1366 /**** 2) init_clocks sets sys_info$time_zone from the BOS CLOK config */ 1367 /**** parameter and then calls set_time_defaults. Then if $zone_index */ 1368 /**** is <1, it will ABORT so that the operator can set a known zone. */ 1369 /**** 3) Anyplace else. Since the system could not come up with an unknown */ 1370 /**** zone in sys_info_, it isn't necessary to check for its being found. */ 1371 1372 zone_index = get_word_index ((sys_info$time_zone), Zone_table); 1373 1374 time_defaults_$zone_index = zone_index; 1375 if (zone_index < 1) 1376 then zone_index = time_info_$gmt_zone_index; 1377 time_defaults_$zone_delta = ti_zone.delta (lang_index, zone_index); 1378 time_defaults_$zone_short = ti_zone.short (lang_index, zone_index); 1379 time_defaults_$zone_long = ti_zone.long (lang_index, zone_index); 1380 return; /* @@END set_time_defaults */ 1381 end set_time_defaults_rtn; /* <##> */ 1382 /* @@@@@@ ext proc .. set_zone */ 1383 /* ***********************************+************************************* */ 1384 /* */ 1385 /* ENTRY: date_time_$set_zone */ 1386 /* */ 1387 /* This entry sets or resets the user's default zone. */ 1388 /* */ 1389 /* USAGE: */ 1390 /* dcl date_time_$set_zone entry(char (*), fixed bin (35)); */ 1391 /* call date_time_$set_zone (zone, code); */ 1392 /* */ 1393 /* ARGUMENTS: */ 1394 /* zone (input) */ 1395 /* the short name of the zone which is to be made current. */ 1396 /* "system_zone" means use the system default zone. */ 1397 /* code (output) */ 1398 /* is a standard status code. It can have one of the following */ 1399 /* values-- */ 1400 /* error_table_$unknown_zone */ 1401 /* */ 1402 /* ***********************************+************************************* */ 1403 /* ------------------------------------------------------------------------- */ 1404 /* Note that this setting does not effect lower rings. */ 1405 /* ------------------------------------------------------------------------- */ 1406 set_zone: entry (new_str, code); 1407 1408 /* format: off */ 1409 /*new_str char (*); /* candidate zone name [In]*/ 1410 /*code fixed bin (35); /* error code [Out]*/ 1411 /* format: on */ 1412 set_zone_rtn: begin; /* <<##>> */ 1413 dcl ( 1414 error_table_$unknown_zone /* <##> */ 1415 ) fixed bin (35) ext static; 1416 1417 if (time_defaults_$zone_delta = -1) 1418 then call date_time_$set_time_defaults; 1419 if new_str = "" /* Restore system default time zone. */ 1420 | new_str = "system_zone" 1421 then zone_index = get_word_index ((sys_info$time_zone), Zone_table); 1422 else do; 1423 zone_index = get_word_index ((new_str), Zone_table); 1424 if zone_index < 1 /* Conversion failed? */ 1425 then do; 1426 code = binary (error_table_$unknown_zone); 1427 return; 1428 end; 1429 end; 1430 lang_index = time_defaults_$language_index; 1431 time_defaults_$zone_short = ti_zone.short (lang_index, zone_index); 1432 time_defaults_$zone_delta = ti_zone.delta (lang_index, zone_index); 1433 time_defaults_$zone_long = ti_zone.long (lang_index, zone_index); 1434 time_defaults_$zone_index = zone_index; 1435 code = 0; 1436 return; /* @@END set_zone */ 1437 end set_zone_rtn; /* <##> */ 1438 /* @@@@@@ ext proc .. to_clock */ 1439 /* ***********************************+************************************* */ 1440 /* */ 1441 /* ENTRY: date_time_$to_clock */ 1442 /* */ 1443 /* Given any or all of the following- years, months, days, hours, */ 1444 /* minutes, seconds, microseconds, day in week, day in year, or day */ 1445 /* in clock, returns a standard clock value which represents the */ 1446 /* encoding of these values. All the values must be valid, i.e. */ 1447 /* hours ^> 23, etc. */ 1448 /* */ 1449 /* USAGE: */ 1450 /* dcl date_time_$to_clock entry (ptr, fixed bin (71), fixed bin */ 1451 /* (35)); */ 1452 /* call date_time_$to_clock (addr (time_value), clock, code); */ 1453 /* */ 1454 /* ARGUMENTS: */ 1455 /* time_value (input) */ 1456 /* is the structure containing time parts. The structure is */ 1457 /* defined in time_value.incl.pl1. */ 1458 /* clock (output) */ 1459 /* is the encoded clock value */ 1460 /* code (output) */ 1461 /* is a standard status code. It can have one of the following */ 1462 /* values-- */ 1463 /* error_table_$bad_time */ 1464 /* error_table_$dt_bad_day_of_week */ 1465 /* error_table_$dt_bad_dm */ 1466 /* error_table_$dt_bad_dy */ 1467 /* error_table_$dt_bad_my */ 1468 /* error_table_$dt_conflict */ 1469 /* error_table_$dt_date_not_exist */ 1470 /* error_table_$dt_date_too_big */ 1471 /* error_table_$dt_date_too_small */ 1472 /* error_table_$unimplemented_version */ 1473 /* error_table_$unknown_zone */ 1474 /* */ 1475 /* NOTES: */ 1476 /* "day" (as opposed to "time") data is only valid in certain */ 1477 /* combinations. This table shows with the *'s which fields may be */ 1478 /* present together. All others must be zero. */ 1479 /* */ 1480 /* +-1-+-2-+-3-+-4-+ */ 1481 /* time_value.yc | * | * | | | In cases 1, 2, & 4, if dw is */ 1482 /* time_value.my | * | | | | present, it is used to verify */ 1483 /* time_value.dm | * | | | | the value converted. */ 1484 /* time_value.fw | | | * | | */ 1485 /* time_value.dw | | |(*)| | In case 3 it actually defines */ 1486 /* time_value.dy | | * | | | a day. If not present, Monday */ 1487 /* time_value.dc | | | | * | is assumed. */ 1488 /* +-v-+-v-+-v-+-v-+ */ 1489 /* | | | +-clock_days = dc */ 1490 /* | | +-----clock_days = converted (fw,dw) */ 1491 /* | +---------clock_days = converted (yc,dy) */ 1492 /* +-------------clock_days = converted (yc,my,dm) */ 1493 /* */ 1494 /* ***********************************+************************************* */ 1495 to_clock: entry (APtime_value, clock_value, code); 1496 1497 /* format: off */ 1498 /*APtime_value ptr /* ->input structure. [In]*/ 1499 /*clock_value fixed bin (71) /* standard clock value [Out]*/ 1500 /*code fixed bin (35) /* standard return code [Out]*/ 1501 /* format: on */ 1502 1503 to_clock_rtn: begin; /* <<##>> */ 1504 dcl ( 1505 error_table_$bad_time, /* <##> */ 1506 error_table_$dt_bad_day_of_week, /* <##> */ 1507 error_table_$dt_bad_fw, /* <##> */ 1508 error_table_$dt_conflict, /* <##> */ 1509 error_table_$dt_date_too_big, /* <##> */ 1510 error_table_$dt_date_too_small, /* <##> */ 1511 error_table_$unknown_zone, /* <##> */ 1512 error_table_$unimplemented_version /* <##> */ 1513 ) fixed bin (35) ext static; 1514 dcl combination bit(6); 1515 dcl fiscal_day_value fixed bin; 1516 1517 1518 Ptime_value = APtime_value; /* point to caller's data */ 1519 day_adjust = 0; 1520 if (time_value.Hd = 24) | (time_value.fw ^= 0) 1521 then do; /* will need to modify the data, */ 1522 auto_time_value = time_value; /* ..so make a copy. */ 1523 Ptime_value = addr (auto_time_value); 1524 if (time_value.Hd = 24) 1525 then do; 1526 time_value.Hd = 0; 1527 day_adjust = 1; 1528 end; 1529 end; 1530 code, lcode = 0; 1531 if (time_value.version ^= Vtime_value_3) & (time_value.version ^= "3") 1532 then do; 1533 code = binary (error_table_$unimplemented_version); 1534 return; 1535 end; 1536 if (time_defaults_$zone_delta = -1) 1537 then call date_time_$set_time_defaults; 1538 lang_index = time_defaults_$language_index; 1539 1540 if time_value.dw < 0 /* 0 ==> no check */ 1541 | time_value.dw > 7 /* 1=Mon <= day_in_week <= 7=Sun; */ 1542 then do; 1543 code = binary (error_table_$dt_bad_day_of_week); 1544 return; 1545 end; 1546 if time_value.Hd < 0 1547 | time_value.Hd > 23 /* 24 hours per day */ 1548 | time_value.MH < 0 1549 | time_value.MH > 59 /* 60 minutes per hour */ 1550 | time_value.SM < 0 1551 | time_value.SM > 59 /* 60 seconds per minute */ 1552 | time_value.US < 0 1553 | time_value.US >= 1000000 1554 then do; 1555 code = binary (error_table_$bad_time); 1556 return; 1557 end; 1558 if time_value.yc > 9999 1559 then goto toobig; 1560 1561 substr (combination, 1, 1) = (time_value.yc ^= 0); 1562 substr (combination, 2, 1) = (time_value.my ^= 0); 1563 substr (combination, 3, 1) = (time_value.dm ^= 0); 1564 substr (combination, 4, 1) = (time_value.fw ^= 0); 1565 substr (combination, 5, 1) = (time_value.dy ^= 0); 1566 substr (combination, 6, 1) = (time_value.dc ^= 0); 1567 if ( combination = "111000"b) /* year,month,day */ 1568 | ( combination = "100010"b) /* year,day-in-year */ 1569 then do; 1570 call ymd_to_days; 1571 if (lcode ^= 0) 1572 then goto to_clock_exit; 1573 end; 1574 else if (combination = "000100"b) /* fiscal week */ 1575 then do; 1576 fiscal_year_value = divide (time_value.fw, 100, 17, 0); 1577 fiscal_week_value = time_value.fw - fiscal_year_value * 100; 1578 if (fiscal_week_value < 1) 1579 then do; 1580 err_dt_bad_fw: 1581 code = binary (error_table_$dt_bad_fw); 1582 return; 1583 end; 1584 time_value.yc = fiscal_year_value; 1585 retry_fw: 1586 time_value.my = 1; 1587 time_value.dm = 1; 1588 call ymd_to_days; 1589 fiscal_day_value = /* yields 1=Mon ... 7=Sun */ 1590 (lclock_days + 4) - divide ((lclock_days + 4), 7, 11) * 7 + 1; 1591 time_value.my, time_value.dm = 0; 1592 time_value.dy = fiscal_week_value * 7 - fiscal_day_value - 5; 1593 if (fiscal_day_value > 4) 1594 then time_value.dy = time_value.dy + 7; 1595 if (time_value.dy < 1) 1596 then do; /* FW[first] is in last year, */ 1597 fiscal_week_value = 53; /* ..back up */ 1598 time_value.yc = time_value.yc - 1; 1599 goto retry_fw; /* ..and recalculate */ 1600 end; 1601 if (time_value.dy > 366) 1602 then do; /* years don't get that big */ 1603 if (time_value.yc = fiscal_year_value) 1604 then goto err_dt_bad_fw; /* user can't say that */ 1605 else time_value.dy = time_value.dy - 7; /* (but I can) */ 1606 end; 1607 call ymd_to_days; 1608 if (lcode ^= 0) 1609 then goto to_clock_exit; 1610 if (time_value.dw ^= 0) /* adjust to day-of-week given */ 1611 then lclock_days = lclock_days + time_value.dw -1; 1612 time_value.dw = 0; 1613 end; 1614 else if (combination = "000001"b) /* day-in-clock */ 1615 then do; 1616 if (time_value.dc < 1) 1617 then do; 1618 code = binary (error_table_$dt_date_too_small); 1619 return; 1620 end; 1621 if (time_value.dc > 0) 1622 then if time_value.dc > 3652061 - day_adjust 1623 then do; 1624 toobig: 1625 code = binary (error_table_$dt_date_too_big); 1626 return; 1627 end; 1628 lclock_days = time_value.dc; /* ready to go */ 1629 cal_val.J_G = None; 1630 end; 1631 else do; 1632 code = binary (error_table_$dt_conflict); 1633 return; 1634 end; 1635 1636 lclock_days = lclock_days + day_adjust; 1637 1638 zone_index = get_word_index ((time_value.za), Zone_table); 1639 if (zone_index < 1) 1640 then do; 1641 if (verify (time_value.za, "-+0123456789") ^= 0) 1642 then do; 1643 code = binary (error_table_$unknown_zone); 1644 return; 1645 end; 1646 zone_index = 0; 1647 cal_val.z = time_value.za; 1648 cal_val.dx 1649 = convert (cal_val.dx, substr (cal_val.z, 2, 2)) * 3600000000 1650 + convert (cal_val.dx, substr (cal_val.z, 4, 2)) * 60000000; 1651 if (substr (cal_val.z, 1, 1) = "+") 1652 then cal_val.dx = -cal_val.dx; 1653 /**** This negates on "+" instead of "-" because our internal use of */ 1654 /**** zone offsets is opposite that of a zone differential. */ 1655 end; 1656 else do; 1657 cal_val.z = ti_zone.short (lang_index, zone_index); 1658 cal_val.dx = ti_zone.delta (lang_index, zone_index); 1659 end; 1660 time_value.zone_index = zone_index; 1661 1662 cal_val.zi = zone_index; /* format: off */ 1663 cal_val.x = ( time_value.US 1664 + 1000000 * (time_value.SM 1665 + 60 * (time_value.MH 1666 + 60 * (time_value.Hd 1667 + precision (24 * (lclock_days - 1), 27))))); /* format: on */ 1668 /**** lclock_days contains a 1-based value, but we needed a 0-based number */ 1669 /**** of days for use in computing the microsecond clock value. */ 1670 1671 if (time_value.dw ^= 0) 1672 then do; 1673 diw = (lclock_days + 4) - divide ((lclock_days + 4), 7, 11) * 7 + 1; 1674 if (time_value.dw ^= diw) 1675 then do; 1676 code = error_table_$dt_bad_day_of_week; 1677 return; 1678 end; 1679 end; 1680 else diw = 0; 1681 1682 call vc_2_Multics (cal_val, clock_value); 1683 to_clock_exit: 1684 code = lcode; 1685 return; /* @@END to_clock */ 1686 end to_clock_rtn; /* <##> */ 1687 /* ***********************************+************************************* */ 1688 /* _ */ 1689 /* o _|_ | */ 1690 /* __ _ | _ _ _ ___ | */ 1691 /* | |/ \ | / \ |/ \ |/ \ ___\ | */ 1692 /* | | | | (__/ | | | / | | */ 1693 /* _|_ | | \_ \_/ | | | \__/| _|_ */ 1694 /* */ 1695 /* ***********************************+************************************* */ 1696 1697 /* @@@@@@ int proc .. apply_offset */ 1698 /* ***********************************+************************************* */ 1699 /* apply a set of offsets to a calendar value */ 1700 /* ***********************************+************************************* */ 1701 apply_offset: proc; /* <<##>> */ 1702 1703 dcl 1 toa like time_offset_array based (toa_p); 1704 dcl toa_p ptr; 1705 dcl toa_i fixed bin; 1706 dcl overflow condition; 1707 dcl ( 1708 error_table_$dt_bad_day_of_week, /* <##> */ 1709 error_table_$dt_offset_too_big_negative, /* <##> */ 1710 error_table_$dt_offset_too_big_positive /* <##> */ 1711 ) fixed bin (35) ext static; 1712 1713 1714 toa_p = addr (auto_time_offset); 1715 lang_index = 1; /* force a valid amount */ 1716 do i = 1 to 8; /* make sure all unused fields */ 1717 if (toa.flag (i) = UNUSED) /* ..are empty */ 1718 then toa.val (i) = 0; 1719 end; 1720 if (auto_time_offset.dw.flag ^= UNUSED) 1721 then if auto_time_offset.dw.val < 1 /* validate user-specified */ 1722 | auto_time_offset.dw.val > 7 /* ...day-of-week offset. */ 1723 then do; 1724 lcode = binary (error_table_$dt_bad_day_of_week); 1725 exit: return; 1726 end; 1727 on overflow 1728 begin; 1729 if (toa.val (toa_i) < 0) 1730 then lcode = binary (error_table_$dt_offset_too_big_negative); 1731 else lcode = binary (error_table_$dt_offset_too_big_positive); 1732 goto exit; 1733 end; 1734 1735 /* First, apply any day-of-week offset to input clock value. This offset is */ 1736 /* negative if the previous day is to be used and positive if the next one. */ 1737 /* If absolute value of the offset is the same as clock value day-of-week, */ 1738 /* add/subtract a week to get the needed occurence of that day-of-week; */ 1739 /* otherwise, add/subtract enough days (<7) to reach wanted day-of-week. */ 1740 1741 if (auto_time_offset.dw.flag ^= UNUSED) 1742 then do; 1743 Ptime_value = addr (decoded_clock); 1744 call fromclock$no_FW; /* decode base value */ 1745 if lcode ^= 0 1746 then return; 1747 if (auto_time_offset.dw.flag > UNUSED) 1748 then do; 1749 auto_time_offset.dw.val = auto_time_offset.dw.val 1750 - decoded_clock.dw; 1751 if (auto_time_offset.dw.val < 0) 1752 | (auto_time_offset.dw.val = 0) & (auto_time_offset.dw.flag = AFTER) 1753 then auto_time_offset.dw.val = auto_time_offset.dw.val + 7; 1754 end; 1755 else if (auto_time_offset.dw.flag < UNUSED) 1756 then do; 1757 auto_time_offset.dw.val = auto_time_offset.dw.val 1758 - decoded_clock.dw; 1759 if (auto_time_offset.dw.val > 0) 1760 | (auto_time_offset.dw.val = 0) & (auto_time_offset.dw.flag = BEFORE) 1761 then auto_time_offset.dw.val = auto_time_offset.dw.val - 7; 1762 end; 1763 /**** breaking 864e8 into 2 parts makes for better (inline) code. */ 1764 cal_val.x = cal_val.x + 100000000 * (auto_time_offset.dw.val * 864); 1765 end; /* ***** DAY-IN-WEEK finished ***** */ 1766 1767 if (auto_time_offset.flag.yr > 0) 1768 then do; 1769 Ptime_value = addr (decoded_clock); 1770 call fromclock$no_FW; /* decode values in terms of our */ 1771 if lcode ^= 0 1772 then return; 1773 toa_i = 1; /* to help the condition handler */ 1774 /**** Separate year offset into integer and fraction parts. */ 1775 Tyear = auto_time_offset.val.yr; 1776 fld24 = auto_time_offset.val.yr - trunc (auto_time_offset.val.yr); 1777 /**** Ensure that auto_time_value.yc gets set. */ 1778 auto_time_value.yc = decoded_clock.yc + Tyear; 1779 if (Tyear ^= 0) 1780 then do; 1781 auto_time_value.dm = decoded_clock.dm; 1782 auto_time_value.my = decoded_clock.my; 1783 auto_time_value.dy = 0; 1784 /**** If decoded day # falls in the 10-day gap between Julian & */ 1785 /**** Gregorian calendars, push it back to the last valid day. */ 1786 if (auto_time_value.yc = 1582) & (auto_time_value.my = OCTOBER) 1787 & (auto_time_value.dm > 4) & (auto_time_value.dm < 15) 1788 then auto_time_value.dm = 4; 1789 if auto_time_value.my = FEBRUARY & auto_time_value.dm = 29 1790 then if calc_leap_day (auto_time_value.yc) = 0 1791 then if Tyear < 0 /* adjust date when year offset from */ 1792 /* 02/29/ lands in a */ 1793 /* non-leap_year. */ 1794 then auto_time_value.dm = 28; 1795 else do; 1796 auto_time_value.my = MARCH; 1797 auto_time_value.dm = 1; 1798 end; 1799 Ptime_value = addr (auto_time_value); 1800 call ymd_to_days; /* break down the adjusted year */ 1801 if (lcode ^= 0) 1802 then return; 1803 cal_val.x = (decoded_clock.US + 1000000 * (decoded_clock.SM 1804 + 60 * (decoded_clock.MH + 60 * (decoded_clock.Hd 1805 + precision (24 * (lclock_days - 1), 27))))); 1806 end; 1807 else cal_val.J_G = None; 1808 if (fld24 ^= 0) 1809 then do; /* apply fractional part, if any */ 1810 /**** How many days in the year? */ 1811 if (auto_time_value.yc = 1582) 1812 then unit_size = 355; 1813 else unit_size = 365 + calc_leap_day (auto_time_value.yc); 1814 /**** How many microseconds is that? (-1 bias helps roundoff problem) */ 1815 unit_size = (unit_size * 864) * 100000000 - 1; 1816 /**** Add in the number of Usec that the fraction represents. */ 1817 fld24 = convert (fld24, unit_size) * fld24; 1818 cal_val.x = cal_val.x + convert (cal_val.x, fld24); 1819 end; 1820 end; 1821 1822 if (auto_time_offset.flag.mo > 0) 1823 then do; 1824 Ptime_value = addr (decoded_clock); 1825 call fromclock$no_FW; /* decode value */ 1826 if lcode ^= 0 1827 then return; 1828 toa_i = 2; /* to help the condition handler */ 1829 /**** Separate month offset into integer and fraction parts. */ 1830 Tmonth = auto_time_offset.val.mo; 1831 fld24 = auto_time_offset.val.mo - trunc (auto_time_offset.val.mo); 1832 Tmonth = Tmonth + decoded_clock.my; 1833 /**** Tmonth, originally an offset, is now a month-in-year */ 1834 /* rule: 1 <= month <= 12; */ 1835 if (Tmonth < 1) /* enforce this rule by normalizing */ 1836 then do; /* the month and year values. */ 1837 Tyear = divide (Tmonth, 12, 17) - 1; /* -1 accounts for */ 1838 Tmonth = Tmonth - Tyear * 12; /* ..the 0 month # */ 1839 end; 1840 else if (Tmonth > 12) /* N year, 0 mon = N-1 year, 12 mon */ 1841 then do; 1842 Tyear = divide (Tmonth - 1, 12, 17); 1843 Tmonth = Tmonth - Tyear * 12; 1844 end; 1845 else Tyear = 0; 1846 Tyear = Tyear + decoded_clock.yc; 1847 /**** If day # from decoded clock value is greater than # of days in the */ 1848 /**** adjusted month, then set it to # of days in month; thus: */ 1849 /**** May 31, 1973 -3 months */ 1850 /**** produces an intermediate result of: */ 1851 /**** February 28, 1973 */ 1852 if Tmonth = FEBRUARY /* if this is February */ 1853 then Tday = 28 + calc_leap_day ((Tyear)); 1854 else Tday = days_in_month (Tmonth); 1855 Tday = min (decoded_clock.dm, Tday); 1856 /**** If decoded day # falls in the 10-day gap between Julian & Gregorian */ 1857 /**** calendars, push it back to the last valid day. This mimics the */ 1858 /**** action mentioned above. */ 1859 if (Tyear = 1582) & (Tmonth = OCTOBER) 1860 & (Tday > 4) & (Tday < 15) 1861 then Tday = 4; 1862 auto_time_value.dm = Tday; 1863 auto_time_value.my = Tmonth; 1864 auto_time_value.yc = Tyear; 1865 auto_time_value.dy = 0; 1866 Ptime_value = addr (auto_time_value); 1867 call ymd_to_days; /* break down the adjusted yr/mo */ 1868 if (lcode ^= 0) 1869 then return; 1870 cal_val.x = (decoded_clock.US + 1000000 * (decoded_clock.SM 1871 + 60 * (decoded_clock.MH + 60 * (decoded_clock.Hd 1872 + precision (24 * (lclock_days - 1), 27))))); 1873 if (fld24 ^= 0) 1874 then do; /* apply fractional part, if any */ 1875 /**** How many days in the month? */ 1876 if Tmonth = FEBRUARY /* if this is February */ 1877 then unit_size = 28 + calc_leap_day ((Tyear)); 1878 else unit_size = days_in_month (Tmonth); 1879 /**** How many microseconds is that? (-1 bias helps roundoff problem) */ 1880 unit_size = (unit_size * 864) * 100000000 - 1; 1881 /**** Add in the number of Usec that the fraction represents. */ 1882 fld24 = convert (fld24, unit_size) * fld24; 1883 cal_val.x = cal_val.x + convert (cal_val.x, fld24); 1884 end; 1885 end; 1886 /**** Now take care of the easy ones: wk, da, hr, min, sec, Usec. */ 1887 /**** 3 4 5 6 7 8 */ 1888 do toa_i = 3 to 8; 1889 if (toa.flag (toa_i) > 0) 1890 then cal_val.x = cal_val.x 1891 + convert (cal_val.x, toa.val (toa_i) * unit_sizes (toa_i)); 1892 end; 1893 revert overflow; 1894 1895 end apply_offset; /* <##> */ 1896 /* @@@@@@ int func .. calc_leap_day */ 1897 /* ***********************************+************************************* */ 1898 /* ***********************************+************************************* */ 1899 calc_leap_day: proc (yr) returns (fixed bin); /* <<##>> */ 1900 1901 dcl yr fixed bin; 1902 1903 if (yr > 1582) 1904 then return (1 1905 - divide (yr - divide (yr, 4, 17) * 4 + 3, 4, 17) 1906 + divide (yr - divide (yr, 100, 17) * 100 + 99, 100, 17) 1907 - divide (yr - divide (yr, 400, 17) * 400 + 399, 400, 17)); 1908 if (mod (yr, 4) = 0) 1909 then return (1); 1910 return (0); 1911 1912 end calc_leap_day; /* <##> */ 1913 /* @@@@@@ int proc .. cv_fmt_kwd */ 1914 /* ***********************************+************************************* */ 1915 /* ***********************************+************************************* */ 1916 1917 cv_fmt_kwd: proc (fmt_str) returns (char (256)var); /* <<##>> */ 1918 1919 dcl fmt_str char(512)var; 1920 1921 dcl ( 1922 error_table_$dt_no_format_selector /* <##> */ 1923 ) fixed bin (35) ext static; 1924 dcl ii fixed bin; 1925 dcl result char (256)var; 1926 dcl ct fixed bin; 1927 1928 lcode = 0; 1929 ct = 0; 1930 result = fmt_str; 1931 check: 1932 if (result = "date_time") 1933 then result = time_defaults_$date_time; 1934 else if (result = "date") 1935 then result = time_defaults_$date; 1936 else if (result = "time") 1937 then result = time_defaults_$time; 1938 else do; 1939 do ii = 1 to ti_keyword.number_kwd; 1940 if (ti_keyword.name (ii) = result) 1941 then do; 1942 result = ti_keyword.str (ii); 1943 goto found_kwd; 1944 end; 1945 end; 1946 no_good: 1947 lcode = binary (error_table_$dt_no_format_selector); 1948 return(fmt_str); 1949 found_kwd: 1950 end; 1951 if (index (result, "^") = 0) /* if the keyword gave a keyword */ 1952 then do; 1953 if (ct = 0) /* ..and this is the first time */ 1954 then do; /* ..thru, give it another shot. */ 1955 ct = 2; 1956 goto check; 1957 end; 1958 goto no_good; /* ..otherwise complain */ 1959 end; 1960 return (result); 1961 1962 end cv_fmt_kwd; 1963 1964 /* @@@@@@ int proc .. do_format */ 1965 /* ***********************************+************************************* */ 1966 /* ***********************************+************************************* */ 1967 do_format: proc; /* <<##>> */ 1968 1969 dcl i fixed bin; 1970 1971 Ptime_value = addr (decoded_clock); /* point to a structure */ 1972 time_value.version = Vtime_value_3; 1973 call fromclock; /* ..and get it filled in, in the */ 1974 /* ..zone specified or implied */ 1975 error: 1976 if lcode ^= 0 /* report error to user. */ 1977 then do; 1978 lresult = "01/01/01 0000.00 gmt Tue"; 1979 return; 1980 end; 1981 do_format$direct: entry; 1982 errloc = 1; /* in case there's an error */ 1983 if (index (lformat, "^") = 0) /* if no ^'s, it must be a keyword */ 1984 then do; /* ..get it translated */ 1985 lformat = cv_fmt_kwd (lformat); 1986 errlocad.n = 1; 1987 errlocad.start(1) = 1; 1988 errlocad.enclosed_key(1) = 0; 1989 errlocad.old_len(1) = length(format); 1990 errlocad.new_len(1) = length(lformat); 1991 end; 1992 if (lcode ^= 0) 1993 then goto error; 1994 1995 lresult = ""; /* set up to scan his format string */ 1996 format_i = 1; 1997 do while ((format_i <= length (lformat)) & (lcode = 0)); 1998 i = index (substr (lformat, format_i), "^"); 1999 if (i = 0) 2000 then i = length (lformat) - format_i + 1; 2001 else i = i - 1; 2002 if (i > 0) 2003 then lresult = lresult || substr (lformat, format_i, i); 2004 format_i = format_i + i; 2005 if (format_i <= length (lformat)) 2006 then do; 2007 call proc_selector; 2008 end; 2009 end; 2010 2011 end do_format; /* <##> */ 2012 /* @@@@@@ int proc .. fromclock */ 2013 /* ***********************************+************************************* */ 2014 /* Arguments to this proc are: */ 2015 /* Ptime_value= ptr to time_value output struc. [In]*/ 2016 /* cal_val = calendar value in zone specified to be converted [In]*/ 2017 /* lcode = error code if nonzero [Out]*/ 2018 /* ***********************************+************************************* */ 2019 fromclock: proc; /* <<##>> */ 2020 do_FW = "1"b; 2021 goto start; 2022 2023 fromclock$no_FW: entry; 2024 do_FW = ""b; 2025 start: ; 2026 2027 dcl ( 2028 error_table_$badcall /* <##> */ 2029 ) fixed bin (35) ext static; 2030 2031 dcl (A, B, C) fixed bin; /* factors for leap year calculation */ 2032 dcl lclock_seconds fixed bin (36); 2033 dcl lclock_minutes fixed bin (31); 2034 dcl lclock_hours fixed bin (25); 2035 dcl lclock_days fixed bin (20); 2036 dcl leap_day fixed bin; /* number of Feb 29's in this year. */ 2037 dcl do_FW bit (1); 2038 dcl day_for_fiscal fixed bin; 2039 dcl fiscal_constant fixed bin; 2040 dcl fiscal_week_value fixed bin; 2041 dcl fiscal_year_value fixed bin; 2042 2043 lcode = 0; 2044 time_value.zone_index = cal_val.zi; 2045 2046 /* ***********************************+************************************* */ 2047 /* */ 2048 /* 1) compute number of micro-seconds in excess of 1 second in clock value. */ 2049 /* 2) compute number of seconds in excess of 1 minute in clock value. */ 2050 /* 3) compute number of minutes in excess of 1 hour in clock value. */ 2051 /* 4) compute number of hours in excess of 1 day in clock value. */ 2052 /* */ 2053 /* ***********************************+************************************* */ 2054 /* format: off */ 2055 2056 time_value.Uc = cal_val.x; 2057 time_value.za = cal_val.z; 2058 time_value.zone_index = cal_val.zi; 2059 2060 lclock_seconds = divide (cal_val.x, 1000000, 39); 2061 time_value.US = cal_val.x - lclock_seconds * 1000000; 2062 2063 lclock_minutes = divide (lclock_seconds, 60, 10); 2064 time_value.SM = lclock_seconds - lclock_minutes * 60; 2065 2066 lclock_hours = divide (lclock_minutes, 60, 8); 2067 time_value.MH = lclock_minutes - lclock_hours * 60; 2068 2069 lclock_days = divide (lclock_hours, 24, 7); 2070 time_value.Hd = lclock_hours - lclock_days * 24; 2071 /* format: on */ 2072 /**** Add 1 because Us 0 at beginning of day 1 */ 2073 time_value.dc = lclock_days + 1; 2074 if (cal_val.J_G = Special) /* this range does Julian type of */ 2075 then do; /* ..breakdown (cheaper) */ 2076 lclock_days = lclock_days + 13; 2077 goto Julian_style; 2078 end; 2079 if (cal_val.J_G = Gregorian) 2080 then do; 2081 2082 /* ***********************************+************************************* */ 2083 /* */ 2084 /* G R E G O R I A N D A T E S : 1582-10-15 thru 9999-12-31 */ 2085 /* During this interval, the Gregorian leap calculation is used. */ 2086 /* */ 2087 /* Compute the year by dividing the whole number of days in the clock value */ 2088 /* into a whole number of 400 year groups plus a whole number of 100 year */ 2089 /* groups plus a whole number of 4 year groups plus a number of years in */ 2090 /* excess of the last 4 year group. */ 2091 /* */ 2092 /* ***********************************+************************************* */ 2093 2094 A, B, C = 1; /* format: off */ 2095 lclock_days = lclock_days - 2; /* The base value of the Gregorian */ 2096 /* ..algorithm is 2 days before that */ 2097 /* ..of the Julian. */ 2098 2099 num_of__400s = divide (lclock_days, 146097, 2); 2100 rest_of__400 = lclock_days - 146097 * num_of__400s; 2101 if (rest_of__400 >= 146097-366) 2102 then C = 0; 2103 2104 num_of__100s = divide ( rest_of__400, 36524, 1); 2105 if (num_of__100s = 4) /* Account for leap day every 4th */ 2106 then num_of__100s = 3; /* century. */ 2107 rest_of__100 = rest_of__400 - 36524 * num_of__100s; 2108 if (rest_of__100 >= 36524-365) 2109 then B = 0; 2110 2111 num_of____4s = divide ( rest_of__100, 1461, 2); 2112 rest_of____4 = rest_of__100 - 1461 * num_of____4s; 2113 if (rest_of____4 >= 1461-366) 2114 then A = 0; 2115 2116 num_of____1s = divide ( rest_of____4, 365, 1); 2117 if (num_of____1s = 4) /* Account for leap day every 4th */ 2118 then num_of____1s = 3; /* year */ 2119 rest_of____1 = rest_of____4 - 365 * num_of____1s + 1; 2120 /* Number of the day of the year. */ 2121 time_value.yc 2122 = num_of__400s * 400 2123 + num_of__100s * 100 2124 + num_of____4s * 4 2125 + num_of____1s + 1; 2126 /* format: on */ 2127 time_value.dy = rest_of____1; 2128 if (time_value.yc = 1582) /* Only 355 days in year 1582. */ 2129 & (rest_of____1 >= 288) 2130 then time_value.dy = rest_of____1 - 10; 2131 2132 leap_day = 1 - A + B - C; 2133 end; 2134 /* ***********************************+************************************* */ 2135 /* */ 2136 /* J U L I A N D A T E S : 0001-01-01 thru 1582-10-04 */ 2137 /* */ 2138 /* Compute the year by dividing the whole number of days in the clock value */ 2139 /* into a whole number of 4 year groups plus a number of years in excess */ 2140 /* of the last 4 year group. */ 2141 /* */ 2142 /* ***********************************+************************************* */ 2143 2144 else if (cal_val.J_G = Julian) 2145 then do; 2146 Julian_style: 2147 num_of____4s = divide (lclock_days, 1461, 17); 2148 rest_of____4 = lclock_days - (1461 * num_of____4s); 2149 num_of____1s = divide (rest_of____4, 365, 1); 2150 if (num_of____1s >= 3) /* =4 on last day of leap year. */ 2151 then do; 2152 num_of____1s = 3; 2153 leap_day = 1; 2154 end; 2155 else leap_day = 0; 2156 2157 rest_of____1 = rest_of____4 - (365 * num_of____1s) + 1; 2158 time_value.yc 2159 = num_of____4s * 4 2160 + num_of____1s + 1; 2161 time_value.dy = rest_of____1; 2162 2163 2164 end; 2165 else do; 2166 lcode = binary (error_table_$badcall); 2167 return; 2168 end; 2169 /* ***********************************+************************************* */ 2170 /* 0001-1-1 has dc=1 and is a Saturday(=6). Calculate the day of the week */ 2171 /* by removing the number of whole weeks and adjusting what is left. */ 2172 /* when dc=1 the formula will be (1+4)-(1+4)/7*7+1 */ 2173 /* which works out to be 5 - 0 +1 = 6 */ 2174 /* when dc=3 the formula will be (3+4)-(3+4)/7*7+1 */ 2175 /* which works out to be 7 - 7 +1 = 1 */ 2176 /* This show that the wrap around is at the right place. */ 2177 /* ***********************************+************************************* */ 2178 2179 time_value.dw /* yields 1=Mon ... 7=Sun */ 2180 = (time_value.dc + 4) - divide ((time_value.dc + 4), 7, 11) * 7 + 1; 2181 2182 /* ***********************************+************************************* */ 2183 /* */ 2184 /* Calculate the fiscal week. This method is derived from equations in */ 2185 /* an article in Interface Age by R. W. Bemer; Feb 1979 p75-79 */ 2186 /* */ 2187 /* ***********************************+************************************* */ 2188 if do_FW 2189 then do; 2190 day_for_fiscal = divide (time_value.dy - 1, 7, 17); 2191 day_for_fiscal = time_value.dy - 1 - day_for_fiscal * 7; 2192 fiscal_constant = time_value.dw - day_for_fiscal + 6; 2193 if (fiscal_constant < 4) 2194 then fiscal_constant = fiscal_constant + 7; 2195 if (fiscal_constant > 10) 2196 then fiscal_constant = fiscal_constant - 7; 2197 2198 fiscal_week_value 2199 = divide (time_value.dy + fiscal_constant - 1, 7, 17); 2200 fiscal_year_value = time_value.yc; 2201 2202 /**** take care of the special cases */ 2203 2204 if (fiscal_week_value = 53) 2205 then do; 2206 if fiscal_constant + leap_day < 10 2207 then do; 2208 fiscal_year_value = fiscal_year_value + 1; 2209 fiscal_week_value = 1; 2210 end; 2211 end; 2212 else if fiscal_week_value = 0 2213 then do; 2214 fiscal_year_value = fiscal_year_value - 1; 2215 fiscal_week_value = 53 2216 - divide (fiscal_constant + 1 - calc_leap_day (fiscal_year_value), 6, 17); 2217 end; 2218 2219 /* 9999-12-31=FW999952, so we don't */ 2220 /* ..have to check for year 10000 */ 2221 time_value.fw = fiscal_year_value * 100 + fiscal_week_value; 2222 end; 2223 /* ***********************************+************************************* */ 2224 /* */ 2225 /* Compute the month of the year, and day of the month, using the */ 2226 /* algorithm of Richard A. Stone; Communications of the ACM; */ 2227 /* Vol 13, No 10; October, 1970; p 621. */ 2228 /* */ 2229 /* ***********************************+************************************* */ 2230 2231 if rest_of____1 > (59 + leap_day) /* make Feb have 30 days. */ 2232 then rest_of____1 = rest_of____1 + 2 - leap_day; 2233 rest_of____1 = rest_of____1 + 91; 2234 /* get pseudo-month_number */ 2235 time_value.my = divide (rest_of____1, 30.55, 2); 2236 time_value.dm = rest_of____1 2237 - precision ((30.55 * time_value.my), 3, 0); 2238 /* pseudo-month_number * 30.55 gives */ 2239 /* ..number of days before the first */ 2240 /* ..day of this month. ITS MAGIC! */ 2241 time_value.my = time_value.my - 2; 2242 /* Algorithm says subtract 2 to get */ 2243 /* real month no. */ 2244 time_value.leap_year = leap_day; 2245 return; /* All done! */ 2246 end fromclock; /* <##> */ 2247 /* @@@@@@ int proc .. get_word_index */ 2248 /* ***********************************+************************************* */ 2249 /* ***********************************+************************************* */ 2250 2251 /* A portion of this routine also exists in convert_date_to_binary_.rd. */ 2252 2253 get_word_index: proc (Atoken, Atable) returns (fixed bin); /* <<##>> */ 2254 2255 dcl Atoken char (32), /* word to look for */ 2256 Atable fixed bin; /* kind off thing it must be */ 2257 2258 dcl (lb, hb) fixed bin; 2259 dcl symb char (32); 2260 dcl cur_token fixed bin; 2261 dcl e_count fixed bin; 2262 2263 if (Atable = Language_table) 2264 then do; 2265 if (Atoken = "") /* User wants process default. */ 2266 then return (time_defaults_$language_index); 2267 if (Atoken = "system_lang") 2268 then return (time_info_$default_language_index); 2269 end; 2270 if (Atable = Zone_table) 2271 then do; 2272 if (Atoken = "") /* User wants process default. */ 2273 then return (time_defaults_$zone_index); 2274 if (Atoken = "system_zone") 2275 then do; 2276 symb = sys_info$time_zone; 2277 goto search; 2278 end; 2279 end; 2280 item_p = null (); 2281 symb = translate (Atoken, az, AZ);/* get to normal form */ 2282 search: 2283 ti_token_p = addr (time_info_$tokens); 2284 lb = 1; /* set lower bound of search */ 2285 hb = ti_token.count; /* set upper bound of search */ 2286 do while (lb <= hb); /* as long as range is non-null */ 2287 cur_token = divide (lb + hb, 2, 17); /* find center of range */ 2288 if (ti_token.symbol (cur_token) = symb) 2289 then do; 2290 item_p = addrel (addr (time_info_$version), 2291 ti_token.list_r (cur_token)); 2292 goto found_token; 2293 end; 2294 if (ti_token.symbol (cur_token) < symb) 2295 then lb = cur_token + 1; 2296 else hb = cur_token - 1; 2297 end; 2298 return (-1); /* Tell caller name was not there */ 2299 2300 found_token: 2301 do e_count = 1 to item.count; 2302 if (Atable = item.table (e_count)) 2303 then return (item.element (e_count)); 2304 end; 2305 return (0); /* Tell caller name was there, */ 2306 /* ..but not the kind she wanted. */ 2307 2308 end get_word_index; /* <##> */ 2309 /* @@@@@@ int func .. make_fraction */ 2310 /* ***********************************+************************************* */ 2311 /* ***********************************+************************************* */ 2312 make_fraction: proc (interval, units) returns (float dec (20)); /* <<##>> */ 2313 2314 dcl (interval, units) fixed bin (71); 2315 2316 dcl (fldA, fldB) float dec (24); 2317 dcl fldC float dec (20); 2318 2319 fldA = convert (fldA, interval); 2320 fldB = convert (fldB, units); 2321 fldC = fldA / fldB; 2322 return (fldC); 2323 2324 end make_fraction; /* <##> */ 2325 /* @@@@@@ int proc .. Multics_2_vc */ 2326 Multics_2_vc: proc (Mval, zname, zval, lval, cval); /* <<##>> */ 2327 2328 dcl Mval fixed bin (71), /* Multics value [IN] */ 2329 zname char (5), /* zone name in which to work [IN] */ 2330 /* ""=> zone-name(zval) is used */ 2331 zval fixed bin, /* zone index of value [IN] */ 2332 /* 0 => zname is a zone differential */ 2333 /* and is converted. */ 2334 /* >0=> zname assumed to match zval */ 2335 lval fixed bin, /* language in which working [IN] */ 2336 /* (needed when zname="") */ 2337 1 cval like cal_val; /* virtual value, zoned [OUT] */ 2338 2339 /* Convert a Multics clock value (org 1901-01-01 00:00:00.000000 gmt Tue) */ 2340 /* into a virtual clock value (org 0001-01-01__00:00:00.000000_gmt_Sat) and */ 2341 /* then adjust to the indicated time zone. */ 2342 /* The results are placed in a structure which contains */ 2343 /* x the adjusted value. */ 2344 /* dx the value to add to x to give GMT */ 2345 /* z the name of the zone related to dx */ 2346 /* zi the zone_index into ti_zone for this zone. */ 2347 /* J_G which calendar system the value is in */ 2348 2349 dcl ( 2350 error_table_$dt_date_too_big, /* <##> */ 2351 error_table_$dt_date_too_small, /* <##> */ 2352 error_table_$dt_year_too_big, /* <##> */ 2353 error_table_$dt_year_too_small /* <##> */ 2354 ) fixed bin (35) ext static; 2355 2356 lcode = 0; 2357 /**** First adjust to an absolute virtual clock value, check range. */ 2358 cval.x = Mval + M_vc_adjust; 2359 if (cval.x < 0) 2360 then do; /* 0001-01-01__00:00:00.000000_gmt */ 2361 lcode = binary (error_table_$dt_date_too_small); 2362 return; 2363 end; 2364 if (cval.x >= max_vc_value) 2365 then do; /* 9999-12-31__23:59:59.999999_gmt */ 2366 lcode = binary (error_table_$dt_date_too_big); 2367 return; 2368 end; 2369 /**** Now zone adjust the value and keep associated info. */ 2370 /**** If zval=0 then zname is a zone differential. This is a signed number */ 2371 /**** pair (sHHMM) representing the hour and minute adjustment to GMT to */ 2372 /**** given the needed local value, i.e. -0700 is Mountain Standard Time, */ 2373 /**** +0530 is India Standard Time. */ 2374 if (zval = 0) 2375 then do; 2376 cval.dx 2377 = convert (cval.dx, substr (zname, 2, 2)) * 3600000000 2378 + convert (cval.dx, substr (zname, 4, 2)) * 60000000; 2379 if (substr (zname, 1, 1) = "+") 2380 then cval.dx = -cval.dx; 2381 end; 2382 else cval.dx = ti_zone.delta (1, zval); 2383 cval.x = cval.x - cval.dx; 2384 cval.zi = zval; 2385 cval.z = zname; 2386 if (cval.z = "") 2387 then cval.z = ti_zone.short (lval, cval.zi); 2388 2389 /**** Now make sure it still is within bounds and see which calendar its in. */ 2390 if (cval.x < begin_Special) /* < 1901-01-01 00:00:00.000000 */ 2391 then do; 2392 if (cval.x < begin_Gregorian) /* < 1582-10-15 00:00:00.000000 */ 2393 then do; 2394 if (cval.x < 0) /* (ZAT == Zone Adjusted Time) */ 2395 then do; /* < 0001-01-01 00:00:00.000000 ZAT */ 2396 lcode = binary (error_table_$dt_year_too_small); 2397 return; 2398 end; 2399 cval.J_G = Julian; /* 0001-01-01 thru 1582-10-04 */ 2400 end; 2401 else cval.J_G = Gregorian; /* 1582-10-15 thru 1900-12-31 */ 2402 end; 2403 else if (cval.x < end_Special) 2404 then cval.J_G = Special; /* 1901-01-01 thru 2099-12-31 */ 2405 else do; 2406 if (cval.x >= max_vc_value) 2407 then do; /* > 9999-12-31 23:59:59.999999 ZAT */ 2408 lcode = binary (error_table_$dt_year_too_big); 2409 return; 2410 end; 2411 cval.J_G = Gregorian; /* 2100-01-01 thru 9999-12-31 */ 2412 end; 2413 2414 return; 2415 2416 end Multics_2_vc; /* <##> */ 2417 /* @@@@@@ int proc .. proc_selector */ 2418 /* ***********************************+************************************* */ 2419 /* ***********************************+************************************* */ 2420 proc_selector: proc; /* <<##>> */ 2421 dcl ( 2422 error_table_$bad_conversion, /* <##> */ 2423 error_table_$dt_bad_format_selector,/* <##> */ 2424 error_table_$picture_bad, /* <##> */ 2425 error_table_$picture_scale, /* <##> */ 2426 error_table_$picture_too_big, /* <##> */ 2427 error_table_$size_error /* <##> */ 2428 ) fixed bin (35) ext static; 2429 /* format: off */ 2430 dcl selector (43)char(2)int static options (constant) init ( 2431 "Hc", /* 01 "(8)Z9" Hour/calendar */ 2432 "Hd", /* 02 "99" Hour/day */ 2433 "Hh", /* 03 "99" Hour/half-day */ 2434 "Hm", /* 04 "(3)Z9" Hour/month */ 2435 "Hw", /* 05 "(3)Z9" Hour/week */ 2436 "Hy", /* 06 "(4)Z9" Hour/year */ 2437 "MH", /* 07 "99" Minute/Hour */ 2438 "Mc", /* 08 "(10)Z9" Minute/calendar */ 2439 "Md", /* 09 "(4)Z9" Minute/day */ 2440 "Mm", /* 10 "(5)Z9" Minute/month */ 2441 "Mw", /* 11 "(5)Z9" Minute/week */ 2442 "My", /* 12 "(6)Z9" Minute/year */ 2443 "SH", /* 13 "(4)Z9" Second/Hour */ 2444 "SM", /* 14 "99" Second/Minute */ 2445 "Sc", /* 15 "(12)Z9" Second/calendar */ 2446 "Sd", /* 16 "(5)Z9" Second/day */ 2447 "Sm", /* 17 "(8)Z9" Second/month */ 2448 "Sw", /* 18 "(6)Z9" Second/week */ 2449 "Sy", /* 19 "(12)Z9" Second/year */ 2450 "UH", /* 20 "(10)Z9" Usecond/Hour (microsecond) */ 2451 "UM", /* 21 "(8)Z9" Usecond/Minute */ 2452 "US", /* 22 "(5)Z9" Usecond/Second */ 2453 "Uc", /* 23 "(18)Z9" Usecond/calendar */ 2454 "Ud", /* 24 "(11)Z9" Usecond/day */ 2455 "Um", /* 25 "(13)Z9" Usecond/month */ 2456 "Uw", /* 26 "(12)Z9" Usecond/week */ 2457 "Uy", /* 27 "(14)Z9" Usecond/year */ 2458 "da", /* 28 "(8)X" day abbrev */ 2459 "dc", /* 29 "(7)Z9" day/calendar */ 2460 "dm", /* 30 "99" day/month */ 2461 "dn", /* 31 "(32)X" day name */ 2462 "dw", /* 32 "9" day/week */ 2463 "dy", /* 33 "999" day/year */ 2464 "fw", /* 34 "OOO999" fiscal week */ 2465 "ma", /* 35 "(8)X" month abbrev */ 2466 "mi", /* 36 "a" meridiem indicator */ 2467 "mn", /* 37 "(32)X" month name */ 2468 "my", /* 38 "99" month/year */ 2469 "yc", /* 39 "OO99" year/calendar */ 2470 "za", /* 40 "(8)X" zone abbrev */ 2471 "zn", /* 41 "(64)X" zone name */ 2472 "fi", /* 42 "(8)X" fiscal indicator */ 2473 "zd"); /* 43 "s9999" zone differential */ 2474 /* format: on */ 2475 2476 dcl Ar_ct fixed bin; 2477 dcl assign_ entry (ptr, fixed bin, fixed bin (35), ptr, fixed bin, 2478 fixed bin (35)); 2479 dcl bit1 bit (1) unaligned based; 2480 dcl buff (20) fixed binary; 2481 dcl conversion condition; 2482 dcl ftype fixed bin; 2483 dcl fx2 fixed bin; 2484 dcl i1 fixed bin; 2485 dcl i2 fixed bin; 2486 dcl ii fixed bin; 2487 dcl pack_picture_ options (variable); 2488 /**** pack_picture_ declares itself to be "(char(1), fixed bin, char(1))", */ 2489 /**** but it does not play straight with it's arguments. */ 2490 dcl Pic char (64); 2491 dcl PIC char (64); 2492 dcl picl fixed bin; 2493 dcl picp ptr; 2494 dcl pictured char (256) var; 2495 dcl picture_code fixed bin (15); /* I think it's weird also. */ 2496 dcl picture_info_ entry (char (*) aligned, ptr, fixed bin (15)); 2497 dcl picv char (picl) based (picp); 2498 dcl Pic_l fixed bin; 2499 dcl pi_p ptr; 2500 dcl size condition; 2501 dcl target char (128); 2502 dcl target_length fixed bin (35); 2503 dcl temp char (64); 2504 dcl Ol_sw bit (1); 2505 dcl Zl_ct fixed bin; 2506 dcl Zr_ct fixed bin; 2507 2508 dcl map_type (24:28) fixed bin int static init ( 2509 42, /* character */ 2510 18, /* real fixed dec */ 2511 22, /* cplx fixed dec */ 2512 20, /* real float dec */ 2513 24); /* cplx float dec */ 2514 2515 dcl 1 pi like picture_image based (pi_p); 3 1 /* BEGIN INCLUDE FILE ... picture_image.incl.pl1 3 2* 3 3* James R. Davis 12 Mar 79 3 4**/ 3 5 3 6 dcl 1 picture_image aligned based, 3 7 2 type fixed bin (8) unal, 3 8 2 prec fixed bin (8) unal, /* precision or length of associated value */ 3 9 2 scale fixed bin (8) unal, /* for both fixed and float pictures, 3 10* =ndigits after "v" - scale_factor */ 3 11 2 piclength fixed bin (8) unal, /* length of picture_constant.chars, <64 3 12* =length of normalized-picture-string */ 3 13 2 varlength fixed bin (8) unal, /* length of pictured variable in chars, <64 3 14* =length of normalized_picture_string - "k" and "v" */ 3 15 2 scalefactor fixed bin (8) unal, /* value of pict-sc-f, -256<=x<256 */ 3 16 2 explength fixed bin (8) unal, /* length of exp field for float */ 3 17 2 drift_character char (1) unal, 3 18 2 chars char (0 refer (picture_image.piclength)) aligned; 3 19 3 20 dcl ( 3 21 picture_char_type init (24), 3 22 picture_realfix_type init (25), 3 23 picture_complexfix_type 3 24 init (26), 3 25 picture_realflo_type init (27), 3 26 picture_complexflo_type 3 27 init (28) 3 28 ) fixed bin (8) unal static internal options (constant); 3 29 3 30 /* END INCLUDE FILE ... picture_image.incl.pl1 */ 2516 2517 2518 2519 /**** see if a picture is here */ 2520 Pic = ""; 2521 Pic_l = 0; 2522 pi_p = addr (buff); 2523 pi.scale = 0; 2524 format_i = format_i + 1; /* skip the "^" */ 2525 if (substr (lformat, format_i, 1) = "^") 2526 then do; /* Just wants a "^" */ 2527 format_i = format_i + 1; 2528 lresult = lresult || "^"; 2529 exit_selector: 2530 return; 2531 end; 2532 if (substr (lformat, format_i, 1) = "<") 2533 then do; /* imbedded ^ */ 2534 /**** Replace the keyword reference with it's associated string. */ 2535 /**** This is done in such a manner so as to avoid any string temporaries */ 2536 /**** other than the compiler assigned one to receive cv_fmt_kwd output. */ 2537 /**** The "----------" comments below are intended to show how the pieces */ 2538 /**** of the string "BBB^AAA" are manipulated. xxx is converted kk. */ 2539 errloc = format_i+1; /* point to beginning of keyword */ 2540 /* ..in case an error occurs */ 2541 temp_512_v /* ------------"kk" */ 2542 = before (substr (lformat, errloc), ">"); 2543 i = min(errlocad.n+1, hbound(errlocad.keywords,1)); 2544 errlocad.start(i) = format_i-1; 2545 errlocad.enclosed_key(i) = 1; 2546 errlocad.old_len(i) = length(temp_512_v) + length("^<>"); 2547 /* remember start/length of keyword. */ 2548 temp_512_v /* ------------"xxx" */ 2549 = cv_fmt_kwd (temp_512_v); 2550 if (lcode ^= 0) 2551 then goto err_exit; 2552 errlocad.new_len(i) = length(temp_512_v); 2553 errlocad.n = i; /* remember length of keyword */ 2554 /* replacement value, so errloc can */ 2555 /* be adjusted if an error occurs. */ 2556 temp_512_v = temp_512_v /* ------------"xxxAAA" */ 2557 || after (substr (lformat, errloc), ">"); 2558 format_i = format_i -1; /* set scan index properly */ 2559 lformat /* ------------"BBB" */ 2560 = substr (lformat, 1, format_i-1); 2561 lformat /* ------------"BBBxxxAAA" */ 2562 = lformat || temp_512_v; 2563 goto exit_selector; /* and that's all we do, no output */ 2564 end; 2565 i = verify (substr (lformat, format_i), "abcefksvxzXZ9().,-+O012345678"); 2566 if (i = 0) 2567 then i = length (lformat) - format_i + 1; 2568 else i = i - 1; 2569 /**** There is some overlap between valid picture characters and selector */ 2570 /**** characters. This is not an ambiguity, but does require this special */ 2571 /**** handling, since determining the picture length is very simplistic. */ 2572 if (substr (lformat, format_i + i - 1, length ("f")) = "f") 2573 then i = i - 1; 2574 else if (substr (lformat, format_i + i - 1, length ("zn")) = "zn") 2575 | (substr (lformat, format_i + i - 1, length ("zd")) = "zd") 2576 then i = i - 1; 2577 else if (i > 1) then do; /* ^za can be followed by .,+- et al*/ 2578 ii = index(substr (lformat, format_i, i), "za"); 2579 if ii > 0 2580 then i = ii-1; 2581 end; 2582 if (i > 0) 2583 then do; 2584 Pic_l = i; 2585 if (Pic_l > length (Pic)) 2586 then do; 2587 lcode = binary (error_table_$picture_too_big); 2588 errloc = format_i; 2589 goto err_exit; 2590 end; 2591 Pic = substr (lformat, format_i, Pic_l); 2592 picloc = format_i; /* in case there is an error later */ 2593 format_i = format_i + Pic_l; 2594 end; 2595 if (format_i ^< length (lformat)) 2596 then do; /* no room for selector */ 2597 errloc = length (lformat) + 1; 2598 goto bad_selector; 2599 end; 2600 errloc = format_i; /* set up in case failure next */ 2601 i = index (string (selector), substr (lformat, format_i, 2)); 2602 if (i = 0) 2603 then do; 2604 bad_selector: 2605 lcode = binary (error_table_$dt_bad_format_selector); 2606 err_exit: 2607 errlocad.unadjusted_errloc = errloc; 2608 do i = lbound(errlocad.keywords,1) to errlocad.n; 2609 if errloc > errlocad.start(i) then do; 2610 if errloc > errlocad.start(i) - 1 + errlocad.new_len(i) 2611 then errloc = errloc - errlocad.new_len(i)+errlocad.old_len(i); 2612 else errloc = errlocad.start(i) + 2613 errlocad.enclosed_key(i)*length("^<"); 2614 end; 2615 end; 2616 return; 2617 end; 2618 ftype = divide (i + 1, 2, 17); 2619 format_i = format_i + 2; 2620 on condition (conversion) /* just in case he blows it */ 2621 begin; 2622 lcode = binary (error_table_$bad_conversion); 2623 goto err_exit; 2624 end; 2625 on condition (size) /* just in case he blows it */ 2626 begin; 2627 lcode = binary (error_table_$size_error); 2628 goto err_exit; 2629 end; 2630 Pic_supplied: 2631 if (Pic ^= "") 2632 then do; 2633 Pic_expand: 2634 picp = addr (Pic); 2635 picl = Pic_l; 2636 i = index (picv, "("); 2637 if (i > 0) 2638 then do; 2639 if (i > 1) 2640 then do; 2641 if (substr (Pic, i - 1, length ("f")) = "f") 2642 then goto Pic_expanded; /* it's a scale factor */ 2643 end; 2644 ii = index (picv, ")"); 2645 if (ii < i) | (ii = Pic_l) 2646 then goto pic_syntax; 2647 i1 = ii - i - 1; /* length of the repeat number */ 2648 i2 = convert (i2, substr (Pic, i + 1, i1)); 2649 Pic = substr (Pic, 1, i - 1) 2650 || copy (substr (Pic, ii + 1, 1), i2 - 1) 2651 || substr (Pic, ii + 1); 2652 Pic_l = Pic_l - i1 - length ("()9") + i2; 2653 goto Pic_expand; 2654 end; 2655 Pic_expanded: 2656 Ar_ct = verify (reverse (substr (Pic, 1, Pic_l)), "X"); 2657 if (Ar_ct = 0) 2658 then Ar_ct = Pic_l; 2659 else Ar_ct = Ar_ct - 1; 2660 if (Ar_ct > 0) 2661 then substr (Pic, Pic_l - Ar_ct + 1, Ar_ct) = copy ("x", Ar_ct); 2662 2663 Zr_ct = verify (reverse (substr (Pic, 1, Pic_l)), "Z"); 2664 if (Zr_ct ^= 0) /* if its all Z's, use them left */ 2665 then do; 2666 Zr_ct = Zr_ct - 1; 2667 if (Zr_ct > 0) 2668 then substr (Pic, Pic_l - Zr_ct + 1, Zr_ct) = copy ("9", Zr_ct); 2669 end; 2670 2671 Zl_ct = verify (substr (Pic, 1, Pic_l), "Z"); 2672 if (Zl_ct = 0) 2673 then Zl_ct = Pic_l; 2674 else Zl_ct = Zl_ct - 1; 2675 if (Zl_ct > 0) 2676 then substr (Pic, 1, Zl_ct) = copy ("z", Zl_ct); 2677 2678 /**** Os may appear scattered around in a picture. */ 2679 if (index (substr (Pic, 1, Pic_l), "O") = 0) 2680 then Ol_sw = ""b; 2681 else do; /* There is at least 1 O present */ 2682 Ol_sw = "1"b; 2683 PIC = Pic; /* keep the original for reference. */ 2684 i = index (PIC, "v"); /* ..The presence of a "v" does not */ 2685 if (i ^= 0) /* ..produce a result character, so */ 2686 then do; /* ..remove it. */ 2687 substr (PIC, i) = substr (PIC, i+1); 2688 Pic_l = Pic_l - 1; 2689 end; 2690 /**** O's in the midst of z's cannot translate to 9's. Check for this */ 2691 i = verify (Pic, "ZOz"); 2692 if (i = 0) 2693 then i = Pic_l + 1; 2694 if (i > 0) 2695 then do; 2696 i = i - 1; 2697 substr (Pic, 1, i) = translate (substr (Pic, 1, i), "z", "O"); 2698 end; 2699 Pic = translate (Pic, "9", "O"); /* make working copy "proper" */ 2700 end; 2701 2702 call picture_info_ ((picv), pi_p, picture_code); 2703 /* let PL/I routine process it */ 2704 if (picture_code ^= 0) /* Oh, */ 2705 then do; /* ...you didnt like that one! */ 2706 if (picture_code = 434) 2707 then lcode = binary (error_table_$picture_scale); 2708 else if (picture_code < 434) 2709 then lcode = binary (error_table_$picture_too_big); 2710 else do; 2711 pic_syntax: 2712 lcode = binary (error_table_$picture_bad); 2713 end; 2714 errloc = picloc; 2715 goto exit_selector; 2716 end; 2717 target_length = pi.prec + 262144 * (pi.scale - pi.scalefactor); 2718 end; 2719 fld24 = 0; 2720 if testing_format 2721 then goto exit_selector; 2722 goto sel (ftype); 2723 dcl pic25 pic "(25)-9"; 2724 dcl ch64 char (64) var; 2725 sel_pic2: 2726 lresult = lresult || pic2; 2727 goto exit_selector; 2728 sel_ascii: 2729 if (Pic_l = 0) 2730 then do; 2731 lresult = lresult || ch64; 2732 goto exit_selector; 2733 end; 2734 arg_p = addr (ch64); 2735 arg_t = 44; 2736 arg_l = length (ch64); 2737 goto sel_done; 2738 2739 sel_dec_pic: 2740 if (Pic_l = 0) 2741 then do; 2742 pic25 = fld24; 2743 lresult = lresult || ltrim (pic25); 2744 goto exit_selector; 2745 end; 2746 sel_dec: 2747 arg_p = addr (fld24); 2748 arg_t = 20; 2749 arg_l = 24; 2750 sel_done: 2751 /**** picture_info_ has decided what type pack_picture_ is going to need */ 2752 /**** to be able to get it's job done. We must convert the value we have */ 2753 /**** into that needed type. */ 2754 begin; 2755 /**** If a character value is assigned to a picture which has too few */ 2756 /**** ..characters, assign_ signals stringsize. The default system */ 2757 /**** ..action is to truncate without comment. We want that. We don't */ 2758 /**** ..want someone else's handler to get in the way so we make our own. */ 2759 on stringsize system; 2760 call assign_ (addr (temp), map_type (pi.type), target_length, 2761 arg_p, arg_t, arg_l); 2762 dcl stringsize condition; 2763 end; 2764 call pack_picture_ (addr (target) -> bit1, buff, temp); 2765 2766 pictured = substr (target, 1, pi.varlength); 2767 2768 /**** The "O" processing must be done first, because the characters to be */ 2769 /**** worked on are position dependant. */ 2770 if Ol_sw 2771 then do; /* copy all characters which did not */ 2772 pictured = ""; /* ..have a "O" in the picture. Note */ 2773 do i = 1 to Pic_l; /* ..that "v" was removed above. */ 2774 if (substr (PIC, i, 1) ^= "O") 2775 then pictured = pictured || substr (target, i, 1); 2776 end; 2777 end; 2778 2779 if (Ar_ct > 0) 2780 then do; /* rtrim up to Ar_ct spaces */ 2781 i = verify (reverse (pictured), " "); 2782 if (i = 0) 2783 then i = length (pictured); 2784 else i = i - 1; 2785 i = length (pictured) - min (i, Ar_ct); 2786 pictured = substr (pictured, 1, i); 2787 end; 2788 else if (Zr_ct > 0) /* rtrim up to Zr_ct zeroes */ 2789 then do; 2790 i = verify (reverse (pictured), "0"); 2791 if (i = 0) 2792 then i = length (pictured); 2793 else i = i - 1; 2794 i = length (pictured) - min (i, Zr_ct); 2795 pictured = substr (pictured, 1, i); 2796 end; 2797 2798 if (Zl_ct > 0) 2799 then do; /* ltrim up to Zl_ct spaces */ 2800 i = verify (pictured, " "); 2801 if (i = 0) 2802 then i = length (pictured); 2803 else i = i - 1; 2804 i = min (i, Zl_ct); 2805 if (i = length (pictured)) 2806 then pictured = ""; 2807 else pictured = substr (pictured, i + 1); 2808 end; 2809 2810 /**** After all that, add what's left to the string being built. */ 2811 lresult = lresult || pictured; 2812 goto exit_selector; 2813 /**** Usecond is a 0-based quantity. Thus any of the 1-based quantities */ 2814 /**** will have to have 1 subtracted in order to "fit". */ 2815 sel (23): /* "Uc", "(18)Z9" Usec of calendar */ 2816 fld24 = cal_val.x; /* Uc is 0-based */ 2817 goto sel_dec_pic; 2818 2819 sel (27): /* "Uy", "(14)Z9" Usecond of year */ 2820 fld24 = time_value.dy - 1; /* dy is 1-based */ 2821 goto sel (24); 2822 2823 sel (25): /* "Um", "(13)Z9 Usecond of month */ 2824 fld24 = time_value.dm - 1; /* dm is 1-based */ 2825 goto sel (24); 2826 2827 sel (26): /* "Uw", "(12)Z9" Usecond of week */ 2828 fld24 = time_value.dw - 1; /* dw is 1-based */ 2829 2830 sel (24): /* "Ud", "(11)Z9" Usecond of day */ 2831 fld24 = fld24 * 24 + time_value.Hd; /* Hd is 0-based */ 2832 2833 sel (20): /* "UH", "(10)Z9" Usecond of Hour */ 2834 fld24 = fld24 * 60 + time_value.MH; /* MH is 0-based */ 2835 2836 sel (21): /* "UM", "(8)Z9" Usecond of Minute*/ 2837 fld24 = fld24 * 60 + time_value.SM; /* SM is 0-based */ 2838 2839 sel (22): /* "US", "(5)Z9" Usecond of Second*/ 2840 fld24 = fld24 * 1e6 + time_value.US; /* US is 0-based */ 2841 goto sel_dec_pic; 2842 2843 sel (15): /* "Sc", "(12)Z9" Sec of calendar */ 2844 fld24 = convert (fld24, cal_val.x) / 1e6; 2845 goto sel_dec_pic; 2846 2847 sel (19): /* "Sy", "(12)Z9" Second of year */ 2848 fld24 = time_value.dy - 1; 2849 goto sel (16); 2850 2851 sel (17): /* "Sm", "(8)Z9" Second of month */ 2852 fld24 = time_value.dm - 1; 2853 goto sel (16); 2854 2855 sel (18): /* "Sw", "(6)Z9" Second of week */ 2856 fld24 = time_value.dw - 1; 2857 2858 sel (16): /* "Sd", "(5)Z9" Second of day */ 2859 fld24 = fld24 * 24 + time_value.Hd; 2860 2861 sel (13): /* "SH", "(4)Z9" Second of Hour */ 2862 fld24 = fld24 * 60 + time_value.MH; 2863 fld24 = fld24 * 60 + time_value.SM; 2864 SM_fraction: 2865 if (pi.scale > 0) 2866 then fld24 = fld24 + convert (fld24, time_value.US) / 1e6; 2867 goto sel_dec_pic; 2868 2869 sel (14): /* "SM", "99" Second of Minute */ 2870 if (Pic_l > 0) 2871 then do; 2872 fld24 = time_value.SM; 2873 goto SM_fraction; 2874 end; 2875 pic2 = time_value.SM; 2876 goto sel_pic2; 2877 2878 sel (08): /* "Mc", "(10)Z9" Min of calendar */ 2879 fld24 = convert (fld24, cal_val.x) / 6e7; /* 60*1e6 */ 2880 goto sel_dec_pic; 2881 2882 sel (12): /* "My", "(6)Z9" Minute of year */ 2883 fld24 = time_value.dy - 1; 2884 goto sel (09); 2885 2886 sel (10): /* "Mm", "(5)Z9" Minute of month */ 2887 fld24 = time_value.dm - 1; 2888 goto sel (09); 2889 2890 sel (11): /* "Mw", "(5)Z9" Minute of week */ 2891 fld24 = time_value.dw - 1; 2892 2893 sel (09): /* "Md", "(4)Z9" Minute of day */ 2894 fld24 = fld24 * 24 + time_value.Hd; 2895 fld24 = fld24 * 60 + time_value.MH; 2896 MH_fraction: 2897 if (pi.scale > 0) 2898 then do; 2899 fld24 = fld24 + convert (fld24, time_value.SM) / 60; 2900 fld24 = fld24 + convert (fld24, time_value.US) / 6e7; /* 60*1e6 */ 2901 end; 2902 goto sel_dec_pic; 2903 2904 sel (07): /* "MH", "99" Minute of Hour */ 2905 if (Pic_l > 0) 2906 then do; 2907 fld24 = time_value.MH; 2908 goto MH_fraction; 2909 end; 2910 pic2 = time_value.MH; 2911 goto sel_pic2; 2912 2913 sel (01): /* "Hc", "(8)Z9" Hour of calendar */ 2914 fld24 = convert (fld24, cal_val.x) / 36e8; /* 60*60*1e6 */ 2915 goto sel_dec_pic; 2916 2917 sel (06): /* "Hy", "(4)Z9" Hour of year */ 2918 fld24 = time_value.dy - 1; 2919 goto Hday; 2920 2921 sel (04): /* "Hm", "(3)Z9" Hour of month */ 2922 fld24 = time_value.dm - 1; 2923 goto Hday; 2924 2925 sel (05): /* "Hw", "(3)Z9" Hour of week */ 2926 fld24 = time_value.dw - 1; 2927 Hday: 2928 fld24 = fld24 * 24 + time_value.Hd; 2929 Hd_fraction: 2930 if (pi.scale > 0) 2931 then do; 2932 fld24 = fld24 + convert (fld24, time_value.MH) / 60; 2933 fld24 = fld24 + convert (fld24, time_value.SM) / 36e2; /* 60*60 */ 2934 fld24 = fld24 + convert (fld24, time_value.US) / 36e8; /* 60*60*1e6 */ 2935 end; 2936 goto sel_dec_pic; 2937 2938 sel (02): /* "Hd", "99" Hour of day */ 2939 if (Pic_l > 0) 2940 then do; 2941 fld24 = time_value.Hd; 2942 goto Hd_fraction; 2943 end; 2944 pic2 = time_value.Hd; 2945 goto sel_pic2; 2946 2947 sel (03): /* "Hh", "99" Hour of half-day */ 2948 fx2 = time_value.Hd; 2949 if (fx2 > 11) then fx2 = fx2 - 12; 2950 if (fx2 = 00) then fx2 = 12; 2951 if (Pic_l > 0) 2952 then do; 2953 fld24 = fx2; 2954 goto Hd_fraction; 2955 end; 2956 pic2 = fx2; 2957 goto sel_pic2; 2958 2959 sel (29): /* "dc", "(7)Z9" day of calendar */ 2960 fld24 = time_value.dc; 2961 dc_fraction: 2962 if (pi.scale > 0) 2963 then do; 2964 fld24 = fld24 + convert (fld24, time_value.Hd) / 24; 2965 fld24 = fld24 + convert (fld24, time_value.MH) / 1440; /* 24*60 */ 2966 fld24 = fld24 + convert (fld24, time_value.SM) / 864e2; /* ..*60 */ 2967 fld24 = fld24 + convert (fld24, time_value.US) / 864e8; /* ..*1e6 */ 2968 end; 2969 goto sel_dec_pic; 2970 2971 sel (33): /* "dy", "999" day of year */ 2972 if (Pic_l = 0) 2973 then do; /* if no specification, */ 2974 Pic = "999"; /* ..we shall supply the default */ 2975 Pic_l = 3; /* ..and go fake it. */ 2976 goto Pic_expand; /* ....(It'll be back) */ 2977 end; /* This is not optimized in any way */ 2978 fld24 = time_value.dy; /* ..because it is felt to be a low */ 2979 goto dc_fraction; /* ..usage datum. */ 2980 2981 sel (30): /* "dm", "99" day of month */ 2982 /**** Given: clock ^99v.9999dm feb15m ut -zone z +12hr */ 2983 /**** you get: 15.5000 */ 2984 /**** i.e. 12 hours into feb15 is .5 day */ 2985 2986 if (Pic_l > 0) 2987 then do; 2988 fld24 = time_value.dm; 2989 goto dc_fraction; 2990 end; 2991 pic2 = time_value.dm; 2992 goto sel_pic2; 2993 2994 sel (32): /* "dw", "9" day of week */ 2995 if (Pic_l > 0) 2996 then do; 2997 fld24 = time_value.dw; 2998 goto dc_fraction; 2999 end; 3000 lresult = lresult || substr ("1234567", time_value.dw, 1); 3001 goto exit_selector; 3002 3003 sel (28): /* "da", "(8)X" day abbrev */ 3004 if format_max 3005 then do; 3006 ch64 = ""; 3007 do i = 1 to 7; 3008 if length (ch64) < length (ti_day.short (lang_index, i)) 3009 then ch64 = ti_day.short (lang_index, i); 3010 end; 3011 end; 3012 else ch64 = ti_day.short (lang_index, time_value.dw); 3013 goto sel_ascii; 3014 3015 sel (31): /* "dn", "(15)X" day name */ 3016 if format_max 3017 then do; 3018 ch64 = ""; 3019 do i = 1 to 7; 3020 if length (ch64) < length (ti_day.long (lang_index, i)) 3021 then ch64 = ti_day.long (lang_index, i); 3022 end; 3023 end; 3024 else ch64 = ti_day.long (lang_index, time_value.dw); 3025 goto sel_ascii; 3026 3027 sel (42): /* "fi", "aa" fiscal indicator */ 3028 ch64 = ti_word.word (lang_index, tiw_FiscalIndicator); 3029 goto sel_ascii; 3030 3031 sel (34): /* "fw", "OOO999" fiscal week */ 3032 if (Pic_l = 0) 3033 then do; /* if no specification, */ 3034 Pic = "OOO999"; /* ..we shall supply the default */ 3035 Pic_l = 6; /* ..and go fake it. */ 3036 goto Pic_expand; /* ....(It'll be back) */ 3037 end; 3038 fld24 = time_value.fw; 3039 goto sel_dec_pic; 3040 3041 sel (38): /* "my", "99" month of year */ 3042 if (Pic_l > 0) 3043 then do; 3044 fld24 = time_value.my; 3045 if (pi.scale ^= 0) 3046 then do; 3047 /**** How many days in the month? */ 3048 if (time_value.my = FEBRUARY) 3049 then unit_size = 28 + calc_leap_day ((time_value.yc)); 3050 else unit_size = days_in_month (time_value.my); 3051 /**** How many microseconds is that? (-1 bias helps roundoff problem) */ 3052 unit_size = (unit_size * 864) * 100000000 - 1; 3053 t_interval = time_value.dm - 1; 3054 t_interval = t_interval * 024 + time_value.Hd; 3055 t_interval = t_interval * 060 + time_value.MH; 3056 t_interval = t_interval * 060 + time_value.SM; 3057 t_interval = t_interval * 1000000 + time_value.US; 3058 fld24 = fld24 + make_fraction (t_interval, unit_size); 3059 end; 3060 goto sel_dec; 3061 end; 3062 pic2 = time_value.my; 3063 goto sel_pic2; 3064 3065 sel (37): /* "mn", "(15)X" month name */ 3066 if format_max 3067 then do; 3068 ch64 = ""; 3069 do i = 1 to 12; 3070 if length (ch64) < length (ti_month.long (lang_index, i)) 3071 then ch64 = ti_month.long (lang_index, i); 3072 end; 3073 end; 3074 else ch64 = ti_month.long (lang_index, time_value.my); 3075 goto sel_ascii; 3076 3077 sel (35): /* "ma", "(8)X" month abbrev */ 3078 if format_max 3079 then do; 3080 ch64 = ""; 3081 do i = 1 to 12; 3082 if length (ch64) < length (ti_month.short (lang_index, i)) 3083 then ch64 = ti_month.short (lang_index, i); 3084 end; 3085 end; 3086 else ch64 = ti_month.short (lang_index, time_value.my); 3087 goto sel_ascii; 3088 3089 sel (39): /* "yc", "OO99" year of calendar */ 3090 if (Pic_l > 0) 3091 then do; 3092 fld24 = time_value.yc; 3093 if (pi.scale ^= 0) 3094 then do; 3095 /**** How many days in the year? */ 3096 if (time_value.yc = 1582) 3097 then unit_size = 355; 3098 else unit_size = 365 + calc_leap_day (time_value.yc); 3099 /**** How many microseconds is that? (-1 bias helps roundoff problem) */ 3100 unit_size = (unit_size * 864) * 100000000 - 1; 3101 t_interval = time_value.dy - 1; 3102 t_interval = t_interval * 024 + time_value.Hd; 3103 t_interval = t_interval * 060 + time_value.MH; 3104 t_interval = t_interval * 060 + time_value.SM; 3105 t_interval = t_interval * 1000000 + time_value.US; 3106 fld24 = fld24 + make_fraction (t_interval, unit_size); 3107 end; 3108 goto sel_dec; 3109 end; 3110 pic2 = mod (time_value.yc, 100); 3111 goto sel_pic2; 3112 3113 sel (36): /* "mi", "a" meridiem indic. */ 3114 if (time_value.Hd < 12) 3115 then ch64 = "A"; 3116 else ch64 = "P"; 3117 goto sel_ascii; 3118 3119 sel (41): /* "zn", "(64)X" zone name */ 3120 if format_max 3121 then do; 3122 ch64 = ""; 3123 do i = 1 to ti_zone.number_zone; 3124 if length (ch64) < length (ti_zone.long (lang_index, i)) 3125 then ch64 = ti_zone.long (lang_index, i); 3126 end; 3127 end; 3128 else ch64 = ti_zone.long (lang_index, time_value.zone_index); 3129 goto sel_ascii; 3130 3131 sel (40): /* "za", "(8)X" zone abbrev */ 3132 if format_max 3133 then do; 3134 ch64 = ""; 3135 do i = 1 to ti_zone.number_zone; 3136 if length (ch64) < length (ti_zone.short (lang_index, i)) 3137 then ch64 = ti_zone.short (lang_index, i); 3138 end; 3139 end; 3140 else ch64 = ti_zone.short (lang_index, time_value.zone_index); 3141 goto sel_ascii; 3142 3143 sel (43): /* "zd", "s9999" z. differential */ 3144 ch64 = zone_dif (ti_zone.delta (lang_index, time_value.zone_index)); 3145 goto sel_ascii; 3146 3147 zone_dif: proc (td) returns (char (5)); 3148 dcl td fixed bin (71); 3149 3150 dcl time fixed bin (71); 3151 dcl 1 result, 3152 2 s char (1), 3153 2 (HH,MM) pic "99"; 3154 3155 time = td; 3156 s = "-"; /* values stored in table have */ 3157 if (time < 0) /* ..opposite sign from the way it */ 3158 then do; /* ..is displayed. */ 3159 s = "+"; 3160 time = -time; 3161 end; 3162 HH, i = divide (time, 3600000000, 17, 0); 3163 time = time - i*3600000000; 3164 MM = divide (time, 60000000, 17, 0); 3165 return (string (result)); 3166 end zone_dif; 3167 3168 end proc_selector; /* <##> */ 3169 /* @@@@@@ int proc .. vc_2_Multics */ 3170 /* ***********************************+************************************* */ 3171 /* ***********************************+************************************* */ 3172 vc_2_Multics: proc (cval, Mval); /* <<##>> */ 3173 3174 dcl 1 cval like cal_val, /* virtual value [In]*/ 3175 Mval fixed bin (71); /* Multics value [Out]*/ 3176 3177 dcl ( 3178 error_table_$dt_date_too_big, /* <##> */ 3179 error_table_$dt_date_too_small /* <##> */ 3180 ) fixed bin (35) ext static; 3181 3182 Mval = 0; 3183 if (cval.x > max_vc_value) 3184 then lcode = binary (error_table_$dt_date_too_big); 3185 else if (cval.x < 0) 3186 then lcode = binary (error_table_$dt_date_too_small); 3187 else Mval /* make GMT Multics value */ 3188 = cval.x - M_vc_adjust + cval.dx; 3189 return; 3190 3191 end vc_2_Multics; /* <##> */ 3192 /* @@@@@@ int proc .. ymd_to_days */ 3193 /* ************************************************************************* */ 3194 /**** This converts either yc,my,dm or yc,dy into dc. fw is ignored */ 3195 /**** cal_val.J_G is set to reflect Julian or Gregorian */ 3196 /* ************************************************************************* */ 3197 3198 ymd_to_days: proc; /* <<##>> */ 3199 3200 dcl adjustment fixed bin; 3201 dcl ( 3202 error_table_$dt_bad_dm, /* <##> */ 3203 error_table_$dt_bad_dy, /* <##> */ 3204 error_table_$dt_bad_my, /* <##> */ 3205 error_table_$dt_date_not_exist /* <##> */ 3206 ) fixed bin (35) ext static; 3207 3208 /**** Figure out which calendar we are in. */ 3209 cal_val.J_G = Gregorian; 3210 if (time_value.yc < 1583) 3211 then do; 3212 cal_val.J_G = Julian; 3213 if (time_value.yc = 1582) 3214 then do; /* 1582 only had 355 days */ 3215 if (time_value.dy > 355) 3216 then do; 3217 lcode = binary (error_table_$dt_bad_dy); 3218 return; 3219 end; 3220 if (time_value.dy > 277) /* > 1582-10-04 */ 3221 | (time_value.my > OCTOBER) 3222 then cal_val.J_G = Gregorian; 3223 else if (time_value.my = OCTOBER) 3224 then do; 3225 if (time_value.dm > 14) 3226 then cal_val.J_G = Gregorian; 3227 else if (time_value.dm > 4) 3228 then do; 3229 lcode = binary (error_table_$dt_date_not_exist); 3230 return; 3231 end; 3232 end; 3233 end; 3234 end; 3235 /**** Break down the date into the cycles it contains and find if leap year. */ 3236 A, B, C = 1; 3237 lyear = time_value.yc - 1; /* yc is 1-based, we need 0-based */ 3238 if (cal_val.J_G = Julian) 3239 then num_of__400s, num_of__100s = 0; 3240 else do; 3241 num_of__400s = divide (lyear, 400, 17); 3242 lyear = lyear - num_of__400s * 400; 3243 if (lyear = 399) then C = 0; 3244 3245 num_of__100s = divide (lyear, 100, 17); 3246 lyear = lyear - num_of__100s * 100; 3247 if (lyear = 99) then B = 0; 3248 end; 3249 num_of____4s = divide (lyear, 4, 2); 3250 num_of____1s = lyear - num_of____4s * 4; 3251 3252 if (num_of____1s >= 3) /* =4 on last day of leap year */ 3253 then A = 0; 3254 leap_day = 1 - A + B - C; 3255 /**** figure how many days in calendar prior to this year. */ 3256 lclock_days 3257 = num_of__400s * 146097 3258 + num_of__100s * 36524 3259 + num_of____4s * 1461 3260 + num_of____1s * 365; 3261 3262 if (time_value.dy > 0) 3263 then do; /* day-in-year is given */ 3264 /**** Make sure day-in-year is a valid #. 1582 only has 355 days. */ 3265 if (time_value.dy > 365 + leap_day) 3266 | (time_value.yc = 1582 & time_value.dy > 355) 3267 then do; /* not valid day-in-year */ 3268 lcode = binary (error_table_$dt_bad_dy); 3269 return; 3270 end; 3271 3272 /**** The Gregorian cycles don't know anything about any missing 10 days. */ 3273 /**** The convention used here is that the days are numbered from 1:355 */ 3274 /**** in 1582. Thus the last part of 1582 needs to be pushed up by 10 so */ 3275 /**** it falls in the right place in the cycle. */ 3276 if (time_value.yc = 1582) & (time_value.dy > 277) 3277 then adjustment = 10; /* kept separate for debug display */ 3278 else adjustment = 0; 3279 /**** NOTE1: The base of the Gregorian cycles is 2 days different from */ 3280 /**** the base of the Julian cycle. We must adjust the numbers so that */ 3281 /**** the day-in-calendar of 1582-10-04 is 1 less that of 1582-10-15, */ 3282 /**** since this is the way it occurred. */ 3283 if (cal_val.J_G = Gregorian) 3284 then lclock_days = lclock_days + 2; 3285 3286 lclock_days = lclock_days + adjustment + time_value.dy; 3287 end; 3288 else do; 3289 if (time_value.my < 1) 3290 | (time_value.my > 12) 3291 then do; /* month must be 1:12 */ 3292 lcode = binary (error_table_$dt_bad_my); 3293 return; 3294 end; 3295 if (time_value.dm < 1) /* N days per month */ 3296 | (time_value.dm > days_in_month (time_value.my) 3297 + fixed (time_value.my = FEBRUARY) * leap_day) 3298 then do; /* day must be 1:(SizeOfMonth) */ 3299 lcode = binary (error_table_$dt_bad_dm); 3300 return; 3301 end; 3302 lclock_days = lclock_days + before_month (time_value.my) 3303 + leap_day * fixed (time_value.my > FEBRUARY) + time_value.dm; 3304 if (cal_val.J_G = Gregorian) /* See NOTE1 above */ 3305 then lclock_days = lclock_days + 2; 3306 end; 3307 3308 end ymd_to_days; /* <##> */ 3309 dcl ( 3310 Gregorian init (1), 3311 Julian init (2), 3312 Special init (3), 3313 None init (4), 3314 FEBRUARY init (2), 3315 MARCH init (3), 3316 OCTOBER init (10) 3317 ) fixed bin int static options (constant); 3318 3319 dcl (A, B, C) fixed bin; 3320 dcl lclock_days fixed bin (27); 3321 dcl leap_day fixed bin; /* number of Feb 29's in this year. */ 3322 dcl lyear fixed bin (35); 3323 dcl rest_of__400 fixed bin; /* days left from 400 year cycle */ 3324 dcl rest_of__100 fixed bin; /* days left from 100 year cycle */ 3325 dcl rest_of____4 fixed bin; /* days left from 4 year cycle */ 3326 dcl rest_of____1 fixed bin; /* days left from 1 year cycle */ 3327 3328 dcl num_of__400s fixed bin; /* number of 400 year cycles */ 3329 dcl num_of__100s fixed bin; /* number of 100 year cycles */ 3330 dcl num_of____4s fixed bin; /* number of 4 year cycles */ 3331 dcl num_of____1s fixed bin; /* number of years left */ 3332 dcl cur_unit fixed bin; 3333 dcl day_adjust fixed bin; 3334 dcl diw fixed bin; 3335 dcl fb24 fixed bin (24); 3336 dcl fiscal_week_value fixed bin (24); 3337 dcl fiscal_year_value fixed bin (24); 3338 dcl unit_sizes (3:8) fixed bin (71) int static options (constant) init ( 3339 6048e8, 864e8, 36e8, 6e7, 1e6, 1); 3340 /*** wk da hr min sec Usec */ 3341 dcl temp_clock fixed bin (71); /* holds a Multics clock value */ 3342 dcl arg_l fixed bin (35); 3343 dcl arg_p ptr; 3344 dcl arg_t fixed bin; 3345 dcl AZ char (26) int static options (constant) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"); 3346 dcl az char (26) int static options (constant) init ("abcdefghijklmnopqrstuvwxyz"); 3347 3348 dcl 1 cal_val, /* x+dx gives virtual clock in GMT */ 3349 2 x fixed bin (71), /* calendar value */ 3350 2 dx fixed bin (71), /* delta */ 3351 2 z char (5), /* zone it's in */ 3352 2 zi fixed bin, /* zone_index of cal_val.z */ 3353 /* =0 => cal_val.z is differential */ 3354 2 J_G fixed bin; /* Julian/Gregorian indicator */ 3355 dcl 1 (ref_val, off_val) like cal_val; 3356 3357 /* format: off */ 3358 dcl ( 3359 /* 0 1 2 3 4 5 6 7 8 9 10 11 12 13 */ 3360 /* . jan feb mar apr may jun jul aug sep oct nov dec . */ 3361 days_in_month init (0,031,028,031,030,031,030,031,031,030,031,030,031,000), 3362 before_month init (0,000,031,059,090,120,151,181,212,243,273,304,334,365) 3363 ) (0:13) fixed bin int static options (constant); 3364 /* format: on */ 3365 3366 dcl errloc fixed bin; 3367 dcl 1 errlocad aligned, /* error location adjustments. */ 3368 2 n fixed bin, 3369 2 unadjusted_errloc 3370 fixed bin, 3371 2 keywords (20), 3372 3 start fixed bin, /* column in which keyword started. */ 3373 3 enclosed_key /* =1 for ^ */ 3374 fixed bin, /* =0 for key */ 3375 3 old_len fixed bin, /* length (original keyword). */ 3376 3 new_len fixed bin; /* length (keyword value). */ 3377 dcl fld24 float dec (24); 3378 dcl format_i fixed bin; 3379 dcl i fixed bin; 3380 dcl lang_index fixed bin; 3381 dcl lcode fixed bin (35); 3382 dcl lformat char (512) var; 3383 dcl temp_512_v char (512) var; 3384 dcl lresult char (256) var; 3385 dcl pic2 pic "99"; 3386 dcl pic4 pic "9999"; 3387 dcl picloc fixed bin; 3388 dcl sys_info$time_zone char (4) ext static; 3389 dcl Tday fixed bin; 3390 dcl t_interval fixed bin (71); 3391 dcl Tmonth fixed bin; 3392 dcl Tusec fixed bin (71); 3393 dcl Tyear fixed bin; 3394 dcl unit_size fixed bin (71); 3395 dcl zone_index fixed bin; 3396 3397 dcl 1 auto_time_value aligned like time_value; 3398 dcl 1 auto_time_offset aligned like time_offset; 3399 dcl 1 decoded_clock aligned like time_value; 3400 dcl 1 decoded_ref aligned like time_value; 3401 dcl 1 fs_time_value aligned based, 3402 2 pad1 bit (20) unal, 3403 2 time bit (36) unal, 3404 2 pad2 bit (16) unal; 3405 3406 dcl com_err_ entry options (variable); 3407 dcl date_time_$set_time_defaults entry; 3408 3409 dcl (addr, addrel, after, before, convert, copy, divide, fixed, hbound, index, 3410 lbound, length, ltrim, min, mod, null, precision, reverse, string, substr, 3411 translate, trunc, unspec, verify) builtin; 4 1 /* START OF: time_names_.incl.pl1 * * * * * * * * * * * * * * * * */ 4 2 4 3 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 4 4 /* */ 4 5 /* Name: time_names_.incl.pl1 */ 4 6 /* */ 4 7 /* This include file defines the structure of values in the time_table_. The table */ 4 8 /* includes a list of time zones known to the system, as well as lists of month names */ 4 9 /* and names of days of the week. All names are expressed in several different languages */ 4 10 /* to facilitate transliteration of dates into these languages. The table includes */ 4 11 /* the list of languages in which dates may be expressed. */ 4 12 /* */ 4 13 /* Status */ 4 14 /* */ 4 15 /* 0) Created 06/07/78: J. Falksen */ 4 16 /* 1) Modified 07/04/78: G. Dixon */ 4 17 /* */ 4 18 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 4 19 4 20 4 21 dcl time_info_$version char (8) ext static; /* Version number of all structures in the */ 4 22 /* time_info_. Currently = 1. */ 4 23 dcl Vtime_info_2 char (8) int static options(constant) init("tinfo002"); 4 24 4 25 dcl time_info_$gmt_zone_index fixed bin (17) ext static; 4 26 dcl time_info_$default_language_index fixed bin (17) ext static; 4 27 4 28 dcl time_info_$date_time_keywords fixed bin ext static; /* Table of named date/time format strings */ 4 29 dcl 1 ti_keyword based (addr (time_info_$date_time_keywords)), 4 30 2 number_kwd fixed bin, /* number of keywords present */ 4 31 2 pad fixed bin, 4 32 2 e (0 refer (ti_keyword.number_kwd)), 4 33 3 name char (32), 4 34 3 str char (128)var; 4 35 dcl (site_date init (1), 4 36 site_date_time init (2), 4 37 site_time init (3) 4 38 ) fixed bin int static options (constant); 4 39 4 40 dcl time_info_$language_names fixed bin ext static; /* Table of language names, in various languages */ 4 41 4 42 dcl 1 ti_language based (addr (time_info_$language_names)), 4 43 2 number_lang fixed bin, /* number of language names present */ 4 44 2 pad fixed bin, 4 45 2 name (0 refer (ti_language.number_lang), 0 refer (ti_language.number_lang)) 4 46 char(32) varying; /* Name of the language. */ 4 47 /* All language names are expressed in all languages. name(i,j) gives the */ 4 48 /* jth language name in language i. name(i,i) gives a language name in its */ 4 49 /* own language. */ 4 50 dcl time_info_$month_names fixed bin ext static; /* Table of month names in various languages. */ 4 51 4 52 dcl 1 ti_month based (addr (time_info_$month_names)), 4 53 2 number_lang fixed bin, /* number of languages in the table. */ 4 54 2 pad fixed bin, 4 55 2 e (0 refer (ti_month.number_lang), 12), 4 56 3 short char(8) var, /* short form of a month name, i.e., Nov */ 4 57 3 long char(32) var; /* long form of a month name, i.e. November */ 4 58 dcl time_info_$day_names fixed bin ext static; /* Table of day names in various languages. */ 4 59 4 60 dcl 1 ti_day based (addr (time_info_$day_names)), 4 61 2 number_lang fixed bin, /* number of languages in the table. */ 4 62 2 pad fixed bin, 4 63 2 e (0 refer (ti_day.number_lang), 7), 4 64 3 short char(8) var, /* short for of a day name, i.e. Sat */ 4 65 3 long char(32) var; /* long form of a day name, i.e. Saturday */ 4 66 dcl time_info_$offset_names fixed bin ext static; /* Table of offset names in various languages. */ 4 67 4 68 dcl 1 ti_offset based (addr (time_info_$offset_names)), 4 69 2 number_lang fixed bin, /* number of languages in the table. */ 4 70 2 number_offset fixed bin, 4 71 2 e (0 refer (ti_offset.number_lang), 0 refer (ti_offset.number_offset)), 4 72 3 short char(32) var, /* short form of an offset name, i.e. min */ 4 73 3 plural char(32) var, /* plural form of an offset name, i.e. minutes */ 4 74 3 singular char(32) var, /* singular for of an offset name, i.e. minute */ 4 75 3 this char(32) var; /* "this" which goes with singular */ 4 76 dcl time_info_$word_names fixed bin ext static; /* Table of word names in various languages. */ 4 77 4 78 dcl 1 ti_word based (addr (time_info_$word_names)), 4 79 2 number_lang fixed bin, /* number of languages in the table. */ 4 80 2 number_word fixed bin, 4 81 2 short (0 refer (ti_word.number_lang), 0 refer (ti_word.number_word)) 4 82 char (8) var, 4 83 2 word (0 refer (ti_word.number_lang), 0 refer (ti_word.number_word)) 4 84 char(32) var; /* a "word", i.e. Midnight */ 4 85 4 86 dcl time_info_$zone_names fixed bin ext static; /* Table of known time zones. */ 4 87 4 88 dcl 1 ti_zone based (addr (time_info_$zone_names)), 4 89 2 number_lang fixed bin, /* number of languages in which zone names */ 4 90 /* are defined. */ 4 91 2 number_zone fixed bin, /* number of zone names in the table. */ 4 92 2 e (0 refer (ti_zone.number_lang), 0 refer (ti_zone.number_zone)), 4 93 3 short char(4) var, /* short form of the zone name. */ 4 94 3 long char(64) var, /* long form of the zone name */ 4 95 3 pad fixed bin, 4 96 3 delta fixed bin(71); /* offset, in microseconds, of this time zone */ 4 97 /* from GMT (Greenwich mean time). This value */ 4 98 /* should be subtracted from a clock value */ 4 99 /* (which is expressed in GMT by definition). */ 4 100 /* to obtain a date/time expressed in the */ 4 101 /* named time zone. */ 4 102 /* NOTE: zones are listed in order of descending */ 4 103 /* delta, from +11 to -12. print_time_zones */ 4 104 /* requires this. */ 4 105 4 106 4 107 dcl (tiw_FiscalIndicator init (11) 4 108 ) fixed bin int static options (constant); 4 109 4 110 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 4 111 /* NOTE TO MAINTAINER: Before changing this file, see the comments in */ 4 112 /* time_info_cds.incl.pl1 */ 4 113 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 4 114 4 115 /* END OF: time_names_.incl.pl1 * * * * * * * * * * * * * * * * */ 3412 5 1 /* BEGIN INCLUDE FILE .... time_info_search.incl.pl1 .... 03/16/83 J Falksen */ 5 2 5 3 /* This include file describes an internal interface mainly used by */ 5 4 /* convert_date_to_binary_ to rapidly search the words in time_info_. */ 5 5 /* ** USER PROGRAMS ARE NOT TO USE THIS TABLE. ** */ 5 6 5 7 dcl time_info_$tokens fixed bin ext static; 5 8 /* reference point for token table */ 5 9 5 10 dcl 1 ti_token based (ti_token_p), 5 11 2 count fixed bin, 5 12 2 ambig bit (1)aligned, /* 1- str does not have same */ 5 13 /* ..meaning in all languages */ 5 14 2 item (0 refer (ti_token.count)), 5 15 3 symbol char (32),/* canonical lowercase form */ 5 16 3 list_r bit (18)aligned; 5 17 /**** list_r is the offset of the item list which goes with symbol. To */ 5 18 /**** build a pointer to the list, use: */ 5 19 /**** addrel (addr (time_info_$version), ti_token.list_r (cur_token)) */ 5 20 5 21 5 22 dcl ti_token_p ptr; /* = addr (time_info_$tokens) */ 5 23 5 24 dcl item_p ptr, 5 25 1 item based (item_p)unal, 5 26 2 count fixed bin aligned, /* >1 => diff mean/diff lang */ 5 27 2 e (0 refer (item.count)), 5 28 3 ambig bit (1), /* 1-same mean/diff lang */ 5 29 3 table fixed bin (7) unsigned, /* what table is this */ 5 30 3 element fixed bin (10) unsigned, /* which element in table */ 5 31 3 in_lang bit (18); /* languages using it */ 5 32 5 33 5 34 /**** Note that this last element places a limit of 18 on the */ 5 35 /**** number of languages which may be defined in the table. */ 5 36 5 37 /* The table name values assigned here are as needed by CDTB */ 5 38 dcl (Day_table init (1), 5 39 Language_table init (2), 5 40 Month_table init (3), 5 41 Offset_table init (4), 5 42 Word_table init (5), 5 43 Zone_table init (6), 5 44 This_table init (7) /* resides in offset table */ 5 45 ) fixed bin int static options (constant); 5 46 5 47 dcl mo_name (12) char (3) int static options (constant) init ( 5 48 "Jan", "Feb", "Mar", "Apr", "May", "Jun", 5 49 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"); 5 50 dcl da_name (7) char (3) int static options (constant) init ( 5 51 "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"); 5 52 5 53 dcl the_offset_count fixed bin int static options (constant) init (8); 5 54 dcl of_name (8) char (12) int static options (constant) init ( 5 55 "year", "month", "week", "day", 5 56 "Hour", "Minute", "Second", "Microsecond"); 5 57 5 58 dcl the_word_count fixed bin int static options (constant) init (13); 5 59 dcl wo_name (13) char (12) int static options (constant) init ( 5 60 "Before", "Or", "After", "On", "Noon", "Midnight", "Now", 5 61 "Yesterday", "Today", "Tomorrow", "FiscalWeek", 5 62 "AM", "PM"); 5 63 5 64 5 65 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 66 /* NOTE TO MAINTAINER: Before changing this file, see the comments in */ 5 67 /* time_info_cds.incl.pl1 */ 5 68 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 69 5 70 /* END INCLUDE FILE ..... time_info_search.incl.pl1 ..... */ 3413 6 1 /* BEGIN INCLUDE FILE ..... time_defaults_.incl.pl1 ..... 03/29/83 J Falksen */ 6 2 6 3 6 4 /****^ HISTORY COMMENTS: 6 5* 1) change(86-07-18,GDixon), approve(86-07-25,MCR7495), 6 6* audit(86-07-25,Martinson), install(86-08-19,MR12.0-1120): 6 7* Add declaration for time_defaults_$debug. 6 8* END HISTORY COMMENTS */ 6 9 6 10 6 11 /* This include file defines the values in the time_default_ table. This */ 6 12 /* table declares the name and index (in time_info_) of the user-specified, */ 6 13 /* per-process default time language. Also, the full name, acronym, index */ 6 14 /* and time delta (difference from GMT) of the default time zone. The */ 6 15 /* per-process date_time, date, and time format string are here also. */ 6 16 6 17 /**** date_time_$format control strings */ 6 18 dcl time_defaults_$date_time char (64)var ext static; 6 19 dcl time_defaults_$date char (64)var ext static; 6 20 dcl time_defaults_$time char (64)var ext static; 6 21 6 22 /**** Name of default language in which dates are expressed. */ 6 23 dcl time_defaults_$language char(32) ext static; 6 24 6 25 /**** Value of ti_language_names.index for the default language. */ 6 26 dcl time_defaults_$language_index fixed bin ext static; 6 27 6 28 /**** full name of the default time zone. */ 6 29 dcl time_defaults_$zone_long char(64) var ext static; 6 30 6 31 /**** acronym for default time zone. */ 6 32 dcl time_defaults_$zone_short char(4) var ext static; 6 33 6 34 /**** offset, in microseconds, of default time zone from GMT */ 6 35 dcl time_defaults_$zone_delta fixed bin(71) ext static; 6 36 6 37 /**** index, in time_info_$zone_names, of the default time zone. */ 6 38 dcl time_defaults_$zone_index fixed bin ext static; 6 39 6 40 /**** debug switch controlling debugging within the date/time software. 6 41* Mainly of use in convert_date_to_binary_. */ 6 42 dcl time_defaults_$debug bit(1) aligned ext static; 6 43 6 44 /* END INCLUDE FILE ..... time_defaults_.incl.pl1 ..... */ 3414 7 1 /* START OF* time_value.incl.pl1 * * * * * * * * */ 7 2 7 3 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 7 4 /* */ 7 5 /* Name: time_value.incl.pl1 */ 7 6 /* */ 7 7 /* This structure holds output from date_time_$from_clock */ 7 8 /* and input to date_time_$to_clock */ 7 9 /* (A clock value is a combination of a day portion and a time portion. */ 7 10 /* clock_days represents one part and clock_time the other.) */ 7 11 /* to_clock accepts "day" (as opposed to "time") data only in certain */ 7 12 /* combinations. This table shows with the *'s which fields may be present */ 7 13 /* together. All others must be zero. */ 7 14 /* +-1-+-2-+-3-+-4-+--------------+ */ 7 15 /* | * | * | | | year | In cases 1, 2, & 4, if day_in_week is */ 7 16 /* | * | | | | mm | present, it is used to verify the */ 7 17 /* | * | | | | dd | value converted. */ 7 18 /* | | | * | | fiscal_week | In case 3 it actually defines a day. */ 7 19 /* | | |(*)| | day_in_week | If not present, Monday is assumed. */ 7 20 /* | | * | | | day_in_year | */ 7 21 /* | | | | * | day_in_clock | */ 7 22 /* +-v-+-v-+-v-+-v-+--------------+ */ 7 23 /* | | | +-- clock_days = day_in_calendar */ 7 24 /* | | +------ clock_days = converted (fiscal_week,day_in_week) */ 7 25 /* | +---------- clock_days = converted (year,day_in_year) */ 7 26 /* +-------------- clock_days = converted (year,mm,dd) */ 7 27 /* */ 7 28 /* clock_time = converted (HH,MM,SS,UUUUUU) */ 7 29 /* */ 7 30 /* The zone adjustment may be in one of two forms: */ 7 31 /* if zone^="" then zone_index = INDEX_IN_time_info_OF (zone); */ 7 32 /* [ERROR if not found] */ 7 33 /* if zone="" & zone_index=0 then zone_index = time_defaults_$zone_index */ 7 34 /* After these two steps, if zone_index=0, it is an ERROR. */ 7 35 /* The value in time_info_ of zone_delta (zone_index) is used to adjust */ 7 36 /* clock_time. */ 7 37 /* */ 7 38 /* If leap_year^=0 it is an ERROR. All values are range checked, e.g. */ 7 39 /* year<0 or year>9999. Out-of-range is an ERROR. */ 7 40 /* */ 7 41 /* Refer to time_offset_.incl.pl1 for the structure used to input data to */ 7 42 /* date_time_$offset_to_clock. */ 7 43 /* */ 7 44 /* Status */ 7 45 /* */ 7 46 /* 0) Created by: J. Falksen - 06/20/78 */ 7 47 /* 1) Updated: jaf - 84-11-01 US & fw enlarged to bin(20) */ 7 48 /* */ 7 49 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 7 50 7 51 /* All values in this structure are zone adjusted, not GMT. */ 7 52 7 53 dcl 1 time_value aligned based(Ptime_value), 7 54 2 version char (8), 7 55 2 yc fixed bin, /* Year part of date (eg, 1978) */ 7 56 2 my fixed bin, /* Month part of date (eg, 7= July) */ 7 57 2 dm fixed bin, /* Day of month part of date (eg, 4) */ 7 58 2 Hd fixed bin, /* Hour of the day (eg, 18) */ 7 59 2 MH fixed bin, /* Minute of the hour (eg, 35) */ 7 60 2 SM fixed bin, /* Second of the minute (eg, 59) */ 7 61 2 US fixed bin (20), /* Microseconds in excess of second */ 7 62 2 fw fixed bin (20), /* the digits are yyyyww [OUT] */ 7 63 2 dw fixed bin, /* Day of the week (1=Mon, 7=Sun). */ 7 64 2 dy fixed bin, /* Day of the year */ 7 65 /* (eg, 12/31 = 365 or 366). */ 7 66 2 dc fixed bin(22), /* Day in calendar value */ 7 67 /* (eg, 1 = Jan 1, 0001). */ 7 68 2 Uc fixed bin(71), /* Microsecond in calendar value */ 7 69 /* (eg, 0 = 0001-01-01m) */ 7 70 2 za char (5), /* Zone abbreviation */ 7 71 2 zone_index fixed bin, /* Index in time_table_$zone_names, */ 7 72 /* of zone in which time expressed */ 7 73 2 leap_year fixed bin, /* 1- this is a leap year [OUT] */ 7 74 7 75 Ptime_value ptr, 7 76 Vtime_value_3 char(8) int static options(constant) init("timeval3"); 7 77 7 78 /* END OF* time_value.incl.pl1 * * * * * * * * */ 3415 8 1 /* BEGIN INCLUDE FILE ..... time_offset.incl.pl1 ..... 08/23/79 J Falksen */ 8 2 8 3 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 8 4 /* */ 8 5 /* Name: time_offset.incl.pl1 */ 8 6 /* */ 8 7 /* 1) This structure provides input to date_time_$offset_to_clock. */ 8 8 /* Both integer and real fields may be supplied. Each field containing data */ 8 9 /* must have its use bit set. All values may be positive or negative. */ 8 10 /* a) dw is applied first. */ 8 11 /* b) The size of a year is dependant upon WHICH year. The base year is */ 8 12 /* determined. The (adjusted) clock value is the reference for this. */ 8 13 /* The integral years (whether from fixed, float, or both) are added to */ 8 14 /* this base year. The new base year is used to determine what value the */ 8 15 /* fraction is applied to. */ 8 16 /* c) The size of a month is dependant upon WHICH month of WHICH year. */ 8 17 /* The base year/month is determined. The (adjusted) clock value is the */ 8 18 /* reference for this. The integral months are added to this base month, */ 8 19 /* forming a new base year/month. The new base month in used to determine */ 8 20 /* value the fraction is applied to. */ 8 21 /* d) Values smaller than a month are added "in parallel" because their */ 8 22 /* size is always constant (leap-seconds ignored). */ 8 23 /* */ 8 24 /* 2) This structure receives output from date_time_$from_clock_interval. */ 8 25 /* time_offset.dw is not used. The input values in val are ignored; they */ 8 26 /* are reset. flag specifies the units in which the output is to be */ 8 27 /* expressed and whether the fractional amount is desired. If only the */ 8 28 /* smallest unit is set to receive the fraction it leaves the structure in */ 8 29 /* a state that it may be given to $offset_to_clock without modification. */ 8 30 /* */ 8 31 /* Status */ 8 32 /* 06/07/83 jaf 0) Created */ 8 33 /* 84-11-19 jaf 1) Changed the form of the dw field, added named constants */ 8 34 /* */ 8 35 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 8 36 8 37 dcl 1 time_offset aligned based(Ptime_offset), 8 38 2 version char (8), 8 39 2 flag, 8 40 3 yr fixed bin, 8 41 3 mo fixed bin, 8 42 3 wk fixed bin, 8 43 3 da fixed bin, 8 44 3 hr fixed bin, 8 45 3 min fixed bin, 8 46 3 sec fixed bin, 8 47 3 Usec fixed bin, 8 48 2 val, 8 49 3 yr float dec (20), /* years */ 8 50 3 mo float dec (20), /* months */ 8 51 3 wk float dec (20), /* weeks */ 8 52 3 da float dec (20), /* days */ 8 53 3 hr float dec (20), /* hours */ 8 54 3 min float dec (20), /* minutes */ 8 55 3 sec float dec (20), /* seconds */ 8 56 3 Usec float dec (20), /* microseconds */ 8 57 2 dw, 8 58 3 flag fixed bin, /* how to select day, if at all */ 8 59 3 val fixed bin; /* Day of the week (1=Mon...7=Sun). */ 8 60 8 61 /**** time_offset.flag settings for $offset_to_clock */ 8 62 dcl (UNUSED init (0), /* this offset unit is unused */ 8 63 USED init (1), /* this offset unit has a value */ 8 64 /**** time_offset.flag settings for $from_clock_interval */ 8 65 /****UNUSED init (0), /* this offset unit is unused */ 8 66 INTEGER init (1), /* return interval unit as an integer */ 8 67 FRACTION init (2), /* return interval unit as integer+fraction */ 8 68 /**** offset.dw.flag settings for $offset_to_clock. Tells how to select the */ 8 69 /* day given in offset.dw.val */ 8 70 BEFORE init (-2),/* before day given in clock_in */ 8 71 ON_OR_BEFORE init (-1),/* on or before day given in clock_in */ 8 72 /****UNUSED init (0), /* don't apply day of week offset */ 8 73 ON_OR_AFTER init (1), /* on or after day given in clock_in */ 8 74 AFTER init (2) /* after day given in clock_in */ 8 75 ) fixed bin int static options (constant); 8 76 8 77 dcl Ptime_offset ptr, 8 78 Vtime_offset_2 char (8) int static options(constant) init("timeoff2"); 8 79 8 80 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 8 81 /* */ 8 82 /* Name: time_offset_array_.incl.pl1 */ 8 83 /* */ 8 84 /* This is an array form of time_offset. */ 8 85 /* */ 8 86 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 8 87 8 88 dcl 1 time_offset_array aligned based(Ptime_offset), 8 89 2 version char (8), 8 90 2 flag (8) fixed bin, 8 91 2 val (8) float dec (20), 8 92 2 dw, 8 93 3 (flag, val) fixed bin; 8 94 8 95 /* END INCLUDE FILE ..... time_offset.incl.pl1 ..... */ 3416 3417 3418 /* ***********************************+************************************* */ 3419 /* During debugging, there is an internal procedure named binary which is */ 3420 /* central point thru which all error codes are set. It allows me to catch */ 3421 /* when error codes are being set. Once debugging is complete, the */ 3422 /* definition of it is deleted and the calls revert to the builtin, which */ 3423 /* has no effect on the generated code. */ 3424 /* ***********************************+************************************* */ 3425 dcl binary builtin; 3426 end date_time_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0830.0 date_time_.pl1 >special_ldd>install>MR12.3-1114>date_time_.pl1 472 1 04/16/82 0958.1 sub_err_flags.incl.pl1 >ldd>include>sub_err_flags.incl.pl1 573 2 04/16/82 0958.1 sub_err_flags.incl.pl1 >ldd>include>sub_err_flags.incl.pl1 2516 3 06/28/79 1204.8 picture_image.incl.pl1 >ldd>include>picture_image.incl.pl1 3412 4 09/06/84 0850.2 time_names.incl.pl1 >ldd>include>time_names.incl.pl1 3413 5 09/06/84 0850.2 time_info_search.incl.pl1 >ldd>include>time_info_search.incl.pl1 3414 6 09/02/86 1552.9 time_defaults_.incl.pl1 >ldd>include>time_defaults_.incl.pl1 3415 7 12/21/84 1239.8 time_value.incl.pl1 >ldd>include>time_value.incl.pl1 3416 8 12/21/84 1239.8 time_offset.incl.pl1 >ldd>include>time_offset.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. A 000110 automatic fixed bin(17,0) dcl 3319 in procedure "date_time_" set ref 3236* 3252* 3254 A 000100 automatic fixed bin(17,0) dcl 2031 in procedure "fromclock" set ref 2094* 2113* 2132 ACTION_CANT_RESTART 000254 constant bit(36) initial dcl 1-7 in begin block on line 428 set ref 444* ACTION_CANT_RESTART 000254 constant bit(36) initial dcl 2-7 in begin block on line 561 set ref 562* AFTER constant fixed bin(17,0) initial dcl 8-62 ref 1751 APtime_offset parameter pointer dcl 767 ref 764 782 1158 1184 APtime_value parameter pointer dcl 680 ref 677 693 1495 1518 AZ 000153 constant char(26) initial packed unaligned dcl 3345 ref 2281 Aerrloc parameter fixed bin(17,0) dcl 610 set ref 609 616* 633* Aoff_clock parameter fixed bin(71,0) dcl 767 set ref 764 795 821* Ar_ct 000100 automatic fixed bin(17,0) dcl 2476 set ref 2655* 2657 2657* 2659* 2659 2660 2660 2660 2660 2779 2785 Aref_clock parameter fixed bin(71,0) dcl 767 set ref 764 795 811* Atable parameter fixed bin(17,0) dcl 1038 in procedure "date_time_" set ref 1036 1041* Atable parameter fixed bin(17,0) dcl 2255 in procedure "get_word_index" ref 2253 2263 2270 2302 Atoken parameter char(32) packed unaligned dcl 2255 in procedure "get_word_index" ref 2253 2265 2267 2272 2274 2281 Atoken parameter char packed unaligned dcl 1038 in procedure "date_time_" ref 1036 1041 B 000101 automatic fixed bin(17,0) dcl 2031 in procedure "fromclock" set ref 2094* 2108* 2132 B 000111 automatic fixed bin(17,0) dcl 3319 in procedure "date_time_" set ref 3236* 3247* 3254 BEFORE 017520 constant fixed bin(17,0) initial dcl 8-62 ref 1759 C 000112 automatic fixed bin(17,0) dcl 3319 in procedure "date_time_" set ref 3236* 3243* 3254 C 000102 automatic fixed bin(17,0) dcl 2031 in procedure "fromclock" set ref 2094* 2101* 2132 FEBRUARY constant fixed bin(17,0) initial dcl 3309 ref 915 1789 1852 1876 3048 3295 3302 FRACTION constant fixed bin(17,0) initial dcl 8-62 ref 912 929 Gregorian constant fixed bin(17,0) initial dcl 3309 ref 2079 2401 2411 3209 3220 3225 3283 3304 HH 0(09) 000450 automatic picture(2) level 2 in structure "result" packed packed unaligned dcl 3151 in procedure "zone_dif" set ref 3162* HH 2 001302 automatic picture(4) level 2 in structure "standard" packed packed unaligned dcl 995 in begin block on line 969 set ref 985* Hd 1(18) 000103 automatic picture(2) level 2 in structure "rqid" packed packed unaligned dcl 1266 in procedure "date_time_" set ref 1255* Hd 5 based fixed bin(17,0) level 2 in structure "time_value" dcl 7-53 in procedure "date_time_" set ref 544* 985 1255 1520 1524 1526* 1546 1546 1663 2070* 2830 2858 2893 2927 2941 2944 2947 2964 3054 3102 3113 Hd 5 001176 automatic fixed bin(17,0) level 2 in structure "decoded_clock" dcl 3399 in procedure "date_time_" set ref 1803 1870 J_G 7 000144 automatic fixed bin(17,0) level 2 in structure "cal_val" dcl 3348 in procedure "date_time_" set ref 1629* 1807* 2074 2079 2144 3209* 3212* 3220* 3225* 3238 3283 3304 J_G 7 parameter fixed bin(17,0) level 2 in structure "cval" dcl 2328 in procedure "Multics_2_vc" set ref 2399* 2401* 2403* 2411* Julian constant fixed bin(17,0) initial dcl 3309 ref 2144 2399 3212 3238 Language_table constant fixed bin(17,0) initial dcl 5-38 set ref 440* 528* 1318* 2263 MARCH constant fixed bin(17,0) initial dcl 3309 ref 1796 MH 6 based fixed bin(17,0) level 2 in structure "time_value" dcl 7-53 in procedure "date_time_" set ref 545* 988 1256 1546 1546 1663 2067* 2833 2861 2895 2907 2910 2932 2965 3055 3103 MH 2 000103 automatic picture(2) level 2 in structure "rqid" packed packed unaligned dcl 1266 in procedure "date_time_" set ref 1256* MH 6 001176 automatic fixed bin(17,0) level 2 in structure "decoded_clock" dcl 3399 in procedure "date_time_" set ref 1803 1870 MM 3 001302 automatic picture(5) level 2 in structure "standard" packed packed unaligned dcl 995 in begin block on line 969 set ref 988* MM 0(27) 000450 automatic picture(2) level 2 in structure "result" packed packed unaligned dcl 3151 in procedure "zone_dif" set ref 3164* M_vc_adjust 000200 constant fixed bin(71,0) initial dcl 260 ref 2358 3187 Mval parameter fixed bin(71,0) dcl 2328 in procedure "Multics_2_vc" ref 2326 2358 Mval parameter fixed bin(71,0) dcl 3174 in procedure "vc_2_Multics" set ref 3172 3182* 3187* None constant fixed bin(17,0) initial dcl 3309 ref 1629 1807 OCTOBER constant fixed bin(17,0) initial dcl 3309 ref 1786 1859 3220 3223 Ol_sw 000401 automatic bit(1) packed unaligned dcl 2504 set ref 2679* 2682* 2770 PIC 000161 automatic char(64) packed unaligned dcl 2491 set ref 2683* 2684 2687* 2687 2774 Pic 000141 automatic char(64) packed unaligned dcl 2490 set ref 2520* 2585 2591* 2630 2633 2641 2648 2649* 2649 2649 2649 2655 2660* 2663 2667* 2671 2675* 2679 2683 2691 2697* 2697 2699* 2699 2974* 3034* Pic_l 000306 automatic fixed bin(17,0) dcl 2498 set ref 2521* 2584* 2585 2591 2593 2635 2645 2652* 2652 2655 2657 2660 2663 2667 2671 2672 2679 2688* 2688 2692 2728 2739 2773 2869 2904 2938 2951 2971 2975* 2981 2994 3031 3035* 3041 3089 Ptime_offset 001254 automatic pointer dcl 8-77 set ref 782* 783 791 791 791 791 791 791 791 791 807 807 864 866 882 887 887 893 895 912 917 917 923 928 929 931 931 1184* 1185 1190 Ptime_value 001252 automatic pointer dcl 7-53 set ref 540* 541 542 543 544 545 546 547 548 549 550 551 552 553 554 693* 694 694 810* 820* 876* 906* 974* 975 982 983 984 985 988 988 989 990 1240* 1251 1253 1254 1255 1256 1257 1258 1518* 1520 1520 1522 1523* 1524 1526 1531 1531 1540 1540 1546 1546 1546 1546 1546 1546 1546 1546 1558 1561 1562 1563 1564 1565 1566 1576 1577 1584 1585 1587 1591 1591 1592 1593 1593 1595 1598 1598 1601 1603 1605 1605 1610 1610 1612 1616 1621 1621 1628 1638 1641 1647 1660 1663 1663 1663 1663 1671 1674 1743* 1769* 1799* 1824* 1866* 1971* 1972 2044 2056 2057 2058 2061 2064 2067 2070 2073 2121 2127 2128 2128 2158 2161 2179 2179 2179 2190 2191 2192 2198 2200 2221 2235 2236 2236 2241 2241 2244 2819 2823 2827 2830 2833 2836 2839 2847 2851 2855 2858 2861 2863 2864 2872 2875 2882 2886 2890 2893 2895 2899 2900 2907 2910 2917 2921 2925 2927 2932 2933 2934 2941 2944 2947 2959 2964 2965 2966 2967 2978 2988 2991 2997 3000 3012 3024 3038 3044 3048 3048 3050 3053 3054 3055 3056 3057 3062 3074 3086 3092 3096 3098 3101 3102 3103 3104 3105 3110 3113 3128 3140 3143 3210 3213 3215 3220 3220 3223 3225 3227 3237 3262 3265 3265 3265 3276 3276 3286 3289 3289 3295 3295 3295 3295 3302 3302 3302 SM 7 001176 automatic fixed bin(17,0) level 2 in structure "decoded_clock" dcl 3399 in procedure "date_time_" set ref 1803 1870 SM 7 based fixed bin(17,0) level 2 in structure "time_value" dcl 7-53 in procedure "date_time_" set ref 546* 988 1257 1546 1546 1663 2064* 2836 2863 2872 2875 2899 2933 2966 3056 3104 SM 2(18) 000103 automatic picture(2) level 2 in structure "rqid" packed packed unaligned dcl 1266 in procedure "date_time_" set ref 1257* Special constant fixed bin(17,0) initial dcl 3309 ref 2074 2403 Tday 001040 automatic fixed bin(17,0) dcl 3389 set ref 832* 839* 839 841 852* 852 854 1852* 1854* 1855* 1855 1859 1859 1859* 1862 Tmonth 001044 automatic fixed bin(17,0) dcl 3391 set ref 831* 841* 841 845 848* 848 854* 854 856 859* 859 891* 891 895 896 900 1830* 1832* 1832 1835 1837 1838* 1838 1840 1842 1843* 1843 1852 1854 1859 1863 1876 1878 Tusec 001046 automatic fixed bin(71,0) dcl 3392 set ref 833* 839 852 Tyear 001050 automatic fixed bin(17,0) dcl 3393 set ref 830* 847* 847 858* 858 866 867 869 891 1775* 1778 1779 1789 1837* 1838 1842* 1843 1845* 1846* 1846 1852 1859 1864 1876 UNUSED constant fixed bin(17,0) initial dcl 8-62 ref 1717 1720 1741 1747 1755 US 3 000103 automatic picture(7) level 2 in structure "rqid" packed packed unaligned dcl 1266 in procedure "date_time_" set ref 1258* US 10 based fixed bin(20,0) level 2 in structure "time_value" dcl 7-53 in procedure "date_time_" set ref 547* 1258 1546 1546 1663 2061* 2839 2864 2900 2934 2967 3057 3105 US 10 001176 automatic fixed bin(20,0) level 2 in structure "decoded_clock" dcl 3399 in procedure "date_time_" set ref 1803 1870 Uc 16 based fixed bin(71,0) level 2 dcl 7-53 set ref 551* 2056* Usec 64 based float dec(20) level 3 dcl 8-37 set ref 791* Vtime_info_2 000106 constant char(8) initial packed unaligned dcl 4-23 ref 1343 Vtime_offset_2 000102 constant char(8) initial packed unaligned dcl 8-77 ref 863 1185 Vtime_value_3 000104 constant char(8) initial packed unaligned dcl 7-53 ref 694 975 1531 1972 Zl_ct 000402 automatic fixed bin(17,0) dcl 2505 set ref 2671* 2672 2672* 2674* 2674 2675 2675 2675 2798 2804 Zone_table constant fixed bin(17,0) initial dcl 5-38 set ref 456* 534* 702* 1191* 1191* 1372* 1419* 1423* 1638* 2270 Zr_ct 000403 automatic fixed bin(17,0) dcl 2506 set ref 2663* 2664 2666* 2666 2667 2667 2667 2667 2788 2794 addr builtin function dcl 3409 ref 540 810 820 876 906 967 974 990 1240 1314 1323 1352 1353 1354 1360 1377 1378 1379 1431 1432 1433 1523 1657 1658 1714 1743 1769 1799 1824 1866 1939 1940 1942 1971 2282 2290 2382 2386 2522 2633 2734 2746 2760 2760 2764 3008 3008 3012 3020 3020 3024 3027 3070 3070 3074 3082 3082 3086 3123 3124 3124 3128 3135 3136 3136 3140 3143 addrel builtin function dcl 3409 ref 2290 adjustment 000100 automatic fixed bin(17,0) dcl 3200 set ref 3276* 3278* 3286 after builtin function dcl 3409 ref 2556 arg_l 000136 automatic fixed bin(35,0) dcl 3342 set ref 2736* 2749* 2760* arg_p 000140 automatic pointer dcl 3343 set ref 2734* 2746* 2760* arg_t 000142 automatic fixed bin(17,0) dcl 3344 set ref 2735* 2748* 2760* assign_ 000202 constant entry external dcl 2477 ref 2760 auto_time_offset 001102 automatic structure level 1 dcl 3398 set ref 862* 1190* 1714 auto_time_value 001056 automatic structure level 1 dcl 3397 set ref 1522* 1523 1799 1866 az 000144 constant char(26) initial packed unaligned dcl 3346 ref 2281 before builtin function dcl 3409 ref 2541 before_month 000110 constant fixed bin(17,0) initial array dcl 3358 ref 3302 begin_Gregorian 000206 constant fixed bin(71,0) initial dcl 260 ref 2392 begin_Special 000204 constant fixed bin(71,0) initial dcl 260 ref 2390 binary builtin function dcl 3425 ref 443 461 531 537 696 708 785 1187 1319 1426 1533 1543 1555 1580 1618 1624 1632 1643 1724 1729 1731 1946 2166 2361 2366 2396 2408 2587 2604 2622 2627 2706 2708 2711 3183 3185 3217 3229 3268 3292 3299 bit1 based bit(1) packed unaligned dcl 2479 set ref 2764* buff 000101 automatic fixed bin(17,0) array dcl 2480 set ref 2522 2764* cal_val 000144 automatic structure level 1 unaligned dcl 3348 set ref 466* 627* 713* 812* 822* 871* 873 901* 903 976* 1076* 1191* 1195* 1244* 1682* ch64 000413 automatic varying char(64) dcl 2724 set ref 2731 2734 2736 3006* 3008 3008* 3012* 3018* 3020 3020* 3024* 3027* 3068* 3070 3070* 3074* 3080* 3082 3082* 3086* 3113* 3116* 3122* 3124 3124* 3128* 3134* 3136 3136* 3140* 3143* clock_in_value parameter fixed bin(71,0) dcl 1161 set ref 1158 1191* clock_value parameter fixed bin(71,0) dcl 117 set ref 114 122 416 426 677 713* 1062 1070 1158 1195* 1203 1231 1244* 1495 1682* code parameter fixed bin(35,0) dcl 610 set ref 477* 609 619* 632* 677 696* 708* 716* 764 780* 785* 817* 827* 1158 1183* 1187* 1197* 1295 1308* 1319* 1406 1426* 1435* 1495 1530* 1533* 1543* 1555* 1580* 1618* 1624* 1632* 1643* 1676* 1683* com_err_ 000020 constant entry external dcl 3406 ref 1345 combination 001310 automatic bit(6) packed unaligned dcl 1514 set ref 1561* 1562* 1563* 1564* 1565* 1566* 1567 1567 1574 1614 conversion 000126 stack reference condition dcl 2481 ref 2620 convert builtin function dcl 3409 ref 1648 1648 1817 1818 1882 1883 1889 2319 2320 2376 2376 2648 2843 2864 2878 2899 2900 2913 2932 2933 2934 2964 2965 2966 2967 copy builtin function dcl 3409 ref 2649 2660 2667 2675 count based fixed bin(17,0) level 2 in structure "item" dcl 5-24 in procedure "date_time_" ref 2300 count based fixed bin(17,0) level 2 in structure "ti_token" dcl 5-10 in procedure "date_time_" ref 2285 ct 000202 automatic fixed bin(17,0) dcl 1926 set ref 1929* 1953 1955* cur_token 001342 automatic fixed bin(17,0) dcl 2260 set ref 2287* 2288 2290 2294 2294 2296 cur_unit 000126 automatic fixed bin(17,0) dcl 3332 set ref 922* 923 925 928 929 931 931* cval parameter structure level 1 unaligned dcl 3174 in procedure "vc_2_Multics" ref 3172 cval parameter structure level 1 unaligned dcl 2328 in procedure "Multics_2_vc" set ref 2326 da 5(09) 001302 automatic char(3) level 2 in structure "standard" packed packed unaligned dcl 995 in begin block on line 969 set ref 990* da 34 based float dec(20) level 3 in structure "time_offset" dcl 8-37 in procedure "date_time_" set ref 791* date_time_$set_time_defaults 000022 constant entry external dcl 3407 ref 438 526 699 788 970 1073 1241 1306 1417 1536 day_adjust 000127 automatic fixed bin(17,0) dcl 3333 set ref 1519* 1527* 1621 1636 day_for_fiscal 000113 automatic fixed bin(17,0) dcl 2038 set ref 2190* 2191* 2191 2192 days_in_month 000126 constant fixed bin(17,0) initial array dcl 3358 ref 914 1854 1878 3050 3295 dc 14 001176 automatic fixed bin(22,0) level 2 in structure "decoded_clock" dcl 3399 in procedure "date_time_" set ref 833 dc 14 001222 automatic fixed bin(22,0) level 2 in structure "decoded_ref" dcl 3400 in procedure "date_time_" set ref 833 dc 14 based fixed bin(22,0) level 2 in structure "time_value" dcl 7-53 in procedure "date_time_" set ref 550* 1566 1616 1621 1621 1628 2073* 2179 2179 2959 dd 0(27) 001302 automatic picture(2) level 2 packed packed unaligned dcl 995 set ref 984* ddt_sw 000102 automatic bit(1) packed unaligned dcl 1207 set ref 1204* 1237* 1261 decoded_clock 001176 automatic structure level 1 dcl 3399 set ref 540 820 974 1240 1743 1769 1824 1971 decoded_ref 001222 automatic structure level 1 dcl 3400 set ref 810 876 906 delta 26 based fixed bin(71,0) array level 3 dcl 4-88 set ref 1377 1432 1658 2382 3143* divide builtin function dcl 3409 ref 926 988 1576 1589 1673 1837 1842 1903 1903 1903 1903 1903 1903 2060 2063 2066 2069 2099 2104 2111 2116 2146 2149 2179 2190 2198 2215 2235 2287 2618 3162 3164 3241 3245 3249 diw 000130 automatic fixed bin(17,0) dcl 3334 set ref 1673* 1674 1680* dm 4 001176 automatic fixed bin(17,0) level 2 in structure "decoded_clock" dcl 3399 in procedure "date_time_" set ref 832 1781 1855 dm 4 based fixed bin(17,0) level 2 in structure "time_value" dcl 7-53 in procedure "date_time_" set ref 543* 984 1254 1563 1587* 1591* 2236* 2823 2851 2886 2921 2988 2991 3053 3225 3227 3295 3295 3302 dm 4 001056 automatic fixed bin(17,0) level 2 in structure "auto_time_value" dcl 3397 in procedure "date_time_" set ref 1781* 1786 1786 1786* 1789 1789* 1797* 1862* dm 1 000103 automatic picture(2) level 2 in structure "rqid" packed packed unaligned dcl 1266 in procedure "date_time_" set ref 1254* dm 4 001222 automatic fixed bin(17,0) level 2 in structure "decoded_ref" dcl 3400 in procedure "date_time_" set ref 832 do_FW 000112 automatic bit(1) packed unaligned dcl 2037 set ref 2020* 2024* 2188 dw 12 based fixed bin(17,0) level 2 in structure "time_value" dcl 7-53 in procedure "date_time_" set ref 990 1540 1540 1610 1610 1612* 1671 1674 2179* 2192 2827 2855 2890 2925 2997 3000 3012 3024 dw 72 001102 automatic structure level 2 in structure "auto_time_offset" dcl 3398 in procedure "date_time_" dw 12 001176 automatic fixed bin(17,0) level 2 in structure "decoded_clock" dcl 3399 in procedure "date_time_" set ref 1749 1757 dx 2 000144 automatic fixed bin(71,0) level 2 in structure "cal_val" dcl 3348 in procedure "date_time_" set ref 1648* 1648 1648 1651* 1651 1658* dx 2 000154 automatic fixed bin(71,0) level 2 in structure "ref_val" dcl 3355 in procedure "date_time_" set ref 833 878 908 dx 2 000164 automatic fixed bin(71,0) level 2 in structure "off_val" dcl 3355 in procedure "date_time_" set ref 833 878 908 dx 2 parameter fixed bin(71,0) level 2 in structure "cval" dcl 3174 in procedure "vc_2_Multics" ref 3187 dx 2 parameter fixed bin(71,0) level 2 in structure "cval" dcl 2328 in procedure "Multics_2_vc" set ref 2376* 2376 2376 2379* 2379 2382* 2383 dy 13 based fixed bin(17,0) level 2 in structure "time_value" dcl 7-53 in procedure "date_time_" set ref 549* 1565 1592* 1593* 1593 1595 1601 1605* 1605 2127* 2128* 2161* 2190 2191 2198 2819 2847 2882 2917 2978 3101 3215 3220 3262 3265 3265 3276 3286 dy 13 001056 automatic fixed bin(17,0) level 2 in structure "auto_time_value" dcl 3397 in procedure "date_time_" set ref 1783* 1865* e 2 based structure array level 2 in structure "ti_keyword" unaligned dcl 4-29 in procedure "date_time_" e 2 based structure array level 2 in structure "ti_month" unaligned dcl 4-52 in procedure "date_time_" e 1 based structure array level 2 in structure "item" packed packed unaligned dcl 5-24 in procedure "date_time_" e 2 based structure array level 2 in structure "ti_day" unaligned dcl 4-60 in procedure "date_time_" e 2 based structure array level 2 in structure "ti_zone" unaligned dcl 4-88 in procedure "date_time_" e_count 001343 automatic fixed bin(17,0) dcl 2261 set ref 2300* 2302 2302* element 1(08) based fixed bin(10,0) array level 3 packed packed unsigned unaligned dcl 5-24 ref 2302 enclosed_key 3 000175 automatic fixed bin(17,0) array level 3 dcl 3367 set ref 1988* 2545* 2612 end_Special 000202 constant fixed bin(71,0) initial dcl 260 ref 2403 errloc 000174 automatic fixed bin(17,0) dcl 3366 set ref 436* 444 444* 444 444* 524* 562 562* 562 562* 616* 633 1982* 2539* 2541 2556 2588* 2597* 2600* 2606 2609 2610 2610* 2610 2612* 2714* errlocad 000175 automatic structure level 1 dcl 3367 error_table_$bad_conversion 000166 external static fixed bin(35,0) dcl 2421 ref 2622 error_table_$bad_time 000124 external static fixed bin(35,0) dcl 1504 ref 1555 error_table_$badcall 000154 external static fixed bin(35,0) dcl 2027 ref 2166 error_table_$dt_bad_day_of_week 000144 external static fixed bin(35,0) dcl 1707 in procedure "apply_offset" ref 1724 error_table_$dt_bad_day_of_week 000126 external static fixed bin(35,0) dcl 1504 in begin block on line 1503 ref 1543 1676 error_table_$dt_bad_dm 000214 external static fixed bin(35,0) dcl 3201 ref 3299 error_table_$dt_bad_dy 000216 external static fixed bin(35,0) dcl 3201 ref 3217 3268 error_table_$dt_bad_format_selector 000170 external static fixed bin(35,0) dcl 2421 ref 2604 error_table_$dt_bad_fw 000130 external static fixed bin(35,0) dcl 1504 ref 1580 error_table_$dt_bad_my 000220 external static fixed bin(35,0) dcl 3201 ref 3292 error_table_$dt_conflict 000132 external static fixed bin(35,0) dcl 1504 ref 1632 error_table_$dt_date_not_exist 000222 external static fixed bin(35,0) dcl 3201 ref 3229 error_table_$dt_date_too_big 000210 external static fixed bin(35,0) dcl 3177 in procedure "vc_2_Multics" ref 3183 error_table_$dt_date_too_big 000156 external static fixed bin(35,0) dcl 2349 in procedure "Multics_2_vc" ref 2366 error_table_$dt_date_too_big 000134 external static fixed bin(35,0) dcl 1504 in begin block on line 1503 ref 1624 error_table_$dt_date_too_small 000212 external static fixed bin(35,0) dcl 3177 in procedure "vc_2_Multics" ref 3185 error_table_$dt_date_too_small 000160 external static fixed bin(35,0) dcl 2349 in procedure "Multics_2_vc" ref 2361 error_table_$dt_date_too_small 000136 external static fixed bin(35,0) dcl 1504 in begin block on line 1503 ref 1618 error_table_$dt_no_format_selector 000152 external static fixed bin(35,0) dcl 1921 ref 1946 error_table_$dt_no_interval_units 000112 external static fixed bin(35,0) dcl 776 ref 785 error_table_$dt_offset_too_big_negative 000146 external static fixed bin(35,0) dcl 1707 ref 1729 error_table_$dt_offset_too_big_positive 000150 external static fixed bin(35,0) dcl 1707 ref 1731 error_table_$dt_unknown_time_language 000116 external static fixed bin(35,0) dcl 1302 in begin block on line 1301 ref 1319 error_table_$dt_unknown_time_language 000100 external static fixed bin(35,0) dcl 517 in begin block on line 516 ref 531 error_table_$dt_unknown_time_language 000072 external static fixed bin(35,0) dcl 429 in begin block on line 428 ref 443 error_table_$dt_year_too_big 000162 external static fixed bin(35,0) dcl 2349 ref 2408 error_table_$dt_year_too_small 000164 external static fixed bin(35,0) dcl 2349 ref 2396 error_table_$picture_bad 000172 external static fixed bin(35,0) dcl 2421 ref 2711 error_table_$picture_scale 000174 external static fixed bin(35,0) dcl 2421 ref 2706 error_table_$picture_too_big 000176 external static fixed bin(35,0) dcl 2421 ref 2587 2708 error_table_$size_error 000200 external static fixed bin(35,0) dcl 2421 ref 2627 error_table_$unimplemented_version 000114 external static fixed bin(35,0) dcl 1179 in begin block on line 1178 ref 1187 error_table_$unimplemented_version 000120 external static fixed bin(35,0) dcl 1339 in begin block on line 1338 set ref 1345* error_table_$unimplemented_version 000106 external static fixed bin(35,0) dcl 688 in begin block on line 687 ref 696 error_table_$unimplemented_version 000142 external static fixed bin(35,0) dcl 1504 in begin block on line 1503 ref 1533 error_table_$unknown_zone 000074 external static fixed bin(35,0) dcl 429 in begin block on line 428 ref 461 error_table_$unknown_zone 000110 external static fixed bin(35,0) dcl 688 in begin block on line 687 ref 708 error_table_$unknown_zone 000102 external static fixed bin(35,0) dcl 517 in begin block on line 516 ref 537 error_table_$unknown_zone 000140 external static fixed bin(35,0) dcl 1504 in begin block on line 1503 ref 1643 error_table_$unknown_zone 000122 external static fixed bin(35,0) dcl 1413 in begin block on line 1412 ref 1426 fb24 000131 automatic fixed bin(24,0) dcl 3335 set ref 926* 927 928 fiscal_constant 000114 automatic fixed bin(17,0) dcl 2039 set ref 2192* 2193 2193* 2193 2195 2195* 2195 2198 2206 2215 fiscal_day_value 001311 automatic fixed bin(17,0) dcl 1515 set ref 1589* 1592 1593 fiscal_week_value 000132 automatic fixed bin(24,0) dcl 3336 in procedure "date_time_" set ref 1577* 1578 1592 1597* fiscal_week_value 000115 automatic fixed bin(17,0) dcl 2040 in procedure "fromclock" set ref 2198* 2204 2209* 2212 2215* 2221 fiscal_year_value 000116 automatic fixed bin(17,0) dcl 2041 in procedure "fromclock" set ref 2200* 2208* 2208 2214* 2214 2215* 2221 fiscal_year_value 000133 automatic fixed bin(24,0) dcl 3337 in procedure "date_time_" set ref 1576* 1577 1584 1603 fixed builtin function dcl 3409 ref 3295 3302 flag 2 based fixed bin(17,0) array level 2 in structure "toa" dcl 1703 in procedure "apply_offset" ref 1717 1889 flag 72 001102 automatic fixed bin(17,0) level 3 in structure "auto_time_offset" dcl 3398 in procedure "date_time_" set ref 1720 1741 1747 1751 1755 1759 flag 2 based structure level 2 in structure "time_offset" dcl 8-37 in procedure "date_time_" ref 783 flag 2 based fixed bin(17,0) array level 2 in structure "time_offset_array" dcl 8-88 in procedure "date_time_" ref 923 929 flag 2 001102 automatic structure level 2 in structure "auto_time_offset" dcl 3398 in procedure "date_time_" fld24 000317 automatic float dec(24) dcl 3377 set ref 1776* 1808 1817* 1817 1817 1818 1831* 1873 1882* 1882 1882 1883 2719* 2742 2746 2815* 2819* 2823* 2827* 2830* 2830 2833* 2833 2836* 2836 2839* 2839 2843* 2843 2847* 2851* 2855* 2858* 2858 2861* 2861 2863* 2863 2864* 2864 2864 2872* 2878* 2878 2882* 2886* 2890* 2893* 2893 2895* 2895 2899* 2899 2899 2900* 2900 2900 2907* 2913* 2913 2917* 2921* 2925* 2927* 2927 2932* 2932 2932 2933* 2933 2933 2934* 2934 2934 2941* 2953* 2959* 2964* 2964 2964 2965* 2965 2965 2966* 2966 2966 2967* 2967 2967 2978* 2988* 2997* 3038* 3044* 3058* 3058 3092* 3106* 3106 fldA 000100 automatic float dec(24) dcl 2316 set ref 2319* 2319 2321 fldB 000107 automatic float dec(24) dcl 2316 set ref 2320* 2320 2321 fldC 000116 automatic float dec(20) dcl 2317 set ref 2321* 2322 fmt_str parameter varying char(512) dcl 1919 ref 1917 1930 1948 format parameter char packed unaligned dcl 419 set ref 416 437 444* 444 444 512 525 562* 562 562 609 624 1989 format_i 000326 automatic fixed bin(17,0) dcl 3378 set ref 1996* 1997 1998 1999 2002 2004* 2004 2005 2524* 2524 2525 2527* 2527 2532 2539 2544 2558* 2558 2559 2565 2566 2572 2574 2574 2578 2588 2591 2592 2593* 2593 2595 2600 2601 2619* 2619 format_max 000100 automatic bit(1) packed unaligned dcl 514 set ref 435* 522* 618* 1069* 3003 3015 3065 3077 3119 3131 fs_time_value based structure level 1 dcl 3401 ftype 000134 automatic fixed bin(17,0) dcl 2482 set ref 2618* 2722 fw 11 based fixed bin(20,0) level 2 dcl 7-53 set ref 548* 1520 1564 1576 1577 2221* 3038 fx2 000135 automatic fixed bin(17,0) dcl 2483 set ref 2947* 2949 2949* 2949 2950 2950* 2953 2956 hb 001331 automatic fixed bin(17,0) dcl 2258 set ref 2285* 2286 2287 2296* hbound builtin function dcl 3409 ref 2543 hr 42 based float dec(20) level 3 dcl 8-37 set ref 791* i 001320 automatic fixed bin(17,0) dcl 1969 in procedure "do_format" set ref 1998* 1999 1999* 2001* 2001 2002 2002 2004 i 000327 automatic fixed bin(17,0) dcl 3379 in procedure "date_time_" set ref 1716* 1717 1717* 2543* 2544 2545 2546 2552 2553 2565* 2566 2566* 2568* 2568 2572 2572* 2572 2574 2574 2574* 2574 2577 2578 2579* 2582 2584 2601* 2602 2608* 2609 2610 2610 2610 2610 2612 2612* 2618 2636* 2637 2639 2641 2645 2647 2648 2649 2684* 2685 2687 2687 2691* 2692 2692* 2694 2696* 2696 2697 2697 2773* 2774 2774* 2781* 2782 2782* 2784* 2784 2785* 2785 2786 2790* 2791 2791* 2793* 2793 2794* 2794 2795 2800* 2801 2801* 2803* 2803 2804* 2804 2805 2807 3007* 3008 3008* 3019* 3020 3020* 3069* 3070 3070* 3081* 3082 3082* 3123* 3124 3124* 3135* 3136 3136* 3162* 3163 i1 000136 automatic fixed bin(17,0) dcl 2484 set ref 2647* 2648 2652 i2 000137 automatic fixed bin(17,0) dcl 2485 set ref 2648* 2648 2649 2652 ii 000100 automatic fixed bin(17,0) dcl 1924 in procedure "cv_fmt_kwd" set ref 1939* 1940 1942* ii 000140 automatic fixed bin(17,0) dcl 2486 in procedure "proc_selector" set ref 2578* 2579 2579 2644* 2645 2645 2647 2649 2649 index builtin function dcl 3409 ref 1951 1983 1998 2578 2601 2636 2644 2679 2684 interval parameter fixed bin(71,0) dcl 2314 ref 2312 2319 item 2 based structure array level 2 in structure "ti_token" unaligned dcl 5-10 in procedure "date_time_" item based structure level 1 unaligned dcl 5-24 in procedure "date_time_" item_p 001250 automatic pointer dcl 5-24 set ref 2280* 2290* 2300 2302 2302 keywords 2 000175 automatic structure array level 2 dcl 3367 set ref 2543 2608 lang_index 000330 automatic fixed bin(17,0) dcl 3380 set ref 440* 441 466* 528* 529 625* 627* 701* 713* 781* 972* 976* 990 1075* 1076* 1243* 1244* 1312* 1314 1314 1318* 1319 1323 1323 1325 1358* 1360 1360 1377 1378 1379 1430* 1431 1432 1433 1538* 1657 1658 1715* 3008 3008 3012 3020 3020 3024 3027 3070 3070 3074 3082 3082 3086 3124 3124 3128 3136 3136 3140 3143 language parameter char packed unaligned dcl 419 ref 416 440 512 528 lb 001330 automatic fixed bin(17,0) dcl 2258 set ref 2284* 2286 2287 2294* lbound builtin function dcl 3409 ref 2608 lclock_days 000110 automatic fixed bin(20,0) dcl 2035 in procedure "fromclock" set ref 2069* 2070 2073 2076* 2076 2095* 2095 2099 2100 2146 2148 lclock_days 000113 automatic fixed bin(27,0) dcl 3320 in procedure "date_time_" set ref 1589 1589 1610* 1610 1628* 1636* 1636 1663 1673 1673 1803 1870 3256* 3283* 3283 3286* 3286 3302* 3302 3304* 3304 lclock_hours 000107 automatic fixed bin(25,0) dcl 2034 set ref 2066* 2067 2069 2070 lclock_minutes 000106 automatic fixed bin(31,0) dcl 2033 set ref 2063* 2064 2066 2067 lclock_seconds 000104 automatic fixed bin(36,0) dcl 2032 set ref 2060* 2061 2063 2064 lcode 000331 automatic fixed bin(35,0) dcl 3381 set ref 436* 443* 444* 461* 467 470 477 524* 531* 537* 557 562* 619* 630 632 714 716 780* 813 815 817 823 825 827 874 904 978 980 1078 1183* 1193 1195 1197 1239* 1246 1248 1530* 1571 1608 1683 1724* 1729* 1731* 1745 1771 1801 1826 1868 1928* 1946* 1975 1992 1997 2043* 2166* 2356* 2361* 2366* 2396* 2408* 2550 2587* 2604* 2622* 2627* 2706* 2708* 2711* 3183* 3185* 3217* 3229* 3268* 3292* 3299* leap_day 000114 automatic fixed bin(17,0) dcl 3321 in procedure "date_time_" set ref 3254* 3265 3295 3302 leap_day 000111 automatic fixed bin(17,0) dcl 2036 in procedure "fromclock" set ref 2132* 2153* 2155* 2206 2231 2231 2244 leap_year 23 based fixed bin(17,0) level 2 in structure "time_value" dcl 7-53 in procedure "date_time_" set ref 554* 2244* leap_year 23 001222 automatic fixed bin(17,0) level 2 in structure "decoded_ref" dcl 3400 in procedure "date_time_" set ref 886 915 length builtin function dcl 3409 ref 444 444 560 562 562 989 1989 1990 1997 1999 2005 2546 2546 2552 2566 2572 2574 2574 2585 2595 2597 2612 2641 2652 2736 2782 2785 2791 2794 2801 2805 3008 3008 3020 3020 3070 3070 3082 3082 3124 3124 3136 3136 lformat 000332 automatic varying char(512) dcl 3382 set ref 437* 444 444* 525* 562 562* 624* 1071* 1983 1985* 1985* 1990 1997 1998 1999 2002 2005 2525 2532 2541 2556 2559* 2559 2561* 2561 2565 2566 2572 2574 2574 2578 2591 2595 2597 2601 list_r 12 based bit(18) array level 3 dcl 5-10 ref 2290 long 4 based varying char(64) array level 3 in structure "ti_zone" dcl 4-88 in procedure "date_time_" ref 1379 1433 3124 3124 3128 long 5 based varying char(32) array level 3 in structure "ti_day" dcl 4-60 in procedure "date_time_" ref 3020 3020 3024 long 5 based varying char(32) array level 3 in structure "ti_month" dcl 4-52 in procedure "date_time_" ref 3070 3070 3074 lresult 000734 automatic varying char(256) dcl 3384 set ref 474 560 1080 1978* 1995* 2002* 2002 2528* 2528 2725* 2725 2731* 2731 2743* 2743 2811* 2811 3000* 3000 ltrim builtin function dcl 3409 ref 2743 lval parameter fixed bin(17,0) dcl 2328 ref 2326 2386 lyear 000115 automatic fixed bin(35,0) dcl 3322 set ref 3237* 3241 3242* 3242 3243 3245 3246* 3246 3247 3249 3250 map_type 000010 internal static fixed bin(17,0) initial array dcl 2508 set ref 2760* max_vc_value 000176 constant fixed bin(71,0) initial dcl 260 ref 2364 2406 3183 microseconds_per_day 000210 constant fixed bin(71,0) initial dcl 177 ref 887 917 min 50 based float dec(20) level 3 in structure "time_offset" dcl 8-37 in procedure "date_time_" set ref 791* min builtin function dcl 3409 in procedure "date_time_" ref 1855 2543 2785 2794 2804 mm 001302 automatic picture(2) level 2 packed packed unaligned dcl 995 set ref 983* mo 3 001102 automatic fixed bin(17,0) level 3 in structure "auto_time_offset" dcl 3398 in procedure "date_time_" set ref 899* 1822 mo 20 based float dec(20) level 3 in structure "time_offset" dcl 8-37 in procedure "date_time_" set ref 791* 895* 917* 917 mo 3 based fixed bin(17,0) level 3 in structure "time_offset" dcl 8-37 in procedure "date_time_" ref 807 893 912 mo 20 001102 automatic float dec(20) level 3 in structure "auto_time_offset" dcl 3398 in procedure "date_time_" set ref 900* 1830 1831 1831 mod builtin function dcl 3409 ref 982 1908 3110 my 3 001056 automatic fixed bin(17,0) level 2 in structure "auto_time_value" dcl 3397 in procedure "date_time_" set ref 1782* 1786 1789 1796* 1863* my 3 001176 automatic fixed bin(17,0) level 2 in structure "decoded_clock" dcl 3399 in procedure "date_time_" set ref 831 1782 1832 my 3 based fixed bin(17,0) level 2 in structure "time_value" dcl 7-53 in procedure "date_time_" set ref 542* 983 1253 1562 1585* 1591* 2235* 2236 2241* 2241 3044 3048 3050 3062 3074 3086 3220 3223 3289 3289 3295 3295 3302 3302 my 3 001222 automatic fixed bin(17,0) level 2 in structure "decoded_ref" dcl 3400 in procedure "date_time_" set ref 831 914 915 my 0(18) 000103 automatic picture(2) level 2 in structure "rqid" packed packed unaligned dcl 1266 in procedure "date_time_" set ref 1253* n 000175 automatic fixed bin(17,0) level 2 dcl 3367 set ref 436* 524* 616* 1986* 2543 2553* 2608 name 2 based char(32) array level 3 in structure "ti_keyword" packed packed unaligned dcl 4-29 in procedure "date_time_" ref 1940 name 2 based varying char(32) array level 2 in structure "ti_language" dcl 4-42 in procedure "date_time_" ref 1314 1323 1360 new_len 5 000175 automatic fixed bin(17,0) array level 3 dcl 3367 set ref 1990* 2552* 2610 2610 new_str parameter char packed unaligned dcl 1298 ref 1295 1309 1309 1318 1406 1419 1419 1423 null builtin function dcl 3409 ref 444 444 562 562 2280 num_of__100s 000123 automatic fixed bin(17,0) dcl 3329 set ref 2104* 2105 2105* 2107 2121 3238* 3245* 3246 3256 num_of__400s 000122 automatic fixed bin(17,0) dcl 3328 set ref 2099* 2100 2121 3238* 3241* 3242 3256 num_of____1s 000125 automatic fixed bin(17,0) dcl 3331 set ref 2116* 2117 2117* 2119 2121 2149* 2150 2152* 2157 2158 3250* 3252 3256 num_of____4s 000124 automatic fixed bin(17,0) dcl 3330 set ref 2111* 2112 2121 2146* 2148 2158 3249* 3250 3256 number_kwd based fixed bin(17,0) level 2 dcl 4-29 ref 1939 number_lang based fixed bin(17,0) level 2 in structure "ti_word" dcl 4-78 in procedure "date_time_" ref 3027 number_lang based fixed bin(17,0) level 2 in structure "ti_language" dcl 4-42 in procedure "date_time_" ref 1314 1314 1323 1323 1360 1360 number_word 1 based fixed bin(17,0) level 2 dcl 4-78 ref 3027 3027 3027 number_zone 1 based fixed bin(17,0) level 2 dcl 4-88 ref 1377 1377 1378 1378 1379 1379 1431 1431 1432 1432 1433 1433 1657 1657 1658 1658 2382 2382 2386 2386 3123 3124 3124 3124 3124 3128 3128 3135 3136 3136 3136 3136 3140 3140 3143 3143 off_val 000164 automatic structure level 1 unaligned dcl 3355 set ref 821* 822 old_len 4 000175 automatic fixed bin(17,0) array level 3 dcl 3367 set ref 1989* 2546* 2610 overflow 000104 stack reference condition dcl 1706 ref 1727 1893 pack_picture_ 000204 constant entry external dcl 2487 ref 2764 pi based structure level 1 unaligned dcl 2515 pi_p 000310 automatic pointer dcl 2499 set ref 2522* 2523 2702* 2717 2717 2717 2760 2766 2864 2896 2929 2961 3045 3093 pic2 001035 automatic picture(2) packed unaligned dcl 3385 set ref 2725 2875* 2910* 2944* 2956* 2991* 3062* 3110* pic25 000404 automatic picture(26) packed unaligned dcl 2723 set ref 2742* 2743 pic4 001036 automatic picture(4) packed unaligned dcl 3386 set ref 1251* 1252 picl 000201 automatic fixed bin(17,0) dcl 2492 set ref 2635* 2636 2644 2702 picloc 001037 automatic fixed bin(17,0) dcl 3387 set ref 2592* 2714 picp 000202 automatic pointer dcl 2493 set ref 2633* 2636 2644 2702 picture_code 000305 automatic fixed bin(15,0) dcl 2495 set ref 2702* 2704 2706 2708 picture_image based structure level 1 dcl 3-6 picture_info_ 000206 constant entry external dcl 2496 ref 2702 pictured 000204 automatic varying char(256) dcl 2494 set ref 2766* 2772* 2774* 2774 2781 2782 2785 2786* 2786 2790 2791 2794 2795* 2795 2800 2801 2805 2805* 2807* 2807 2811 picv based char packed unaligned dcl 2497 ref 2636 2644 2702 prec 0(09) based fixed bin(8,0) level 2 packed packed unaligned dcl 2515 ref 2717 precision builtin function dcl 3409 ref 1663 1803 1870 2236 ref_val 000154 automatic structure level 1 unaligned dcl 3355 set ref 811* 812 871 873* 901 903* rest_of__100 000117 automatic fixed bin(17,0) dcl 3324 set ref 2107* 2108 2111 2112 rest_of__400 000116 automatic fixed bin(17,0) dcl 3323 set ref 2100* 2101 2104 2107 rest_of____1 000121 automatic fixed bin(17,0) dcl 3326 set ref 2119* 2127 2128 2128 2157* 2161 2231 2231* 2231 2233* 2233 2235 2236 rest_of____4 000120 automatic fixed bin(17,0) dcl 3325 set ref 2112* 2113 2116 2119 2148* 2149 2157 result 000450 automatic structure level 1 packed packed unaligned dcl 3151 in procedure "zone_dif" set ref 3165 result 000101 automatic varying char(256) dcl 1925 in procedure "cv_fmt_kwd" set ref 1930* 1931 1931* 1934 1934* 1936 1936* 1940 1942* 1951 1960 reverse builtin function dcl 3409 ref 2655 2663 2781 2790 rqid 000103 automatic structure level 1 packed packed unaligned dcl 1266 set ref 1248* 1261 1263 s 000450 automatic char(1) level 2 packed packed unaligned dcl 3151 set ref 3156* 3159* scale 0(18) based fixed bin(8,0) level 2 packed packed unaligned dcl 2515 set ref 2523* 2717 2864 2896 2929 2961 3045 3093 scalefactor 1(09) based fixed bin(8,0) level 2 packed packed unaligned dcl 2515 ref 2717 sec 56 based float dec(20) level 3 dcl 8-37 set ref 791* selector 000053 constant char(2) initial array packed unaligned dcl 2430 ref 2601 short 2 based varying char(8) array level 3 in structure "ti_month" dcl 4-52 in procedure "date_time_" ref 3082 3082 3086 short 2 based varying char(8) array level 3 in structure "ti_day" dcl 4-60 in procedure "date_time_" ref 990 3008 3008 3012 short 2 based varying char(4) array level 3 in structure "ti_zone" dcl 4-88 in procedure "date_time_" ref 1378 1431 1657 2386 3136 3136 3140 site_date constant fixed bin(17,0) initial dcl 4-35 ref 1353 site_date_time constant fixed bin(17,0) initial dcl 4-35 ref 1352 site_time constant fixed bin(17,0) initial dcl 4-35 ref 1354 size 000312 stack reference condition dcl 2500 ref 2625 standard 001302 automatic structure level 1 packed packed unaligned dcl 995 set ref 973* 992 start 2 000175 automatic fixed bin(17,0) array level 3 dcl 3367 set ref 1987* 2544* 2609 2610 2612 stime parameter bit(36) dcl 961 ref 958 967 str parameter char packed unaligned dcl 117 in procedure "date_time_" set ref 114 958 992* 1062 1080* 1203 1263* str 12 based varying char(128) array level 3 in structure "ti_keyword" dcl 4-29 in procedure "date_time_" ref 1352 1353 1354 1942 string builtin function dcl 3409 set ref 973* 992 1248* 1261 1263 2601 3165 stringsize 000100 stack reference condition dcl 2762 ref 2759 sub_err_ 000104 constant entry external dcl 572 in begin block on line 561 ref 562 sub_err_ 000076 constant entry external dcl 433 in begin block on line 428 ref 444 substr builtin function dcl 3409 set ref 989 1252 1561* 1562* 1563* 1564* 1565* 1566* 1648 1648 1651 1998 2002 2376 2376 2379 2525 2532 2541 2556 2559 2565 2572 2574 2574 2578 2591 2601 2641 2648 2649 2649 2649 2655 2660* 2663 2667* 2671 2675* 2679 2687* 2687 2697* 2697 2766 2774 2774 2786 2795 2807 3000 symb 001332 automatic char(32) packed unaligned dcl 2259 set ref 2276* 2281* 2288 2294 symbol 2 based char(32) array level 3 packed packed unaligned dcl 5-10 ref 2288 2294 sys_info$time_zone 000016 external static char(4) packed unaligned dcl 3388 ref 1372 1419 2276 t_interval 001042 automatic fixed bin(71,0) dcl 3390 set ref 795* 796 837 878* 887* 908* 917* 926 927* 927 931* 3053* 3054* 3054 3055* 3055 3056* 3056 3057* 3057 3058* 3101* 3102* 3102 3103* 3103 3104* 3104 3105* 3105 3106* table 1(01) based fixed bin(7,0) array level 3 packed packed unsigned unaligned dcl 5-24 ref 2302 target 000320 automatic char(128) packed unaligned dcl 2501 set ref 2764 2766 2774 target_length 000360 automatic fixed bin(35,0) dcl 2502 set ref 2717* 2760* td parameter fixed bin(71,0) dcl 3148 ref 3147 3155 temp 000361 automatic char(64) packed unaligned dcl 2503 set ref 2760 2760 2764* temp_512_v 000533 automatic varying char(512) dcl 3383 set ref 2541* 2546 2548* 2548* 2552 2556* 2556 2561 temp_clock 000134 automatic fixed bin(71,0) dcl 3341 set ref 122* 426* 466* 966* 967 976* 1070* 1076* testing_format 000101 automatic bit(1) packed unaligned dcl 614 set ref 435* 523* 617* 1069* 2720 ti_day based structure level 1 unaligned dcl 4-60 ti_keyword based structure level 1 unaligned dcl 4-29 ti_language based structure level 1 unaligned dcl 4-42 ti_month based structure level 1 unaligned dcl 4-52 ti_token based structure level 1 unaligned dcl 5-10 ti_token_p 001246 automatic pointer dcl 5-22 set ref 2282* 2285 2288 2290 2294 ti_word based structure level 1 unaligned dcl 4-78 ti_zone based structure level 1 unaligned dcl 4-88 time 000446 automatic fixed bin(71,0) dcl 3150 in procedure "zone_dif" set ref 3155* 3157 3160* 3160 3162 3163* 3163 3164 time 0(20) based bit(36) level 2 in structure "fs_time_value" packed packed unaligned dcl 3401 in procedure "date_time_" set ref 967* time_defaults_$date 000052 external static varying char(64) dcl 6-19 set ref 1353* 1934 time_defaults_$date_time 000050 external static varying char(64) dcl 6-18 set ref 1352* 1931 time_defaults_$language 000056 external static char(32) packed unaligned dcl 6-23 set ref 1314* 1323* 1360* time_defaults_$language_index 000060 external static fixed bin(17,0) dcl 6-26 set ref 701 972 1075 1243 1312* 1325* 1358* 1430 1538 2265 time_defaults_$time 000054 external static varying char(64) dcl 6-20 set ref 1354* 1936 time_defaults_$zone_delta 000066 external static fixed bin(71,0) dcl 6-35 set ref 438 526 699 788 970 1073 1241 1306 1377* 1417 1432* 1536 time_defaults_$zone_index 000070 external static fixed bin(17,0) dcl 6-38 set ref 976* 1076* 1374* 1434* 2272 time_defaults_$zone_long 000062 external static varying char(64) dcl 6-29 set ref 1379* 1433* time_defaults_$zone_short 000064 external static varying char(4) dcl 6-32 set ref 976 1076 1378* 1431* time_info_$date_time_keywords 000032 external static fixed bin(17,0) dcl 4-28 set ref 1352 1353 1354 1939 1940 1942 time_info_$day_names 000040 external static fixed bin(17,0) dcl 4-58 set ref 990 3008 3008 3012 3020 3020 3024 time_info_$default_language_index 000030 external static fixed bin(17,0) dcl 4-26 ref 1312 1358 2267 time_info_$gmt_zone_index 000026 external static fixed bin(17,0) dcl 4-25 set ref 811* 821* 1244* 1375 time_info_$language_names 000034 external static fixed bin(17,0) dcl 4-40 set ref 1314 1323 1360 time_info_$month_names 000036 external static fixed bin(17,0) dcl 4-50 set ref 3070 3070 3074 3082 3082 3086 time_info_$tokens 000046 external static fixed bin(17,0) dcl 5-7 set ref 2282 time_info_$version 000024 external static char(8) packed unaligned dcl 4-21 set ref 1343 1345* 2290 time_info_$word_names 000042 external static fixed bin(17,0) dcl 4-76 set ref 3027 time_info_$zone_names 000044 external static fixed bin(17,0) dcl 4-86 set ref 1377 1378 1379 1431 1432 1433 1657 1658 2382 2386 3123 3124 3124 3128 3135 3136 3136 3140 3143 time_offset based structure level 1 dcl 8-37 set ref 1190 time_offset_array based structure level 1 dcl 8-88 time_value based structure level 1 dcl 7-53 set ref 1522 tiw_FiscalIndicator constant fixed bin(17,0) initial dcl 4-107 ref 3027 toa based structure level 1 unaligned dcl 1703 toa_i 000102 automatic fixed bin(17,0) dcl 1705 set ref 1729 1773* 1828* 1888* 1889 1889 1889* toa_p 000100 automatic pointer dcl 1704 set ref 1714* 1717 1717 1729 1889 1889 translate builtin function dcl 3409 ref 2281 2697 2699 trunc builtin function dcl 3409 ref 1776 1831 type based fixed bin(8,0) level 2 packed packed unaligned dcl 2515 ref 2760 unadjusted_errloc 1 000175 automatic fixed bin(17,0) level 2 dcl 3367 set ref 444 562 2606* unit_size 001052 automatic fixed bin(71,0) dcl 3394 set ref 884* 886* 887 914* 915* 915 917 925* 926 927 931* 1811* 1813* 1815* 1815 1817 1876* 1878* 1880* 1880 1882 3048* 3050* 3052* 3052 3058* 3096* 3098* 3100* 3100 3106* unit_sizes 000162 constant fixed bin(71,0) initial array dcl 3338 ref 925 1889 units parameter fixed bin(71,0) dcl 2314 ref 2312 2320 unspec builtin function dcl 3409 set ref 783 862* val 12 001102 automatic structure level 2 in structure "auto_time_offset" dcl 3398 in procedure "date_time_" val 12 based float dec(20) array level 2 in structure "toa" dcl 1703 in procedure "apply_offset" set ref 1717* 1729 1889 val 12 based float dec(20) array level 2 in structure "time_offset_array" dcl 8-88 in procedure "date_time_" set ref 928* 931* 931 val 12 based structure level 2 in structure "time_offset" dcl 8-37 in procedure "date_time_" val 73 001102 automatic fixed bin(17,0) level 3 in structure "auto_time_offset" dcl 3398 in procedure "date_time_" set ref 1720 1720 1749* 1749 1751 1751 1751* 1751 1757* 1757 1759 1759 1759* 1759 1764 varlength 1 based fixed bin(8,0) level 2 packed packed unaligned dcl 2515 ref 2766 verify builtin function dcl 3409 ref 459 706 1641 2565 2655 2663 2671 2691 2781 2790 2800 version 001102 automatic char(8) level 2 in structure "auto_time_offset" dcl 3398 in procedure "date_time_" set ref 863* version based char(8) level 2 in structure "time_value" dcl 7-53 in procedure "date_time_" set ref 694 694 975* 1531 1531 1972* version based char(8) level 2 in structure "time_offset" dcl 8-37 in procedure "date_time_" ref 1185 wk 26 based float dec(20) level 3 dcl 8-37 set ref 791* word based varying char(32) array level 2 dcl 4-78 ref 3027 x 000144 automatic fixed bin(71,0) level 2 in structure "cal_val" dcl 3348 in procedure "date_time_" set ref 1663* 1764* 1764 1803* 1818* 1818 1818 1870* 1883* 1883 1883 1889* 1889 1889 2056 2060 2061 2815 2843 2878 2913 x parameter fixed bin(71,0) level 2 in structure "cval" dcl 2328 in procedure "Multics_2_vc" set ref 2358* 2359 2364 2383* 2383 2390 2392 2394 2403 2406 x 000164 automatic fixed bin(71,0) level 2 in structure "off_val" dcl 3355 in procedure "date_time_" set ref 833 878 908 x 000154 automatic fixed bin(71,0) level 2 in structure "ref_val" dcl 3355 in procedure "date_time_" set ref 833 878 908 x parameter fixed bin(71,0) level 2 in structure "cval" dcl 3174 in procedure "vc_2_Multics" ref 3183 3185 3187 yc 2 001056 automatic fixed bin(17,0) level 2 in structure "auto_time_value" dcl 3397 in procedure "date_time_" set ref 1778* 1786 1789* 1811 1813* 1864* yc 2 001176 automatic fixed bin(17,0) level 2 in structure "decoded_clock" dcl 3399 in procedure "date_time_" set ref 830 1778 1846 yc 000103 automatic char(2) level 2 in structure "rqid" packed packed unaligned dcl 1266 in procedure "date_time_" set ref 1252* yc 2 001222 automatic fixed bin(17,0) level 2 in structure "decoded_ref" dcl 3400 in procedure "date_time_" set ref 830 884 yc 2 based fixed bin(17,0) level 2 in structure "time_value" dcl 7-53 in procedure "date_time_" set ref 541* 982 1251 1558 1561 1584* 1598* 1598 1603 2121* 2128 2158* 2200 3048 3092 3096 3098* 3110 3210 3213 3237 3265 3276 yr 12 based float dec(20) level 3 in structure "time_offset" dcl 8-37 in procedure "date_time_" set ref 791* 866* 887* 887 yr 2 001102 automatic fixed bin(17,0) level 3 in structure "auto_time_offset" dcl 3398 in procedure "date_time_" set ref 870* 898* 1767 yr 12 001102 automatic float dec(20) level 3 in structure "auto_time_offset" dcl 3398 in procedure "date_time_" set ref 869* 1775 1776 1776 yr parameter fixed bin(17,0) dcl 1901 in procedure "calc_leap_day" ref 1899 1903 1903 1903 1903 1903 1903 1903 1908 yr 2 based fixed bin(17,0) level 3 in structure "time_offset" dcl 8-37 in procedure "date_time_" ref 807 864 882 yy 1(18) 001302 automatic picture(2) level 2 packed packed unaligned dcl 995 set ref 982* z 4 parameter char(5) level 2 in structure "cval" packed packed unaligned dcl 2328 in procedure "Multics_2_vc" set ref 2385* 2386 2386* z 4 000144 automatic char(5) level 2 in structure "cal_val" packed packed unaligned dcl 3348 in procedure "date_time_" set ref 1647* 1648 1648 1651 1657* 2057 za 20 based char(5) level 2 dcl 7-53 set ref 552* 989 1638 1641 1647 2057* zi 6 000144 automatic fixed bin(17,0) level 2 in structure "cal_val" dcl 3348 in procedure "date_time_" set ref 1662* 2044 2058 zi 6 parameter fixed bin(17,0) level 2 in structure "cval" dcl 2328 in procedure "Multics_2_vc" set ref 2384* 2386 zname parameter char(5) packed unaligned dcl 2328 ref 2326 2376 2376 2379 2385 zone parameter char packed unaligned dcl 419 ref 416 456 459 466 512 534 552 677 702 706 713 1158 1191 1191 1191 zone_index 22 based fixed bin(17,0) level 2 in structure "time_value" dcl 7-53 in procedure "date_time_" set ref 553* 1660* 2044* 2058* 3128 3140 3143 zone_index 001054 automatic fixed bin(17,0) dcl 3395 in procedure "date_time_" set ref 456* 457 464* 466* 534* 535 553 702* 703 711* 713* 1372* 1374 1375 1375* 1377 1378 1379 1419* 1423* 1424 1431 1432 1433 1434 1638* 1639 1646* 1657 1658 1660 1662 zval parameter fixed bin(17,0) dcl 2328 ref 2326 2374 2382 2384 zz 4(09) 001302 automatic char(4) level 2 packed packed unaligned dcl 995 set ref 989* 989 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ACTION_CAN_RESTART internal static bit(36) initial dcl 2-7 in begin block on line 561 ACTION_CAN_RESTART internal static bit(36) initial dcl 1-7 in begin block on line 428 ACTION_DEFAULT_RESTART internal static bit(36) initial dcl 1-7 in begin block on line 428 ACTION_DEFAULT_RESTART internal static bit(36) initial dcl 2-7 in begin block on line 561 ACTION_QUIET_RESTART internal static bit(36) initial dcl 1-7 in begin block on line 428 ACTION_QUIET_RESTART internal static bit(36) initial dcl 2-7 in begin block on line 561 ACTION_SUPPORT_SIGNAL internal static bit(36) initial dcl 2-7 in begin block on line 561 ACTION_SUPPORT_SIGNAL internal static bit(36) initial dcl 1-7 in begin block on line 428 Day_table internal static fixed bin(17,0) initial dcl 5-38 INTEGER internal static fixed bin(17,0) initial dcl 8-62 Month_table internal static fixed bin(17,0) initial dcl 5-38 ON_OR_AFTER internal static fixed bin(17,0) initial dcl 8-62 ON_OR_BEFORE internal static fixed bin(17,0) initial dcl 8-62 Offset_table internal static fixed bin(17,0) initial dcl 5-38 This_table internal static fixed bin(17,0) initial dcl 5-38 USED internal static fixed bin(17,0) initial dcl 8-62 Word_table internal static fixed bin(17,0) initial dcl 5-38 da_name internal static char(3) initial array packed unaligned dcl 5-50 mo_name internal static char(3) initial array packed unaligned dcl 5-47 of_name internal static char(12) initial array packed unaligned dcl 5-54 picture_char_type internal static fixed bin(8,0) initial packed unaligned dcl 3-20 picture_complexfix_type internal static fixed bin(8,0) initial packed unaligned dcl 3-20 picture_complexflo_type internal static fixed bin(8,0) initial packed unaligned dcl 3-20 picture_realfix_type internal static fixed bin(8,0) initial packed unaligned dcl 3-20 picture_realflo_type internal static fixed bin(8,0) initial packed unaligned dcl 3-20 the_offset_count internal static fixed bin(17,0) initial dcl 5-53 the_word_count internal static fixed bin(17,0) initial dcl 5-58 ti_offset based structure level 1 unaligned dcl 4-68 time_defaults_$debug external static bit(1) dcl 6-42 time_info_$offset_names external static fixed bin(17,0) dcl 4-66 wo_name internal static char(12) initial array packed unaligned dcl 5-59 NAMES DECLARED BY EXPLICIT CONTEXT. Hd_fraction 013617 constant label dcl 2929 ref 2942 2954 Hday 013564 constant label dcl 2927 ref 2919 2923 Julian_style 010034 constant label dcl 2146 ref 2077 MH_fraction 013413 constant label dcl 2896 ref 2908 Multics_2_vc 010503 constant entry internal dcl 2326 ref 466 627 713 811 821 976 1076 1191 1244 Pic_expand 011410 constant label dcl 2633 ref 2653 2976 3036 Pic_expanded 011547 constant label dcl 2655 ref 2641 Pic_supplied 011404 constant label dcl 2630 SM_fraction 013171 constant label dcl 2864 ref 2873 apply_offset 006161 constant entry internal dcl 1701 ref 872 902 1193 bad_selector 011265 constant label dcl 2604 ref 2598 calc_leap_day 007137 constant entry internal dcl 1899 ref 1789 1813 1852 1876 2215 3048 3098 check 007243 constant label dcl 1931 ref 1956 cv_fmt_kwd 007221 constant entry internal dcl 1917 ref 1985 2548 date_time_ 000513 constant entry external dcl 114 date_time_rtn 003156 constant label dcl 969 ref 123 dc_fraction 013776 constant label dcl 2961 ref 2979 2989 2998 decimal_date_time_ 004014 constant entry external dcl 1203 do_format 007420 constant entry internal dcl 1967 ref 469 630 1078 do_format$direct 007443 constant entry internal dcl 1981 ref 556 err_dt_bad_fw 005434 constant label dcl 1580 ref 1603 err_exit 011267 constant label dcl 2606 ref 2550 2589 2623 2628 error 007432 constant label dcl 1975 ref 1992 exit 001121 constant label dcl 475 in procedure "date_time_" exit 006227 constant label dcl 1725 in procedure "apply_offset" ref 1732 exit_selector 010745 constant label dcl 2529 ref 2563 2715 2720 2727 2732 2744 2812 3001 fmt_max 001212 constant label dcl 516 format 000543 constant entry external dcl 416 format_max_length 001162 constant entry external dcl 512 format_rtn 000576 constant label dcl 428 found_kwd 007370 constant label dcl 1949 ref 1943 found_token 010412 constant label dcl 2300 set ref 2292 from_clock 001713 constant entry external dcl 677 from_clock_interval 002156 constant entry external dcl 764 from_clock_interval_rtn 002172 constant label dcl 774 from_clock_rtn 001736 constant label dcl 687 fromclock 007576 constant entry internal dcl 2019 ref 714 1973 fromclock$no_FW 007607 constant entry internal dcl 2023 ref 813 823 877 907 978 1246 1744 1770 1825 fstime 003130 constant entry external dcl 958 get_time_info_index 003367 constant entry external dcl 1036 get_word_index 010254 constant entry internal dcl 2253 ref 440 456 528 534 702 1041 1191 1191 1318 1372 1419 1423 1638 hundredths 003477 constant entry external dcl 1062 hundredths_rtn 003517 constant label dcl 1068 lcode_err_exit 001136 constant label dcl 477 set ref 874 904 make_fraction 010443 constant entry internal dcl 2312 ref 887 917 931 3058 3106 no_good 007350 constant label dcl 1946 ref 1958 offset_to_clock 003630 constant entry external dcl 1158 offset_to_clock_rtn 003653 constant label dcl 1178 pic_syntax 012036 constant label dcl 2711 ref 2645 proc_selector 010707 constant entry internal dcl 2420 ref 2007 request_id_ 004043 constant entry external dcl 1231 request_id_rtn 004055 constant label dcl 1238 ref 1205 retry_fw 005460 constant label dcl 1585 ref 1599 search 010336 constant label dcl 2282 set ref 2277 sel 000000 constant label array(43) dcl 2815 ref 2722 2821 2825 2849 2853 2884 2888 sel_ascii 012111 constant label dcl 2728 ref 3013 3025 3029 3075 3087 3117 3129 3141 3145 sel_dec 012177 constant label dcl 2746 ref 3060 3108 sel_dec_pic 012137 constant label dcl 2739 ref 2817 2841 2845 2867 2880 2902 2915 2936 2969 3039 sel_done 012207 constant label dcl 2750 ref 2737 sel_pic2 012075 constant label dcl 2725 ref 2876 2911 2945 2957 2992 3063 3111 set_lang 004311 constant entry external dcl 1295 set_lang_rtn 004331 constant label dcl 1301 set_time_defaults 004464 constant entry external dcl 1336 set_time_defaults_rtn 004473 constant label dcl 1338 set_zone 004734 constant entry external dcl 1406 set_zone_rtn 004754 constant label dcl 1412 signal_sub_err_ 000647 constant label dcl 444 ref 462 467 470 start 007615 constant label dcl 2025 ref 2021 sub_err_return_0 001425 constant label dcl 561 ref 532 538 557 to_clock 005130 constant entry external dcl 1495 to_clock_exit 006122 constant label dcl 1683 ref 1571 1608 to_clock_rtn 005146 constant label dcl 1503 toobig 005610 constant label dcl 1624 ref 1558 valid_format 001603 constant entry external dcl 609 valid_format_rtn 001623 constant label dcl 615 vc_2_Multics 015364 constant entry internal dcl 3172 ref 1195 1682 ymd_to_days 015413 constant entry internal dcl 3198 ref 1570 1588 1607 1800 1867 zone_dif 015306 constant entry internal dcl 3147 ref 3143 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 20672 21116 17532 20702 Length 21740 17532 224 606 1140 6 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME date_time_ 1726 external procedure is an external procedure. begin block on line 428 begin block shares stack frame of external procedure date_time_. begin block on line 516 begin block shares stack frame of external procedure date_time_. begin block on line 561 begin block shares stack frame of external procedure date_time_. begin block on line 615 begin block shares stack frame of external procedure date_time_. begin block on line 687 begin block shares stack frame of external procedure date_time_. begin block on line 774 begin block shares stack frame of external procedure date_time_. begin block on line 969 begin block shares stack frame of external procedure date_time_. begin block on line 1068 begin block shares stack frame of external procedure date_time_. begin block on line 1178 begin block shares stack frame of external procedure date_time_. begin block on line 1238 begin block shares stack frame of external procedure date_time_. begin block on line 1301 begin block shares stack frame of external procedure date_time_. begin block on line 1338 begin block shares stack frame of external procedure date_time_. begin block on line 1412 begin block shares stack frame of external procedure date_time_. begin block on line 1503 begin block shares stack frame of external procedure date_time_. apply_offset 136 internal procedure enables or reverts conditions. on unit on line 1727 65 on unit calc_leap_day 67 internal procedure is called by several nonquick procedures. cv_fmt_kwd 135 internal procedure is called by several nonquick procedures. do_format internal procedure shares stack frame of external procedure date_time_. fromclock 90 internal procedure is called by several nonquick procedures. get_word_index internal procedure shares stack frame of external procedure date_time_. make_fraction 90 internal procedure is called by several nonquick procedures. Multics_2_vc internal procedure shares stack frame of external procedure date_time_. proc_selector 560 internal procedure enables or reverts conditions. on unit on line 2620 64 on unit on unit on line 2625 64 on unit begin block on line 2750 88 begin block enables or reverts conditions. on unit on line 2759 64 on unit zone_dif internal procedure shares stack frame of internal procedure proc_selector. vc_2_Multics internal procedure shares stack frame of external procedure date_time_. ymd_to_days 70 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 map_type proc_selector STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME apply_offset 000100 toa_p apply_offset 000102 toa_i apply_offset cv_fmt_kwd 000100 ii cv_fmt_kwd 000101 result cv_fmt_kwd 000202 ct cv_fmt_kwd date_time_ 000100 format_max date_time_ 000101 testing_format date_time_ 000102 ddt_sw date_time_ 000103 rqid date_time_ 000110 A date_time_ 000111 B date_time_ 000112 C date_time_ 000113 lclock_days date_time_ 000114 leap_day date_time_ 000115 lyear date_time_ 000116 rest_of__400 date_time_ 000117 rest_of__100 date_time_ 000120 rest_of____4 date_time_ 000121 rest_of____1 date_time_ 000122 num_of__400s date_time_ 000123 num_of__100s date_time_ 000124 num_of____4s date_time_ 000125 num_of____1s date_time_ 000126 cur_unit date_time_ 000127 day_adjust date_time_ 000130 diw date_time_ 000131 fb24 date_time_ 000132 fiscal_week_value date_time_ 000133 fiscal_year_value date_time_ 000134 temp_clock date_time_ 000136 arg_l date_time_ 000140 arg_p date_time_ 000142 arg_t date_time_ 000144 cal_val date_time_ 000154 ref_val date_time_ 000164 off_val date_time_ 000174 errloc date_time_ 000175 errlocad date_time_ 000317 fld24 date_time_ 000326 format_i date_time_ 000327 i date_time_ 000330 lang_index date_time_ 000331 lcode date_time_ 000332 lformat date_time_ 000533 temp_512_v date_time_ 000734 lresult date_time_ 001035 pic2 date_time_ 001036 pic4 date_time_ 001037 picloc date_time_ 001040 Tday date_time_ 001042 t_interval date_time_ 001044 Tmonth date_time_ 001046 Tusec date_time_ 001050 Tyear date_time_ 001052 unit_size date_time_ 001054 zone_index date_time_ 001056 auto_time_value date_time_ 001102 auto_time_offset date_time_ 001176 decoded_clock date_time_ 001222 decoded_ref date_time_ 001246 ti_token_p date_time_ 001250 item_p date_time_ 001252 Ptime_value date_time_ 001254 Ptime_offset date_time_ 001302 standard begin block on line 969 001310 combination begin block on line 1503 001311 fiscal_day_value begin block on line 1503 001320 i do_format 001330 lb get_word_index 001331 hb get_word_index 001332 symb get_word_index 001342 cur_token get_word_index 001343 e_count get_word_index fromclock 000100 A fromclock 000101 B fromclock 000102 C fromclock 000104 lclock_seconds fromclock 000106 lclock_minutes fromclock 000107 lclock_hours fromclock 000110 lclock_days fromclock 000111 leap_day fromclock 000112 do_FW fromclock 000113 day_for_fiscal fromclock 000114 fiscal_constant fromclock 000115 fiscal_week_value fromclock 000116 fiscal_year_value fromclock make_fraction 000100 fldA make_fraction 000107 fldB make_fraction 000116 fldC make_fraction proc_selector 000100 Ar_ct proc_selector 000101 buff proc_selector 000134 ftype proc_selector 000135 fx2 proc_selector 000136 i1 proc_selector 000137 i2 proc_selector 000140 ii proc_selector 000141 Pic proc_selector 000161 PIC proc_selector 000201 picl proc_selector 000202 picp proc_selector 000204 pictured proc_selector 000305 picture_code proc_selector 000306 Pic_l proc_selector 000310 pi_p proc_selector 000320 target proc_selector 000360 target_length proc_selector 000361 temp proc_selector 000401 Ol_sw proc_selector 000402 Zl_ct proc_selector 000403 Zr_ct proc_selector 000404 pic25 proc_selector 000413 ch64 proc_selector 000446 time zone_dif 000450 result zone_dif ymd_to_days 000100 adjustment ymd_to_days THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 r_g_a r_e_as r_ne_as alloc_char_temp cat_realloc_chars enter_begin_block leave_begin_block call_ext_out_desc call_ext_out call_int_this call_int_other begin_return_mac return_mac fl2_to_fx2 tra_ext_1 mpfx2 mpfx3 mdfx1 signal_op enable_op shorten_stack ext_entry ext_entry_desc int_entry trunc_fx1 repeat set_chars_eis real_to_real_round_ any_to_any_truncate_ divide_fx1 divide_fx3 divide_fx4 truncate THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. assign_ com_err_ date_time_$set_time_defaults pack_picture_ picture_info_ sub_err_ sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_conversion error_table_$bad_time error_table_$badcall error_table_$dt_bad_day_of_week error_table_$dt_bad_day_of_week error_table_$dt_bad_dm error_table_$dt_bad_dy error_table_$dt_bad_format_selector error_table_$dt_bad_fw error_table_$dt_bad_my error_table_$dt_conflict error_table_$dt_date_not_exist error_table_$dt_date_too_big error_table_$dt_date_too_big error_table_$dt_date_too_big error_table_$dt_date_too_small error_table_$dt_date_too_small error_table_$dt_date_too_small error_table_$dt_no_format_selector error_table_$dt_no_interval_units error_table_$dt_offset_too_big_negative error_table_$dt_offset_too_big_positive error_table_$dt_unknown_time_language error_table_$dt_unknown_time_language error_table_$dt_unknown_time_language error_table_$dt_year_too_big error_table_$dt_year_too_small error_table_$picture_bad error_table_$picture_scale error_table_$picture_too_big error_table_$size_error error_table_$unimplemented_version error_table_$unimplemented_version error_table_$unimplemented_version error_table_$unimplemented_version error_table_$unknown_zone error_table_$unknown_zone error_table_$unknown_zone error_table_$unknown_zone error_table_$unknown_zone sys_info$time_zone time_defaults_$date time_defaults_$date_time time_defaults_$language time_defaults_$language_index time_defaults_$time time_defaults_$zone_delta time_defaults_$zone_index time_defaults_$zone_long time_defaults_$zone_short time_info_$date_time_keywords time_info_$day_names time_info_$default_language_index time_info_$gmt_zone_index time_info_$language_names time_info_$month_names time_info_$tokens time_info_$version time_info_$word_names time_info_$zone_names LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 114 000507 122 000533 123 000535 416 000536 426 000574 435 000576 436 000600 437 000603 438 000615 440 000627 441 000641 443 000644 444 000647 456 000773 457 001005 459 001010 461 001027 462 001032 464 001033 466 001034 467 001047 469 001051 470 001052 474 001054 475 001121 477 001136 479 001140 512 001155 522 001212 523 001214 524 001215 525 001220 526 001232 528 001244 529 001256 531 001261 532 001264 534 001265 535 001277 537 001302 538 001305 540 001306 541 001310 542 001312 543 001314 544 001316 545 001320 546 001322 547 001324 548 001326 549 001330 550 001332 551 001334 552 001336 553 001347 554 001351 556 001352 557 001353 560 001355 562 001425 575 001546 609 001577 616 001623 617 001627 618 001631 619 001632 624 001634 625 001645 627 001647 630 001656 632 001661 633 001663 634 001666 677 001705 693 001736 694 001741 696 001754 697 001757 699 001776 701 002010 702 002013 703 002025 706 002030 708 002047 709 002052 711 002071 713 002072 714 002121 716 002127 717 002131 764 002150 780 002172 781 002174 782 002176 783 002201 785 002205 786 002210 788 002227 791 002241 795 002272 796 002276 807 002316 810 002322 811 002324 812 002347 813 002352 815 002360 817 002362 818 002363 820 002402 821 002404 822 002430 823 002433 825 002441 827 002443 828 002444 830 002463 831 002466 832 002471 833 002474 837 002515 839 002517 841 002523 845 002527 847 002531 848 002533 850 002535 852 002536 854 002541 856 002544 858 002546 859 002547 862 002551 863 002554 864 002556 866 002561 867 002567 869 002571 870 002577 871 002601 872 002604 873 002610 874 002613 876 002615 877 002617 878 002623 882 002632 884 002636 886 002644 887 002651 890 002672 891 002673 893 002676 895 002700 896 002706 898 002710 899 002711 900 002713 901 002721 902 002724 903 002730 904 002733 906 002735 907 002737 908 002743 912 002752 914 002756 915 002762 917 002770 922 003012 923 003017 925 003022 926 003026 927 003033 928 003037 929 003050 931 003055 936 003102 937 003104 958 003123 966 003145 967 003147 970 003156 972 003170 973 003173 974 003176 975 003200 976 003203 978 003227 980 003235 982 003237 983 003253 984 003262 985 003271 988 003300 989 003314 990 003320 992 003335 993 003343 1036 003362 1041 003407 1062 003475 1069 003517 1070 003521 1071 003523 1073 003530 1075 003542 1076 003545 1078 003571 1080 003574 1081 003603 1158 003622 1183 003653 1184 003655 1185 003660 1187 003664 1188 003667 1190 003706 1191 003711 1193 003750 1195 003756 1197 003770 1198 003772 1203 004011 1204 004034 1205 004036 1231 004037 1237 004054 1239 004055 1240 004056 1241 004060 1243 004072 1244 004075 1246 004115 1248 004123 1251 004131 1252 004141 1253 004144 1254 004153 1255 004162 1256 004171 1257 004200 1258 004207 1261 004217 1263 004262 1264 004270 1295 004305 1306 004331 1308 004343 1309 004344 1312 004357 1314 004363 1315 004403 1318 004404 1319 004411 1323 004420 1325 004441 1328 004443 1336 004462 1343 004473 1345 004501 1349 004532 1352 004551 1353 004566 1354 004602 1358 004616 1360 004621 1372 004641 1374 004647 1375 004652 1377 004657 1378 004674 1379 004703 1380 004712 1406 004731 1417 004754 1419 004766 1423 005011 1424 005016 1426 005021 1427 005024 1430 005043 1431 005046 1432 005070 1433 005072 1434 005101 1435 005103 1436 005104 1495 005123 1518 005146 1519 005151 1520 005152 1522 005157 1523 005162 1524 005164 1526 005167 1527 005170 1530 005172 1531 005174 1533 005210 1534 005213 1536 005232 1538 005244 1540 005247 1543 005254 1544 005256 1546 005275 1555 005315 1556 005317 1558 005336 1561 005341 1562 005346 1563 005354 1564 005362 1565 005370 1566 005376 1567 005404 1570 005412 1571 005416 1573 005420 1574 005421 1576 005423 1577 005426 1578 005432 1580 005434 1582 005437 1584 005456 1585 005460 1587 005463 1588 005464 1589 005470 1591 005502 1592 005505 1593 005512 1595 005517 1597 005522 1598 005524 1599 005526 1601 005527 1603 005531 1605 005534 1607 005536 1608 005542 1610 005544 1612 005552 1613 005553 1614 005554 1616 005556 1618 005561 1619 005563 1621 005602 1624 005610 1626 005612 1628 005631 1629 005633 1630 005635 1632 005636 1633 005640 1636 005657 1638 005661 1639 005667 1641 005672 1643 005705 1644 005710 1646 005727 1647 005730 1648 005733 1651 005770 1655 005776 1657 005777 1658 006020 1660 006022 1662 006025 1663 006027 1671 006050 1673 006052 1674 006064 1676 006066 1677 006071 1679 006110 1680 006111 1682 006112 1683 006122 1685 006124 3426 006143 1701 006160 1714 006166 1715 006171 1716 006174 1717 006202 1719 006213 1720 006215 1724 006224 1725 006227 1727 006230 1729 006244 1731 006262 1732 006265 1741 006270 1743 006273 1744 006275 1745 006302 1747 006305 1749 006307 1751 006311 1754 006321 1755 006322 1757 006323 1759 006325 1764 006335 1767 006342 1769 006344 1770 006346 1771 006353 1773 006356 1775 006360 1776 006366 1778 006375 1779 006400 1781 006402 1782 006404 1783 006406 1786 006407 1789 006424 1796 006453 1797 006455 1799 006457 1800 006463 1801 006470 1803 006473 1806 006514 1807 006515 1808 006517 1811 006523 1813 006531 1815 006550 1817 006563 1818 006574 1822 006605 1824 006607 1825 006611 1826 006616 1828 006621 1830 006623 1831 006631 1832 006640 1835 006642 1837 006645 1838 006650 1839 006654 1840 006655 1842 006657 1843 006662 1844 006666 1845 006667 1846 006670 1852 006672 1854 006715 1855 006717 1859 006723 1862 006740 1863 006742 1864 006744 1865 006746 1866 006747 1867 006751 1868 006756 1870 006761 1873 007002 1876 007006 1878 007033 1880 007036 1882 007051 1883 007062 1888 007073 1889 007101 1892 007132 1893 007134 1895 007135 1899 007136 1903 007144 1908 007210 1910 007216 1917 007220 1928 007226 1929 007230 1930 007231 1931 007243 1934 007260 1936 007275 1939 007312 1940 007323 1942 007336 1943 007345 1945 007346 1946 007350 1948 007354 1951 007370 1953 007402 1955 007404 1956 007406 1958 007407 1960 007410 1967 007420 1971 007421 1972 007423 1973 007426 1975 007432 1978 007434 1979 007441 1981 007442 1982 007444 1983 007446 1985 007460 1986 007475 1987 007477 1988 007500 1989 007501 1990 007503 1992 007505 1995 007507 1996 007510 1997 007512 1998 007517 1999 007536 2001 007544 2002 007546 2004 007562 2005 007564 2007 007567 2009 007573 2011 007574 2019 007575 2020 007603 2021 007605 2023 007606 2024 007614 2025 007615 2043 007616 2044 007620 2056 007623 2057 007625 2058 007631 2060 007633 2061 007640 2063 007646 2064 007653 2066 007657 2067 007662 2069 007667 2070 007672 2073 007677 2074 007702 2076 007705 2077 007707 2079 007710 2094 007712 2095 007716 2099 007720 2100 007723 2101 007727 2104 007732 2105 007734 2107 007740 2108 007744 2111 007747 2112 007751 2113 007756 2116 007761 2117 007763 2119 007767 2121 007775 2127 010012 2128 010014 2132 010024 2133 010031 2144 010032 2146 010034 2148 010037 2149 010044 2150 010046 2152 010050 2153 010052 2154 010054 2155 010055 2157 010056 2158 010065 2161 010072 2164 010074 2166 010075 2167 010100 2179 010101 2188 010113 2190 010115 2191 010122 2192 010127 2193 010133 2195 010137 2198 010144 2200 010151 2204 010153 2206 010156 2208 010162 2209 010163 2211 010165 2212 010166 2214 010170 2215 010172 2221 010213 2231 010221 2233 010231 2235 010233 2236 010240 2241 010247 2244 010251 2245 010253 2253 010254 2263 010256 2265 010261 2267 010272 2270 010302 2272 010304 2274 010315 2276 010321 2277 010326 2280 010327 2281 010331 2282 010336 2284 010341 2285 010343 2286 010345 2287 010351 2288 010354 2290 010364 2292 010373 2294 010375 2296 010402 2297 010405 2298 010406 2300 010412 2302 010421 2304 010435 2305 010437 2312 010442 2319 010450 2320 010460 2321 010467 2322 010476 2326 010503 2356 010505 2358 010506 2359 010511 2361 010512 2362 010515 2364 010516 2366 010520 2367 010523 2374 010524 2376 010526 2379 010566 2381 010575 2382 010576 2383 010603 2384 010610 2385 010612 2386 010617 2390 010647 2392 010652 2394 010654 2396 010656 2397 010661 2399 010662 2400 010664 2401 010665 2402 010667 2403 010670 2406 010675 2408 010677 2409 010702 2411 010703 2414 010705 2420 010706 2520 010714 2521 010717 2522 010720 2523 010722 2524 010724 2525 010726 2527 010735 2528 010736 2529 010745 2532 010746 2539 010750 2541 010753 2543 010774 2544 011002 2545 011007 2546 011011 2548 011014 2550 011033 2552 011035 2553 011042 2556 011044 2558 011104 2559 011106 2561 011114 2563 011126 2565 011127 2566 011146 2568 011154 2572 011156 2574 011170 2577 011203 2578 011206 2579 011217 2582 011222 2584 011224 2585 011225 2587 011227 2588 011231 2589 011233 2591 011234 2592 011237 2593 011241 2595 011243 2597 011246 2598 011251 2600 011252 2601 011253 2602 011264 2604 011265 2606 011267 2608 011272 2609 011302 2610 011310 2612 011322 2615 011326 2616 011330 2618 011331 2619 011334 2620 011336 2622 011352 2623 011356 2625 011361 2627 011375 2628 011401 2630 011404 2633 011410 2635 011412 2636 011414 2637 011426 2639 011427 2641 011431 2644 011435 2645 011447 2647 011453 2648 011456 2649 011467 2652 011540 2653 011546 2655 011547 2657 011562 2659 011566 2660 011570 2663 011600 2664 011612 2666 011613 2667 011615 2671 011625 2672 011637 2674 011643 2675 011645 2679 011652 2682 011665 2683 011667 2684 011672 2685 011703 2687 011704 2688 011717 2691 011721 2692 011733 2694 011737 2696 011740 2697 011742 2698 011753 2699 011754 2700 011765 2702 011766 2704 012016 2706 012021 2708 012030 2711 012036 2714 012042 2715 012044 2717 012045 2719 012065 2720 012071 2722 012073 2725 012075 2727 012110 2728 012111 2731 012113 2732 012126 2734 012127 2735 012132 2736 012134 2737 012136 2739 012137 2742 012141 2743 012151 2744 012176 2746 012177 2748 012203 2749 012205 2750 012207 2759 012212 2760 012227 2763 012257 2764 012260 2766 012301 2770 012313 2772 012315 2773 012316 2774 012330 2776 012344 2779 012346 2781 012350 2782 012364 2784 012370 2785 012372 2786 012402 2787 012406 2788 012407 2790 012411 2791 012425 2793 012431 2794 012433 2795 012443 2798 012447 2800 012451 2801 012465 2803 012471 2804 012473 2805 012500 2807 012504 2811 012516 2812 012531 2815 012532 2817 012540 2819 012541 2821 012553 2823 012554 2825 012566 2827 012567 2830 012601 2833 012635 2836 012672 2839 012727 2841 012764 2843 012765 2845 013002 2847 013003 2849 013015 2851 013016 2853 013030 2855 013031 2858 013043 2861 013077 2863 013134 2864 013171 2867 013217 2869 013220 2872 013222 2873 013231 2875 013232 2876 013243 2878 013244 2880 013261 2882 013262 2884 013274 2886 013275 2888 013307 2890 013310 2893 013322 2895 013356 2896 013413 2899 013417 2900 013441 2902 013461 2904 013462 2907 013464 2908 013473 2910 013474 2911 013505 2913 013506 2915 013523 2917 013524 2919 013536 2921 013537 2923 013551 2925 013552 2927 013564 2929 013617 2932 013623 2933 013645 2934 013665 2936 013705 2938 013706 2941 013710 2942 013717 2944 013720 2945 013731 2947 013732 2949 013735 2950 013741 2951 013745 2953 013747 2954 013755 2956 013756 2957 013766 2959 013767 2961 013776 2964 014002 2965 014024 2966 014044 2967 014064 2969 014104 2971 014105 2974 014107 2975 014112 2976 014114 2978 014115 2979 014124 2981 014125 2988 014127 2989 014136 2991 014137 2992 014150 2994 014151 2997 014153 2998 014162 3000 014163 3001 014174 3003 014175 3006 014177 3007 014200 3008 014206 3010 014231 3011 014233 3012 014234 3013 014254 3015 014255 3018 014257 3019 014260 3020 014266 3022 014311 3023 014313 3024 014314 3025 014334 3027 014335 3029 014364 3031 014365 3034 014367 3035 014372 3036 014374 3038 014375 3039 014404 3041 014405 3044 014407 3045 014416 3048 014422 3050 014447 3052 014452 3053 014465 3054 014473 3055 014500 3056 014504 3057 014510 3058 014514 3060 014532 3062 014533 3063 014544 3065 014545 3068 014547 3069 014550 3070 014556 3072 014601 3073 014603 3074 014604 3075 014624 3077 014625 3080 014627 3081 014630 3082 014636 3084 014661 3085 014663 3086 014664 3087 014704 3089 014705 3092 014707 3093 014716 3096 014722 3098 014730 3100 014747 3101 014762 3102 014770 3103 014775 3104 015001 3105 015005 3106 015011 3108 015027 3110 015030 3111 015045 3113 015046 3116 015057 3117 015063 3119 015064 3122 015066 3123 015067 3124 015102 3126 015131 3127 015133 3128 015134 3129 015157 3131 015160 3134 015162 3135 015163 3136 015176 3138 015225 3139 015227 3140 015230 3141 015253 3143 015254 3145 015305 3147 015306 3155 015310 3156 015312 3157 015314 3159 015316 3160 015320 3162 015322 3163 015337 3164 015343 3165 015356 3172 015364 3182 015366 3183 015370 3185 015377 3187 015405 3189 015411 3198 015412 3209 015420 3210 015423 3212 015427 3213 015431 3215 015434 3217 015437 3218 015441 3220 015442 3223 015452 3225 015453 3227 015461 3229 015463 3230 015465 3236 015466 3237 015472 3238 015475 3241 015503 3242 015506 3243 015516 3245 015521 3246 015523 3247 015533 3249 015536 3250 015541 3252 015551 3254 015554 3256 015561 3262 015600 3265 015602 3268 015617 3269 015621 3276 015622 3278 015632 3283 015633 3286 015640 3287 015644 3289 015645 3292 015652 3293 015654 3295 015655 3299 015677 3300 015701 3302 015702 3304 015720 3308 015725 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved