COMPILATION LISTING OF SEGMENT hcom_command_query_ Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 10/24/88 1433.7 mst Mon Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1985 * 4* * * 5* *********************************************************** */ 6 /****^ HISTORY COMMENTS: 7* 1) change(85-09-03,LJAdams), approve(85-11-06,MCR7278), 8* audit(86-02-19,Gilcrease), install(86-02-19,MR12.0-1021): 9* Version of command_query_ that allows inputting 10* of multiple lines of text for the history comment summary field. 11* END HISTORY COMMENTS */ 12 hcom_command_query_: 13 procedure (qip, varying_answer); 14 15 /* BEGIN DESCRIPTION */ 16 17 /* function: */ 18 19 /* The standard procedure to ask a question and read the user's answer: the question is formatted and the condition 20* "command_question" is signalled allowing for programs like "answer" to supply answers automatically; the 21* "repeat_query" command is also contained herein to reask the last question */ 22 23 /* history: */ 24 25 /* Created: September 1971 by Jerry Stern */ 26 /* Modified: 15 September 1971 by Jerry Stern */ 27 /* Modified: 20 November 1975 by Steve Herbst to add the repeat_query command */ 28 /* Modified: 26 October 1976 by Paul Green to switch to iox_ (get it?) */ 29 /* Modified: 13 June 1978 by Steve Herbst to add the temporary entry point user_io */ 30 /* Modified: July 1978 by J. C. Whitmore to remove user_io entry in favor of extended info structures */ 31 /* Modified: 11 August 1978 by W. O. Sibert to add cu_$cp escape feature and set_allow_cp_escape entrypoint */ 32 /* Modified: 23 January 1979 by William M. York to fix overlength substr assignment bug (see MCR 3661), lengthen the 33* internal buffers, and call iox_$put_chars directly, avoiding the 256 char ioa_ restriction */ 34 /* Modified: 7 September 1979 by Steve Herbst to signal command_query_error for bad answers in absentee */ 35 /* Modified: 8 May 1981 by Steve Herbst to add command_query_$yes_no, the explanantion feature, and to accept y/n */ 36 /* Modified: June 1981 by Benson Margulies to set the quiet_restart bit in condition structure */ 37 /* Modified: 6 August 1981 by Richard Lamson to fix out-of-range version numbers in query_info structure */ 38 /* Modified: 11 March 1982 by G. Palter to issue reset_more control order before asking questions */ 39 /* Modified: 12/15/82 by S. Herbst to add literal_sw, prompt_after_explanation, and cp_escape_control value "01"b */ 40 /* Modified: 02/08/84 by S. Herbst to check whether called with varying or nonvarying answer arg */ 41 /* Modified: 02/08/84 by S. Herbst to change length fields in command_question_info.incl.pl1 from fixed to fixed (21) */ 42 /* Modified: 03/27/84 by S. Herbst to say "Answer yes, no, or ? for an explanation" */ 43 /* Modified: 06/14/84 by S. Herbst to call sub_err_ if error from iox_ writing question/reading answer */ 44 /* Modified: 01/08/85 by J. Backs to accept case insensitive yes or no answer by translating answer before testing, 45* plus minor changes to include some coding standards for readablity */ 46 47 48 /* format: style4,delnl,insnl,ifthenstmt,ifthen */ 49 50 51 /* PARAMETERS */ 52 53 dcl varying_answer character (*) varying parameter; 54 dcl qip pointer parameter; 55 dcl yes_sw bit (1) parameter; 56 dcl A_query_code fixed binary (35) parameter; 57 58 59 /* CONSTANTS */ 60 dcl False bit(1) init("0"b) int static options(constant), 61 True bit(1) init("1"b) int static options(constant); 62 dcl GRIPE1 character (27) static options (constant) initial 63 ("Please answer yes or no. "); 64 dcl GRIPE2 character (50) static options (constant) initial 65 ("Please answer yes, no, or ? for an explanation. "); 66 dcl LOWERCASE_YN character (5) static options (constant) initial ("yesno"); 67 dcl NL character (1) static options (constant) initial (" 68 "); 69 dcl SPACE_SPACE character (2) static options (constant) init (" "); 70 dcl UPPERCASE_YN character (5) static options (constant) initial ("YESNO"); 71 dcl WHITE character (5) static options (constant) initial (/* SP HT VT FF NL */ " 72 "); 73 74 /* BASED */ 75 76 dcl alloc_str character (alloc_len) based (alloc_ptr); 77 dcl big_str character (big_len) based (big_ptr); 78 dcl callername character (question_info.name_lth) based (question_info.name_ptr); 79 dcl explanation character (query_info.explanation_len) based (query_info.explanation_ptr); 80 dcl fixed_answer char (fixed_answer_len) based (fixed_answer_ptr); 81 dcl question character (question_info.question_lth) based (question_info.question_ptr); 82 dcl nchars fixed binary (21) based; 83 dcl area area based (area_ptr); 84 85 dcl 1 input_info aligned based (qip) like query_info; 86 87 /* AUTOMATIC */ 88 89 dcl (abs_queue, arg_count, bi, callername_index, control_string_index, ndims, scale, type) fixed binary; 90 dcl (alloc_len, big_len, fixed_answer_len, fixed21, len) fixed binary (21); 91 dcl (alloc_ptr, area_ptr, alp, big_ptr, fixed_answer_ptr) pointer; 92 dcl (alloc_sw, allow_cp_escape, fixed_answer_sw, interpret_cp_escape) bit (1) aligned; 93 dcl buffer character (1000) aligned; 94 dcl code fixed binary (35); 95 dcl (ending_delim_found, multi_line_sw) bit(1); 96 dcl error_string character (100) aligned; 97 dcl Lanswer fixed bin(21); 98 dcl output_buffer character (1004) aligned; 99 dcl (packed, saved_rflag, timer_set, yn_entry_sw) bit (1) aligned; 100 dcl 1 question_info aligned like command_question_info; 101 dcl retstring character (1000); 102 dcl saved_rlabel label variable; 103 dcl yn_answer character (500) aligned varying; 104 105 /* BUILTINS */ 106 107 dcl (addr, addrel, bin, bit, index, length, ltrim, max, maxlength, min, null, 108 rtrim, size, substr, translate, unspec) builtin; 109 110 /* CONDITIONS */ 111 112 dcl cleanup condition; 113 114 /* EXTERNAL STATIC */ 115 116 dcl iox_$user_input pointer external; 117 dcl iox_$user_io pointer external; 118 dcl iox_$user_output pointer external; 119 120 dcl error_table_$long_record fixed binary (35) external; 121 122 /* INTERNAL STATIC */ 123 124 dcl repeat_label label variable static; 125 dcl repeat_flag bit (1) aligned initial ("0"b) static; 126 127 dcl first_call bit (1) static initial ("1"b); 128 dcl static_allow_cp_escape bit (1) aligned static initial ("0"b); 129 130 /* ENTRIES */ 131 132 dcl com_err_ entry () options (variable); 133 dcl convert_status_code_ entry (fixed binary (35), character (8) aligned, character (100) aligned); 134 dcl cu_$arg_count entry (fixed binary); 135 dcl cu_$arg_list_ptr entry (pointer); 136 dcl cu_$arg_ptr entry (fixed binary, pointer, fixed binary (21), fixed binary (35)); 137 dcl cu_$cp entry (pointer, fixed binary (21), fixed binary (35)); 138 dcl decode_descriptor_ 139 entry (pointer, fixed binary, fixed binary, bit (1) aligned, fixed binary, fixed binary, fixed binary); 140 dcl get_group_id_ entry () returns (character (32)); 141 dcl get_system_free_area_ entry () returns (pointer); 142 dcl ioa_ entry() options(variable); 143 dcl ioa_$general_rs 144 entry (pointer, fixed binary, fixed binary, character (*), fixed binary (21), bit (1) aligned, bit (1) aligned); 145 dcl ioa_$ioa_switch entry () options (variable); 146 dcl ioa_$ioa_switch_nnl entry () options (variable); 147 dcl iox_$control entry (pointer, character (*), pointer, fixed binary (35)); 148 dcl iox_$get_line entry (pointer, pointer, fixed binary (21), fixed binary (21), fixed binary (35)); 149 dcl iox_$put_chars entry (pointer, pointer, fixed binary (21), fixed binary (35)); 150 dcl signal_ entry (character (*), pointer, pointer, pointer); 151 dcl sub_err_ entry () options (variable); 152 dcl timer_manager_$alarm_call entry (fixed binary (71), bit (2) aligned, entry); 153 dcl timer_manager_$reset_alarm_call entry (entry); 154 dcl user_info_$absentee_queue entry (fixed binary); 155 156 /* BEGIN */ 157 158 /* hcom_command_query_: entry (qip, varying_answer); */ 159 160 query_info.version = input_info.version; 161 if query_info.version < 1 | query_info.version > 7 then do; 162 /* Old programs are grandfathered */ 163 query_info.version = 2; /* Harmless version number */ 164 end; 165 166 yn_entry_sw = "0"b; 167 callername_index = 3; 168 control_string_index = 4; 169 query_info.yes_or_no_sw = input_info.yes_or_no_sw;/* copy the input data */ 170 query_info.suppress_name_sw = input_info.suppress_name_sw; 171 query_info.status_code = input_info.status_code; 172 query_info.query_code = input_info.query_code; 173 multi_line_sw = False; 174 175 if query_info.version >= 3 then do; /* if more is defined, use it */ 176 if query_info.version >= 4 then do; /* use new bits */ 177 query_info.cp_escape_control = input_info.cp_escape_control; 178 query_info.suppress_spacing = input_info.suppress_spacing; 179 if query_info.version >= 5 then do; 180 query_info.explanation_len = input_info.explanation_len; 181 if query_info.explanation_len ^= 0 then query_info.explanation_ptr = input_info.explanation_ptr; 182 if query_info.version >= 6 then do; 183 query_info.literal_sw = input_info.literal_sw; 184 query_info.prompt_after_explanation = input_info.prompt_after_explanation; 185 if query_info.version >= 7 then do; 186 if input_info.ending_delim ^= "" then do; 187 multi_line_sw = True; 188 query_info.ending_delim = input_info.ending_delim; 189 query_info.ending_delim_description = input_info.ending_delim_description; 190 ending_delim_found = False; 191 end; 192 end; 193 end; 194 end; 195 end; 196 query_info.question_iocbp = input_info.question_iocbp; 197 query_info.answer_iocbp = input_info.answer_iocbp; 198 query_info.repeat_time = input_info.repeat_time; 199 end; 200 201 if query_info.literal_sw | query_info.cp_escape_control = "01"b then do; 202 allow_cp_escape = "1"b; 203 interpret_cp_escape = "0"b; 204 end; 205 else if query_info.cp_escape_control = "11"b then allow_cp_escape, interpret_cp_escape = "1"b; 206 else if query_info.cp_escape_control = "10"b then allow_cp_escape, interpret_cp_escape = "0"b; 207 else allow_cp_escape, interpret_cp_escape = static_allow_cp_escape; 208 209 go to COMMON; 210 211 212 /* format: off */ 213 /* An easy-to-use entry which requires a yes/no answer: 214* call hcom_command_query_$yes_no (yes_sw, status_code, callername, explanation, control_string, args...) */ 215 /* format: on */ 216 217 yes_no: 218 entry (yes_sw, A_query_code); 219 220 yn_entry_sw = "1"b; 221 callername_index = 3; 222 control_string_index = 5; 223 unspec (query_info) = "0"b; 224 query_info.yes_or_no_sw = "1"b; 225 query_info.query_code = A_query_code; 226 query_info.question_iocbp, query_info.answer_iocbp = null; 227 allow_cp_escape, interpret_cp_escape = static_allow_cp_escape; 228 229 230 COMMON: 231 if first_call then do; /* be sure the labels are correctly defined */ 232 repeat_label = ASK; /* basis for saved label */ 233 repeat_flag = "0"b; 234 first_call = "0"b; /* done for this process */ 235 end; 236 saved_rflag = repeat_flag; /* save the state of any previous invocation */ 237 saved_rlabel = repeat_label; 238 repeat_label = ASK; /* redefine question repeat label to this block */ 239 repeat_flag = "0"b; /* but a repeat is not defined yet */ 240 timer_set = "0"b; /* no repeat timer set for this block */ 241 242 call cu_$arg_count (arg_count); 243 call cu_$arg_list_ptr (alp); /* get arglist ptr */ 244 245 if ^yn_entry_sw then do; /* find out if answer arg is varying or non */ 246 call decode_descriptor_ (alp, 2, type, packed, ndims, 0, scale); 247 fixed_answer_sw = (type = char_dtype); 248 if fixed_answer_sw then do; 249 call cu_$arg_ptr (2, fixed_answer_ptr, fixed_answer_len, 0); 250 Lanswer = 0; 251 end; 252 else 253 varying_answer = ""; 254 end; 255 256 call cu_$arg_ptr (callername_index, question_info.name_ptr, fixed21, 0); 257 question_info.name_lth = fixed21; 258 call decode_descriptor_ (alp, callername_index, type, packed, ndims, question_info.name_lth, scale); 259 /* get data type & length of callername */ 260 if type = varying_char_dtype then /* varying string, must get current length */ 261 question_info.name_lth = addrel (question_info.name_ptr, -1) -> nchars; 262 /* the kludge shows its face */ 263 264 /* get callername */ 265 266 bi = 1; 267 buffer = ""; 268 if ^query_info.suppress_name_sw then 269 if question_info.name_lth ^= 0 then do; /* put caller name in buffer */ 270 buffer = rtrim (callername); 271 if buffer ^= "" then do; 272 bi = length (rtrim (buffer)) + 3; 273 substr (buffer, bi - 2, 2) = ": "; 274 end; 275 end; 276 277 /* Get query_code message and verbose explanation of question for $yes_no */ 278 279 if yn_entry_sw then do; 280 if A_query_code ^= 0 then do; 281 call convert_status_code_ (A_query_code, "", error_string); 282 substr(buffer, bi, length(error_string)) = error_string; 283 bi = length(rtrim(buffer)) + 3; 284 end; 285 call cu_$arg_ptr (callername_index + 1, query_info.explanation_ptr, query_info.explanation_len, code); 286 if code ^= 0 | query_info.explanation_len = 0 then query_info.explanation_ptr = null; 287 end; 288 289 /* get user message */ 290 291 if arg_count >= control_string_index then do; 292 call ioa_$general_rs (alp, control_string_index, control_string_index + 1, retstring, len, "0"b, "0"b); 293 len = min (len, length (buffer) - bi + 1); 294 substr (buffer, bi, len) = substr (retstring, 1, len); 295 bi = bi + len; 296 if multi_line_sw then do; 297 bi = length(rtrim(buffer)) + length(NL); 298 substr (buffer,bi,length(NL)) = NL; 299 bi = bi + 1; 300 end; 301 end; 302 303 /* fill in question_info...which will be passed to the handler of the command_question condition. */ 304 305 get_ready_to_signal: 306 question_info.length = size (question_info); 307 question_info.version = cq_info_version_7; 308 question_info.action_flags.cant_restart = "0"b; 309 question_info.action_flags.default_restart = "1"b; 310 question_info.action_flags.quiet_restart = "1"b; 311 question_info.status_code = query_info.status_code; 312 question_info.query_code = query_info.query_code; 313 question_info.question_sw = "1"b; /* by default, print the question */ 314 question_info.yes_or_no_sw = query_info.yes_or_no_sw; 315 question_info.preset_sw = "0"b; /* don't expect a preset answer */ 316 question_info.answer_sw = "1"b; /* but if one comes, print it by default */ 317 question_info.allow_cp_escape = allow_cp_escape; /* computed earlier */ 318 question_info.suppress_spacing = query_info.suppress_spacing; 319 question_info.interpret_cp_escape = interpret_cp_escape; 320 question_info.literal_sw = query_info.literal_sw; 321 question_info.prompt_after_explanation = query_info.prompt_after_explanation; 322 question_info.max_question_lth = size (buffer); 323 question_info.question_ptr = addr (buffer); 324 question_info.question_lth = bi - 1; 325 question_info.info_string = substr (buffer, 1, question_info.question_lth); 326 if yn_entry_sw then do; 327 question_info.answer_ptr, big_ptr = addrel (addr (yn_answer), 1); 328 question_info.max_answer_lth = maxlength (yn_answer); 329 end; 330 else do; 331 if fixed_answer_sw then do; 332 question_info.answer_ptr, big_ptr = fixed_answer_ptr; 333 question_info.max_answer_lth = fixed_answer_len; 334 end; 335 else do; /* varying answer, skip the length word */ 336 question_info.answer_ptr, big_ptr = addrel (addr (varying_answer), 1); 337 question_info.max_answer_lth = maxlength (varying_answer); 338 end; 339 end; 340 question_info.question_iocbp = query_info.question_iocbp; 341 /* give handler caller's output switch */ 342 question_info.answer_iocbp = query_info.answer_iocbp; 343 /* and input switch */ 344 question_info.repeat_time = query_info.repeat_time; 345 /* and also caller's repeat time */ 346 question_info.explanation_ptr = query_info.explanation_ptr; 347 question_info.explanation_len = query_info.explanation_len; 348 349 alloc_ptr = null; 350 351 /* signal command_question */ 352 353 SIGNAL: 354 call signal_ ("command_question", null, addr (question_info), null); 355 356 on cleanup call clean_up; 357 358 if question_info.question_sw & ^question_info.preset_sw then 359 repeat_flag = "1"b; /* if asking a question */ 360 else repeat_flag = "0"b; 361 362 if question_info.question_iocbp = null then /* if no output switch defined by caller or handler */ 363 if question_info.preset_sw then 364 question_info.question_iocbp = iox_$user_output; 365 /* put question in file?? */ 366 else question_info.question_iocbp = iox_$user_io; 367 /* if really asking, go to the terminal */ 368 369 if question_info.answer_iocbp = null then /* if no input switch defined by caller or handler */ 370 question_info.answer_iocbp = iox_$user_input;/* set the default input switch */ 371 372 ASK: 373 if question_info.question_sw then do; /* do we print the question? */ 374 if ^question_info.preset_sw then /* and if we need a reply ... */ 375 call iox_$control (question_info.question_iocbp, "reset_more", null (), (0)); 376 /* ... make sure the user sees the question */ 377 call print_question; 378 end; 379 380 /* process the answer */ 381 382 alloc_sw = "0"b; 383 384 if question_info.preset_sw then /* kludge in the current length */ 385 addrel (question_info.answer_ptr, -1) -> nchars, big_len = question_info.answer_lth; 386 else do; /* read the answer from the user's terminal */ 387 READ_ANSWER: 388 if repeat_flag & question_info.repeat_time >= 30 then do; 389 /* put 30 second lower limit on repeats */ 390 call timer_manager_$alarm_call (question_info.repeat_time, "11"b, repeat_query); 391 timer_set = "1"b; /* indicate that a timer is pending */ 392 end; 393 394 GET_LINE: 395 call iox_$get_line (question_info.answer_iocbp, addr (retstring), length (retstring), len, code); 396 397 if code = error_table_$long_record then do; 398 if ^alloc_sw | big_len + len > alloc_len then do; 399 /* need more room */ 400 if ^alloc_sw then do; 401 alloc_len = length (retstring) * 4; 402 area_ptr = get_system_free_area_ (); 403 end; 404 else alloc_len = max (2 * alloc_len, big_len + len); 405 alloc_ptr = null; 406 407 allocate alloc_str in (area) set (alloc_ptr); 408 409 if alloc_sw then do; 410 substr (alloc_ptr -> big_str, 1, big_len) = substr (big_ptr -> big_str, 1, big_len); 411 free big_ptr -> big_str in (area); 412 end; 413 else big_len = 0; 414 415 big_ptr = alloc_ptr; 416 alloc_sw = "1"b; 417 end; 418 419 substr (big_ptr -> big_str, big_len + 1, length (retstring)) = retstring; 420 big_len = big_len + length (retstring); 421 code = 0; 422 go to GET_LINE; 423 end; 424 425 else if code ^= 0 then do; 426 ANSWER_ERROR: 427 call sub_err_ (code, callername, ACTION_CAN_RESTART, null, 0, "Reading answer."); 428 go to GET_LINE; 429 end; 430 431 if alloc_sw then do; 432 if big_len + len > alloc_len then do; 433 alloc_len = big_len + len; 434 435 allocate alloc_str in (area) set (alloc_ptr); 436 437 substr (alloc_ptr -> big_str, 1, big_len) = substr (big_ptr -> big_str, 1, big_len); 438 free big_ptr -> big_str in (area); 439 big_ptr = alloc_ptr; 440 end; 441 substr (big_ptr -> big_str, big_len + 1, len) = substr (retstring, 1, len); 442 big_len = big_len + len; 443 end; 444 else do; 445 big_ptr = addr (retstring); 446 big_len = len; 447 end; 448 449 if timer_set then call timer_manager_$reset_alarm_call (repeat_query); 450 end; 451 452 if ^query_info.literal_sw & ^multi_line_sw & index (WHITE, substr (big_str, 1, 1)) ^= 0 then 453 big_str = ltrim (big_str, WHITE); /* strip leading white space from answer */ 454 455 if substr (big_str, 1, 2) = ".." then do; /* command processor escape */ 456 if ^allow_cp_escape then do; 457 call com_err_ (0, callername, "No command processor escape allowed for this question."); 458 if question_info.preset_sw then 459 go to SIGNAL; 460 else go to ASK; 461 end; 462 463 if interpret_cp_escape then do; 464 465 call cu_$cp (addr (substr (big_str, 3, 1)), max (0, big_len - 2), code); 466 467 if alloc_sw then do; 468 alloc_sw = "0"b; 469 free alloc_str in (area); 470 alloc_ptr = null; 471 end; 472 473 if question_info.preset_sw then 474 go to SIGNAL; 475 else do; 476 call iox_$control (question_info.question_iocbp, "reset_more", null (), (0)); 477 call ioa_$ioa_switch_nnl (question_info.question_iocbp, "Answer: "); 478 go to READ_ANSWER; /* brief prompt */ 479 end; 480 end; 481 end; 482 483 if ^query_info.literal_sw then big_len = length (rtrim (big_str, WHITE)); 484 485 if question_info.preset_sw & question_info.answer_sw then 486 /* if preset answer exists & should be printed */ 487 if question_info.question_sw | ^(big_str = "") 488 /* and if the question was already printed */ 489 then call ioa_$ioa_switch (question_info.question_iocbp, "^a", big_str); 490 /* print answer and NL */ 491 492 if big_str = "?" & query_info.explanation_ptr ^= null & query_info.explanation_len > 0 then do; 493 /* asking for an explanation and there is one */ 494 call expand_explanation (); 495 496 call iox_$control (question_info.question_iocbp, "reset_more", null (), (0)); 497 /* let the user see the explanation */ 498 PRINT_EXPLANATION: 499 if query_info.suppress_spacing then 500 call iox_$put_chars (question_info.question_iocbp, addr (retstring), len, code); 501 else call ioa_$ioa_switch_nnl (question_info.question_iocbp, 502 "^/^a^[ 503 End input with a line containing just ^a (^a).^;^2s^]^[^/^s^;^[^/^;^2x^]", 504 substr(retstring,1,len), 505 multi_line_sw & query_info.prompt_after_explanation, 506 query_info.ending_delim_description, 507 query_info.ending_delim, 508 query_info.prompt_after_explanation, 509 multi_line_sw); 510 if query_info.prompt_after_explanation then call print_question; 511 go to READ_ANSWER; 512 end; 513 514 if query_info.yes_or_no_sw then do; /* answer must be "yes" or "no" */ 515 516 /* Translate any uppercase letters to lowercase before testing */ 517 big_str = translate (big_str, LOWERCASE_YN, UPPERCASE_YN); 518 519 if big_str ^= "yes" & big_str ^= "y" & big_str ^= "no" & big_str ^= "n" then 520 if question_info.preset_sw then do; /* the handler returned a bum answer */ 521 call signal_ ("command_query_error", null, null, null); 522 go to get_ready_to_signal; /* control may return here if a "start" command is issued */ 523 end; 524 else do; /* the user has given a bum answer */ 525 if get_group_id_ () = "Initializer.SysDaemon.z" then 526 abs_queue = -1; 527 else call user_info_$absentee_queue (abs_queue); 528 if abs_queue ^= -1 then do; /* running in absentee */ 529 call com_err_ (0, "hcom_command_query_", "Invalid answer to question above."); 530 call signal_ ("command_query_error", null, null, null); 531 return; 532 end; 533 call iox_$control (question_info.question_iocbp, "reset_more", null (), (0)); 534 PRINT_GRIPE: 535 if query_info.explanation_ptr ^= null & query_info.explanation_len > 0 then 536 call iox_$put_chars (question_info.question_iocbp, 537 addr (GRIPE2), length (GRIPE2), code); 538 else call iox_$put_chars (question_info.question_iocbp, 539 addr (GRIPE1), length (GRIPE1), code); 540 541 if code ^=0 then do; 542 call sub_err_ (code, callername, ACTION_CAN_RESTART, null, 0, "Writing question."); 543 go to PRINT_GRIPE; 544 end; 545 /* complain */ 546 call iox_$control (question_info.answer_iocbp, "resetread", null, code); 547 /* flush any read-ahead */ 548 if alloc_sw then do; 549 alloc_sw = "0"b; 550 free alloc_str in (area); 551 alloc_ptr = null; 552 end; 553 554 go to READ_ANSWER; 555 end; 556 557 if yn_entry_sw then yes_sw = (big_str = "yes" | big_str = "y"); 558 else if big_str = "y" then call set_answer ("yes"); 559 else if big_str = "n" then call set_answer ("no"); 560 else call set_answer (big_str); 561 end; 562 563 else call set_answer (big_str); 564 565 repeat_flag = saved_rflag; 566 repeat_label = saved_rlabel; 567 568 if alloc_sw then free alloc_str in (area); 569 570 if multi_line_sw & ^ending_delim_found then 571 goto GET_LINE; 572 573 return; 574 575 576 /* INTERNAL PROCEDURES */ 577 578 set_answer: proc (P_str); 579 580 dcl P_str char (*); 581 582 if multi_line_sw then do; 583 if P_str = query_info.ending_delim then do; 584 ending_delim_found = True; 585 goto end_answer; 586 end; 587 goto add_to_answer; 588 end; 589 590 if fixed_answer_sw then 591 fixed_answer = P_str; 592 else 593 varying_answer = P_str; 594 595 goto end_answer; 596 597 add_to_answer: 598 599 if fixed_answer_sw then do; 600 if Lanswer + 1 > length(fixed_answer) then do; 601 call iox_$control (question_info.answer_iocbp, "reset_more", null(), (0)); 602 call ioa_ ("Overflow condition - some data may have been lost."); 603 ending_delim_found = True; 604 end; 605 else if Lanswer + length(P_str) + length(NL) > length(fixed_answer) then do; 606 substr(fixed_answer,Lanswer+1) = NL || P_str; 607 call iox_$control (question_info.answer_iocbp, "reset_more", null(), (0)); 608 call ioa_ ("Overflow condition - some data may have been lost."); 609 ending_delim_found = True; 610 end; 611 else if Lanswer = 0 then do; 612 substr(fixed_answer,1) = P_str; 613 Lanswer = length(P_str); 614 end; 615 else do; 616 substr(fixed_answer,Lanswer+1) = NL || P_str; 617 Lanswer = Lanswer + length(P_str) + length(NL); 618 end; 619 end; 620 else do; 621 if length(varying_answer) + length(P_str) + length(NL) > maxlength(varying_answer) then do; 622 varying_answer = varying_answer || NL || P_str; 623 call iox_$control (question_info.answer_iocbp, "reset_more", null(), (0)); 624 call ioa_ ("Overflow condition - some data may have been lost."); 625 ending_delim_found = True; 626 end; 627 else 628 if varying_answer = "" then 629 varying_answer = P_str; 630 else 631 varying_answer = varying_answer || NL || P_str; 632 end; 633 634 end_answer: 635 end set_answer; 636 637 clean_up: 638 procedure (); 639 640 if timer_set then call timer_manager_$reset_alarm_call (repeat_query); 641 repeat_flag = saved_rflag; 642 repeat_label = saved_rlabel; 643 644 if alloc_ptr ^= null then free alloc_ptr -> alloc_str in (area); 645 646 end clean_up; 647 648 649 /* Substitutes arugments into explanation control string and builds retstring */ 650 651 expand_explanation: 652 procedure (); 653 654 dcl 1 arg_list aligned based (alp), 655 2 arg_count fixed bin (17) unaligned unsigned, 656 2 code bit (19) unaligned, 657 2 desc_count fixed bin (17) unaligned unsigned, 658 2 mbz bit (19) unaligned, 659 2 arg_ptrs (arg_count) ptr, 660 2 display_ptr (bin ((arg_list.code & bit (10, 19)) ^= ""b), 1) ptr, 661 2 desc_ptrs (arg_count) ptr; 662 663 /* For $yes_no, explanation is an argument */ 664 665 if yn_entry_sw then 666 call ioa_$general_rs (alp, control_string_index - 1, control_string_index + 1, retstring, len, "0"b, "0"b); 667 668 /* Otherwise, have to build an argument list containing it */ 669 670 else begin; 671 672 dcl 1 new_arg_list aligned, 673 2 arg_count fixed bin (17) unaligned unsigned, 674 2 code bit (19) unaligned, 675 2 desc_count fixed bin (17) unaligned unsigned, 676 2 mbz bit (19) unaligned, 677 2 arg_ptrs (arg_list.arg_count) ptr, 678 2 display_ptr (bin ((arg_list.code & bit (10, 19)) ^= ""b), 1) ptr, 679 2 desc_ptrs (arg_list.arg_count) ptr; 680 1 1 /* BEGIN INCLUDE FILE ... descriptor.incl.pl1 */ 1 2 1 3 dcl 1 desc_ aligned, 1 4 2 version2_ bit(1) unal, 1 5 2 type_ fixed bin(6) unsigned unal, 1 6 2 pack_ bit(1) unal, 1 7 2 dimension_ bit(4) unal, 1 8 2 scale_ fixed bin(11) unal, 1 9 2 precision_ fixed bin(11) unal; 1 10 1 11 /* END INCLUDE FILE ... descriptor.incl.pl1 */ 681 682 683 dcl desc_size fixed bin (24) unaligned unsigned based (addr (desc_.scale_)); 684 685 new_arg_list = arg_list; /* replace question arg with explanation arg */ 686 desc_.version2_ = "1"b; 687 desc_.type_ = char_dtype; 688 desc_.pack_ = "1"b; 689 desc_.dimension_ = "0"b; 690 691 desc_size = length (explanation); 692 693 new_arg_list.desc_ptrs (control_string_index) = addr (desc_); 694 new_arg_list.arg_ptrs (control_string_index) = addr (explanation); 695 696 call ioa_$general_rs (addr (new_arg_list), control_string_index, control_string_index + 1, retstring, len, 697 "0"b, "0"b); 698 699 end; 700 701 end expand_explanation; 702 703 704 print_question: proc; 705 706 PRINT_QUESTION: 707 if query_info.suppress_spacing then do; 708 call iox_$put_chars (question_info.question_iocbp, question_info.question_ptr, 709 (question_info.question_lth), code); 710 if code ^= 0 then do; 711 QUESTION_ERROR: 712 call sub_err_ (code, callername, ACTION_CAN_RESTART, null, 0, "Writing question."); 713 go to PRINT_QUESTION; 714 end; 715 end; 716 else do; 717 substr (output_buffer, 1, 1) = NL; 718 substr (output_buffer, 2, (bi - 1) + length(SPACE_SPACE)) = 719 question; 720 if multi_line_sw then 721 call iox_$put_chars (question_info.question_iocbp, addr (output_buffer), 722 (bi - 1) + length(NL), code); 723 else 724 call iox_$put_chars (question_info.question_iocbp, addr (output_buffer), 725 (bi - 1) + length(NL) + length(SPACE_SPACE), 726 code); 727 if code ^= 0 then go to QUESTION_ERROR; 728 end; 729 730 end print_question; 731 732 733 /* Repeat the last question and ask for the answer again */ 734 735 repeat_query: 736 rq: 737 entry () options (variable); 738 739 if first_call then do; /* be sure the labels are correctly defined */ 740 repeat_label = ASK; /* basis for saved label */ 741 repeat_flag = "0"b; 742 first_call = "0"b; /* done for this process */ 743 end; 744 745 if repeat_flag then 746 go to repeat_label; 747 else call com_err_ (0, "repeat_query", "No pending query."); 748 749 return; 750 751 752 /* ENTRYPOINT */ 753 754 /* Enable/disable use of the command processor escape */ 755 756 set_cp_escape_enable: 757 entry (new_allow_cp_escape, old_allow_cp_escape); 758 759 dcl new_allow_cp_escape bit (1) aligned parameter; /* whether it is enabled now */ 760 dcl old_allow_cp_escape bit (1) aligned parameter; /* was it enabled before? */ 761 762 old_allow_cp_escape = static_allow_cp_escape; 763 static_allow_cp_escape = new_allow_cp_escape; 764 765 return; 766 767 768 /* INCLUDE FILES */ 769 2 1 /* BEGIN INCLUDE FILE hcom_query_info.incl.pl1 TAC June 1, 1973 */ 2 2 2 3 /****^ HISTORY COMMENTS: 2 4* 1) change(85-10-02,LJAdams), approve(85-11-06,MCR7278), 2 5* audit(86-02-19,Gilcrease), install(86-02-19,MR12.0-1021): 2 6* Provides for multi-line input of text for 2 7* history comment change notices. 2 8* END HISTORY COMMENTS */ 2 9 2 10 /* Renamed to query_info.incl.pl1 and cp_escape_control added, 08/10/78 WOS */ 2 11 /* version number changed to 4, 08/10/78 WOS */ 2 12 /* Version 5 adds explanation_(ptr len) 05/08/81 S. Herbst */ 2 13 /* Version 6 adds literal_sw, prompt_after_explanation switch 12/15/82 S. Herbst */ 2 14 /* Version 7 adds field to accept an ending delimiter for multi-line answers, 06/05/85 L. Adams */ 2 15 2 16 dcl 1 query_info aligned, /* argument structure for command_query_ call */ 2 17 2 version fixed bin, /* version of this structure - must be set, see below */ 2 18 2 switches aligned, /* various bit switch values */ 2 19 3 yes_or_no_sw bit (1) unaligned init ("0"b), /* not a yes-or-no question, by default */ 2 20 3 suppress_name_sw bit (1) unaligned init ("0"b), /* do not suppress command name */ 2 21 3 cp_escape_control bit (2) unaligned init ("00"b), /* obey static default value */ 2 22 /* "01" -> invalid, "10" -> don't allow, "11" -> allow */ 2 23 3 suppress_spacing bit (1) unaligned init ("0"b), /* whether to print extra spacing */ 2 24 3 literal_sw bit (1) unaligned init ("0"b), /* ON => do not strip leading/trailing white space */ 2 25 3 prompt_after_explanation bit (1) unaligned init ("0"b), /* ON => repeat question after explanation */ 2 26 3 padding bit (29) unaligned init (""b), /* pads it out to t word */ 2 27 2 status_code fixed bin (35) init (0), /* query not prompted by any error, by default */ 2 28 2 query_code fixed bin (35) init (0), /* currently has no meaning */ 2 29 2 30 /* Limit of data defined for version 2 */ 2 31 2 32 2 question_iocbp ptr init (null ()), /* IO switch to write question */ 2 33 2 answer_iocbp ptr init (null ()), /* IO switch to read answer */ 2 34 2 repeat_time fixed bin (71) init (0), /* repeat question every N seconds if no answer */ 2 35 /* minimum of 30 seconds required for repeat */ 2 36 /* otherwise, no repeat will occur */ 2 37 /* Limit of data defined for version 4 */ 2 38 2 39 2 explanation_ptr ptr init (null ()), /* explanation of question to be printed if */ 2 40 2 explanation_len fixed bin (21) init (0), /* user answers "?" (disabled if ptr=null or len=0) */ 2 41 /* Limit of data defined for version 5/6 */ 2 42 2 ending_delim char(8) varying init(""), /* ending delimiter for multi line answers */ 2 43 2 ending_delim_description char(32) varying init(""); /* words describing ending delimiter. */ 2 44 2 45 dcl query_info_version_3 fixed bin int static options (constant) init (3); 2 46 dcl query_info_version_4 fixed bin int static options (constant) init (4); 2 47 dcl query_info_version_5 fixed bin int static options (constant) init (5); 2 48 dcl query_info_version_6 fixed bin int static options (constant) init (6); 2 49 dcl query_info_version_7 fixed bin int static options (constant) init (7); /* the current version number */ 2 50 2 51 /* END INCLUDE FILE hcom_query_info.incl.pl1 */ 770 771 3 1 /* BEGIN INCLUDE FILE: command_question_info.incl.pl1 */ 3 2 3 3 /* Last modified: 11/02/78 W. Olin Sibert to change to version 5 and make compatible with query_info */ 3 4 /* Added explanation_ptr & explanation_len (Version 6) 05/13/81 S. Herbst */ 3 5 /* switched to condition_info_header June 1981 B. Margulies */ 3 6 3 7 /* This include file depends on condition_info_header.incl.pl1 */ 3 8 /* It must be included as well */ 3 9 /* Added interpret_cp_escape, literal_sw, prompt_after_explanation 12/16/82 S. Herbst */ 3 10 /* Changed ("" max_)(question answer)_lth declarations to fixed bin (21) 02/08/84 S. Herbst */ 3 11 3 12 3 13 dcl 1 command_question_info based (cq_info_ptr) aligned, 3 14 2 header aligned like condition_info_header, 3 15 2 query_code fixed bin (35), /* extra information supplied by caller */ 3 16 2 switches aligned, /* various bit switches */ 3 17 3 question_sw bit (1) unaligned, /* should command_query_ print the question? */ 3 18 3 yes_or_no_sw bit (1) unaligned, /* must question be answered yes or no? */ 3 19 3 preset_sw bit (1) unaligned, /* is handler supplying a canned answer? */ 3 20 3 answer_sw bit (1) unaligned, /* should canned answer be printed? */ 3 21 3 allow_cp_escape bit (1) unaligned, /* whether to allow answers to begin with ".." */ 3 22 3 suppress_spacing bit (1) unaligned, /* whether to print extra newline and spaces */ 3 23 3 interpret_cp_escape bit (1) unaligned, /* whether to treat ".." as a cp escape */ 3 24 3 literal_sw bit (1) unaligned, /* ON => don't strip whitespace or handle ".." */ 3 25 3 prompt_after_explanation bit (1) unaligned, /* ON => repeat question after explanation */ 3 26 3 mbz bit (27) unaligned, 3 27 2 name_ptr pointer, /* ptr to caller's name */ 3 28 2 name_lth fixed bin, /* length of caller's name */ 3 29 2 question_ptr pointer, /* ptr to quetion being asked */ 3 30 2 question_lth fixed bin (21), /* lentgh of question */ 3 31 2 max_question_lth fixed bin (21), /* max question lth in case handler alters question */ 3 32 2 answer_ptr pointer, /* pointer to space to return answer in */ 3 33 2 answer_lth fixed bin (21), /* length of returned answer */ 3 34 2 max_answer_lth fixed bin (21), /* max space in answer space */ 3 35 2 question_iocbp ptr, /* IO switch to ask (write) question on */ 3 36 2 answer_iocbp ptr, /* IO switch to read the answer from */ 3 37 2 repeat_time fixed bin (71), /* repeat question every N seconds if no answer */ 3 38 2 explanation_ptr ptr, /* ptr to string to print if user answers "?" */ 3 39 2 explanation_len fixed bin (21); /* length of explanation string */ 3 40 /* if N < 30 no repeat will occur */ 3 41 3 42 dcl cq_info_ptr pointer; 3 43 3 44 dcl cq_info_version_7 fixed bin internal static options (constant) init (7); 3 45 3 46 /* END INCLUDE FILE: command_question_info.incl.pl1 */ 772 773 4 1 /* BEGIN INCLUDE FILE condition_info_header.incl.pl1 BIM 1981 */ 4 2 /* format: style2 */ 4 3 4 4 declare condition_info_header_ptr 4 5 pointer; 4 6 declare 1 condition_info_header 4 7 aligned based (condition_info_header_ptr), 4 8 2 length fixed bin, /* length in words of this structure */ 4 9 2 version fixed bin, /* version number of this structure */ 4 10 2 action_flags aligned, /* tell handler how to proceed */ 4 11 3 cant_restart bit (1) unaligned, /* caller doesn't ever want to be returned to */ 4 12 3 default_restart bit (1) unaligned, /* caller can be returned to with no further action */ 4 13 3 quiet_restart bit (1) unaligned, /* return, and print no message */ 4 14 3 support_signal bit (1) unaligned, /* treat this signal as if the signalling procedure had the support bit set */ 4 15 /* if the signalling procedure had the support bit set, do the same for its caller */ 4 16 3 pad bit (32) unaligned, 4 17 2 info_string char (256) varying, /* may contain printable message */ 4 18 2 status_code fixed bin (35); /* if^=0, code interpretable by com_err_ */ 4 19 4 20 /* END INCLUDE FILE condition_info_header.incl.pl1 */ 774 775 5 1 /* BEGIN INCLUDE FILE ... std_descriptor_types.incl.pl1 */ 5 2 5 3 5 4 /****^ HISTORY COMMENTS: 5 5* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 5 6* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1208): 5 7* Added pascal_string_type_dtype descriptor type. Its number is 87. 5 8* Objects of this type are PASCAL string types. 5 9* 2) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 5 10* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 5 11* Added the new C types. 5 12* END HISTORY COMMENTS */ 5 13 5 14 /* This include file defines mnemonic names for the Multics 5 15* standard descriptor types, using both pl1 and cobol terminology. 5 16* PG 780613 5 17* JRD 790530 5 18* JRD 791016 5 19* MBW 810731 5 20* TGO 830614 Add hex types. 5 21* Modified June 83 JMAthane to add PASCAL data types 5 22* TGO 840120 Add float dec extended and generic, float binary generic 5 23**/ 5 24 5 25 dcl (real_fix_bin_1_dtype init (1), 5 26 real_fix_bin_2_dtype init (2), 5 27 real_flt_bin_1_dtype init (3), 5 28 real_flt_bin_2_dtype init (4), 5 29 cplx_fix_bin_1_dtype init (5), 5 30 cplx_fix_bin_2_dtype init (6), 5 31 cplx_flt_bin_1_dtype init (7), 5 32 cplx_flt_bin_2_dtype init (8), 5 33 real_fix_dec_9bit_ls_dtype init (9), 5 34 real_flt_dec_9bit_dtype init (10), 5 35 cplx_fix_dec_9bit_ls_dtype init (11), 5 36 cplx_flt_dec_9bit_dtype init (12), 5 37 pointer_dtype init (13), 5 38 offset_dtype init (14), 5 39 label_dtype init (15), 5 40 entry_dtype init (16), 5 41 structure_dtype init (17), 5 42 area_dtype init (18), 5 43 bit_dtype init (19), 5 44 varying_bit_dtype init (20), 5 45 char_dtype init (21), 5 46 varying_char_dtype init (22), 5 47 file_dtype init (23), 5 48 real_fix_dec_9bit_ls_overp_dtype init (29), 5 49 real_fix_dec_9bit_ts_overp_dtype init (30), 5 50 real_fix_bin_1_uns_dtype init (33), 5 51 real_fix_bin_2_uns_dtype init (34), 5 52 real_fix_dec_9bit_uns_dtype init (35), 5 53 real_fix_dec_9bit_ts_dtype init (36), 5 54 real_fix_dec_4bit_uns_dtype init (38), /* digit-aligned */ 5 55 real_fix_dec_4bit_ts_dtype init (39), /* byte-aligned */ 5 56 real_fix_dec_4bit_bytealigned_uns_dtype init (40), /* COBOL */ 5 57 real_fix_dec_4bit_ls_dtype init (41), /* digit-aligned */ 5 58 real_flt_dec_4bit_dtype init (42), /* digit-aligned */ 5 59 real_fix_dec_4bit_bytealigned_ls_dtype init (43), 5 60 real_flt_dec_4bit_bytealigned_dtype init (44), 5 61 cplx_fix_dec_4bit_bytealigned_ls_dtype init (45), 5 62 cplx_flt_dec_4bit_bytealigned_dtype init (46), 5 63 real_flt_hex_1_dtype init (47), 5 64 real_flt_hex_2_dtype init (48), 5 65 cplx_flt_hex_1_dtype init (49), 5 66 cplx_flt_hex_2_dtype init (50), 5 67 c_typeref_dtype init (54), 5 68 c_enum_dtype init (55), 5 69 c_enum_const_dtype init (56), 5 70 c_union_dtype init (57), 5 71 algol68_straight_dtype init (59), 5 72 algol68_format_dtype init (60), 5 73 algol68_array_descriptor_dtype init (61), 5 74 algol68_union_dtype init (62), 5 75 5 76 cobol_comp_6_dtype init (1), 5 77 cobol_comp_7_dtype init (1), 5 78 cobol_display_ls_dtype init (9), 5 79 cobol_structure_dtype init (17), 5 80 cobol_char_string_dtype init (21), 5 81 cobol_display_ls_overp_dtype init (29), 5 82 cobol_display_ts_overp_dtype init (30), 5 83 cobol_display_uns_dtype init (35), 5 84 cobol_display_ts_dtype init (36), 5 85 cobol_comp_8_uns_dtype init (38), /* digit aligned */ 5 86 cobol_comp_5_ts_dtype init (39), /* byte aligned */ 5 87 cobol_comp_5_uns_dtype init (40), 5 88 cobol_comp_8_ls_dtype init (41), /* digit aligned */ 5 89 real_flt_dec_extended_dtype init (81), /* 9-bit exponent */ 5 90 cplx_flt_dec_extended_dtype init (82), /* 9-bit exponent */ 5 91 real_flt_dec_generic_dtype init (83), /* generic float decimal */ 5 92 cplx_flt_dec_generic_dtype init (84), 5 93 real_flt_bin_generic_dtype init (85), /* generic float binary */ 5 94 cplx_flt_bin_generic_dtype init (86)) fixed bin internal static options (constant); 5 95 5 96 dcl (ft_integer_dtype init (1), 5 97 ft_real_dtype init (3), 5 98 ft_double_dtype init (4), 5 99 ft_complex_dtype init (7), 5 100 ft_complex_double_dtype init (8), 5 101 ft_external_dtype init (16), 5 102 ft_logical_dtype init (19), 5 103 ft_char_dtype init (21), 5 104 ft_hex_real_dtype init (47), 5 105 ft_hex_double_dtype init (48), 5 106 ft_hex_complex_dtype init (49), 5 107 ft_hex_complex_double_dtype init (50) 5 108 ) fixed bin internal static options (constant); 5 109 5 110 dcl (algol68_short_int_dtype init (1), 5 111 algol68_int_dtype init (1), 5 112 algol68_long_int_dtype init (2), 5 113 algol68_real_dtype init (3), 5 114 algol68_long_real_dtype init (4), 5 115 algol68_compl_dtype init (7), 5 116 algol68_long_compl_dtype init (8), 5 117 algol68_bits_dtype init (19), 5 118 algol68_bool_dtype init (19), 5 119 algol68_char_dtype init (21), 5 120 algol68_byte_dtype init (21), 5 121 algol68_struct_struct_char_dtype init (22), 5 122 algol68_struct_struct_bool_dtype init (20) 5 123 ) fixed bin internal static options (constant); 5 124 5 125 dcl (label_constant_runtime_dtype init (24), 5 126 int_entry_runtime_dtype init (25), 5 127 ext_entry_runtime_dtype init (26), 5 128 ext_procedure_runtime_dtype init (27), 5 129 picture_runtime_dtype init (63) 5 130 ) fixed bin internal static options (constant); 5 131 5 132 dcl (pascal_integer_dtype init (1), 5 133 pascal_real_dtype init (4), 5 134 pascal_label_dtype init (24), 5 135 pascal_internal_procedure_dtype init (25), 5 136 pascal_exportable_procedure_dtype init (26), 5 137 pascal_imported_procedure_dtype init (27), 5 138 pascal_typed_pointer_type_dtype init (64), 5 139 pascal_char_dtype init (65), 5 140 pascal_boolean_dtype init (66), 5 141 pascal_record_file_type_dtype init (67), 5 142 pascal_record_type_dtype init (68), 5 143 pascal_set_dtype init (69), 5 144 pascal_enumerated_type_dtype init (70), 5 145 pascal_enumerated_type_element_dtype init (71), 5 146 pascal_enumerated_type_instance_dtype init (72), 5 147 pascal_user_defined_type_dtype init (73), 5 148 pascal_user_defined_type_instance_dtype init (74), 5 149 pascal_text_file_dtype init (75), 5 150 pascal_procedure_type_dtype init (76), 5 151 pascal_variable_formal_parameter_dtype init (77), 5 152 pascal_value_formal_parameter_dtype init (78), 5 153 pascal_entry_formal_parameter_dtype init (79), 5 154 pascal_parameter_procedure_dtype init (80), 5 155 pascal_string_type_dtype init (87)) fixed bin int static options (constant); 5 156 5 157 5 158 /* END INCLUDE FILE ... std_descriptor_types.incl.pl1 */ 776 777 6 1 /* BEGIN INCLUDE FILE sub_err_flags.incl.pl1 BIM 11/81 */ 6 2 /* format: style3 */ 6 3 6 4 /* These constants are to be used for the flags argument of sub_err_ */ 6 5 /* They are just "string (condition_info_header.action_flags)" */ 6 6 6 7 declare ( 6 8 ACTION_CAN_RESTART init (""b), 6 9 ACTION_CANT_RESTART init ("1"b), 6 10 ACTION_DEFAULT_RESTART 6 11 init ("01"b), 6 12 ACTION_QUIET_RESTART 6 13 init ("001"b), 6 14 ACTION_SUPPORT_SIGNAL 6 15 init ("0001"b) 6 16 ) bit (36) aligned internal static options (constant); 6 17 6 18 /* End include file */ 778 779 780 end hcom_command_query_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/24/88 1401.2 hcom_command_query_.pl1 >special_ldd>install>MR12.2-1184>hcom_command_query_.pl1 681 1 11/30/78 1227.5 descriptor.incl.pl1 >ldd>include>descriptor.incl.pl1 770 2 02/19/86 1535.3 hcom_query_info.incl.pl1 >ldd>include>hcom_query_info.incl.pl1 772 3 02/27/84 1141.9 command_question_info.incl.pl1 >ldd>include>command_question_info.incl.pl1 774 4 03/24/82 1347.2 condition_info_header.incl.pl1 >ldd>include>condition_info_header.incl.pl1 776 5 10/24/88 1336.9 std_descriptor_types.incl.pl1 >special_ldd>install>MR12.2-1184>std_descriptor_types.incl.pl1 778 6 04/16/82 0958.1 sub_err_flags.incl.pl1 >ldd>include>sub_err_flags.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. ACTION_CAN_RESTART 000063 constant bit(36) initial dcl 6-7 set ref 426* 542* 711* A_query_code parameter fixed bin(35,0) dcl 56 set ref 217 225 280 281* False constant bit(1) initial packed unaligned dcl 60 ref 173 190 GRIPE1 000023 constant char(27) initial packed unaligned dcl 62 set ref 538 538 538 538 GRIPE2 000006 constant char(50) initial packed unaligned dcl 64 set ref 534 534 534 534 LOWERCASE_YN 000004 constant char(5) initial packed unaligned dcl 66 ref 517 Lanswer 000562 automatic fixed bin(21,0) dcl 97 set ref 250* 600 605 606 611 613* 616 617* 617 NL 005461 constant char(1) initial packed unaligned dcl 67 ref 297 298 298 605 606 616 617 621 622 630 717 720 723 P_str parameter char packed unaligned dcl 580 ref 578 583 590 592 605 606 612 613 616 617 621 622 627 630 SPACE_SPACE constant char(2) initial packed unaligned dcl 69 ref 718 723 True constant bit(1) initial packed unaligned dcl 60 ref 187 584 603 609 625 UPPERCASE_YN 000002 constant char(5) initial packed unaligned dcl 70 ref 517 WHITE 000000 constant char(5) initial packed unaligned dcl 71 ref 452 452 483 abs_queue 000100 automatic fixed bin(17,0) dcl 89 set ref 525* 527* 528 action_flags 2 001162 automatic structure level 3 dcl 100 addr builtin function dcl 107 ref 323 327 336 353 353 394 394 445 465 465 498 498 534 534 538 538 691 693 694 696 696 720 720 723 723 addrel builtin function dcl 107 ref 260 327 336 384 alloc_len 000110 automatic fixed bin(21,0) dcl 90 set ref 398 401* 404* 404 407 407 432 433* 435 435 469 469 550 550 568 568 644 644 alloc_ptr 000116 automatic pointer dcl 91 set ref 349* 405* 407* 410 415 435* 437 439 469 470* 550 551* 568 644 644 alloc_str based char packed unaligned dcl 76 ref 407 435 469 550 568 644 alloc_sw 000130 automatic bit(1) dcl 92 set ref 382* 398 400 409 416* 431 467 468* 548 549* 568 allow_cp_escape 000131 automatic bit(1) dcl 92 in procedure "hcom_command_query_" set ref 202* 205* 206* 207* 227* 317 456 allow_cp_escape 106(04) 001162 automatic bit(1) level 3 in structure "question_info" packed packed unaligned dcl 100 in procedure "hcom_command_query_" set ref 317* alp 000122 automatic pointer dcl 91 set ref 243* 246* 258* 292* 665* 672 672 672 685 685 685 685 685 685 685 685 685 685 685 685 685 693 693 answer_iocbp 6 002122 automatic pointer initial level 2 in structure "query_info" dcl 2-16 in procedure "hcom_command_query_" set ref 197* 226* 342 2-16* answer_iocbp 126 001162 automatic pointer level 2 in structure "question_info" dcl 100 in procedure "hcom_command_query_" set ref 342* 369 369* 394* 546* 601* 607* 623* answer_iocbp 6 based pointer initial level 2 in structure "input_info" dcl 85 in procedure "hcom_command_query_" ref 197 answer_lth 122 001162 automatic fixed bin(21,0) level 2 dcl 100 set ref 384 answer_ptr 120 001162 automatic pointer level 2 dcl 100 set ref 327* 332* 336* 384 answer_sw 106(03) 001162 automatic bit(1) level 3 packed packed unaligned dcl 100 set ref 316* 485 area based area(1024) dcl 83 ref 407 411 435 438 469 550 568 644 area_ptr 000120 automatic pointer dcl 91 set ref 402* 407 411 435 438 469 550 568 644 arg_count 000101 automatic fixed bin(17,0) dcl 89 in procedure "hcom_command_query_" set ref 242* 291 arg_count based fixed bin(17,0) level 2 in structure "arg_list" packed packed unsigned unaligned dcl 654 in procedure "expand_explanation" ref 672 672 685 685 685 685 685 685 685 685 693 arg_list based structure level 1 dcl 654 ref 685 arg_ptrs 2 000100 automatic pointer array level 2 dcl 672 set ref 694* bi 000102 automatic fixed bin(17,0) dcl 89 set ref 266* 272* 273 282 283* 293 294 295* 295 297* 298 299* 299 324 718 720 723 big_len 000111 automatic fixed bin(21,0) dcl 90 set ref 384* 398 404 410 410 410 410 411 411 413* 419 419 420* 420 432 433 437 437 437 437 438 438 441 441 442* 442 446* 452 452 452 455 465 465 465 465 483* 483 485 485 485 492 517 517 519 519 519 519 557 557 558 559 560 560 563 563 big_ptr 000124 automatic pointer dcl 91 set ref 327* 332* 336* 410 411 415* 419 437 438 439* 441 445* 452 452 452 455 465 465 483 485 485 492 517 517 519 519 519 519 557 557 558 559 560 563 big_str based char packed unaligned dcl 77 set ref 410* 410 411 419* 437* 437 438 441* 452 452* 452 455 465 465 483 485 485* 492 517* 517 519 519 519 519 557 557 558 559 560* 563* bin builtin function dcl 107 ref 672 685 685 685 685 693 bit builtin function dcl 107 ref 672 685 685 685 685 693 buffer 000134 automatic char(1000) dcl 93 set ref 267* 270* 271 272 273* 282* 283 293 294* 297 298* 322 323 325 callername based char packed unaligned dcl 78 set ref 270 426* 457* 542* 711* callername_index 000103 automatic fixed bin(17,0) dcl 89 set ref 167* 221* 256* 258* 285 cant_restart 2 001162 automatic bit(1) level 4 packed packed unaligned dcl 100 set ref 308* char_dtype constant fixed bin(17,0) initial dcl 5-25 ref 247 687 cleanup 002114 stack reference condition dcl 112 ref 356 code 0(17) based bit(19) level 2 in structure "arg_list" packed packed unaligned dcl 654 in procedure "expand_explanation" ref 672 685 685 685 685 693 code 000526 automatic fixed bin(35,0) dcl 94 in procedure "hcom_command_query_" set ref 285* 286 394* 397 421* 425 426* 465* 498* 534* 538* 541 542* 546* 708* 710 711* 720* 723* 727 com_err_ 000030 constant entry external dcl 132 ref 457 529 747 command_question_info based structure level 1 dcl 3-13 condition_info_header based structure level 1 dcl 4-6 control_string_index 000104 automatic fixed bin(17,0) dcl 89 set ref 168* 222* 291 292* 292 665 665 693 694 696* 696 convert_status_code_ 000032 constant entry external dcl 133 ref 281 cp_escape_control 1(02) 002122 automatic bit(2) initial level 3 in structure "query_info" packed packed unaligned dcl 2-16 in procedure "hcom_command_query_" set ref 177* 201 205 206 2-16* cp_escape_control 1(02) based bit(2) initial level 3 in structure "input_info" packed packed unaligned dcl 85 in procedure "hcom_command_query_" ref 177 cq_info_version_7 constant fixed bin(17,0) initial dcl 3-44 ref 307 cu_$arg_count 000034 constant entry external dcl 134 ref 242 cu_$arg_list_ptr 000036 constant entry external dcl 135 ref 243 cu_$arg_ptr 000040 constant entry external dcl 136 ref 249 256 285 cu_$cp 000042 constant entry external dcl 137 ref 465 decode_descriptor_ 000044 constant entry external dcl 138 ref 246 258 default_restart 2(01) 001162 automatic bit(1) level 4 packed packed unaligned dcl 100 set ref 309* desc_ 000100 automatic structure level 1 dcl 1-3 set ref 693 desc_ptrs 000100 automatic pointer array level 2 dcl 672 set ref 693* desc_size based fixed bin(24,0) packed unsigned unaligned dcl 683 set ref 691* dimension_ 0(08) 000100 automatic bit(4) level 2 packed packed unaligned dcl 1-3 set ref 689* ending_delim 15 based varying char(8) initial level 2 in structure "input_info" dcl 85 in procedure "hcom_command_query_" ref 186 188 ending_delim 15 002122 automatic varying char(8) initial level 2 in structure "query_info" dcl 2-16 in procedure "hcom_command_query_" set ref 188* 501* 2-16* 583 ending_delim_description 20 based varying char(32) initial level 2 in structure "input_info" dcl 85 in procedure "hcom_command_query_" ref 189 ending_delim_description 20 002122 automatic varying char(32) initial level 2 in structure "query_info" dcl 2-16 in procedure "hcom_command_query_" set ref 189* 501* 2-16* ending_delim_found 000527 automatic bit(1) packed unaligned dcl 95 set ref 190* 570 584* 603* 609* 625* error_string 000531 automatic char(100) dcl 96 set ref 281* 282 282 error_table_$long_record 000026 external static fixed bin(35,0) dcl 120 ref 397 explanation based char packed unaligned dcl 79 set ref 691 694 explanation_len 14 based fixed bin(21,0) initial level 2 in structure "input_info" dcl 85 in procedure "hcom_command_query_" ref 180 explanation_len 134 001162 automatic fixed bin(21,0) level 2 in structure "question_info" dcl 100 in procedure "hcom_command_query_" set ref 347* explanation_len 14 002122 automatic fixed bin(21,0) initial level 2 in structure "query_info" dcl 2-16 in procedure "hcom_command_query_" set ref 180* 181 285* 286 347 492 534 2-16* 691 694 explanation_ptr 132 001162 automatic pointer level 2 in structure "question_info" dcl 100 in procedure "hcom_command_query_" set ref 346* explanation_ptr 12 002122 automatic pointer initial level 2 in structure "query_info" dcl 2-16 in procedure "hcom_command_query_" set ref 181* 285* 286* 346 492 534 2-16* 691 694 explanation_ptr 12 based pointer initial level 2 in structure "input_info" dcl 85 in procedure "hcom_command_query_" ref 181 first_call 000015 internal static bit(1) initial packed unaligned dcl 127 set ref 230 234* 739 742* fixed21 000113 automatic fixed bin(21,0) dcl 90 set ref 256* 257 fixed_answer based char packed unaligned dcl 80 set ref 590* 600 605 606* 612* 616* fixed_answer_len 000112 automatic fixed bin(21,0) dcl 90 set ref 249* 333 590 600 605 606 612 616 fixed_answer_ptr 000126 automatic pointer dcl 91 set ref 249* 332 590 600 605 606 612 616 fixed_answer_sw 000132 automatic bit(1) dcl 92 set ref 247* 248 331 590 597 get_group_id_ 000046 constant entry external dcl 140 ref 525 get_system_free_area_ 000050 constant entry external dcl 141 ref 402 header 001162 automatic structure level 2 dcl 100 index builtin function dcl 107 ref 452 info_string 3 001162 automatic varying char(256) level 3 dcl 100 set ref 325* input_info based structure level 1 dcl 85 interpret_cp_escape 106(06) 001162 automatic bit(1) level 3 in structure "question_info" packed packed unaligned dcl 100 in procedure "hcom_command_query_" set ref 319* interpret_cp_escape 000133 automatic bit(1) dcl 92 in procedure "hcom_command_query_" set ref 203* 205* 206* 207* 227* 319 463 ioa_ 000052 constant entry external dcl 142 ref 602 608 624 ioa_$general_rs 000054 constant entry external dcl 143 ref 292 665 696 ioa_$ioa_switch 000056 constant entry external dcl 145 ref 485 ioa_$ioa_switch_nnl 000060 constant entry external dcl 146 ref 477 501 iox_$control 000062 constant entry external dcl 147 ref 374 476 496 533 546 601 607 623 iox_$get_line 000064 constant entry external dcl 148 ref 394 iox_$put_chars 000066 constant entry external dcl 149 ref 498 534 538 708 720 723 iox_$user_input 000020 external static pointer dcl 116 ref 369 iox_$user_io 000022 external static pointer dcl 117 ref 366 iox_$user_output 000024 external static pointer dcl 118 ref 362 len 000114 automatic fixed bin(21,0) dcl 90 set ref 292* 293* 293 294 294 295 394* 398 404 432 433 441 441 442 446 498* 501 501 665* 696* length 001162 automatic fixed bin(17,0) level 3 in structure "question_info" dcl 100 in procedure "hcom_command_query_" set ref 305* length builtin function dcl 107 in procedure "hcom_command_query_" ref 272 282 283 293 297 297 298 394 394 401 419 420 483 534 534 538 538 600 605 605 605 613 617 617 621 621 621 691 718 720 723 723 literal_sw 1(05) based bit(1) initial level 3 in structure "input_info" packed packed unaligned dcl 85 in procedure "hcom_command_query_" ref 183 literal_sw 1(05) 002122 automatic bit(1) initial level 3 in structure "query_info" packed packed unaligned dcl 2-16 in procedure "hcom_command_query_" set ref 183* 201 320 452 483 2-16* literal_sw 106(07) 001162 automatic bit(1) level 3 in structure "question_info" packed packed unaligned dcl 100 in procedure "hcom_command_query_" set ref 320* ltrim builtin function dcl 107 ref 452 max builtin function dcl 107 ref 404 465 465 max_answer_lth 123 001162 automatic fixed bin(21,0) level 2 dcl 100 set ref 328* 333* 337* max_question_lth 117 001162 automatic fixed bin(21,0) level 2 dcl 100 set ref 322* maxlength builtin function dcl 107 ref 328 337 621 min builtin function dcl 107 ref 293 multi_line_sw 000530 automatic bit(1) packed unaligned dcl 95 set ref 173* 187* 296 452 501 501* 570 582 720 name_lth 112 001162 automatic fixed bin(17,0) level 2 dcl 100 set ref 257* 258* 260* 268 270 426 426 457 457 542 542 711 711 name_ptr 110 001162 automatic pointer level 2 dcl 100 set ref 256* 260 270 426 457 542 711 nchars based fixed bin(21,0) dcl 82 set ref 260 384* ndims 000105 automatic fixed bin(17,0) dcl 89 set ref 246* 258* new_allow_cp_escape parameter bit(1) dcl 759 ref 756 763 new_arg_list 000100 automatic structure level 1 dcl 672 set ref 685* 696 696 null builtin function dcl 107 ref 226 286 349 353 353 353 353 362 369 374 374 405 426 426 470 476 476 492 496 496 521 521 521 521 521 521 530 530 530 530 530 530 533 533 534 542 542 546 546 551 2-16 2-16 2-16 601 601 607 607 623 623 644 711 711 old_allow_cp_escape parameter bit(1) dcl 760 set ref 756 762* output_buffer 000563 automatic char(1004) dcl 98 set ref 717* 718* 720 720 723 723 pack_ 0(07) 000100 automatic bit(1) level 2 packed packed unaligned dcl 1-3 set ref 688* packed 001156 automatic bit(1) dcl 99 set ref 246* 258* padding 1(07) 002122 automatic bit(29) initial level 3 packed packed unaligned dcl 2-16 set ref 2-16* preset_sw 106(02) 001162 automatic bit(1) level 3 packed packed unaligned dcl 100 set ref 315* 358 362 374 384 458 473 485 519 prompt_after_explanation 1(06) 002122 automatic bit(1) initial level 3 in structure "query_info" packed packed unaligned dcl 2-16 in procedure "hcom_command_query_" set ref 184* 321 501 501* 510 2-16* prompt_after_explanation 1(06) based bit(1) initial level 3 in structure "input_info" packed packed unaligned dcl 85 in procedure "hcom_command_query_" ref 184 prompt_after_explanation 106(08) 001162 automatic bit(1) level 3 in structure "question_info" packed packed unaligned dcl 100 in procedure "hcom_command_query_" set ref 321* qip parameter pointer dcl 54 ref 12 160 169 170 171 172 177 178 180 181 183 184 186 188 189 196 197 198 query_code 105 001162 automatic fixed bin(35,0) level 2 in structure "question_info" dcl 100 in procedure "hcom_command_query_" set ref 312* query_code 3 based fixed bin(35,0) initial level 2 in structure "input_info" dcl 85 in procedure "hcom_command_query_" ref 172 query_code 3 002122 automatic fixed bin(35,0) initial level 2 in structure "query_info" dcl 2-16 in procedure "hcom_command_query_" set ref 172* 225* 312 2-16* query_info 002122 automatic structure level 1 dcl 2-16 set ref 223* question based char packed unaligned dcl 81 ref 718 question_info 001162 automatic structure level 1 dcl 100 set ref 305 353 353 question_iocbp 4 002122 automatic pointer initial level 2 in structure "query_info" dcl 2-16 in procedure "hcom_command_query_" set ref 196* 226* 340 2-16* question_iocbp 4 based pointer initial level 2 in structure "input_info" dcl 85 in procedure "hcom_command_query_" ref 196 question_iocbp 124 001162 automatic pointer level 2 in structure "question_info" dcl 100 in procedure "hcom_command_query_" set ref 340* 362 362* 366* 374* 476* 477* 485* 496* 498* 501* 533* 534* 538* 708* 720* 723* question_lth 116 001162 automatic fixed bin(21,0) level 2 dcl 100 set ref 324* 325 708 718 question_ptr 114 001162 automatic pointer level 2 dcl 100 set ref 323* 708* 718 question_sw 106 001162 automatic bit(1) level 3 packed packed unaligned dcl 100 set ref 313* 358 372 485 quiet_restart 2(02) 001162 automatic bit(1) level 4 packed packed unaligned dcl 100 set ref 310* repeat_flag 000014 internal static bit(1) initial dcl 125 set ref 233* 236 239* 358* 360* 387 565* 641* 741* 745 repeat_label 000010 internal static label variable dcl 124 set ref 232* 237 238* 566* 642* 740* 745 repeat_time 130 001162 automatic fixed bin(71,0) level 2 in structure "question_info" dcl 100 in procedure "hcom_command_query_" set ref 344* 387 390* repeat_time 10 002122 automatic fixed bin(71,0) initial level 2 in structure "query_info" dcl 2-16 in procedure "hcom_command_query_" set ref 198* 344 2-16* repeat_time 10 based fixed bin(71,0) initial level 2 in structure "input_info" dcl 85 in procedure "hcom_command_query_" ref 198 retstring 001317 automatic char(1000) packed unaligned dcl 101 set ref 292* 294 394 394 394 394 401 419 419 420 441 445 498 498 501 501 665* 696* rtrim builtin function dcl 107 ref 270 272 283 297 483 saved_rflag 001157 automatic bit(1) dcl 99 set ref 236* 565 641 saved_rlabel 001712 automatic label variable dcl 102 set ref 237* 566 642 scale 000106 automatic fixed bin(17,0) dcl 89 set ref 246* 258* scale_ 0(12) 000100 automatic fixed bin(11,0) level 2 packed packed unaligned dcl 1-3 set ref 691 signal_ 000070 constant entry external dcl 150 ref 353 521 530 size builtin function dcl 107 ref 305 322 static_allow_cp_escape 000016 internal static bit(1) initial dcl 128 set ref 207 227 762 763* status_code 104 001162 automatic fixed bin(35,0) level 3 in structure "question_info" dcl 100 in procedure "hcom_command_query_" set ref 311* status_code 2 based fixed bin(35,0) initial level 2 in structure "input_info" dcl 85 in procedure "hcom_command_query_" ref 171 status_code 2 002122 automatic fixed bin(35,0) initial level 2 in structure "query_info" dcl 2-16 in procedure "hcom_command_query_" set ref 171* 311 2-16* sub_err_ 000072 constant entry external dcl 151 ref 426 542 711 substr builtin function dcl 107 set ref 273* 282* 294* 294 298* 325 410* 410 419* 437* 437 441* 441 452 455 465 465 501 501 606* 612* 616* 717* 718* suppress_name_sw 1(01) based bit(1) initial level 3 in structure "input_info" packed packed unaligned dcl 85 in procedure "hcom_command_query_" ref 170 suppress_name_sw 1(01) 002122 automatic bit(1) initial level 3 in structure "query_info" packed packed unaligned dcl 2-16 in procedure "hcom_command_query_" set ref 170* 268 2-16* suppress_spacing 106(05) 001162 automatic bit(1) level 3 in structure "question_info" packed packed unaligned dcl 100 in procedure "hcom_command_query_" set ref 318* suppress_spacing 1(04) 002122 automatic bit(1) initial level 3 in structure "query_info" packed packed unaligned dcl 2-16 in procedure "hcom_command_query_" set ref 178* 318 498 2-16* 706 suppress_spacing 1(04) based bit(1) initial level 3 in structure "input_info" packed packed unaligned dcl 85 in procedure "hcom_command_query_" ref 178 switches 1 002122 automatic structure level 2 in structure "query_info" dcl 2-16 in procedure "hcom_command_query_" switches 106 001162 automatic structure level 2 in structure "question_info" dcl 100 in procedure "hcom_command_query_" switches 1 based structure level 2 in structure "input_info" dcl 85 in procedure "hcom_command_query_" timer_manager_$alarm_call 000074 constant entry external dcl 152 ref 390 timer_manager_$reset_alarm_call 000076 constant entry external dcl 153 ref 449 640 timer_set 001160 automatic bit(1) dcl 99 set ref 240* 391* 449 640 translate builtin function dcl 107 ref 517 type 000107 automatic fixed bin(17,0) dcl 89 set ref 246* 247 258* 260 type_ 0(01) 000100 automatic fixed bin(6,0) level 2 packed packed unsigned unaligned dcl 1-3 set ref 687* unspec builtin function dcl 107 set ref 223* user_info_$absentee_queue 000100 constant entry external dcl 154 ref 527 varying_answer parameter varying char dcl 53 set ref 12 252* 336 337 592* 621 621 622* 622 627 627* 630* 630 varying_char_dtype constant fixed bin(17,0) initial dcl 5-25 ref 260 version based fixed bin(17,0) level 2 in structure "input_info" dcl 85 in procedure "hcom_command_query_" ref 160 version 002122 automatic fixed bin(17,0) level 2 in structure "query_info" dcl 2-16 in procedure "hcom_command_query_" set ref 160* 161 161 163* 175 176 179 182 185 version 1 001162 automatic fixed bin(17,0) level 3 in structure "question_info" dcl 100 in procedure "hcom_command_query_" set ref 307* version2_ 000100 automatic bit(1) level 2 packed packed unaligned dcl 1-3 set ref 686* yes_or_no_sw 1 based bit(1) initial level 3 in structure "input_info" packed packed unaligned dcl 85 in procedure "hcom_command_query_" ref 169 yes_or_no_sw 106(01) 001162 automatic bit(1) level 3 in structure "question_info" packed packed unaligned dcl 100 in procedure "hcom_command_query_" set ref 314* yes_or_no_sw 1 002122 automatic bit(1) initial level 3 in structure "query_info" packed packed unaligned dcl 2-16 in procedure "hcom_command_query_" set ref 169* 224* 314 514 2-16* yes_sw parameter bit(1) packed unaligned dcl 55 set ref 217 557* yn_answer 001716 automatic varying char(500) dcl 103 set ref 327 328 yn_entry_sw 001161 automatic bit(1) dcl 99 set ref 166* 220* 245 279 326 557 665 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ACTION_CANT_RESTART internal static bit(36) initial dcl 6-7 ACTION_DEFAULT_RESTART internal static bit(36) initial dcl 6-7 ACTION_QUIET_RESTART internal static bit(36) initial dcl 6-7 ACTION_SUPPORT_SIGNAL internal static bit(36) initial dcl 6-7 algol68_array_descriptor_dtype internal static fixed bin(17,0) initial dcl 5-25 algol68_bits_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_bool_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_byte_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_char_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_compl_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_format_dtype internal static fixed bin(17,0) initial dcl 5-25 algol68_int_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_long_compl_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_long_int_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_long_real_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_real_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_short_int_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_straight_dtype internal static fixed bin(17,0) initial dcl 5-25 algol68_struct_struct_bool_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_struct_struct_char_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_union_dtype internal static fixed bin(17,0) initial dcl 5-25 area_dtype internal static fixed bin(17,0) initial dcl 5-25 bit_dtype internal static fixed bin(17,0) initial dcl 5-25 c_enum_const_dtype internal static fixed bin(17,0) initial dcl 5-25 c_enum_dtype internal static fixed bin(17,0) initial dcl 5-25 c_typeref_dtype internal static fixed bin(17,0) initial dcl 5-25 c_union_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_char_string_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_5_ts_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_5_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_6_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_7_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_8_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_8_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_ls_overp_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_ts_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_ts_overp_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_structure_dtype internal static fixed bin(17,0) initial dcl 5-25 condition_info_header_ptr automatic pointer dcl 4-4 cplx_fix_bin_1_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_fix_bin_2_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_fix_dec_4bit_bytealigned_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_fix_dec_9bit_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_bin_1_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_bin_2_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_bin_generic_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_dec_4bit_bytealigned_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_dec_9bit_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_dec_extended_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_dec_generic_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_hex_1_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_hex_2_dtype internal static fixed bin(17,0) initial dcl 5-25 cq_info_ptr automatic pointer dcl 3-42 entry_dtype internal static fixed bin(17,0) initial dcl 5-25 ext_entry_runtime_dtype internal static fixed bin(17,0) initial dcl 5-125 ext_procedure_runtime_dtype internal static fixed bin(17,0) initial dcl 5-125 file_dtype internal static fixed bin(17,0) initial dcl 5-25 ft_char_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_complex_double_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_complex_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_double_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_external_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_hex_complex_double_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_hex_complex_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_hex_double_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_hex_real_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_integer_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_logical_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_real_dtype internal static fixed bin(17,0) initial dcl 5-96 int_entry_runtime_dtype internal static fixed bin(17,0) initial dcl 5-125 label_constant_runtime_dtype internal static fixed bin(17,0) initial dcl 5-125 label_dtype internal static fixed bin(17,0) initial dcl 5-25 offset_dtype internal static fixed bin(17,0) initial dcl 5-25 pascal_boolean_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_char_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_entry_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_enumerated_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_enumerated_type_element_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_enumerated_type_instance_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_exportable_procedure_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_imported_procedure_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_integer_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_internal_procedure_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_label_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_parameter_procedure_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_procedure_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_real_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_record_file_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_record_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_set_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_string_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_text_file_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_typed_pointer_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_user_defined_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_user_defined_type_instance_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_value_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_variable_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 5-132 picture_runtime_dtype internal static fixed bin(17,0) initial dcl 5-125 pointer_dtype internal static fixed bin(17,0) initial dcl 5-25 query_info_version_3 internal static fixed bin(17,0) initial dcl 2-45 query_info_version_4 internal static fixed bin(17,0) initial dcl 2-46 query_info_version_5 internal static fixed bin(17,0) initial dcl 2-47 query_info_version_6 internal static fixed bin(17,0) initial dcl 2-48 query_info_version_7 internal static fixed bin(17,0) initial dcl 2-49 real_fix_bin_1_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_bin_1_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_bin_2_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_bin_2_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_bytealigned_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_bytealigned_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_ts_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_9bit_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_9bit_ls_overp_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_9bit_ts_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_9bit_ts_overp_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_9bit_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_bin_1_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_bin_2_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_bin_generic_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_dec_4bit_bytealigned_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_dec_4bit_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_dec_9bit_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_dec_extended_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_dec_generic_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_hex_1_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_hex_2_dtype internal static fixed bin(17,0) initial dcl 5-25 structure_dtype internal static fixed bin(17,0) initial dcl 5-25 varying_bit_dtype internal static fixed bin(17,0) initial dcl 5-25 NAMES DECLARED BY EXPLICIT CONTEXT. ANSWER_ERROR 001735 constant label dcl 426 ASK 001502 constant label dcl 372 ref 232 238 460 740 COMMON 000547 constant label dcl 230 ref 209 GET_LINE 001607 constant label dcl 394 ref 422 428 570 PRINT_EXPLANATION 002451 constant label dcl 498 PRINT_GRIPE 003041 constant label dcl 534 ref 543 PRINT_QUESTION 004650 constant label dcl 706 ref 713 QUESTION_ERROR 004674 constant label dcl 711 ref 727 READ_ANSWER 001556 constant label dcl 387 ref 478 511 554 SIGNAL 001363 constant label dcl 353 ref 458 473 add_to_answer 003543 constant label dcl 597 ref 587 clean_up 004210 constant entry internal dcl 637 ref 356 end_answer 004207 constant label dcl 634 ref 585 595 expand_explanation 004251 constant entry internal dcl 651 ref 494 get_ready_to_signal 001211 constant label dcl 305 ref 522 hcom_command_query_ 000310 constant entry external dcl 12 print_question 004647 constant entry internal dcl 704 ref 377 510 repeat_query 003366 constant entry external dcl 735 ref 390 390 449 449 640 640 rq 003356 constant entry external dcl 735 set_answer 003465 constant entry internal dcl 578 ref 558 559 560 563 set_cp_escape_enable 003447 constant entry external dcl 756 yes_no 000514 constant entry external dcl 217 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 6032 6134 5471 6042 Length 6544 5471 102 374 340 10 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME hcom_command_query_ 1356 external procedure is an external procedure. on unit on line 356 78 on unit set_answer internal procedure shares stack frame of external procedure hcom_command_query_. clean_up internal procedure shares stack frame of on unit on line 356. expand_explanation internal procedure shares stack frame of external procedure hcom_command_query_. begin block on line 670 108 begin block uses auto adjustable storage. print_question internal procedure shares stack frame of external procedure hcom_command_query_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 repeat_label hcom_command_query_ 000014 repeat_flag hcom_command_query_ 000015 first_call hcom_command_query_ 000016 static_allow_cp_escape hcom_command_query_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME begin block on line 670 000100 desc_ begin block on line 670 000100 new_arg_list begin block on line 670 hcom_command_query_ 000100 abs_queue hcom_command_query_ 000101 arg_count hcom_command_query_ 000102 bi hcom_command_query_ 000103 callername_index hcom_command_query_ 000104 control_string_index hcom_command_query_ 000105 ndims hcom_command_query_ 000106 scale hcom_command_query_ 000107 type hcom_command_query_ 000110 alloc_len hcom_command_query_ 000111 big_len hcom_command_query_ 000112 fixed_answer_len hcom_command_query_ 000113 fixed21 hcom_command_query_ 000114 len hcom_command_query_ 000116 alloc_ptr hcom_command_query_ 000120 area_ptr hcom_command_query_ 000122 alp hcom_command_query_ 000124 big_ptr hcom_command_query_ 000126 fixed_answer_ptr hcom_command_query_ 000130 alloc_sw hcom_command_query_ 000131 allow_cp_escape hcom_command_query_ 000132 fixed_answer_sw hcom_command_query_ 000133 interpret_cp_escape hcom_command_query_ 000134 buffer hcom_command_query_ 000526 code hcom_command_query_ 000527 ending_delim_found hcom_command_query_ 000530 multi_line_sw hcom_command_query_ 000531 error_string hcom_command_query_ 000562 Lanswer hcom_command_query_ 000563 output_buffer hcom_command_query_ 001156 packed hcom_command_query_ 001157 saved_rflag hcom_command_query_ 001160 timer_set hcom_command_query_ 001161 yn_entry_sw hcom_command_query_ 001162 question_info hcom_command_query_ 001317 retstring hcom_command_query_ 001712 saved_rlabel hcom_command_query_ 001716 yn_answer hcom_command_query_ 002122 query_info hcom_command_query_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. 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 return_mac tra_ext_2 alloc_auto_adj mpfx2 enable_op shorten_stack ext_entry ext_entry_desc int_entry op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ convert_status_code_ cu_$arg_count cu_$arg_list_ptr cu_$arg_ptr cu_$cp decode_descriptor_ get_group_id_ get_system_free_area_ ioa_ ioa_$general_rs ioa_$ioa_switch ioa_$ioa_switch_nnl iox_$control iox_$get_line iox_$put_chars signal_ sub_err_ timer_manager_$alarm_call timer_manager_$reset_alarm_call user_info_$absentee_queue THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$long_record iox_$user_input iox_$user_io iox_$user_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2 16 000250 12 000304 160 000324 161 000330 163 000334 166 000336 167 000337 168 000341 169 000343 170 000350 171 000354 172 000356 173 000360 175 000361 176 000364 177 000366 178 000372 179 000376 180 000400 181 000402 182 000405 183 000410 184 000414 185 000420 186 000422 187 000427 188 000431 189 000436 190 000443 196 000444 197 000446 198 000450 201 000452 202 000464 203 000466 204 000467 205 000470 206 000476 207 000503 209 000507 217 000510 220 000522 221 000524 222 000526 223 000530 224 000533 225 000535 226 000540 227 000543 230 000547 232 000552 233 000555 234 000556 236 000557 237 000561 238 000565 239 000570 240 000571 242 000572 243 000600 245 000607 246 000611 247 000637 248 000643 249 000644 250 000664 251 000665 252 000666 256 000671 257 000707 258 000711 260 000734 266 000743 267 000745 268 000750 270 000755 271 000772 272 000776 273 001011 279 001014 280 001016 281 001021 282 001036 283 001042 285 001055 286 001075 291 001103 292 001106 293 001153 294 001162 295 001166 296 001167 297 001172 298 001205 299 001210 305 001211 307 001213 308 001215 309 001217 310 001221 311 001223 312 001225 313 001227 314 001231 315 001236 316 001240 317 001242 318 001247 319 001254 320 001261 321 001266 322 001273 323 001275 324 001277 325 001302 326 001311 327 001313 328 001321 329 001323 331 001324 332 001326 333 001331 334 001333 336 001334 337 001344 338 001346 340 001347 342 001351 344 001353 346 001355 347 001357 349 001361 353 001363 356 001421 358 001437 360 001454 362 001456 366 001470 369 001473 372 001502 374 001505 377 001543 382 001544 384 001545 387 001556 390 001565 391 001605 394 001607 397 001632 398 001636 400 001647 401 001651 402 001653 403 001661 404 001662 405 001670 407 001672 409 001701 410 001703 411 001710 412 001714 413 001715 415 001716 416 001720 419 001722 420 001727 421 001731 422 001732 425 001733 426 001735 428 002005 431 002006 432 002010 433 002014 435 002017 437 002026 438 002033 439 002040 441 002042 442 002050 443 002051 445 002052 446 002054 449 002056 452 002073 455 002141 456 002146 457 002150 458 002200 460 002203 463 002204 465 002206 467 002233 468 002235 469 002236 470 002243 473 002245 476 002250 477 002303 478 002322 483 002323 485 002337 492 002401 494 002415 496 002416 498 002451 501 002474 510 002564 511 002571 514 002572 517 002575 519 002606 521 002632 522 002667 525 002670 527 002706 528 002715 529 002720 530 002750 531 003005 533 003006 534 003041 538 003071 541 003112 542 003114 543 003165 546 003166 548 003221 549 003223 550 003224 551 003231 554 003233 557 003234 558 003257 559 003271 560 003303 561 003315 563 003316 565 003331 566 003334 568 003340 570 003347 573 003354 735 003355 739 003374 740 003377 741 003402 742 003403 745 003404 747 003411 749 003442 756 003443 762 003455 763 003461 765 003464 578 003465 582 003476 583 003501 584 003510 585 003512 587 003513 590 003514 592 003527 595 003542 597 003543 600 003545 601 003551 602 003604 603 003620 604 003622 605 003623 606 003631 607 003662 608 003716 609 003732 610 003734 611 003735 612 003737 613 003747 614 003751 616 003752 617 004003 619 004007 621 004010 622 004017 623 004055 624 004111 625 004125 626 004127 627 004130 630 004150 632 004206 634 004207 637 004210 640 004211 641 004227 642 004233 644 004237 646 004250 651 004251 665 004252 670 004325 672 004330 685 004360 686 004532 687 004534 688 004540 689 004542 691 004544 693 004546 694 004573 696 004576 699 004645 701 004646 704 004647 706 004650 708 004653 710 004672 711 004674 713 004745 715 004746 717 004747 718 004751 720 004760 723 005005 727 005027 730 005031 ----------------------------------------------------------- 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