COMPILATION LISTING OF SEGMENT query Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 01/12/88 1248.1 mst Tue Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 query: procedure options (variable); 14 15 16 /* 17* Record of Change: 18* 19* Created by Gary C. Dixon on November 23, 1972 20* Control arguments -non_null and -accept added by Txom McGary April 1977. 21* Modified 6/81 by M.R. Jordan to add control arguments. 22* Modified 9/81 by M.R. Jordan to get the defaults for question and answer IOCB pointers right. 23* Modified 06/14/84 by S. Herbst to always write on specified IOCB, never on error_output. 24* 25* Name: query 26* 27* An active function which asks the user a yes-or-no question. If the user 28* answers "yes", then query returns "true". If the user answers "no", query 29* returns "false". 30* 31* Usage 32* 33* [query question-text {-control_args}] 34* 35* 1) question-text (Input) 36* 37* is a character string which forms the text of the question which the 38* user is asked. 39* 40* 2) control_arg (Input) 41* 42* is one of the following: 43* 44* -brief, -bf 45* 46* supresses the newline before and spaces after the question. 47* 48* -disable_cp_escape, -dcpe 49* 50* disables the command processor escape sequence .. as a response. 51* 52* -enable_cp_escape, -ecpe 53* 54* enables the command processor escape sequence .. as a response. 55* 56* -input_switch STR, -isw STR 57* 58* specifies the I/O switch over which input is to be requested. 59* 60* -long, -lg 61* 62* adds leading newline and 3 spaces to question to be asked. 63* 64* -output_switch STR, -osw STR 65* 66* specifies the I/O switch over which the question is to be output. 67* 68* -repeat DT, -rp DT 69* 70* repeats teh question every DT is the user does not answer. 71* 72* Name: response 73* 74* An active function which asks any question of the user, and returns the 75* user's response as the value of the active function. 76* 77* Usage 78* 79* [response question-text {-control_args}] 80* 81* 1) question-text (Input) is as above. 82* 83* 2) control_arg may be one of the control arguments listed above for query 84* or one of the following: 85* 86* -non_null 87* 88* specifies that a null response is not allowed. 89* 90* -accept STR1 ... STRn 91* 92* specifies allowable responses. 93* 94* 95* Example 96* 97* Assume that the user's start_up.ec contained the following lines: 98* 99* &command_line off 100* &print Beginning start_up. 101* abbrev 102* &if [query "start_up: Do you wish to continue?"] &then &else &quit 103* mail 104* check_info_segs 105* . 106* . 107* 108* Then the following dialogue would cause the start_up.ec to terminate 109* execution after the query: 110* 111* Beginning start_up. 112* start_up.ec: Do you wish to continue? !no 113* r 1722 25.797 402+625 114* 115**/ 116 117 118 /****^ HISTORY COMMENTS: 119* 1) change(87-12-17,Gilcrease), approve(88-01-06,MCR7827), 120* audit(88-01-08,Parisek), install(88-01-12,MR12.2-1012): 121* Add the -trim, -no_trim control arguments. 122* END HISTORY COMMENTS */ 123 124 125 /* CONSTANTS */ 126 127 dcl NAME (2) char (8) static options (constant) init ("query", "response"); 128 dcl QUERY fixed bin static options (constant) init (1); 129 dcl RESPONSE fixed bin static options (constant) init (2); 130 131 /* AUTOMATIC */ 132 133 dcl accept_null bit (1); 134 dcl arg_len fixed bin; 135 dcl arg_list_ptr ptr; 136 dcl arg_ptr ptr; 137 dcl argn fixed bin; 138 dcl called_as_active_function bit (1); 139 dcl code fixed bin (35); 140 dcl entry_point fixed bin; 141 dcl error entry options (variable) variable; 142 dcl error_has_occured bit (1); 143 dcl first_acceptable_arg fixed bin; 144 dcl get_arg entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr) variable; 145 dcl max_length fixed bin; 146 dcl nargs fixed bin; 147 dcl no_trim bit (1); 148 dcl print_iocbp ptr; 149 dcl question_len fixed bin; 150 dcl question_ptr ptr; 151 dcl rtn_string_ptr ptr; 152 dcl temp_string char (512) varying; 153 154 dcl 1 my_query_info like query_info; 155 156 /* BASED */ 157 158 dcl answer char (max_length) varying based (rtn_string_ptr); 159 dcl arg char (arg_len) based (arg_ptr); 160 dcl question char (question_len) based (question_ptr); 161 162 dcl 1 open_descrip aligned based, 163 2 length fixed bin (17), 164 2 string char (0 refer (open_descrip.length)); 165 166 /* ERROR CODES */ 167 168 dcl error_table_$bad_arg fixed bin (35) static ext; 169 dcl error_table_$badopt fixed bin (35) static ext; 170 dcl error_table_$noarg fixed bin (35) static ext; 171 dcl error_table_$not_act_fnc fixed bin (35) static ext; 172 dcl error_table_$not_open fixed bin (35) static ext; 173 174 /* EXTERNAL ENTRIES */ 175 176 dcl active_fnc_err_ entry options (variable); 177 dcl com_err_ entry options (variable); 178 dcl command_query_ entry options (variable); 179 dcl convert_date_to_binary_$relative entry (char (*), fixed bin (71), fixed bin (71), fixed bin (35)); 180 dcl cu_$af_arg_count entry (fixed bin, fixed bin (35)); 181 dcl cu_$af_arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); 182 dcl cu_$af_return_arg ext entry (fixed bin, ptr, fixed bin, fixed bin (35)); 183 dcl cu_$arg_list_ptr entry (ptr); 184 dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); 185 dcl ioa_ entry options (variable); 186 dcl ioa_$ioa_switch ext entry options (variable); 187 dcl iox_$look_iocb entry (char (*), ptr, fixed bin (35)); 188 dcl iox_$user_io ptr ext; 189 190 /* BUILTIN FUNCTIONS */ 191 192 dcl addr builtin; 193 dcl clock builtin; 194 dcl divide builtin; 195 dcl maxlength builtin; 196 dcl null builtin; 197 dcl substr builtin; 198 1 1 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 1 2 /* Modified 11/29/82 by S. Krupp to add new entries and to change 1 3* version number to IOX2. */ 1 4 /* format: style2 */ 1 5 1 6 dcl 1 iocb aligned based, /* I/O control block. */ 1 7 2 version character (4) aligned, /* IOX2 */ 1 8 2 name char (32), /* I/O name of this block. */ 1 9 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 1 10 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 1 11 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 1 12 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 1 13 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 1 14 2 reserved bit (72), /* Reserved for future use. */ 1 15 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 1 16 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 1 17 /* open(p,mode,not_used,s) */ 1 18 2 close entry (ptr, fixed (35)),/* close(p,s) */ 1 19 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 20 /* get_line(p,bufptr,buflen,actlen,s) */ 1 21 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 22 /* get_chars(p,bufptr,buflen,actlen,s) */ 1 23 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 1 24 /* put_chars(p,bufptr,buflen,s) */ 1 25 2 modes entry (ptr, char (*), char (*), fixed (35)), 1 26 /* modes(p,newmode,oldmode,s) */ 1 27 2 position entry (ptr, fixed, fixed (21), fixed (35)), 1 28 /* position(p,u1,u2,s) */ 1 29 2 control entry (ptr, char (*), ptr, fixed (35)), 1 30 /* control(p,order,infptr,s) */ 1 31 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 32 /* read_record(p,bufptr,buflen,actlen,s) */ 1 33 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 1 34 /* write_record(p,bufptr,buflen,s) */ 1 35 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 1 36 /* rewrite_record(p,bufptr,buflen,s) */ 1 37 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 1 38 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 39 /* seek_key(p,key,len,s) */ 1 40 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 41 /* read_key(p,key,len,s) */ 1 42 2 read_length entry (ptr, fixed (21), fixed (35)), 1 43 /* read_length(p,len,s) */ 1 44 2 open_file entry (ptr, fixed bin, char (*), bit (1) aligned, fixed bin (35)), 1 45 /* open_file(p,mode,desc,not_used,s) */ 1 46 2 close_file entry (ptr, char (*), fixed bin (35)), 1 47 /* close_file(p,desc,s) */ 1 48 2 detach entry (ptr, char (*), fixed bin (35)); 1 49 /* detach(p,desc,s) */ 1 50 1 51 declare iox_$iocb_version_sentinel 1 52 character (4) aligned external static; 1 53 1 54 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 199 200 2 1 /* BEGIN INCLUDE FILE query_info.incl.pl1 TAC June 1, 1973 */ 2 2 /* Renamed to query_info.incl.pl1 and cp_escape_control added, 08/10/78 WOS */ 2 3 /* version number changed to 4, 08/10/78 WOS */ 2 4 /* Version 5 adds explanation_(ptr len) 05/08/81 S. Herbst */ 2 5 /* Version 6 adds literal_sw, prompt_after_explanation switch 12/15/82 S. Herbst */ 2 6 2 7 dcl 1 query_info aligned, /* argument structure for command_query_ call */ 2 8 2 version fixed bin, /* version of this structure - must be set, see below */ 2 9 2 switches aligned, /* various bit switch values */ 2 10 3 yes_or_no_sw bit (1) unaligned init ("0"b), /* not a yes-or-no question, by default */ 2 11 3 suppress_name_sw bit (1) unaligned init ("0"b), /* do not suppress command name */ 2 12 3 cp_escape_control bit (2) unaligned init ("00"b), /* obey static default value */ 2 13 /* "01" -> invalid, "10" -> don't allow, "11" -> allow */ 2 14 3 suppress_spacing bit (1) unaligned init ("0"b), /* whether to print extra spacing */ 2 15 3 literal_sw bit (1) unaligned init ("0"b), /* ON => do not strip leading/trailing white space */ 2 16 3 prompt_after_explanation bit (1) unaligned init ("0"b), /* ON => repeat question after explanation */ 2 17 3 padding bit (29) unaligned init (""b), /* pads it out to t word */ 2 18 2 status_code fixed bin (35) init (0), /* query not prompted by any error, by default */ 2 19 2 query_code fixed bin (35) init (0), /* currently has no meaning */ 2 20 2 21 /* Limit of data defined for version 2 */ 2 22 2 23 2 question_iocbp ptr init (null ()), /* IO switch to write question */ 2 24 2 answer_iocbp ptr init (null ()), /* IO switch to read answer */ 2 25 2 repeat_time fixed bin (71) init (0), /* repeat question every N seconds if no answer */ 2 26 /* minimum of 30 seconds required for repeat */ 2 27 /* otherwise, no repeat will occur */ 2 28 /* Limit of data defined for version 4 */ 2 29 2 30 2 explanation_ptr ptr init (null ()), /* explanation of question to be printed if */ 2 31 2 explanation_len fixed bin (21) init (0); /* user answers "?" (disabled if ptr=null or len=0) */ 2 32 2 33 dcl query_info_version_3 fixed bin int static options (constant) init (3); 2 34 dcl query_info_version_4 fixed bin int static options (constant) init (4); 2 35 dcl query_info_version_5 fixed bin int static options (constant) init (5); 2 36 dcl query_info_version_6 fixed bin int static options (constant) init (6); /* the current version number */ 2 37 2 38 /* END INCLUDE FILE query_info.incl.pl1 */ 201 202 203 entry_point = QUERY; 204 go to COMMON; 205 206 207 response: entry options (variable); 208 209 entry_point = RESPONSE; 210 211 212 COMMON: 213 214 call cu_$af_arg_count (nargs, code); 215 if code = error_table_$not_act_fnc 216 then do; 217 called_as_active_function = "0"b; 218 rtn_string_ptr = addr (temp_string); 219 max_length = maxlength (temp_string); 220 get_arg = cu_$arg_ptr_rel; 221 error = com_err_; 222 end; 223 else if code = 0 224 then do; 225 called_as_active_function = "1"b; 226 call cu_$af_return_arg (nargs, rtn_string_ptr, max_length, code); 227 if code ^= 0 228 then do; 229 call active_fnc_err_ (code, (NAME (entry_point))); 230 return; 231 end; 232 get_arg = cu_$af_arg_ptr_rel; 233 error = active_fnc_err_; 234 end; 235 else do; 236 error = active_fnc_err_; 237 238 239 USAGE: 240 241 call error (code, (NAME (entry_point)), 242 "^/Usage: ^[[^]^a question {-control_args}^[]^]", 243 called_as_active_function, (NAME (entry_point)), 244 called_as_active_function); 245 return; 246 end; 247 if nargs < 1 248 then do; 249 code = error_table_$noarg; 250 goto USAGE; 251 end; 252 253 254 call cu_$arg_list_ptr (arg_list_ptr); 255 256 257 call get_arg (1, question_ptr, question_len, code, arg_list_ptr); 258 if code ^= 0 259 then do; 260 call error (code, (NAME (entry_point)), 261 "Referencing first argument."); 262 return; 263 end; 264 265 accept_null = "1"b; 266 answer = ""; 267 error_has_occured = "0"b; 268 first_acceptable_arg = 0; 269 no_trim = "0"b; 270 271 272 my_query_info.version = query_info_version_5; 273 my_query_info.switches.yes_or_no_sw = (entry_point = QUERY); 274 my_query_info.switches.suppress_name_sw = "1"b; 275 my_query_info.switches.cp_escape_control = "00"b; 276 my_query_info.switches.suppress_spacing = "0"b; 277 my_query_info.switches.padding = ""b; 278 my_query_info.status_code = 0; 279 my_query_info.query_code = 0; 280 my_query_info.question_iocbp = null (); 281 my_query_info.answer_iocbp = null (); 282 my_query_info.repeat_time = 0; 283 my_query_info.explanation_ptr = null (); 284 my_query_info.explanation_len = 0; 285 286 287 call Process_Control_Args (2); 288 if error_has_occured 289 then return; 290 291 print_iocbp = my_query_info.question_iocbp; 292 if print_iocbp = null then print_iocbp = iox_$user_io; 293 294 295 ASK: 296 297 if no_trim then call command_query_ (addr (my_query_info), answer, (NAME (entry_point)), 298 "^va", question_len, question); 299 else call command_query_ (addr (my_query_info), answer, (NAME (entry_point)), 300 "^a", question); 301 goto PROCESS (entry_point); 302 303 304 PROCESS (1): /* QUERY */ 305 306 if answer = "yes" 307 then answer = "true"; 308 else answer = "false"; 309 310 311 EXIT: 312 313 if ^called_as_active_function 314 then call ioa_ ("^a", answer); 315 return; 316 317 318 PROCESS (2): /* RESPONSE */ 319 320 if ^accept_null & answer = "" 321 then do; 322 call ioa_$ioa_switch (print_iocbp, 323 "^a: Null response not allowed, please retype.", 324 (NAME (entry_point))); 325 goto ASK; 326 end; 327 328 if first_acceptable_arg = 0 329 then goto EXIT; 330 331 do argn = first_acceptable_arg to nargs by 1; 332 call Get_Arg (argn, ""); 333 if answer = arg 334 then goto EXIT; 335 end; 336 call ioa_$ioa_switch (print_iocbp, 337 "^a: '^a' is not an acceptable answer.^/Acceptable answers are:", 338 (NAME (entry_point)), answer); 339 do argn = first_acceptable_arg to nargs; 340 call Get_Arg (argn, ""); 341 call ioa_$ioa_switch (print_iocbp, "^-'^a'", arg); 342 end; 343 goto ASK; 344 345 Process_Control_Args: procedure (first_argn); 346 347 348 dcl first_argn fixed bin; 349 dcl argn fixed bin; 350 351 352 do argn = first_argn repeat argn+1 while (argn <= nargs); 353 354 call Get_Arg (argn, ""); 355 356 if arg = "-accept" & entry_point = RESPONSE 357 then do; 358 first_acceptable_arg = argn+1; 359 if first_acceptable_arg > nargs 360 then do; 361 call error (error_table_$noarg, (NAME (entry_point)), 362 "Missing argument(s) following -accept."); 363 error_has_occured = "1"b; 364 end; 365 argn = nargs; 366 end; 367 368 else if arg = "-brief" | arg = "-bf" 369 then my_query_info.switches.suppress_spacing = "1"b; 370 371 else if arg = "-no_trim" then no_trim = "1"b; 372 373 else if arg = "-trim" then no_trim = "0"b; 374 375 else if arg = "-disable_cp_escape" | arg = "-dcpe" 376 then my_query_info.switches.cp_escape_control = "10"b; 377 378 else if arg = "-enable_cp_escape" | arg = "-ecpe" 379 then my_query_info.switches.cp_escape_control = "11"b; 380 381 else if arg = "-input_switch" | arg = "-isw" 382 then do; 383 call Get_Arg (argn+1, 384 "Missing I/O switch name following " || arg); 385 if addr (arg) ^= null () 386 then my_query_info.answer_iocbp = IOCBp (arg, "1"b); 387 argn = argn+1; 388 end; 389 390 else if arg = "-long" | arg = "-lg" 391 then my_query_info.switches.suppress_spacing = "0"b; 392 393 else if arg = "-non_null" & entry_point = RESPONSE 394 then accept_null = "0"b; 395 396 else if arg = "-output_switch" | arg = "-osw" 397 then do; 398 call Get_Arg (argn+1, 399 "Missing I/O switch name following " || arg); 400 if addr (arg) ^= null () 401 then my_query_info.question_iocbp = IOCBp (arg, "0"b); 402 argn = argn+1; 403 end; 404 405 else if arg = "-repeat" | arg = "-rp" 406 then do; 407 call Get_Arg (argn+1, 408 "Missing repeat interval following " || arg); 409 if addr (arg) ^= null () 410 then my_query_info.repeat_time = Date_Time (arg); 411 argn = argn+1; 412 end; 413 414 else do; 415 call error (error_table_$badopt, (NAME (entry_point)), 416 "^a", arg); 417 error_has_occured = "1"b; 418 end; 419 420 end; 421 422 423 return; 424 425 IOCBp: procedure (switch_name, input_flag) returns (ptr); 426 427 428 dcl input_flag bit (1); 429 dcl iocbp ptr; 430 dcl switch_name char (*); 431 432 433 call iox_$look_iocb (switch_name, iocbp, code); 434 if code ^= 0 435 then do; 436 call error (code, (NAME (entry_point)), "^a", switch_name); 437 error_has_occured = "1"b; 438 return (null ()); 439 end; 440 441 if iocbp -> iocb.open_descrip_ptr = null () 442 then do; 443 call error (error_table_$not_open, (NAME (entry_point)), 444 "^a", switch_name); 445 error_has_occured = "1"b; 446 return (null ()); 447 end; 448 449 if substr (iocbp -> iocb.open_descrip_ptr -> open_descrip.string, 1, 19) = "stream_input_output" 450 then return (iocbp); 451 if substr (iocbp -> iocb.open_descrip_ptr -> open_descrip.string, 1, 12) = "stream_input" & input_flag 452 then return (iocbp); 453 if substr (iocbp -> iocb.open_descrip_ptr -> open_descrip.string, 1, 13) = "stream_output" & ^input_flag 454 then return (iocbp); 455 456 457 call error (0, (NAME (entry_point)), 458 "I/O switch ^a not open for stream_^[input^;output^] or stream_input_output.", 459 switch_name, input_flag); 460 error_has_occured = "1"b; 461 return (null ()); 462 463 464 end IOCBp; 465 466 Date_Time: procedure (date_time_string) returns (fixed bin (71)); 467 468 469 dcl current_date_time fixed bin (71); 470 dcl date_time fixed bin (71); 471 dcl date_time_string char (*); 472 473 474 current_date_time = clock (); 475 call convert_date_to_binary_$relative (date_time_string, 476 date_time, current_date_time, code); 477 date_time = divide ((date_time-current_date_time), 1000000, 71, 0); 478 479 if code ^= 0 480 then do; 481 call error (code, (NAME (entry_point)), 482 "Converting ""^a"" to binary date/time.", 483 date_time_string); 484 error_has_occured = "1"b; 485 return (0); 486 end; 487 else if date_time < 30 /* 30 seconds */ 488 then do; 489 call error (error_table_$bad_arg, (NAME (entry_point)), 490 "Specified date/time is not ^[far enough ^]in the future. ^a", 491 (date_time > 0), date_time_string); 492 error_has_occured = "1"b; 493 return (0); 494 end; 495 496 497 return (date_time); 498 499 500 end Date_Time; 501 502 503 end Process_Control_Args; 504 505 Get_Arg: procedure (argn, mess); 506 507 508 dcl argn fixed bin; 509 dcl mess char (*); 510 511 512 call get_arg (argn, arg_ptr, arg_len, code, arg_list_ptr); 513 if code = 0 514 then return; 515 516 517 call error (code, (NAME (entry_point)), 518 "^[Refencing argument ^d^s^;^s^a^].", 519 (mess = ""), argn, mess); 520 521 522 arg_ptr = null (); 523 arg_len = 0; 524 error_has_occured = "1"b; 525 526 527 return; 528 529 530 end Get_Arg; 531 532 533 end query; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/12/88 1245.0 query.pl1 >spec>install>1012>query.pl1 199 1 05/20/83 1846.4 iocb.incl.pl1 >ldd>include>iocb.incl.pl1 201 2 03/11/83 1204.3 query_info.incl.pl1 >ldd>include>query_info.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. NAME 000002 constant char(8) initial array unaligned dcl 127 ref 229 239 239 260 295 299 322 336 361 415 436 443 457 481 489 517 QUERY constant fixed bin(17,0) initial dcl 128 ref 203 273 RESPONSE constant fixed bin(17,0) initial dcl 129 ref 209 356 393 accept_null 000100 automatic bit(1) unaligned dcl 133 set ref 265* 318 393* active_fnc_err_ 000022 constant entry external dcl 176 ref 229 233 236 addr builtin function dcl 192 ref 218 295 295 299 299 385 400 409 answer based varying char dcl 158 set ref 266* 295* 299* 304 304* 308* 311* 318 333 336* answer_iocbp 6 000360 automatic pointer initial level 2 in structure "query_info" dcl 2-7 in procedure "query" set ref 2-7* answer_iocbp 6 000342 automatic pointer initial level 2 in structure "my_query_info" dcl 154 in procedure "query" set ref 154* 281* 385* arg based char unaligned dcl 159 set ref 333 341* 356 368 368 371 373 375 375 378 378 381 381 383 385 385* 390 390 393 396 396 398 400 400* 405 405 407 409 409* 415* arg_len 000101 automatic fixed bin(17,0) dcl 134 set ref 333 341 341 356 368 368 371 373 375 375 378 378 381 381 383 385 385 385 390 390 393 396 396 398 400 400 400 405 405 407 409 409 409 415 415 512* 523* arg_list_ptr 000102 automatic pointer dcl 135 set ref 254* 257* 512* arg_ptr 000104 automatic pointer dcl 136 set ref 333 341 356 368 368 371 373 375 375 378 378 381 381 383 385 385 390 390 393 396 396 398 400 400 405 405 407 409 409 415 512* 522* argn 000106 automatic fixed bin(17,0) dcl 137 in procedure "query" set ref 331* 332* 339* 340* argn parameter fixed bin(17,0) dcl 508 in procedure "Get_Arg" set ref 505 512* 517* argn 000406 automatic fixed bin(17,0) dcl 349 in procedure "Process_Control_Args" set ref 352* 352* 354* 358 365* 383 387* 387 398 402* 402 407 411* 411* 420 called_as_active_function 000107 automatic bit(1) unaligned dcl 138 set ref 217* 225* 239* 239* 311 clock builtin function dcl 193 ref 474 code 000110 automatic fixed bin(35,0) dcl 139 set ref 212* 215 223 226* 227 229* 239* 249* 257* 258 260* 433* 434 436* 475* 479 481* 512* 513 517* com_err_ 000024 constant entry external dcl 177 ref 221 command_query_ 000026 constant entry external dcl 178 ref 295 299 convert_date_to_binary_$relative 000030 constant entry external dcl 179 ref 475 cp_escape_control 1(02) 000342 automatic bit(2) initial level 3 in structure "my_query_info" packed unaligned dcl 154 in procedure "query" set ref 154* 275* 375* 378* cp_escape_control 1(02) 000360 automatic bit(2) initial level 3 in structure "query_info" packed unaligned dcl 2-7 in procedure "query" set ref 2-7* cu_$af_arg_count 000032 constant entry external dcl 180 ref 212 cu_$af_arg_ptr_rel 000034 constant entry external dcl 181 ref 232 cu_$af_return_arg 000036 constant entry external dcl 182 ref 226 cu_$arg_list_ptr 000040 constant entry external dcl 183 ref 254 cu_$arg_ptr_rel 000042 constant entry external dcl 184 ref 220 current_date_time 000426 automatic fixed bin(71,0) dcl 469 set ref 474* 475* 477 date_time 000430 automatic fixed bin(71,0) dcl 470 set ref 475* 477* 477 487 489 497 date_time_string parameter char unaligned dcl 471 set ref 466 475* 481* 489* divide builtin function dcl 194 ref 477 entry_point 000111 automatic fixed bin(17,0) dcl 140 set ref 203* 209* 229 239 239 260 273 295 299 301 322 336 356 361 393 415 436 443 457 481 489 517 error 000112 automatic entry variable dcl 141 set ref 221* 233* 236* 239 260 361 415 436 443 457 481 489 517 error_has_occured 000116 automatic bit(1) unaligned dcl 142 set ref 267* 288 363* 417* 437* 445* 460* 484* 492* 524* error_table_$bad_arg 000010 external static fixed bin(35,0) dcl 168 set ref 489* error_table_$badopt 000012 external static fixed bin(35,0) dcl 169 set ref 415* error_table_$noarg 000014 external static fixed bin(35,0) dcl 170 set ref 249 361* error_table_$not_act_fnc 000016 external static fixed bin(35,0) dcl 171 ref 215 error_table_$not_open 000020 external static fixed bin(35,0) dcl 172 set ref 443* explanation_len 14 000342 automatic fixed bin(21,0) initial level 2 in structure "my_query_info" dcl 154 in procedure "query" set ref 154* 284* explanation_len 14 000360 automatic fixed bin(21,0) initial level 2 in structure "query_info" dcl 2-7 in procedure "query" set ref 2-7* explanation_ptr 12 000360 automatic pointer initial level 2 in structure "query_info" dcl 2-7 in procedure "query" set ref 2-7* explanation_ptr 12 000342 automatic pointer initial level 2 in structure "my_query_info" dcl 154 in procedure "query" set ref 154* 283* first_acceptable_arg 000117 automatic fixed bin(17,0) dcl 143 set ref 268* 328 331 339 358* 359 first_argn parameter fixed bin(17,0) dcl 348 ref 345 352 get_arg 000120 automatic entry variable dcl 144 set ref 220* 232* 257 512 input_flag parameter bit(1) unaligned dcl 428 set ref 425 451 453 457* ioa_ 000044 constant entry external dcl 185 ref 311 ioa_$ioa_switch 000046 constant entry external dcl 186 ref 322 336 341 iocb based structure level 1 dcl 1-6 iocbp 000416 automatic pointer dcl 429 set ref 433* 441 449 449 451 451 453 453 iox_$look_iocb 000050 constant entry external dcl 187 ref 433 iox_$user_io 000052 external static pointer dcl 188 ref 292 length based fixed bin(17,0) level 2 dcl 162 ref 449 451 453 literal_sw 1(05) 000360 automatic bit(1) initial level 3 in structure "query_info" packed unaligned dcl 2-7 in procedure "query" set ref 2-7* literal_sw 1(05) 000342 automatic bit(1) initial level 3 in structure "my_query_info" packed unaligned dcl 154 in procedure "query" set ref 154* max_length 000124 automatic fixed bin(17,0) dcl 145 set ref 219* 226* 266 295 299 304 308 311 336 maxlength builtin function dcl 195 ref 219 mess parameter char unaligned dcl 509 set ref 505 517 517* my_query_info 000342 automatic structure level 1 unaligned dcl 154 set ref 295 295 299 299 nargs 000125 automatic fixed bin(17,0) dcl 146 set ref 212* 226* 247 331 339 352 359 365 no_trim 000126 automatic bit(1) unaligned dcl 147 set ref 269* 295 371* 373* null builtin function dcl 196 ref 154 154 154 280 281 283 292 2-7 2-7 2-7 385 400 409 438 441 446 461 522 open_descrip based structure level 1 dcl 162 open_descrip_ptr 20 based pointer level 2 dcl 1-6 ref 441 449 451 453 padding 1(07) 000360 automatic bit(29) initial level 3 in structure "query_info" packed unaligned dcl 2-7 in procedure "query" set ref 2-7* padding 1(07) 000342 automatic bit(29) initial level 3 in structure "my_query_info" packed unaligned dcl 154 in procedure "query" set ref 154* 277* print_iocbp 000130 automatic pointer dcl 148 set ref 291* 292 292* 322* 336* 341* prompt_after_explanation 1(06) 000360 automatic bit(1) initial level 3 in structure "query_info" packed unaligned dcl 2-7 in procedure "query" set ref 2-7* prompt_after_explanation 1(06) 000342 automatic bit(1) initial level 3 in structure "my_query_info" packed unaligned dcl 154 in procedure "query" set ref 154* query_code 3 000342 automatic fixed bin(35,0) initial level 2 in structure "my_query_info" dcl 154 in procedure "query" set ref 154* 279* query_code 3 000360 automatic fixed bin(35,0) initial level 2 in structure "query_info" dcl 2-7 in procedure "query" set ref 2-7* query_info 000360 automatic structure level 1 dcl 2-7 query_info_version_5 constant fixed bin(17,0) initial dcl 2-35 ref 272 question based char unaligned dcl 160 set ref 295* 299* question_iocbp 4 000360 automatic pointer initial level 2 in structure "query_info" dcl 2-7 in procedure "query" set ref 2-7* question_iocbp 4 000342 automatic pointer initial level 2 in structure "my_query_info" dcl 154 in procedure "query" set ref 154* 280* 291 400* question_len 000132 automatic fixed bin(17,0) dcl 149 set ref 257* 295* 295 295 299 299 question_ptr 000134 automatic pointer dcl 150 set ref 257* 295 299 repeat_time 10 000342 automatic fixed bin(71,0) initial level 2 in structure "my_query_info" dcl 154 in procedure "query" set ref 154* 282* 409* repeat_time 10 000360 automatic fixed bin(71,0) initial level 2 in structure "query_info" dcl 2-7 in procedure "query" set ref 2-7* rtn_string_ptr 000136 automatic pointer dcl 151 set ref 218* 226* 266 295 299 304 304 308 311 318 333 336 status_code 2 000360 automatic fixed bin(35,0) initial level 2 in structure "query_info" dcl 2-7 in procedure "query" set ref 2-7* status_code 2 000342 automatic fixed bin(35,0) initial level 2 in structure "my_query_info" dcl 154 in procedure "query" set ref 154* 278* string 1 based char level 2 dcl 162 ref 449 451 453 substr builtin function dcl 197 ref 449 451 453 suppress_name_sw 1(01) 000360 automatic bit(1) initial level 3 in structure "query_info" packed unaligned dcl 2-7 in procedure "query" set ref 2-7* suppress_name_sw 1(01) 000342 automatic bit(1) initial level 3 in structure "my_query_info" packed unaligned dcl 154 in procedure "query" set ref 154* 274* suppress_spacing 1(04) 000360 automatic bit(1) initial level 3 in structure "query_info" packed unaligned dcl 2-7 in procedure "query" set ref 2-7* suppress_spacing 1(04) 000342 automatic bit(1) initial level 3 in structure "my_query_info" packed unaligned dcl 154 in procedure "query" set ref 154* 276* 368* 390* switch_name parameter char unaligned dcl 430 set ref 425 433* 436* 443* 457* switches 1 000360 automatic structure level 2 in structure "query_info" dcl 2-7 in procedure "query" switches 1 000342 automatic structure level 2 in structure "my_query_info" dcl 154 in procedure "query" temp_string 000140 automatic varying char(512) dcl 152 set ref 218 219 version 000342 automatic fixed bin(17,0) level 2 dcl 154 set ref 272* yes_or_no_sw 1 000360 automatic bit(1) initial level 3 in structure "query_info" packed unaligned dcl 2-7 in procedure "query" set ref 2-7* yes_or_no_sw 1 000342 automatic bit(1) initial level 3 in structure "my_query_info" packed unaligned dcl 154 in procedure "query" set ref 154* 273* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. iox_$iocb_version_sentinel external static char(4) dcl 1-51 query_info_version_3 internal static fixed bin(17,0) initial dcl 2-33 query_info_version_4 internal static fixed bin(17,0) initial dcl 2-34 query_info_version_6 internal static fixed bin(17,0) initial dcl 2-36 NAMES DECLARED BY EXPLICIT CONTEXT. ASK 000771 constant label dcl 295 ref 325 343 COMMON 000441 constant label dcl 212 ref 204 Date_Time 002446 constant entry internal dcl 466 ref 409 EXIT 001153 constant label dcl 311 ref 328 333 Get_Arg 002650 constant entry internal dcl 505 ref 332 340 354 383 398 407 IOCBp 002167 constant entry internal dcl 425 ref 385 400 PROCESS 000000 constant label array(2) dcl 304 ref 301 Process_Control_Args 001420 constant entry internal dcl 345 ref 287 USAGE 000555 constant label dcl 239 ref 250 query 000417 constant entry external dcl 13 response 000431 constant entry external dcl 207 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3236 3312 3006 3246 Length 3552 3006 54 223 230 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME query 552 external procedure is an external procedure. Process_Control_Args internal procedure shares stack frame of external procedure query. IOCBp internal procedure shares stack frame of external procedure query. Date_Time internal procedure shares stack frame of external procedure query. Get_Arg 110 internal procedure is called during a stack extension. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME query 000100 accept_null query 000101 arg_len query 000102 arg_list_ptr query 000104 arg_ptr query 000106 argn query 000107 called_as_active_function query 000110 code query 000111 entry_point query 000112 error query 000116 error_has_occured query 000117 first_acceptable_arg query 000120 get_arg query 000124 max_length query 000125 nargs query 000126 no_trim query 000130 print_iocbp query 000132 question_len query 000134 question_ptr query 000136 rtn_string_ptr query 000140 temp_string query 000342 my_query_info query 000360 query_info query 000406 argn Process_Control_Args 000416 iocbp IOCBp 000426 current_date_time Date_Time 000430 date_time Date_Time THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a r_e_as alloc_char_temp call_ent_var_desc call_ent_var call_ext_out_desc call_ext_out call_int_this_desc return_mac shorten_stack ext_entry int_entry_desc divide_fx3 clock_mac THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ com_err_ command_query_ convert_date_to_binary_$relative cu_$af_arg_count cu_$af_arg_ptr_rel cu_$af_return_arg cu_$arg_list_ptr cu_$arg_ptr_rel ioa_ ioa_$ioa_switch iox_$look_iocb THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$badopt error_table_$noarg error_table_$not_act_fnc error_table_$not_open iox_$user_io LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 154 000334 2 7 000364 13 000416 203 000425 204 000427 207 000430 209 000437 212 000441 215 000452 217 000456 218 000457 219 000461 220 000463 221 000467 222 000472 223 000473 225 000475 226 000477 227 000513 229 000515 230 000537 232 000540 233 000545 234 000550 236 000551 239 000555 245 000621 247 000622 249 000625 250 000627 254 000630 257 000636 258 000656 260 000660 262 000710 265 000711 266 000713 267 000714 268 000715 269 000716 272 000717 273 000721 274 000727 275 000731 276 000733 277 000735 278 000737 279 000740 280 000741 281 000743 282 000744 283 000746 284 000750 287 000751 288 000755 291 000757 292 000761 295 000771 299 001051 301 001122 304 001124 308 001143 311 001153 315 001201 318 001202 322 001212 325 001243 328 001244 331 001246 332 001255 333 001271 335 001301 336 001303 339 001344 340 001353 341 001367 342 001415 343 001417 345 001420 352 001422 354 001427 356 001443 358 001456 359 001461 361 001463 363 001514 365 001516 366 001520 368 001521 371 001536 373 001545 375 001553 378 001570 381 001603 383 001613 385 001646 387 001702 388 001703 390 001704 393 001717 396 001727 398 001737 400 001772 402 002026 403 002027 405 002030 407 002040 409 002073 411 002121 412 002122 415 002123 417 002162 420 002164 423 002166 425 002167 433 002200 434 002223 436 002225 437 002262 438 002264 441 002270 443 002275 445 002333 446 002335 449 002341 451 002351 453 002366 457 002376 460 002440 461 002442 466 002446 474 002457 475 002461 477 002507 479 002515 481 002517 484 002555 485 002557 487 002563 489 002567 492 002635 493 002637 497 002643 505 002647 512 002663 513 002703 517 002706 522 002763 523 002766 524 002767 527 002771 ----------------------------------------------------------- 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