COMPILATION LISTING OF SEGMENT date_time_equal Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 12/13/84 1140.7 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 /**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16 */ 11 /**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo */ 12 /**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend */ 13 /**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt */ 14 15 date_time_equal: dteq: time_equal: teq: proc; 16 17 /* These active functions compare date-time values; an error is reported if 18* either argument is unacceptable to convert_date_to_binary_$relative. 19* 20* date_time_equal A B "true" if A = B, "false" otherwise. 21* date_time_before A B "true" if A < B, "false" otherwise. 22* date_time_after A B "true" if A > B, "false" otherwise. 23* date_time_valid A "true" if A = time value acceptable 24* to the convert_date_to_binary_ 25* subroutine, "false" otherwise 26* 27* All of these active functions print their result when called as commands. 28* 29* Initial version 3/4/74 by Barry L. Wolman */ 30 /* Time comparison functions added 11/28/78 by Jim Homan */ 31 /* Rewritten 01/18/80 by S. Herbst */ 32 /* Bug fixed in time comparisons 04/14/80 S. Herbst */ 33 /* Changed and, or to accept 0 args or 1 arg 09/16/82 S. Herbst */ 34 /* Added -date to date_time comparison commands 10/26/82 S. Herbst */ 35 /* Fixed dteq and friends to not reject negative times 11/23/82 S. Herbst */ 36 /* Added the date_time_valid function 11/23/82 J. A. Bush */ 37 /* removed a portion, creating date_time_equal.pl1 02/07/84 J A Falksen */ 38 /* Fixed a long-standing bug in dtv relating to multiple args. 84-11-13 jaf */ 39 40 dcl arg char (alen) based (aptr); 41 dcl arg1 char (arg_len (1)) based (arg_ptr (1)); 42 dcl arg2 char (arg_len (2)) based (arg_ptr (2)); 43 44 dcl return_arg char (return_len) varying based (return_ptr); 45 46 dcl (bad_arg, usage) char (168); 47 dcl myname char (32); 48 dcl date_time_string char (128)var; 49 50 dcl arg_ptr (2) ptr; 51 dcl (aptr, return_ptr) ptr; 52 53 dcl (af_sw, date_sw) bit (1); 54 55 dcl (arg_len (2)) fixed bin; 56 dcl (alen, arg_count, i, return_len) fixed bin; 57 dcl code fixed bin (35); 58 dcl (now, time1, time2) fixed bin (71); 59 60 dcl error_table_$not_act_fnc fixed bin (35) ext; 61 62 dcl get_arg entry (fixed bin, ptr, fixed bin, fixed bin (35)) automatic; 63 dcl complain entry variable options (variable); 64 65 dcl (active_fnc_err_, active_fnc_err_$suppress_name) entry options (variable); 66 dcl (com_err_, com_err_$suppress_name) entry options (variable); 67 dcl convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35)); 68 dcl convert_date_to_binary_$relative 69 entry (char (*), fixed bin (71), fixed bin (71), fixed bin (35)); 70 dcl cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin (35)); 71 dcl cu_$af_arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 72 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 73 dcl ioa_ entry options (variable); 74 75 dcl (addr, clock) builtin; 76 77 78 myname = "date_time_equal"; 79 usage = "date_time1 date_time2 {-control_arg}"; 80 81 call get_args; 82 call convert_times; 83 84 if time1 = time2 85 then go to TRUE; 86 else go to FALSE; 87 88 89 date_time_before: dtbe: time_before: tbe: entry; 90 91 myname = "date_time_before"; 92 usage = "date_time1 date_time2 {-control_arg}"; 93 94 call get_args; 95 call convert_times; 96 97 if time1 < time2 98 then go to TRUE; 99 else go to FALSE; 100 101 102 date_time_after: dtaf: time_after: taf: entry; 103 104 myname = "date_time_after"; 105 usage = "date_time1 date_time2 {-control_arg}"; 106 107 call get_args; 108 call convert_times; 109 110 if time1 > time2 111 then go to TRUE; 112 else go to FALSE; 113 114 date_time_valid: dtv: entry; 115 116 myname = "date_time_valid"; 117 usage = "date_time string"; 118 119 call get_count; 120 if arg_count = 0 121 then go to USAGE; 122 call get_arg (1, aptr, alen, code); /* get the first arg */ 123 date_time_string = arg; 124 if arg_count > 1 /* if more than 1 arg */ 125 then do i = 2 to arg_count; /* get the rest and || together */ 126 call get_arg (i, aptr, alen, code); 127 date_time_string = date_time_string || " " || arg; 128 end; 129 call convert_date_to_binary_ ((date_time_string), time1, code); 130 if code = 0 131 then go to TRUE; 132 else go to FALSE; 133 /* */ 134 TRUE: if af_sw 135 then return_arg = "true"; 136 else call ioa_ ("true"); 137 return; 138 139 FALSE: 140 if af_sw 141 then return_arg = "false"; 142 else call ioa_ ("false"); 143 return; 144 145 USAGE: 146 if af_sw 147 then call active_fnc_err_$suppress_name (0, myname, "Usage: ^a ^a", myname, usage); 148 else call com_err_$suppress_name (0, myname, "Usage: ^a ^a", myname, usage); 149 150 RETURN: 151 return; 152 153 154 get_count: proc; 155 156 /* This internal procedure tests for af invocation and gets argument count. */ 157 158 call cu_$af_return_arg (arg_count, return_ptr, return_len, code); 159 160 if code = error_table_$not_act_fnc 161 then do; 162 af_sw = "0"b; 163 complain = com_err_; 164 get_arg = cu_$arg_ptr; 165 end; 166 else do; 167 af_sw = "1"b; 168 complain = active_fnc_err_; 169 get_arg = cu_$af_arg_ptr; 170 end; 171 172 end get_count; 173 174 175 176 get_args: proc; 177 178 /* This internal procedure gets two arguments. */ 179 180 dcl (i, j) fixed bin; 181 182 call get_count; 183 184 j = 0; 185 date_sw = "0"b; 186 187 do i = 1 to arg_count; 188 189 call get_arg (i, aptr, alen, code); 190 191 if (arg = "-date") | (arg = "-dt") 192 then date_sw = "1"b; 193 else do; /* other arg */ 194 j = j + 1; 195 if j > 2 196 then go to USAGE; 197 arg_ptr (j) = aptr; 198 arg_len (j) = alen; 199 end; 200 end; 201 if j < 2 202 then go to USAGE; 203 204 end get_args; 205 206 207 convert_times: proc; 208 209 /* This internal procedure converts both arguments to clock values. */ 210 211 now = clock (); 212 213 call convert_date_to_binary_$relative (arg1, time1, now, code); 214 if code ^= 0 215 then do; 216 bad_arg = arg1; 217 go to BAD_TIME; 218 end; 219 220 call convert_date_to_binary_$relative (arg2, time2, now, code); 221 if code ^= 0 222 then do; 223 bad_arg = arg2; 224 go to BAD_TIME; 225 end; 226 227 if date_sw 228 then do; /* compare date only */ 229 call make_date (time1); 230 call make_date (time2); 231 end; 232 233 return; 234 235 BAD_TIME: call complain (code, myname, "^a", bad_arg); 236 go to RETURN; 237 238 make_date: proc (A_time); 239 240 dcl A_time fixed bin (71); 241 242 tv.version = Vtime_value_3; 243 call date_time_$from_clock (A_time, "", addr (tv), code); 244 A_time = tv.dc; 245 246 dcl date_time_$from_clock entry (fixed bin (71), char (*), ptr, fixed bin (35)); 247 248 dcl 1 tv like time_value; 1 1 /* START OF* time_value.incl.pl1 * * * * * * * * */ 1 2 1 3 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 1 4 /* */ 1 5 /* Name: time_value.incl.pl1 */ 1 6 /* */ 1 7 /* This structure holds output from date_time_$from_clock */ 1 8 /* and input to date_time_$to_clock */ 1 9 /* (A clock value is a combination of a day portion and a time portion. */ 1 10 /* clock_days represents one part and clock_time the other.) */ 1 11 /* to_clock accepts "day" (as opposed to "time") data only in certain */ 1 12 /* combinations. This table shows with the *'s which fields may be present */ 1 13 /* together. All others must be zero. */ 1 14 /* +-1-+-2-+-3-+-4-+--------------+ */ 1 15 /* | * | * | | | year | In cases 1, 2, & 4, if day_in_week is */ 1 16 /* | * | | | | mm | present, it is used to verify the */ 1 17 /* | * | | | | dd | value converted. */ 1 18 /* | | | * | | fiscal_week | In case 3 it actually defines a day. */ 1 19 /* | | |(*)| | day_in_week | If not present, Monday is assumed. */ 1 20 /* | | * | | | day_in_year | */ 1 21 /* | | | | * | day_in_clock | */ 1 22 /* +-v-+-v-+-v-+-v-+--------------+ */ 1 23 /* | | | +-- clock_days = day_in_calendar */ 1 24 /* | | +------ clock_days = converted (fiscal_week,day_in_week) */ 1 25 /* | +---------- clock_days = converted (year,day_in_year) */ 1 26 /* +-------------- clock_days = converted (year,mm,dd) */ 1 27 /* */ 1 28 /* clock_time = converted (HH,MM,SS,UUUUUU) */ 1 29 /* */ 1 30 /* The zone adjustment may be in one of two forms: */ 1 31 /* if zone^="" then zone_index = INDEX_IN_time_info_OF (zone); */ 1 32 /* [ERROR if not found] */ 1 33 /* if zone="" & zone_index=0 then zone_index = time_defaults_$zone_index */ 1 34 /* After these two steps, if zone_index=0, it is an ERROR. */ 1 35 /* The value in time_info_ of zone_delta (zone_index) is used to adjust */ 1 36 /* clock_time. */ 1 37 /* */ 1 38 /* If leap_year^=0 it is an ERROR. All values are range checked, e.g. */ 1 39 /* year<0 or year>9999. Out-of-range is an ERROR. */ 1 40 /* */ 1 41 /* Refer to time_offset_.incl.pl1 for the structure used to input data to */ 1 42 /* date_time_$offset_to_clock. */ 1 43 /* */ 1 44 /* Status */ 1 45 /* */ 1 46 /* 0) Created by: J. Falksen - 06/20/78 */ 1 47 /* 1) Updated: jaf - 84-11-01 US & fw enlarged to bin(20) */ 1 48 /* */ 1 49 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 1 50 1 51 /* All values in this structure are zone adjusted, not GMT. */ 1 52 1 53 dcl 1 time_value aligned based(Ptime_value), 1 54 2 version char (8), 1 55 2 yc fixed bin, /* Year part of date (eg, 1978) */ 1 56 2 my fixed bin, /* Month part of date (eg, 7= July) */ 1 57 2 dm fixed bin, /* Day of month part of date (eg, 4) */ 1 58 2 Hd fixed bin, /* Hour of the day (eg, 18) */ 1 59 2 MH fixed bin, /* Minute of the hour (eg, 35) */ 1 60 2 SM fixed bin, /* Second of the minute (eg, 59) */ 1 61 2 US fixed bin (20), /* Microseconds in excess of second */ 1 62 2 fw fixed bin (20), /* the digits are yyyyww [OUT] */ 1 63 2 dw fixed bin, /* Day of the week (1=Mon, 7=Sun). */ 1 64 2 dy fixed bin, /* Day of the year */ 1 65 /* (eg, 12/31 = 365 or 366). */ 1 66 2 dc fixed bin(22), /* Day in calendar value */ 1 67 /* (eg, 1 = Jan 1, 0001). */ 1 68 2 Uc fixed bin(71), /* Microsecond in calendar value */ 1 69 /* (eg, 0 = 0001-01-01m) */ 1 70 2 za char (5), /* Zone abbreviation */ 1 71 2 zone_index fixed bin, /* Index in time_table_$zone_names, */ 1 72 /* of zone in which time expressed */ 1 73 2 leap_year fixed bin, /* 1- this is a leap year [OUT] */ 1 74 1 75 Ptime_value ptr, 1 76 Vtime_value_3 char(8) int static options(constant) init("timeval3"); 1 77 1 78 /* END OF* time_value.incl.pl1 * * * * * * * * */ 249 250 251 end make_date; 252 253 end convert_times; 254 255 end date_time_equal; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 12/13/84 1140.1 date_time_equal.pl1 >spec>temp>7065>date_time_equal.pl1 249 1 12/13/84 1138.9 time_value.incl.pl1 >spec>temp>7065>time_value.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_time parameter fixed bin(71,0) dcl 240 set ref 238 243* 244* Vtime_value_3 000000 constant char(8) initial unaligned dcl 1-53 ref 242 active_fnc_err_ 000012 constant entry external dcl 65 ref 168 active_fnc_err_$suppress_name 000014 constant entry external dcl 65 ref 145 addr builtin function dcl 75 ref 243 243 af_sw 000306 automatic bit(1) unaligned dcl 53 set ref 134 139 145 162* 167* alen 000312 automatic fixed bin(17,0) dcl 56 set ref 122* 123 126* 127 189* 191 191 198 aptr 000302 automatic pointer dcl 51 set ref 122* 123 126* 127 189* 191 191 197 arg based char unaligned dcl 40 ref 123 127 191 191 arg1 based char unaligned dcl 41 set ref 213* 216 arg2 based char unaligned dcl 42 set ref 220* 223 arg_count 000313 automatic fixed bin(17,0) dcl 56 set ref 120 124 124 158* 187 arg_len 000310 automatic fixed bin(17,0) array dcl 55 set ref 198* 213 213 216 220 220 223 arg_ptr 000276 automatic pointer array dcl 50 set ref 197* 213 216 220 223 bad_arg 000100 automatic char(168) unaligned dcl 46 set ref 216* 223* 235* clock builtin function dcl 75 ref 211 code 000316 automatic fixed bin(35,0) dcl 57 set ref 122* 126* 129* 130 158* 160 189* 213* 214 220* 221 235* 243* com_err_ 000016 constant entry external dcl 66 ref 163 com_err_$suppress_name 000020 constant entry external dcl 66 ref 148 complain 000332 automatic entry variable dcl 63 set ref 163* 168* 235 convert_date_to_binary_ 000022 constant entry external dcl 67 ref 129 convert_date_to_binary_$relative 000024 constant entry external dcl 68 ref 213 220 cu_$af_arg_ptr 000030 constant entry external dcl 71 ref 169 cu_$af_return_arg 000026 constant entry external dcl 70 ref 158 cu_$arg_ptr 000032 constant entry external dcl 72 ref 164 date_sw 000307 automatic bit(1) unaligned dcl 53 set ref 185* 191* 227 date_time_$from_clock 000036 constant entry external dcl 246 ref 243 date_time_string 000234 automatic varying char(128) dcl 48 set ref 123* 127* 127 129 dc 14 000374 automatic fixed bin(22,0) level 2 dcl 248 set ref 244 error_table_$not_act_fnc 000010 external static fixed bin(35,0) dcl 60 ref 160 get_arg 000326 automatic entry variable dcl 62 set ref 122 126 164* 169* 189 i 000314 automatic fixed bin(17,0) dcl 56 in procedure "teq" set ref 124* 126* i 000354 automatic fixed bin(17,0) dcl 180 in procedure "get_args" set ref 187* 189* ioa_ 000034 constant entry external dcl 73 ref 136 142 j 000355 automatic fixed bin(17,0) dcl 180 set ref 184* 194* 194 195 197 198 201 myname 000224 automatic char(32) unaligned dcl 47 set ref 78* 91* 104* 116* 145* 145* 148* 148* 235* now 000320 automatic fixed bin(71,0) dcl 58 set ref 211* 213* 220* return_arg based varying char dcl 44 set ref 134* 139* return_len 000315 automatic fixed bin(17,0) dcl 56 set ref 134 139 158* return_ptr 000304 automatic pointer dcl 51 set ref 134 139 158* time1 000322 automatic fixed bin(71,0) dcl 58 set ref 84 97 110 129* 213* 229* time2 000324 automatic fixed bin(71,0) dcl 58 set ref 84 97 110 220* 230* time_value based structure level 1 dcl 1-53 tv 000374 automatic structure level 1 unaligned dcl 248 set ref 243 243 usage 000152 automatic char(168) unaligned dcl 46 set ref 79* 92* 105* 117* 145* 148* version 000374 automatic char(8) level 2 packed unaligned dcl 248 set ref 242* NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Ptime_value automatic pointer dcl 1-53 NAMES DECLARED BY EXPLICIT CONTEXT. BAD_TIME 001071 constant label dcl 235 ref 217 224 FALSE 000502 constant label dcl 139 ref 86 99 112 132 RETURN 000627 constant label dcl 150 ref 236 TRUE 000452 constant label dcl 134 ref 84 97 110 130 USAGE 000532 constant label dcl 145 ref 120 195 201 convert_times 000761 constant entry internal dcl 207 ref 82 95 108 date_time_after 000231 constant entry external dcl 102 date_time_before 000162 constant entry external dcl 89 date_time_equal 000113 constant entry external dcl 15 date_time_valid 000262 constant entry external dcl 114 dtaf 000222 constant entry external dcl 102 dtbe 000153 constant entry external dcl 89 dteq 000104 constant entry external dcl 15 dtv 000253 constant entry external dcl 114 get_args 000675 constant entry internal dcl 176 ref 81 94 107 get_count 000630 constant entry internal dcl 154 ref 119 182 make_date 001120 constant entry internal dcl 238 ref 229 230 taf 000204 constant entry external dcl 102 tbe 000135 constant entry external dcl 89 teq 000066 constant entry external dcl 15 time_after 000213 constant entry external dcl 102 time_before 000144 constant entry external dcl 89 time_equal 000075 constant entry external dcl 15 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1450 1510 1173 1460 Length 1732 1173 40 206 255 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME teq 408 external procedure is an external procedure. get_count internal procedure shares stack frame of external procedure teq. get_args internal procedure shares stack frame of external procedure teq. convert_times internal procedure shares stack frame of external procedure teq. make_date internal procedure shares stack frame of external procedure teq. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME teq 000100 bad_arg teq 000152 usage teq 000224 myname teq 000234 date_time_string teq 000276 arg_ptr teq 000302 aptr teq 000304 return_ptr teq 000306 af_sw teq 000307 date_sw teq 000310 arg_len teq 000312 alen teq 000313 arg_count teq 000314 i teq 000315 return_len teq 000316 code teq 000320 now teq 000322 time1 teq 000324 time2 teq 000326 get_arg teq 000332 complain teq 000354 i get_args 000355 j get_args 000374 tv make_date THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_var_desc call_var call_ext_out_desc call_ext_out return shorten_stack ext_entry clock THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ active_fnc_err_$suppress_name com_err_ com_err_$suppress_name convert_date_to_binary_ convert_date_to_binary_$relative cu_$af_arg_ptr cu_$af_return_arg cu_$arg_ptr date_time_$from_clock ioa_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$not_act_fnc LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 15 000065 78 000120 79 000123 81 000126 82 000127 84 000130 86 000133 89 000134 91 000167 92 000172 94 000175 95 000176 97 000177 99 000202 102 000203 104 000236 105 000241 107 000244 108 000245 110 000246 112 000251 114 000252 116 000267 117 000272 119 000275 120 000276 122 000300 123 000316 124 000327 126 000341 127 000355 128 000412 129 000415 130 000446 132 000451 134 000452 136 000466 137 000501 139 000502 142 000516 143 000531 145 000532 148 000572 150 000627 154 000630 158 000631 160 000646 162 000652 163 000653 164 000657 165 000662 167 000663 168 000665 169 000671 172 000674 176 000675 182 000676 184 000677 185 000700 187 000701 189 000711 191 000725 194 000742 195 000743 197 000746 198 000750 200 000753 201 000755 204 000760 207 000761 211 000762 213 000764 214 001013 216 001015 217 001022 220 001023 221 001052 223 001054 224 001061 227 001062 229 001064 230 001066 233 001070 235 001071 236 001117 238 001120 242 001122 243 001124 244 001153 251 001157 ----------------------------------------------------------- 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