COMPILATION LISTING OF SEGMENT abs_io_v2_get_line Compiled by: Multics PL/I Compiler, Release 30, of February 16, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 10/04/88 1311.8 mst Tue Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1983 * 6* * * 7* *********************************************************** */ 8 9 10 11 12 /****^ HISTORY COMMENTS: 13* 1) change(86-03-13,Herbst), approve(86-04-17,MCR7376), 14* audit(86-04-17,Kissel), install(86-04-22,MR12.0-1041): 15* Fixed bug where null &else failed to close an &if-&then-&else. 16* 2) change(87-06-04,Parisek), approve(87-07-23,MCR7716), 17* audit(87-08-07,Fawcett), install(87-08-11,MR12.1-1080): 18* Continue execution with next exec_com line when abs_io_data.noabort 19* is ON. 20* 3) change(87-09-18,Parisek), approve(87-09-18,PBF7716), 21* audit(87-09-21,Farley), install(87-09-21,MR12.1-1111): 22* Set end_ec & goto ERROR_RETURN label when noabort is ON if error 23* occurs on the last line of the exec_com. 24* 4) change(88-08-08,TLNguyen), approve(88-08-08,MCR7934), 25* audit(88-09-15,Parisek), install(88-09-16,MR12.2-1111): 26* Make the &exit statement and the &goto LABEL statement constructed within 27* the &on unit work as documented. Also fixed a size condition and 28* stringrange condition raised while fixing errors. 29* 5) change(88-09-29,TLNguyen), approve(88-09-29,PBF7934), 30* audit(88-09-30,Parisek), install(88-10-04,MR12.2-1128): 31* Remove unnessesary label searching within the &label block, and 32* make more extensive checks for the value of goto_entry_sw and 33* abs_data.label_search_sw in determining what action to take when 34* inside an &on unit block in the exec_com/absin. 35* END HISTORY COMMENTS */ 36 37 38 /* format: off */ 39 40 abs_io_v2_get_line: proc (A_iocb_ptr, A_buffer_ptr, A_buffer_len, A_return_len) returns (fixed (35)); 41 42 43 /* Implements &version 2 exec_com language; reads and executes control lines from an input file 44* until it encounters a non-control line, then returns this expanded line. */ 45 46 /* Added &print_switch{_nnl} 10/20/81 Steve Herbst */ 47 /* Modified: 15 February 1982 by G. Palter for new calling sequence of ec_data.eval_string */ 48 /* Fixed &if-&then-&else to be impervious to imbedded get_line 04/20/82 Steve Herbst */ 49 /* Fixed to detect all cases of null &then and &else clauses 07/19/82 Steve Herbst */ 50 /* Fixed to detect missing &quit statement 07/28/82 Steve Herbst */ 51 /* Changed to zero xd.label_search_values to be filled in by abs_io_expand_ 10/06/82 Steve Herbst */ 52 /* Fixed &label inside &do group to not destroy block info 11/15/82 Steve Herbst */ 53 /* Fixed &is_af and "Missing &quit statement" line number 12/07/82 Steve Herbst */ 54 /* Fixed &goto to position correctly to 1st char in target line 02/24/83 Steve Herbst */ 55 /* Added &on, &begin, &revert, etc., also added $goto for handler's nonlocal &goto 04/07/83 Steve Herbst */ 56 /* Added &attach &trim on/off 06/02/83 Steve Herbst */ 57 /* Added &list_variables (&lsv) 06/07/83 Steve Herbst */ 58 /* Fixed &if...&then...BLANK LINE&else... 07/22/83 Steve Herbst */ 59 /* Fixed bug causing &on unit to screw up later &if's 10/13/83 Steve Herbst */ 60 /* Fixed &else&if to be a null &else rather than an &else &if 10/13/83 Steve Herbst */ 61 /* Changed to set abs_data.goto_pl1_label for absentee_listen_, doing &goto from an &on unit 11/17/83 Steve Herbst */ 62 /* Fixed not to wait until non-ctl line to set abs_data.(position limit) 11/30/83 Steve Herbst */ 63 /* Removed useless and undocumented "Missing &quit statement" warning 11/30/83 Steve Herbst */ 64 /* Made &on accept commas as well as white space between condition names 01/25/84 Steve Herbst */ 65 /* Made ec -trace, -no_trace override &trace statements 03/20/84 Steve Herbst */ 66 /* Added &all_types, &all_expansions keywords to &trace 05/03/84 Steve Herbst */ 67 /* Fixed &revert, &signal, &trace to parse result of expansion yielding "token1 token2" 07/18/84 Steve Herbst */ 68 /* Fixed bug that stopped skipping while inside skipped &do-&end 08/03/84 Steve Herbst */ 69 /* Fixed bug where a handler's &end fouled up later &if-&then skipping 08/10/84 Steve Herbst */ 70 /* Fixed &list_variables bug that used default value seg if no variables set 08/10/84 Steve Herbst */ 71 /* Fixed end-of-file processing to log out an absentee only if not executing an &on unit 09/17/84 Steve Herbst */ 72 /* Fixed $goto to record found label in hash table 01/02/85 Steve Herbst */ 73 /* Fixed &on-&end to not require the &end to be followed by a newline character 01/03/85 Steve Herbst */ 74 /* Fixed &goto not to allocate storage if label has already been parsed 02/15/85 Steve Herbst */ 75 /* Fixed to free parsed_args structure allocated by abs_io_expand_ 02/19/85 Steve Herbst */ 76 77 78 /* Parameters */ 79 80 dcl A_goto_label char (*); 81 dcl (A_iocb_ptr, iocb_ptr) ptr; /* ptr to IOCB of abs_io_ or syn_ attached to abs_io_ */ 82 dcl (A_abs_data_ptr, A_ec_data_ptr) ptr; /* ptr to caller's info structures (for $goto) */ 83 dcl (A_buffer_ptr, buffer_ptr) ptr; /* ptr to caller's input buffer */ 84 dcl (A_buffer_len, buffer_len) fixed bin (21); /* max length (in chars) of caller's buffer */ 85 dcl (A_return_len, actual_len) fixed bin (21); /* length of data actually returned */ 86 dcl A_code fixed bin (35); /* standard status code */ 87 88 /* Constants */ 89 90 /* NOTE: These next five values depend on the values of the STMTS array in abs_io_expand_ */ 91 92 dcl BEGIN_ACTION fixed bin int static options (constant) init (2); 93 dcl DO_ACTION fixed bin int static options (constant) init (6); 94 dcl ELSE_ACTION fixed bin int static options (constant) init (7); 95 dcl IF_ACTION fixed bin int static options (constant) init (13); 96 dcl THEN_ACTION fixed bin int static options (constant) init (35); 97 98 99 100 dcl DO_TYPE fixed bin int static options (constant) init (0); 101 dcl BEGIN_TYPE fixed bin int static options (constant) init (1); 102 dcl THEN_TYPE fixed bin int static options (constant) init (2); 103 dcl ELSE_TYPE fixed bin int static options (constant) init (3); 104 105 dcl NO_UPDATE bit (1) int static options (constant) init ("0"b); 106 107 dcl ALPHA char (52) int static options (constant) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"); 108 dcl DIGITS char (10) int static options (constant) init ("0123456789"); 109 dcl LABEL fixed bin int static options (constant) init (1); 110 dcl NL char (1) int static options (constant) init (" 111 "); 112 dcl WHITE_SPACE char (4) int static options (constant) init (" "); /* SP HT VT FF */ 113 114 115 /* Based */ 116 117 dcl condition_array (condition_count) char (32) based (condition_array_ptr); 118 119 dcl 1 saved_if_info aligned like abs_data.if_info based; 120 121 dcl 1 default_args (abs_data.default_arg_count) based (abs_data.default_arg_ptr), 122 2 ptr ptr, 123 2 len fixed bin (21), 124 2 quote_count fixed bin (21); 125 126 dcl default_values_ptr ptr; 127 dcl default_values (abs_data.default_arg_count) char (max_default_len) based (default_values_ptr); 128 129 dcl allocated_chars char (abs_data.allocated_chars_len) based (abs_data.allocated_chars_ptr); 130 dcl ec_path char (arg_info.ec_path_len) based (arg_info.ec_path_ptr); 131 132 dcl allocated_buffer char (alloc_len) based (xd.allocated_ptr); 133 dcl arg char (xd.arg_len) based (xd.arg_ptr); 134 dcl buffer char (buffer_len) based (buffer_ptr); 135 dcl goto_name char (goto_name_len) based (goto_name_ptr); 136 dcl input_string char (input_string.len) based (input_string.ptr); 137 dcl label_val char (label_val_len) based (label_val_ptr); 138 dcl remainder char (abs_data.chars_len) based (abs_data.chars_ptr); 139 dcl return_arg char (ec_data.return_len) varying based (ec_data.return_ptr); 140 dcl val_string char (val_len) based (val_ptr); 141 dcl var_string char (var_len) based (var_ptr); 142 143 dcl based_area area based (area_ptr); 144 dcl xd_area area based (xd.area_ptr); 145 146 147 /* Automatic */ 148 149 dcl 1 xd aligned like expand_data; 150 151 dcl (message, switch_name) char (168); 152 dcl token char (128) varying; 153 dcl token32 char (32); 154 155 dcl (begin_line_sw, goto_entry_sw, nnl_sw, skipping_handler_sw, some_left_sw) bit (1); 156 157 dcl area_ptr ptr init (null); 158 dcl (condition_array_ptr, goto_name_ptr, handler_ptr, label_val_ptr, last_node_ptr, lastp) ptr; 159 dcl (on_saved_if_ptr, p, saved_if_ptr, saved_label_ptr, test_ptr, val_ptr, var_ptr) ptr; 160 161 dcl (active_string_pos, alloc_len, cond_string_len, goto_name_len, handler_len, handler_start) fixed bin (21); 162 dcl (label_val_len, max_default_len, name_len, saved_goto_pos) fixed bin (21); 163 dcl (saved_statement_len, saved_statement_pos, tpos, val_len, var_len) fixed bin (21); 164 dcl (condition_count, hash, i, saved_hash, saved_skip_block_level, search_type) fixed bin; 165 dcl code fixed bin (35); 166 167 dcl (area, bad_area_format, bad_area_initialization, cleanup) condition; 168 169 170 /* External */ 171 172 dcl error_table_$badsyntax fixed bin (35) ext; 173 dcl error_table_$command_line_overflow fixed bin (35) ext; 174 dcl error_table_$end_of_info fixed bin (35) ext; 175 dcl error_table_$long_record fixed bin (35) ext; 176 dcl error_table_$noalloc fixed bin (35); 177 dcl error_table_$notalloc fixed bin (35) ext; 178 179 dcl abs_io_control$attach entry (ptr, ptr, fixed bin (35)); 180 dcl abs_io_control$detach entry (ptr, ptr, fixed bin (35)); 181 dcl abs_io_expand_ entry (1 aligned like expand_data, fixed bin (35)); 182 dcl abs_io_expand_$expand_label entry (1 aligned like expand_data, fixed (21), fixed (21), ptr, fixed (21), fixed (35)); 183 dcl (abs_io_expand_$delete, abs_io_expand_$set) entry (ptr, char (*), char (*), fixed bin (35)); 184 dcl abs_io_expand_$label_search entry (1 aligned like expand_data, fixed bin (35)); 185 dcl abs_io_expand_$skip entry (1 aligned like expand_data, fixed bin (35)); 186 dcl abs_io_list_vars entry (ptr, ptr, char (*), fixed bin (35)); 187 dcl (active_fnc_err_, com_err_) entry options (variable); 188 dcl cu_$evaluate_active_string entry (ptr, char (*), fixed bin, char (*) varying, fixed bin (35)); 189 dcl cu_$arg_list_ptr entry returns (ptr); 190 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 191 dcl cu_$set_ready_mode entry (1 aligned like ready_mode); 192 dcl get_system_free_area_ entry returns (ptr); 193 dcl (ioa_, ioa_$nnl, ioa_$general_rs, ioa_$ioa_switch, ioa_$ioa_switch_nnl) entry options (variable); 194 dcl iox_$find_iocb entry (char (*), ptr, fixed bin (35)); 195 dcl iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 196 dcl iox_$look_iocb entry (char (*), ptr, fixed bin (35)); 197 dcl iox_$user_input ptr ext; 198 dcl logout entry; 199 dcl signal_ entry options (variable); 200 dcl signal_io_error_ entry (char (*), ptr, fixed bin (35)); 201 202 dcl 1 ready_mode aligned, 203 2 flag bit (1) unaligned, 204 2 pad bit (35) unaligned; 205 206 dcl input_linep bit (1) aligned; 207 208 dcl (addcharno, addr, binary, char, charno, codeptr, index, length, max, mod, null) builtin; 209 dcl (reverse, rtrim, search, substr, translate, unspec, verify) builtin; 210 211 START: 212 goto_entry_sw, skipping_handler_sw = "0"b; 213 214 A_code = 0; 215 216 call get_data_ptrs (NO_UPDATE); 217 218 if abs_data.active then 219 if abs_data.attach.save_ptr ^= null then do; /* use previous attachment */ 220 call iox_$get_line (abs_data.attach.save_ptr, A_buffer_ptr, A_buffer_len, A_return_len, A_code); 221 return (A_code); 222 end; 223 else call recurse_error; 224 abs_data.active = "1"b; 225 226 if ^abs_data.in_handler_sw then abs_data.get_line_pl1_label = START; 227 /* target for &goto from inside &on unit invoked while inside this program */ 228 229 if abs_data.ec_data_ptr = null () then input_linep = "0"b; 230 else input_linep = abs_data.ec_data_ptr -> ec_data.input_line; 231 232 if abs_data.chars_len > 0 then do; /* pending chars to return */ 233 234 if input_linep ^= abs_data.last_input_line_sw then do; /* changed input/command mode in mid-line */ 235 abs_data.chars_len = 0; 236 free allocated_chars; 237 go to EXPAND_NEXT_STMT; /* flush the rest of the old line */ 238 end; 239 240 if abs_data.chars_len > A_buffer_len then do; /* return as much as will fit */ 241 some_left_sw = "1"b; 242 actual_len = buffer_len; 243 end; 244 else do; /* return it all */ 245 some_left_sw = "0"b; 246 actual_len = abs_data.chars_len; 247 end; 248 249 substr (buffer, 1, actual_len) = substr (remainder, 1, actual_len); 250 251 if some_left_sw then do; 252 abs_data.chars_ptr = addr (substr (remainder, actual_len + 1)); 253 abs_data.chars_len = abs_data.chars_len - actual_len; 254 A_code = error_table_$long_record; 255 end; 256 else do; 257 abs_data.chars_len = 0; 258 free allocated_chars; 259 end; 260 261 RETURN: abs_data.last_input_line_sw = input_linep; 262 abs_data.active = "0"b; 263 264 if ^goto_entry_sw then A_return_len = actual_len; 265 266 return (A_code); 267 end; 268 269 /* Initialize local expand_data */ 270 271 call init_xd (); 272 273 EXPAND_NEXT_STMT: 274 if ^goto_entry_sw then do; 275 xd.caller_buffer_ptr = A_buffer_ptr; /* expanded line will be returned in caller's buffer */ 276 xd.caller_buffer_len = A_buffer_len; 277 end; 278 279 xd.allocated_ptr = null; 280 xd.allocated_len = 0; 281 282 if input_linep then xd.trace_lines = abs_data.input_line; 283 else xd.trace_lines = abs_data.command_line; 284 285 if abs_data.if_sw then call test_end_of_if (); 286 287 MIGHT_SKIP: 288 if xd.parsed_args_ptr ^= null then free xd.parsed_args_ptr -> parsed_args in (xd_area); 289 unspec (xd.expander_output) = "0"b; 290 xd.arg_ptr, xd.parsed_args_ptr = null; 291 292 /* Call the expander */ 293 294 saved_statement_pos = xd.this_statement.pos; /* in case we run off end with no &quit */ 295 296 i = 0; /* in case it doesn't get set below we can avoid stringrange error */ 297 if xd.input_pos > 1 then /* to avoid stringrange condition raised when finding the substring */ 298 /* does the input substring characters begin with NL? */ 299 i = verify (substr (input_string, xd.input_pos - 1), NL || WHITE_SPACE); 300 301 if i < 2 then begin_line_sw = "0"b; /* no, the input substring characters does not start with NL */ 302 else begin_line_sw = (index (substr (input_string, xd.input_pos - 1, i - 1), NL) ^= 0); 303 304 if begin_line_sw & abs_data.next_action = IF_ACTION then do; /* &if always starts a new &if statement */ 305 abs_data.if_sw = "0"b; 306 if ^skipping_handler_sw & abs_data.skip_block_level = 0 then abs_data.skip_sw = "0"b; 307 end; 308 309 if abs_data.label_search_sw then do; 310 call abs_io_expand_$label_search (xd, code); 311 if code ^= 0 then 312 if code = error_table_$end_of_info then go to END_OF_FILE; /* label not found */ 313 else call error (code, xd.error_msg); 314 end; 315 316 else if abs_data.skip_sw then /* after &if FALSE &then, skip to &else */ 317 call abs_io_expand_$skip (xd, code); 318 319 else call abs_io_expand_ (xd, code); 320 321 if code ^= 0 then 322 if code = error_table_$end_of_info then do; 323 if saved_statement_pos ^= 0 then xd.this_statement.pos = saved_statement_pos; 324 else if xd.this_statement.pos = 0 then xd.this_statement.pos = abs_data.input_string.len - 1; 325 go to END_OF_FILE; 326 end; 327 else call error (code, xd.error_msg); 328 329 input_string.limit = max (input_string.limit, xd.input_pos - 1); /* how far parsed by abs_io_expand_ */ 330 input_string.position = xd.input_pos; 331 332 parsed_args_ptr = xd.parsed_args_ptr; 333 334 if abs_data.if_sw & begin_line_sw & /* previous &then or &else clause */ 335 abs_data.this_action ^= THEN_ACTION & /* and current stmt is neither &then nor &else */ 336 abs_data.this_action ^= ELSE_ACTION then 337 if abs_data.this_action = 0 & /* except for blank line followed by &then or &else */ 338 (abs_data.next_action = THEN_ACTION | abs_data.next_action = ELSE_ACTION) then; 339 else do; /* force end of &if construct */ 340 abs_data.if_sw = "0"b; 341 if abs_data.skip_block_level = 0 then abs_data.skip_sw = "0"b; 342 end; 343 344 if abs_data.skip_sw then go to SKIP (abs_data.this_action); 345 346 if abs_data.this_action = 0 then do; 347 348 if abs_data.label_search_sw then 349 go to END_OF_FILE; /* label search failed (no more &label stmts) */ 350 351 RETURN_LINE: if xd.caller_actual_len >= xd.caller_buffer_len then do; /* no room to append NL */ 352 if xd.allocated_ptr = null then do; 353 alloc_len = 1; 354 355 allocate allocated_buffer in (abs_data.work_area) set (xd.allocated_ptr); 356 357 xd.allocated_buffer_len = 1; 358 xd.allocated_len = 0; 359 end; 360 xd.allocated_len = xd.allocated_len + 1; /* append NL */ 361 substr (allocated_buffer, xd.allocated_len, 1) = NL; 362 actual_len = xd.caller_actual_len; 363 abs_data.allocated_chars_ptr, abs_data.chars_ptr = xd.allocated_ptr; 364 abs_data.allocated_chars_len, abs_data.chars_len = xd.allocated_len; 365 A_code = error_table_$long_record; 366 end; 367 else do; /* fits in caller's buffer */ 368 substr (buffer, xd.caller_actual_len + 1, 1) = NL; 369 actual_len = xd.caller_actual_len + 1; 370 A_code = 0; 371 end; 372 373 go to RETURN; 374 end; 375 376 else go to ACTION (abs_data.this_action); 377 378 goto: entry (A_abs_data_ptr, A_ec_data_ptr, A_goto_label) returns (fixed bin (35)); 379 380 /* Called by absentee_listen_$execute_handler if the handler did a nonlocal &goto */ 381 382 goto_entry_sw = "1"b; 383 384 abs_data_ptr = A_abs_data_ptr; 385 ec_data_ptr = A_ec_data_ptr; 386 387 call init_xd (); 388 xd.caller_buffer_ptr, xd.allocated_ptr = null; 389 unspec (xd.trace_lines) = "0"b; 390 /* save the location and the length of the line containing "&goto LABEL_NAME" */ 391 /* for later referenced in the error message when LABEL_NAME not found */ 392 xd.this_statement.pos = abs_data.goto_statement_pos; 393 xd.this_statement.len = abs_data.goto_statement_len; 394 395 goto_name_len = length (rtrim (A_goto_label, WHITE_SPACE)); 396 allocate goto_name in (abs_data.work_area) set (goto_name_ptr); 397 goto_name = A_goto_label; 398 399 go to GOTO_STMT; 400 401 ACTION (0): /* end of the input file */ 402 403 END_OF_FILE: 404 call reset_input (); /* implicit &detach at end of file */ 405 406 if abs_data.label_search_sw then do; 407 408 if abs_data.in_handler_sw & ^goto_entry_sw then do; 409 /* nonlocal &goto out of &on unit */ 410 if abs_data.condition_name = "cleanup" then 411 call error (0, "Attempted nonlocal &goto from inside cleanup handler."); 412 abs_data.goto_sw, abs_data.exit_sw = "1"b; 413 abs_data.goto_label_ptr = addr (saved_label_ptr -> label.name); 414 abs_data.goto_label_len = saved_label_ptr -> label.len; 415 go to ERROR_RETURN; 416 end; 417 418 xd.this_statement.pos = saved_goto_pos; 419 xd.this_statement.len = saved_statement_len; 420 421 if search_type = LABEL then message = "Label ""^a"" not found."; 422 else message = "Search failed for ""^a""."; 423 424 call error (0, message, saved_label_ptr -> label.name); 425 end; 426 427 ERROR_RETURN: 428 abs_data.eof = "1"b; 429 if ^goto_entry_sw then A_return_len = 0; 430 431 if abs_data.absentee & ^abs_data.in_handler_sw then call logout; 432 433 else return (error_table_$end_of_info); 434 435 /* NOTE: These labels correspond to the STMTS array in abs_io_expand_ */ 436 437 ACTION (1): /* &attach */ 438 if ec_data_ptr ^= null & ^attachedp () then do; 439 call abs_io_control$attach (abs_data_ptr, null, code); 440 if code ^= 0 then call error (code, "Error while performing &attach."); 441 end; 442 443 if parsed_args_ptr = null then abs_data.trim_whitespace_sw = "1"b; 444 else if parsed_args.count = 0 then abs_data.trim_whitespace_sw = "1"b; 445 else do; 446 xd.arg_ptr = parsed_args.ptr (1); 447 xd.arg_len = parsed_args.len (1); 448 if arg ^= "&trim" then call error (0, "Invalid &attach control argument " || arg || "."); 449 if parsed_args.count = 1 then abs_data.trim_whitespace_sw = "1"b; 450 else if parsed_args.count > 2 then call error (0, "Too many arguments for &attach."); 451 else do; 452 xd.arg_ptr = parsed_args.ptr (2); 453 xd.arg_len = parsed_args.len (2); 454 if arg = "on" | arg = "true" then abs_data.trim_whitespace_sw = "1"b; 455 else if arg = "off" | arg = "false" then abs_data.trim_whitespace_sw = "0"b; 456 else call error (0, "Invalid argument to &attach &trim: " || arg); 457 end; 458 end; 459 460 SET_INPUT_LIMIT: /* done expanding and executing this control stmt */ 461 input_string.limit = max (input_string.limit, xd.input_pos - 1); /* how far parsed by abs_io_expand_ */ 462 go to EXPAND_NEXT_STMT; 463 464 465 ACTION (2): /* &begin */ 466 if abs_data.label_search_sw then do; 467 468 call execute_begin (); 469 470 go to SET_INPUT_LIMIT; 471 end; 472 else call error (0, "&begin not preceded by &on."); 473 474 475 ACTION (3): /* &call (UNIMPLEMENTED) */ 476 BAD_KEY: call error (0, "Invalid keyword ^a", 477 substr (input_string, xd.this_statement.pos, xd.this_statement.keyword_len)); 478 479 480 ACTION (4): /* &default */ 481 call set_defaults (xd.parsed_args_ptr); 482 go to SET_INPUT_LIMIT; 483 484 485 ACTION (5): /* &detach */ 486 call reset_input (); 487 go to SET_INPUT_LIMIT; 488 489 490 ACTION (6): /* &do */ 491 call execute_do (); 492 493 go to EXPAND_NEXT_STMT; 494 495 496 ACTION (7): /* &else */ 497 abs_data.clause_type = ELSE_TYPE; 498 499 call execute_else (); 500 501 go to SET_INPUT_LIMIT; 502 503 504 ACTION (8): /* &end */ 505 END_STMT: 506 call execute_end (); 507 508 go to SET_INPUT_LIMIT; 509 510 511 ACTION (9): /* &exit */ 512 if ^abs_data.in_handler_sw then call error (0, "&exit is allowed only inside an &on unit."); 513 if parsed_args_ptr ^= null then do; 514 do i = 1 to parsed_args.count; 515 xd.arg_ptr = parsed_args.ptr (i); 516 xd.arg_len = parsed_args.len (i); 517 if arg = "&continue" then abs_data.on_info.continue_to_signal_sw = "1"b; 518 else call error (0, "Invalid &exit control argument " || arg || "."); 519 end; 520 end; 521 go to END_OF_FILE; 522 523 524 ACTION (10): /* &entry (UNIMPLEMENTED) */ 525 go to BAD_KEY; 526 527 528 ACTION (11): /* &function (UNIMPLEMENTED) */ 529 /* 530* block_ptr = allocate_block (); 531* 532* block.containing_lex_block_ptr = null; 533* block.containing_proc_block_ptr = current_proc_block_ptr; 534* block.args_ptr = xd.parsed_args_ptr; 535* block.identifier = FUNCTION_TYPE; 536* 537* current_proc_block_ptr = block_ptr; 538* current_lex_block_ptr = null; 539* go to EXPAND_NEXT_STMT; 540**/ 541 go to BAD_KEY; 542 543 544 ACTION (12): /* &goto */ 545 abs_data.goto_statement_pos = xd.this_statement.pos; 546 abs_data.goto_statement_len = xd.this_statement.len; 547 548 goto_name_len, xd.arg_len = length (rtrim (arg, WHITE_SPACE)); 549 allocate goto_name in (abs_data.work_area) set (goto_name_ptr); 550 goto_name = arg; 551 552 GOTO_STMT: 553 label_ptr = lookup_label (abs_data.labels_ptr, goto_name, hash); /* see if the right &label was seen */ 554 555 if label_ptr ^= null then do; /* already compiled label */ 556 xd.input_pos = label.statement_pos + label.statement_len + 1; 557 if label.lex_block_ptr ^= null then do; /* target is inside a &do group */ 558 abs_data.if_info = label.lex_block_ptr -> block.if_info; 559 560 /* Check for &goto into a &do group (not allowed). 561* When &proc's are added, check for &goto's into &proc's too. */ 562 563 do test_ptr = abs_data.current_lex_block_ptr 564 repeat (test_ptr -> block.containing_lex_block_ptr) 565 while (test_ptr ^= label.lex_block_ptr); 566 if test_ptr = null then call error (0, "&goto into a &do group"); 567 end; 568 end; 569 abs_data.current_lex_block_ptr = label.lex_block_ptr; 570 free goto_name in (abs_data.work_area); 571 if goto_entry_sw then do; 572 input_string.limit = max (input_string.limit, xd.input_pos - 1); 573 input_string.position = xd.input_pos; 574 return (0); /* return from $goto */ 575 end; 576 else go to EXPAND_NEXT_STMT; /* start executing after the label stmt */ 577 end; 578 579 saved_label_ptr = allocate_label (goto_name); /* create a node for the &label when found */ 580 saved_hash = hash; /* save everything */ 581 saved_goto_pos = xd.this_statement.pos; 582 saved_statement_len = xd.this_statement.len; 583 584 abs_data.label_search_sw = "1"b; 585 unspec (xd.label_search_values) = "0"b; /* next &do, &end, etc. for searching */ 586 xd.searching_for = goto_name; /* for error message */ 587 search_type = LABEL; 588 free goto_name in (abs_data.work_area); 589 go to EXPAND_NEXT_STMT; 590 591 592 ACTION (13): /* &if */ 593 call execute_if (); 594 595 go to SET_INPUT_LIMIT; 596 597 598 ACTION (14): /* &label */ 599 xd.arg_len = length (rtrim (arg, WHITE_SPACE)); 600 if abs_data.label_search_sw & search_type = LABEL then 601 if arg = saved_label_ptr -> label.name then do; /* the one we want */ 602 label_ptr = saved_label_ptr; 603 hash = saved_hash; 604 xd.input_pos = xd.this_statement.pos + xd.this_statement.len + 1; /* begin executing from here */ 605 abs_data.label_search_sw = "0"b; 606 go to GOT_LABEL; 607 end; 608 609 label_ptr = allocate_label (arg); 610 hash = mod (binary (unspec (char (arg, 2)), 18) + length (arg), 61); 611 GOT_LABEL: /* compile label for finding later */ 612 label.lex_block_ptr = abs_data.current_lex_block_ptr; /* &goto to here restores all of this stuff */ 613 label.statement_pos = xd.this_statement.pos; 614 label.statement_len = xd.this_statement.len; 615 616 if goto_entry_sw & ^abs_data.label_search_sw then do; 617 input_string.limit = max (input_string.limit, xd.input_pos - 1); 618 input_string.position = xd.input_pos; 619 end; 620 else input_string.limit = xd.input_pos; 621 622 if xd.expanded_sw then do; /* was an expandable label */ 623 /* thread into xlabel chain */ 624 if abs_data.first_xlabel_ptr = null then abs_data.first_xlabel_ptr = label_ptr; 625 if abs_data.last_xlabel_ptr ^= null then 626 abs_data.last_xlabel_ptr -> label.next_ptr = label_ptr; 627 abs_data.last_xlabel_ptr = label_ptr; 628 label.next_ptr = null; /* last in chain */ 629 end; 630 631 else do; 632 /* else thread into hash tree of constant labels */ 633 if abs_data.labels_ptr = null then abs_data.labels_ptr = allocate_hash_table (); 634 635 label.next_ptr = abs_data.labels_ptr -> hash_table (hash); 636 abs_data.labels_ptr -> hash_table (hash) = label_ptr; /* thread in as first node for hash */ 637 end; 638 639 if goto_entry_sw & ^abs_data.label_search_sw then return (0); 640 /* return from $goto */ 641 else go to EXPAND_NEXT_STMT; 642 643 644 ACTION (15): /* &leave (UNIMPLEMENTED) */ 645 go to BAD_KEY; 646 647 648 ACTION (16): /* &list_variables */ 649 LIST_VARIABLES_STMT: 650 if abs_data.variables_ptr = null then call ioa_ ("No variables set."); 651 else do; 652 call abs_io_list_vars (abs_data_ptr, parsed_args_ptr, message, code); 653 if code ^= 0 then call error (code, message); 654 end; 655 656 go to SET_INPUT_LIMIT; 657 658 659 ACTION (17): /* &lsv (synonym for &list_variables) */ 660 go to LIST_VARIABLES_STMT; 661 662 663 ACTION (18): /* &on */ 664 if parsed_args_ptr = null then 665 NO_ON_ARGS: call error (0, "No condition names specified for &on statement."); 666 if parsed_args.count = 0 then go to NO_ON_ARGS; 667 668 if abs_data.next_action ^= BEGIN_ACTION then 669 NO_BEGIN: call error (0, "&on statement not followed by &begin"); 670 671 cond_string_len = 0; 672 do i = 1 to parsed_args.count; 673 cond_string_len = cond_string_len + parsed_args.len (i) + 1; 674 end; 675 begin; 676 dcl cond_string char (cond_string_len) varying; 677 cond_string = ""; 678 do i = 1 to parsed_args.count; 679 xd.arg_ptr = parsed_args.ptr (i); 680 xd.arg_len = parsed_args.len (i); 681 cond_string = cond_string || arg || " "; 682 end; 683 cond_string = translate (cond_string, " ", ","); 684 685 condition_count = 0; 686 i = verify (cond_string, " "); 687 do while (i > 0 & i < cond_string_len); 688 condition_count = condition_count + 1; 689 i = i + index (substr (cond_string, i), " ") - 1; 690 if verify (substr (cond_string, i), " ") = 0 then i = cond_string_len; 691 else i = i + verify (substr (cond_string, i), " ") - 1; 692 end; 693 694 695 allocate condition_array in (abs_data.work_area) set (condition_array_ptr); 696 697 condition_count = 0; 698 i = verify (cond_string, " "); 699 do while (i > 0 & i < cond_string_len); 700 name_len = index (substr (cond_string, i), " ") - 1; 701 if name_len > 32 then call error (0, "Condition name ^a longer than 32 characters.", 702 substr (cond_string, i, name_len)); 703 condition_count = condition_count + 1; 704 condition_array (condition_count) = substr (cond_string, i, name_len); 705 i = i + name_len; 706 if verify (substr (cond_string, i), " ") = 0 then i = cond_string_len; 707 else i = i + verify (substr (cond_string, i), " ") - 1; 708 end; 709 end; 710 711 i = index (substr (input_string, xd.input_pos), "&begin"); 712 if i = 0 then go to NO_BEGIN; 713 xd.input_pos = xd.input_pos + i + length ("&begin") - 1; /* position past &begin */ 714 if substr (input_string, xd.input_pos, 1) = NL then xd.input_pos = xd.input_pos + 1; /* and newline */ 715 716 handler_start = xd.input_pos; 717 handler_ptr = addcharno (input_string.ptr, xd.input_pos - 1); 718 719 call execute_begin (); 720 721 allocate saved_if_info in (abs_data.work_area) set (on_saved_if_ptr); 722 on_saved_if_ptr -> saved_if_info = abs_data.if_info; 723 724 saved_skip_block_level = abs_data.skip_block_level; 725 abs_data.skip_block_level = 1; 726 abs_data.skip_sw, skipping_handler_sw = "1"b; 727 728 go to SET_INPUT_LIMIT; 729 730 GOT_HANDLER: 731 do i = xd.input_pos by -1 to 1 while (substr (input_string, i, 4) ^= "&end"); end; 732 if i = 0 then 733 NO_ON_END: call error (0, "Missing &end following &on...&begin."); 734 else if index (ALPHA, substr (input_string, i + 4, 1)) ^= 0 then go to NO_ON_END; 735 handler_len = i - handler_start; /* length of handler text not including &end */ 736 if substr (input_string,xd.input_pos, 1) = NL then xd.input_pos = xd.input_pos + 1; /* and trailing newline */ 737 738 do i = 1 to condition_count; 739 740 if condition_array (i) = "cleanup" then do; /* treat cleanup special */ 741 if abs_data.cleanup_handler_ptr = null then do; 742 allocate handler_node in (abs_data.work_area) set (abs_data.cleanup_handler_ptr); 743 abs_data.cleanup_handler_ptr -> handler_node.condition_name = "cleanup"; 744 abs_data.cleanup_handler_ptr -> handler_node.next_ptr = null; 745 end; 746 abs_data.cleanup_handler_ptr -> handler_node.ptr = handler_ptr; 747 abs_data.cleanup_handler_ptr -> handler_node.len = handler_len; 748 end; 749 else do; 750 751 /* Is there already a handler for this condition? */ 752 753 if abs_data.first_handler_ptr = null then do; /* no handlers at all */ 754 allocate handler_node in (abs_data.work_area) set (handler_node_ptr); 755 handler_node.condition_name = condition_array (i); 756 handler_node.next_ptr = null; 757 abs_data.first_handler_ptr = handler_node_ptr; 758 end; 759 760 else do; 761 do handler_node_ptr = abs_data.first_handler_ptr repeat (handler_node.next_ptr) 762 while (handler_node_ptr ^= null); 763 if handler_node.condition_name = condition_array (i) then go to SET_HANDLER; 764 last_node_ptr = handler_node_ptr; 765 end; 766 767 allocate handler_node in (abs_data.work_area) set (handler_node_ptr); 768 handler_node.condition_name = condition_array (i); 769 handler_node.next_ptr = null; 770 last_node_ptr -> handler_node.next_ptr = handler_node_ptr; 771 end; 772 773 SET_HANDLER: handler_node.ptr = handler_ptr; 774 handler_node.len = handler_len; 775 end; 776 end; 777 778 abs_data.if_info = on_saved_if_ptr -> saved_if_info; 779 free on_saved_if_ptr -> saved_if_info in (abs_data.work_area); 780 781 go to SET_INPUT_LIMIT; 782 783 784 ACTION (19): /* &print */ 785 call ioa_ ("^a", arg); 786 go to SET_INPUT_LIMIT; 787 788 789 ACTION (20): /* &print_nnl */ 790 call ioa_$nnl ("^a", arg); 791 go to SET_INPUT_LIMIT; 792 793 794 ACTION (21): /* &print_switch */ 795 nnl_sw = "0"b; 796 PRINT_SWITCH: 797 i = search (arg, WHITE_SPACE); 798 if i = 0 then i = xd.arg_len + 1; 799 switch_name = substr (arg, 1, i - 1); 800 801 call iox_$look_iocb (switch_name, iocb_ptr, code); 802 if code ^= 0 then call error (code, "^a", switch_name); 803 804 if nnl_sw then call ioa_$ioa_switch_nnl (iocb_ptr, "^a", substr (arg, i + 1)); 805 else call ioa_$ioa_switch (iocb_ptr, "^a", substr (arg, i + 1)); 806 go to SET_INPUT_LIMIT; 807 808 809 ACTION (22): /* &print_switch_nnl */ 810 nnl_sw = "1"b; 811 go to PRINT_SWITCH; 812 813 814 ACTION (23): /* &procedure (UNIMPLEMENTED)*/ 815 PROC_STMT: 816 /* 817* block_ptr = allocate_block (); 818* 819* block.containing_lex_block_ptr = null; 820* block.containing_proc_block_ptr = current_proc_block_ptr; 821* block.args_ptr = xd.parsed_args_ptr; 822* block.identifier = PROC_TYPE; 823* 824* current_proc_block_ptr = block_ptr; 825* current_lex_block_ptr = null; 826* go to EXPAND_NEXT_STMT; 827**/ 828 go to BAD_KEY; 829 830 831 ACTION (24): /* &proc (synonym for &procedure) */ 832 go to PROC_STMT; 833 834 835 ACTION (25): /* &quit */ 836 if xd.caller_actual_len ^= 0 then 837 call warning (0, "&quit accepts no arguments."); 838 go to END_OF_FILE; 839 840 841 ACTION (26): /* &ready */ 842 READY_STMT: 843 ready_mode.flag = get_ready_mode (); 844 ready_mode.pad = "0"b; 845 if ec_data_ptr ^= null then 846 if codeptr (ec_data.set_ready_mode) ^= null then do; /* ready proc specified (e.g., by absentee) */ 847 call ec_data.set_ready_mode (ready_mode); 848 go to SET_INPUT_LIMIT; 849 end; 850 851 call cu_$set_ready_mode (ready_mode); 852 go to SET_INPUT_LIMIT; 853 854 855 ACTION (27): /* &ready_mode (synonym for &ready) */ 856 go to READY_STMT; 857 858 859 ACTION (28): /* &ready_proc */ 860 if ec_data_ptr ^= null then ec_data.call_ready_proc = get_ready_mode (); 861 go to SET_INPUT_LIMIT; 862 863 864 ACTION (29): /* &repeat (UNIMPLEMENTED) */ 865 go to BAD_KEY; 866 867 868 ACTION (30): /* &resignal */ 869 /* 870* THIS IS THE WRONG IMPLEMENTATION BECAUSE IT RE-INVOKES HANDLERS ABOVE THIS ONE. 871* 872* if ^abs_data.in_handler_sw then call error (0, "&resignal is allowed only inside an &on unit."); 873* 874* saved_condition_name = abs_data.handler_node_ptr -> handler_node.condition_name; 875* abs_data.handler_node_ptr -> handler_node.condition_name = ""; temp. disable handler for this cond 876* 877* call signal_ ((abs_data.condition_name), abs_data.mc_ptr, abs_data.info_ptr, abs_data.wc_ptr); 878* 879* abs_data.handler_node_ptr -> handler_node.condition_name = saved_condition_name; 880**/ 881 go to BAD_KEY; 882 883 884 ACTION (31): /* &return */ 885 if functionp () then do; /* called as [exec_com] */ 886 if xd.arg_len > ec_data.return_len then 887 call warning (error_table_$command_line_overflow, 888 "Expanded value length of ^d characters exceeds return argument length of ^d characters.", 889 xd.arg_len, ec_data.return_len); 890 891 return_arg = arg; 892 end; 893 894 else call ioa_ ("^a", arg); /* called as a command */ 895 go to END_OF_FILE; 896 897 ACTION (32): /* &revert */ 898 if abs_data.in_handler_sw then call error (0, "Cannot execute &revert inside an &on unit."); 899 if parsed_args_ptr = null then call error (0, "No argument specified for &revert."); 900 901 do i = 1 to parsed_args.count; 902 xd.arg_ptr = parsed_args.ptr (i); 903 xd.arg_len = parsed_args.len (i); 904 905 do token = first_token (arg, tpos) repeat (next_token (arg, tpos)) while (token ^= ""); 906 907 if token = "cleanup" then 908 if abs_data.cleanup_handler_ptr = null then 909 NO_HANDLER: 910 call warning (0, "(&revert) No &on unit for " || arg); 911 else abs_data.cleanup_handler_ptr = null; 912 913 else do; 914 p = abs_data.first_handler_ptr; 915 lastp = null; 916 do while (p ^= null); 917 if p -> handler_node.condition_name = token then do; 918 /* free the node */ 919 if lastp = null then abs_data.first_handler_ptr = p -> handler_node.next_ptr; 920 else lastp -> handler_node.next_ptr = p -> handler_node.next_ptr; 921 free p -> handler_node in (abs_data.work_area); 922 go to END_REVERT_LOOP; 923 end; 924 else do; 925 lastp = p; 926 p = p -> handler_node.next_ptr; 927 end; 928 end; 929 end; 930 END_REVERT_LOOP: 931 end; 932 end; 933 go to SET_INPUT_LIMIT; 934 935 936 ACTION (33): /* &set */ 937 if parsed_args_ptr = null then 938 NO_SET_ARGS: call error (0, "No arguments specified for &set."); 939 if parsed_args.count = 0 then go to NO_SET_ARGS; 940 941 if mod (parsed_args.count, 2) ^= 0 then do; /* odd number of args */ 942 var_ptr = parsed_args.ptr (parsed_args.count); 943 var_len = parsed_args.len (parsed_args.count); 944 call error (0, "Missing last value; no value set for ""^a"".", var_string); 945 end; 946 947 do i = 1 by 2 to parsed_args.count - 1; /* test all args first to rule out integers */ 948 var_ptr = parsed_args.ptr (i); 949 var_len = parsed_args.len (i); 950 if verify (var_string, DIGITS || WHITE_SPACE) = 0 then 951 call error (0, "Invalid syntax in var name ""^a""; all white space and digits.", var_string); 952 end; 953 954 do i = 1 by 2 to parsed_args.count - 1; 955 var_ptr = parsed_args.ptr (i); 956 var_len = parsed_args.len (i); 957 val_ptr = parsed_args.ptr (i + 1); 958 val_len = parsed_args.len (i + 1); 959 960 if val_string = "&undefined" | val_string = "&undef" then 961 call abs_io_expand_$delete (abs_data.variables_ptr, var_string, "", code); 962 963 else call abs_io_expand_$set (abs_data.variables_ptr, var_string, val_string, code); 964 if code ^= 0 then call error (code, xd.error_msg); 965 end; 966 go to SET_INPUT_LIMIT; 967 968 969 ACTION (34): /* &signal */ 970 token = first_token (arg, tpos); 971 if next_token (arg, tpos) ^= "" then 972 call error (0, "&signal accepts only one condition name: " || rtrim (arg)); 973 974 if abs_data.in_handler_sw & token = abs_data.condition_name then 975 call error (0, "Attempt to &signal " || rtrim (token) || " from within " 976 || rtrim (token) || " &on unit."); 977 978 abs_data.input_string.position = xd.input_pos; 979 980 token32 = token; 981 call signal_ (token32); 982 983 xd.input_pos = abs_data.input_string.position; /* a handler's &goto may have changed it */ 984 go to SET_INPUT_LIMIT; 985 986 987 ACTION (35): /* &then */ 988 abs_data.clause_type = THEN_TYPE; 989 990 call execute_then (); 991 992 go to SET_INPUT_LIMIT; 993 994 995 ACTION (36): /* &trace */ 996 call set_trace; 997 go to SET_INPUT_LIMIT; 998 999 1000 ACTION (37): /* &until (UNIMPLEMENTED) */ 1001 go to BAD_KEY; 1002 1003 1004 ACTION (38): /* &version */ 1005 call error (0, "The ""&version"" statement can only be the first line of the program."); 1006 1007 1008 ACTION (39): /* &while (UNIMPLEMENTED) */ 1009 go to BAD_KEY; 1010 1011 /* NOTE: These labels (except 0) correspond to the STMTS array in abs_io_expand_ */ 1012 1013 SKIP (0): /* non-control stmt */ 1014 1015 SKIP_TEST: 1016 if abs_data.if_sw then call test_end_of_if (); /* done skipping? */ 1017 1018 else if abs_data.skip_block_level = 0 then abs_data.skip_sw = "0"b; 1019 1020 if ^abs_data.skip_sw & skipping_handler_sw then do; 1021 skipping_handler_sw = "0"b; 1022 abs_data.skip_block_level = saved_skip_block_level; 1023 go to GOT_HANDLER; 1024 end; 1025 1026 else go to MIGHT_SKIP; /* loop to call abs_io_expand_ again */ 1027 1028 SKIP (1): 1029 go to SKIP_TEST; 1030 1031 SKIP (2): /* &begin */ 1032 call execute_begin (); 1033 1034 abs_data.skip_block_level = abs_data.skip_block_level + 1; 1035 go to SKIP_TEST; 1036 1037 SKIP (3): SKIP (4): SKIP (5): 1038 go to SKIP_TEST; 1039 1040 SKIP (6): /* &do */ 1041 call execute_do (); 1042 1043 abs_data.skip_block_level = abs_data.skip_block_level + 1; 1044 go to SKIP_TEST; 1045 1046 SKIP (7): /* &else */ 1047 abs_data.clause_type = ELSE_TYPE; 1048 1049 call execute_else (); 1050 1051 go to SKIP_TEST; 1052 1053 SKIP (8): /* &end */ 1054 call execute_end (); 1055 1056 go to SKIP_TEST; 1057 1058 SKIP (9): SKIP (10): SKIP (11): SKIP (12): 1059 go to SKIP_TEST; 1060 1061 SKIP (13): /* &if */ 1062 call execute_if (); 1063 1064 go to SKIP_TEST; 1065 1066 SKIP (14): SKIP (15): 1067 SKIP (16): SKIP (17): SKIP (18): SKIP (19): 1068 SKIP (20): SKIP (21): SKIP (22): SKIP (23): 1069 SKIP (24): SKIP (25): SKIP (26): SKIP (27): 1070 SKIP (28): SKIP (29): SKIP (30): SKIP (31): 1071 SKIP (32): SKIP (33): SKIP (34): 1072 go to SKIP_TEST; 1073 1074 SKIP (35): /* &then */ 1075 abs_data.clause_type = THEN_TYPE; 1076 call execute_then (); 1077 go to SKIP_TEST; 1078 1079 SKIP (36): SKIP (37): SKIP (38): SKIP (39): 1080 go to SKIP_TEST; 1081 1082 /**/ 1083 allocate_block: proc returns (ptr); 1084 1085 dcl block_ptr ptr; 1086 1087 on area call error (error_table_$noalloc, "Allocating program block."); 1088 on bad_area_format call error (error_table_$notalloc, "Allocating program block."); 1089 on bad_area_initialization call error (error_table_$notalloc, "Allocating program block."); 1090 1091 allocate block in (abs_data.work_area) set (block_ptr); 1092 1093 block_ptr -> block.prev_block_ptr = abs_data.last_block_ptr; 1094 abs_data.last_block_ptr = block_ptr; 1095 1096 block_ptr -> block.keyword_pos = xd.this_statement.pos; 1097 block_ptr -> block.if_info = abs_data.if_info; 1098 block_ptr -> block.statement_end_pos = 0; 1099 1100 return (block_ptr); 1101 1102 end allocate_block; 1103 /**/ 1104 1105 allocate_hash_table: proc returns (ptr); 1106 1107 /* Allocates a labels hash table for use by lookup_label */ 1108 1109 dcl labels_ptr ptr; 1110 1111 on area call error (error_table_$noalloc, "Allocating label hash table."); 1112 on bad_area_format call error (error_table_$notalloc, "Allocating label hash table."); 1113 on bad_area_initialization call error (error_table_$notalloc, "Allocating label hash table."); 1114 1115 allocate hash_table in (abs_data.work_area) set (labels_ptr); 1116 1117 revert area; 1118 revert bad_area_format; 1119 revert bad_area_initialization; 1120 1121 return (labels_ptr); 1122 1123 end allocate_hash_table; 1124 1125 allocate_label: proc (P_label_name) returns (ptr); 1126 1127 /* allocates a single label node to be threaded by the caller */ 1128 1129 dcl P_label_name char (*); 1130 dcl label_ptr ptr; 1131 1132 on area call error (error_table_$noalloc, "Allocating label ""^a""", P_label_name); 1133 on bad_area_format call error (error_table_$notalloc, 1134 "Allocating label ""^a""", P_label_name); 1135 on bad_area_initialization call error (error_table_$notalloc, 1136 "Allocating label ""^a""", P_label_name); 1137 1138 current_label_ptr = addr (P_label_name); 1139 current_label_len = length (P_label_name); 1140 1141 allocate label in (abs_data.work_area) set (label_ptr); 1142 1143 revert area; 1144 revert bad_area_format; 1145 revert bad_area_initialization; 1146 1147 label_ptr -> label.name = P_label_name; 1148 label_ptr -> label.statement_pos = input_string.position; 1149 label_ptr -> label.statement_len = 0; /* until set by caller */ 1150 label_ptr -> label.next_ptr = null; 1151 1152 return (label_ptr); 1153 1154 end allocate_label; 1155 1156 attachedp: proc returns (bit (1) aligned); 1157 1158 /* TRUE if input is being read from the file (&attach) */ 1159 1160 if abs_data_ptr = null then return ("0"b); 1161 else return (abs_data.attach.target_ptr ^= null); 1162 1163 end attachedp; 1164 1165 conditional: proc returns (bit (1) aligned); 1166 1167 /* TRUE if expanded string = "true", FALSE if "false", otherwise strip off brackets and 1168* evaluate by calling the command processor to expand an active string */ 1169 1170 dcl active_string char (active_string_len) based (active_string_ptr); 1171 dcl (active_string_len, temp_len) fixed bin (21); 1172 dcl (active_string_ptr, saved_ptr, temp_ptr) ptr; 1173 dcl bars_len fixed bin (21); 1174 dcl free_sw bit (1); 1175 dcl temp_string char (temp_len) based (temp_ptr); 1176 dcl value char (8) varying; 1177 1178 if xd.allocated_ptr ^= null then do; /* rest-of-line allocated, have to copy */ 1179 1180 active_string_len = xd.caller_actual_len + xd.allocated_len; 1181 if area_ptr = null then area_ptr = get_system_free_area_ (); 1182 free_sw = "1"b; 1183 on cleanup free active_string in (area_ptr -> based_area); 1184 1185 allocate active_string in (area_ptr -> based_area) set (active_string_ptr); 1186 1187 temp_ptr = xd.caller_buffer_ptr; 1188 temp_len = xd.caller_actual_len; 1189 substr (active_string, 1, temp_len) = temp_string; 1190 1191 temp_ptr = xd.allocated_ptr; 1192 temp_len = xd.allocated_len; 1193 substr (active_string, xd.caller_actual_len + 1, temp_len) = temp_string; 1194 end; 1195 else do; 1196 free_sw = "0"b; 1197 active_string_ptr = xd.arg_ptr; 1198 active_string_len = xd.arg_len; 1199 end; 1200 1201 active_string_pos = verify (active_string, WHITE_SPACE); 1202 active_string_len = active_string_len - verify (reverse (active_string), WHITE_SPACE) + 1; 1203 1204 if active_string = "true" then return ("1"b); 1205 1206 else if active_string = "false" then return ("0"b); 1207 1208 /* Also accept [...], |[...], ||[...] for compatibility */ 1209 1210 if substr (active_string, active_string_pos, 1) = "|" then 1211 if substr (active_string, active_string_pos + 1, 1) = "|" then bars_len = 2; /* ||[ */ 1212 else bars_len = 1; /* |[ */ 1213 else bars_len = 0; 1214 1215 if substr (active_string, active_string_pos + bars_len, 1) ^= "[" | 1216 substr (active_string, active_string_len, 1) ^= "]" then 1217 call error (0, "Malformed conditional in ""&if"" statement."); 1218 1219 saved_ptr = active_string_ptr; 1220 active_string_ptr = addr (substr (active_string, active_string_pos + bars_len + 1)); 1221 active_string_len = active_string_len - bars_len - 2; 1222 if ec_data_ptr ^= null then 1223 if codeptr (ec_data.eval_string) ^= null then do; /* an af evaluation routine was specified */ 1224 call ec_data.eval_string (null, active_string, bars_len + 1, value, code); 1225 go to EVALUATED; 1226 end; 1227 1228 call cu_$evaluate_active_string (null, active_string, bars_len + 1, value, code); 1229 EVALUATED: 1230 if free_sw then do; 1231 active_string_ptr = saved_ptr; 1232 free active_string in (area_ptr -> based_area); 1233 end; 1234 1235 if code ^= 0 then call error (code, "Evaluating ""&if"" clause."); 1236 1237 if value = "true" then return ("1"b); 1238 else if value = "false" then return ("0"b); 1239 else call error (0, "Invalid ""&if"" value ""^a""; must be true or false.", value); 1240 1241 end conditional; 1242 1243 error: proc options (variable); 1244 1245 /* Prints an error message (ec syntax or whatever) and skips to end of file */ 1246 1247 dcl based_ec_string char (based_ec_len) based (based_ec_ptr); 1248 dcl based_ec_ptr ptr; 1249 dcl based_ec_len fixed bin (21); 1250 dcl (error_pos, line_len, line_number, line_start) fixed bin (21); 1251 dcl complain entry variable options (variable); 1252 dcl statement_ptr ptr; 1253 dcl statement char (xd.this_statement.len) based (statement_ptr); 1254 dcl message char (4096); 1255 dcl who char (72) varying; 1256 dcl severity_sw bit (1); /* ON for skip to end of file, OFF for warning only */ 1257 dcl end_ec bit (1); /* Note end of file */ 1258 dcl status_ptr ptr; 1259 dcl status fixed bin (25) based (status_ptr); 1260 1261 severity_sw = "1"b; /* skip to end of file after printing error */ 1262 go to ERROR_COMMON; 1263 1264 1265 warning: entry options (variable); 1266 1267 /* Prints a warning message and returns */ 1268 1269 severity_sw = "0"b; 1270 1271 ERROR_COMMON: 1272 end_ec = "0"b; 1273 call cu_$arg_ptr (1, status_ptr, (0), (0)); 1274 call ioa_$general_rs (cu_$arg_list_ptr (), 2, 3, message, (0), "1"b, "0"b); 1275 1276 if abs_data.in_handler_sw & ^goto_entry_sw then do; 1277 /* count line numbers in parent ec if inside &on unit */ 1278 based_ec_ptr = abs_data.parent_abs_data_ptr -> abs_data.input_string.ptr; 1279 based_ec_len = abs_data.parent_abs_data_ptr -> abs_data.input_string.len; 1280 error_pos = xd.this_statement.pos + charno (abs_data.handler_node_ptr -> handler_node.ptr) 1281 - charno (based_ec_ptr); 1282 end; 1283 else do; 1284 based_ec_ptr = abs_data.input_string.ptr; 1285 based_ec_len = abs_data.input_string.len; 1286 error_pos = xd.this_statement.pos; 1287 end; 1288 1289 line_number = 0; /* calculate line number of error */ 1290 do line_start = 0 repeat (line_start + line_len + 1) while (line_start <= error_pos); 1291 line_len = index (substr (based_ec_string, line_start + 1), NL) - 1; 1292 if line_len < 0 then do; 1293 end_ec = "1"b; 1294 line_len = error_pos - line_start; 1295 end; 1296 line_number = line_number + 1; 1297 end; 1298 1299 if ec_data_ptr = null then do; 1300 complain = com_err_; 1301 who = rtrim (abs_data.io_module_name); 1302 end; 1303 else do; 1304 if codeptr (ec_data.error) = null then 1305 if ec_data.active_function then complain = active_fnc_err_; 1306 else complain = com_err_; 1307 else complain = ec_data.error; 1308 who = ec_data.who_am_i; 1309 end; 1310 1311 if status = error_table_$badsyntax then status = 0; 1312 1313 statement_ptr = addr (substr (input_string, xd.this_statement.pos)); 1314 1315 call complain (status, who, "^[^/^]^[Error^;Warning^] on line #^d of ^a:^/^a^/SOURCE:^-^a", 1316 status ^= 0, severity_sw, line_number, ec_path, message, statement); 1317 1318 if severity_sw then do; 1319 if end_ec then go to ERROR_RETURN; 1320 if abs_data.noabort then do; 1321 actual_len = 0; 1322 A_code = 0; 1323 go to RETURN; 1324 end; 1325 else go to ERROR_RETURN; 1326 end; 1327 1328 end error; 1329 1330 execute_begin: proc; 1331 1332 block_ptr = allocate_block (); 1333 1334 block.containing_lex_block_ptr = abs_data.current_lex_block_ptr; 1335 block.containing_proc_block_ptr = abs_data.current_proc_block_ptr; 1336 block.args_ptr = null; 1337 block.identifier = BEGIN_TYPE; 1338 1339 block.if_info = abs_data.if_info; 1340 abs_data.if_sw = "0"b; 1341 abs_data.prev_if_ptr = null; 1342 1343 abs_data.current_lex_block_ptr = block_ptr; 1344 1345 end execute_begin; 1346 1347 execute_do: proc; 1348 1349 block_ptr = allocate_block (); 1350 1351 block.containing_lex_block_ptr = abs_data.current_lex_block_ptr; 1352 block.containing_proc_block_ptr = abs_data.current_proc_block_ptr; 1353 block.args_ptr = null; 1354 if abs_data.clause_type = THEN_TYPE | abs_data.clause_type = ELSE_TYPE then 1355 block.identifier = abs_data.clause_type; 1356 else block.identifier = DO_TYPE; 1357 1358 block.if_info = abs_data.if_info; 1359 abs_data.if_sw = "0"b; 1360 abs_data.prev_if_ptr = null; 1361 1362 abs_data.current_lex_block_ptr = block_ptr; 1363 1364 end execute_do; 1365 1366 execute_else: proc; 1367 1368 if ^abs_data.if_sw | abs_data.got_else_sw then call error (0, "&else not preceded by &if"); 1369 1370 abs_data.got_else_sw = "1"b; 1371 1372 if abs_data.skip_block_level = 0 then 1373 1374 /* Unless inside an &if being skipped in its entirety (abs_data.prev_if_ptr -> saved_if_info.skip_sw is ON), 1375* or inside a &do-&end block being skipped (abs_data.skip_block_level > 0), 1376* decide whether to skip this &else clause depending on value of the &if conditional. */ 1377 1378 if abs_data.prev_if_ptr = null then call set_skip (abs_data.true_sw); 1379 else if ^abs_data.prev_if_ptr -> saved_if_info.skip_sw then call set_skip (abs_data.true_sw); 1380 1381 end execute_else; 1382 1383 execute_end: proc; 1384 1385 dcl (saved_this_action, saved_next_action) fixed bin; 1386 1387 block_ptr = abs_data.current_lex_block_ptr; 1388 if block_ptr = null then call error (0, "&end not preceded by &do or &on...&begin"); 1389 1390 saved_this_action = abs_data.this_action; /* don't restore these from block */ 1391 saved_next_action = abs_data.next_action; 1392 1393 abs_data.if_info = block.if_info; 1394 1395 abs_data.this_action = saved_this_action; 1396 abs_data.next_action = saved_next_action; 1397 1398 if abs_data.current_lex_block_ptr = null then call error (0, "&end not preceded by &do"); 1399 1400 block.statement_end_pos = xd.this_statement.pos; 1401 if abs_data.next_action = ELSE_ACTION then 1402 block.else_clause_pos = xd.next_statement.pos; 1403 else block.else_clause_pos = 0; 1404 1405 abs_data.current_lex_block_ptr = block.containing_lex_block_ptr; 1406 1407 end execute_end; 1408 1409 execute_if: proc; 1410 1411 if abs_data.next_action ^= THEN_ACTION & abs_data.next_action ^= ELSE_ACTION then 1412 call error (0, "Missing &then or &else following &if"); 1413 1414 if abs_data.if_sw then do; /* already inside an &if */ 1415 1416 on area call error (error_table_$noalloc, "Allocating &if statement information."); 1417 on bad_area_format call error (error_table_$notalloc, "Allocating &if statement information."); 1418 on bad_area_initialization call error (error_table_$notalloc, "Allocating &if statement information."); 1419 1420 allocate saved_if_info in (abs_data.work_area) set (saved_if_ptr); 1421 1422 saved_if_ptr -> saved_if_info = abs_data.if_info; 1423 abs_data.prev_if_ptr = saved_if_ptr; 1424 end; 1425 1426 abs_data.if_sw = "1"b; 1427 abs_data.got_then_sw, abs_data.got_else_sw = "0"b; 1428 1429 if abs_data.skip_sw then abs_data.true_sw = "1"b; 1430 1431 else abs_data.true_sw = conditional (); 1432 1433 end execute_if; 1434 1435 execute_then: proc; 1436 1437 if ^abs_data.if_sw | abs_data.got_then_sw | abs_data.got_else_sw then 1438 call error (0, "&then not preceded by &if"); 1439 1440 abs_data.got_then_sw = "1"b; 1441 1442 /* Unless inside an &if being skipped in its entirety (abs_data.prev_if_ptr -> saved_if_info.skip_sw is ON), 1443* or inside a &do-&end block being skipped (abs_data.skip_block_level > 0), 1444* decide whether to skip this &then clause based on the value of the &if conditional. */ 1445 1446 if abs_data.skip_block_level = 0 then 1447 if abs_data.prev_if_ptr = null then call set_skip (^abs_data.true_sw); 1448 else if ^abs_data.prev_if_ptr -> saved_if_info.skip_sw then call set_skip (^abs_data.true_sw); 1449 1450 end execute_then; 1451 1452 first_token: proc (P_str, P_pos) returns (char (128) varying); 1453 1454 dcl P_str char (*); 1455 dcl (P_pos, i, j) fixed bin (21); 1456 1457 if length (P_str) = 0 then return (""); 1458 i = search (P_str, WHITE_SPACE); 1459 if i = 0 then do; 1460 P_pos = length (P_str) + 1; 1461 return (P_str); 1462 end; 1463 j = verify (substr (P_str, i + 1), WHITE_SPACE); 1464 if i = 1 then do; 1465 if j = 0 then return (""); 1466 P_pos = j + 1; 1467 return (next_token (P_str, P_pos)); 1468 end; 1469 if j = 0 then do; 1470 P_pos = length (P_str) + 1; 1471 return (substr (P_str, 1)); 1472 end; 1473 else do; 1474 P_pos = i + j; 1475 return (substr (P_str, 1, i - 1)); 1476 end; 1477 1478 end first_token; 1479 1480 functionp: proc returns (bit (1) aligned); 1481 1482 /* TRUE if exec_com was invoked as an active function */ 1483 1484 if ec_data_ptr = null then return ("0"b); /* unusual case */ 1485 else return (ec_data.active_function); 1486 1487 end functionp; 1488 1489 get_data_ptrs: proc (P_update_sw); 1490 1491 /* Copies parameters and gets pointers to the various databases. It is called with P_update_sw = "0"b when 1492* abs_io_v2_get_line is entered, and with P_update_sw = "1"b after calling signal_io_error_ to make sure 1493* that nothing has changed that we care about. */ 1494 1495 dcl P_update_sw bit (1); 1496 1497 iocb_ptr = A_iocb_ptr -> iocb.actual_iocb_ptr; /* chase syn's */ 1498 1499 if P_update_sw then do; 1500 do while (abs_data_ptr ^= iocb_ptr -> iocb.attach_data_ptr); /* something's wrong */ 1501 call signal_io_error_ ("Attachment of " || abs_data.io_module_name || " has been moved.", 1502 A_iocb_ptr, 0); 1503 iocb_ptr = A_iocb_ptr -> iocb.actual_iocb_ptr; 1504 end; 1505 return; 1506 end; 1507 1508 buffer_ptr = A_buffer_ptr; 1509 buffer_len = A_buffer_len; 1510 1511 abs_data_ptr = iocb_ptr -> iocb.attach_data_ptr; 1512 ec_data_ptr = abs_data.ec_data_ptr; 1513 1514 1515 end get_data_ptrs; 1516 1517 get_ready_mode: proc returns (bit (1)); 1518 1519 /* TRUE if "on" or "true" is the argument, FALSE if "off" or "false" */ 1520 1521 dcl arg char (arg_len) based (arg_ptr); 1522 dcl arg_ptr ptr; 1523 dcl arg_len fixed bin (21); 1524 dcl mode_sw bit (1); 1525 1526 if parsed_args_ptr = null then 1527 NO_READY_ARGS: call warning (0, "Missing argument to &ready; ""on"" assumed."); 1528 if parsed_args.count = 0 then go to NO_READY_ARGS; 1529 1530 arg_ptr = parsed_args.ptr (1); 1531 arg_len = parsed_args.len (1); 1532 if arg = "on" | arg = "true" then mode_sw = "1"b; 1533 else if arg = "off" | arg = "false" then mode_sw = "0"b; 1534 else do; 1535 call warning (0, "Invalid argument ""^a"" to ready statement; ""on"" assumed.", arg); 1536 mode_sw = "1"b; 1537 end; 1538 1539 if parsed_args.count > 1 then 1540 call warning (0, "Ready statement accepts only one argument; extra args ignored."); 1541 1542 return (mode_sw); 1543 1544 end get_ready_mode; 1545 1546 init_xd: proc; 1547 1548 /* Initializes much of the auto (in the external proc) xd structure. */ 1549 1550 unspec (xd) = "0"b; 1551 xd.version = expand_data_version_2; 1552 xd.abs_data_ptr = abs_data_ptr; 1553 xd.expand_data_ptr = addr (xd); 1554 xd.area_ptr = addr (abs_data.work_area); 1555 xd.parsed_args_ptr = null; 1556 xd.next_expand_data_ptr, xd.last_expand_data_ptr, xd.allocated_ptr = null; 1557 xd.first_loop_ptr, xd.first_block_ptr = null; 1558 xd.is_absin = abs_data.absentee; 1559 xd.is_af = functionp (); 1560 xd.is_input = input_linep; 1561 1562 xd.input_pos = input_string.position; 1563 1564 end init_xd; 1565 1566 lookup_label: proc (P_labels_ptr, P_name, P_hash) returns (ptr); 1567 1568 /* Sets P_last_node_info from tree of defined labels and returns either ptr to requested label node or null */ 1569 1570 dcl P_labels_ptr ptr; 1571 dcl P_name char (*); 1572 dcl P_hash fixed bin; 1573 1574 dcl (found_label_ptr, label_ptr) ptr; 1575 dcl limit_pos fixed bin (21); 1576 1577 if P_labels_ptr = null then P_labels_ptr = allocate_hash_table (); /* no tree of labels allocated yet */ 1578 1579 P_hash = mod (binary (unspec (char (P_name, 2)), 18) + length (P_name), 61); 1580 1581 do label_ptr = P_labels_ptr -> hash_table (P_hash) 1582 repeat (label_ptr -> label.next_ptr) while (label_ptr ^= null); 1583 1584 if label_ptr -> label.name = P_name then do; 1585 found_label_ptr = label_ptr; 1586 limit_pos = label_ptr -> label.statement_pos + label_ptr -> label.statement_len; 1587 go to CHECK_EXPANDABLES; 1588 end; 1589 end; 1590 1591 found_label_ptr = null; /* no matching constant label in table */ 1592 limit_pos = xd.this_statement.pos; 1593 1594 CHECK_EXPANDABLES: 1595 /* loop through expandables (e.g., &label &(foo)) */ 1596 if abs_data.first_xlabel_ptr ^= null & unspec (abs_data.first_xlabel_ptr) ^= "0"b then 1597 do label_ptr = abs_data.first_xlabel_ptr repeat (label_ptr -> label.next_ptr) 1598 while (label_ptr ^= null); 1599 1600 if label_ptr -> label.statement_pos >= limit_pos then return (found_label_ptr); 1601 1602 call abs_io_expand_$expand_label (xd, label_ptr -> label.statement_pos, 1603 label_ptr -> label.statement_len, label_val_ptr, label_val_len, 0); 1604 1605 if label_val = P_name then return (label_ptr); 1606 end; 1607 1608 return (found_label_ptr); 1609 1610 end lookup_label; 1611 1612 next_token: proc (P_str, P_pos) returns (char (128) varying); 1613 1614 dcl P_str char (*); 1615 dcl (P_pos, i, j, start_pos) fixed (21); 1616 1617 start_pos = P_pos; 1618 if start_pos > length (P_str) then return (""); 1619 i = search (substr (P_str, start_pos), WHITE_SPACE); 1620 if i = 0 then do; 1621 P_pos = length (P_str) + 1; 1622 return (substr (P_str, start_pos)); 1623 end; 1624 j = verify (substr (P_str, start_pos + i), WHITE_SPACE); 1625 if j = 0 then do; 1626 P_pos = length (P_str) + 1; 1627 return (substr (P_str, start_pos)); 1628 end; 1629 else do; 1630 P_pos = start_pos + i + j - 1; 1631 return (substr (P_str, start_pos, i - 1)); 1632 end; 1633 1634 end next_token; 1635 1636 recurse_error: proc; 1637 1638 /* Aborts recursive $get_line invocation since there's no previous attachment to use */ 1639 1640 dcl complain entry variable options (variable); 1641 dcl who char (72) varying; 1642 1643 if ec_data_ptr = null then do; 1644 complain = com_err_; 1645 who = rtrim (abs_data.io_module_name); 1646 end; 1647 else do; 1648 if codeptr (ec_data.error) = null then 1649 if ec_data.active_function then complain = active_fnc_err_; 1650 else complain = com_err_; 1651 else complain = ec_data.error; 1652 who = ec_data.who_am_i; 1653 end; 1654 1655 call complain (0, who, "Attempt to read recursively from the exec_com."); 1656 1657 go to END_OF_FILE; 1658 1659 end recurse_error; 1660 1661 reset_input: proc; 1662 1663 /* Performs &detach */ 1664 1665 if attachedp () then do; 1666 1667 call abs_io_control$detach (abs_data_ptr, null, code); 1668 if code ^= 0 then call error (code, "Error while performing ""&detach""."); 1669 if input_linep then do; 1670 /* return a line from the prior user_input instead */ 1671 call iox_$get_line (iox_$user_input, buffer_ptr, buffer_len, actual_len, A_code); 1672 input_string.limit = max (input_string.limit, xd.input_pos - 1); 1673 go to RETURN; 1674 end; 1675 end; 1676 1677 end reset_input; 1678 1679 set_defaults: proc (P_args_ptr); 1680 1681 /* Sets default values for the first N arguments to exec_com */ 1682 1683 dcl P_args_ptr ptr; 1684 dcl i fixed bin; 1685 1686 if unspec (P_args_ptr) = "0"b then return; 1687 else if P_args_ptr = null then return; 1688 else parsed_args_ptr = P_args_ptr; 1689 abs_data.default_arg_count = parsed_args.count; 1690 1691 max_default_len = 0; 1692 do i = 1 to parsed_args.count; /* compute max string len to allocate values */ 1693 max_default_len = max (max_default_len, parsed_args.len (i)); 1694 end; 1695 1696 on area call error (error_table_$noalloc, "Allocating &default args."); 1697 on bad_area_format call error (error_table_$notalloc, "Allocating &default args."); 1698 on bad_area_initialization call error (error_table_$notalloc, "Allocating &default args."); 1699 1700 allocate default_values in (abs_data.work_area) set (default_values_ptr); 1701 allocate default_args in (abs_data.work_area) set (abs_data.default_arg_ptr); 1702 1703 revert area; 1704 revert bad_area_format; 1705 revert bad_area_initialization; 1706 1707 do i = 1 to parsed_args.count; /* copy &default statement args */ 1708 val_ptr = parsed_args.ptr (i); 1709 val_len = parsed_args.len (i); 1710 if val_string = "&undefined" | val_string = "&undef" then default_args (i).ptr = null; 1711 else do; 1712 default_values (i) = val_string; 1713 default_args (i).ptr = addr (default_values (i)); 1714 default_args (i).len = val_len; 1715 default_args (i).quote_count = parsed_args.quote_count (i); 1716 end; 1717 end; 1718 1719 end set_defaults; 1720 1721 set_skip: proc (P_sw); 1722 1723 dcl P_sw bit (1) aligned; 1724 1725 if substr (input_string, xd.input_pos - 1, 1) = NL & /* &then or &else ends line and */ 1726 abs_data.next_action ^= IF_ACTION then /* not nested &if means */ 1727 abs_data.skip_sw = /* null &then or &else, hence end of &if construct */ 1728 (abs_data.skip_block_level > 0); 1729 1730 else abs_data.skip_sw = P_sw; 1731 1732 end set_skip; 1733 1734 set_trace: proc; 1735 1736 /* Reads arguments to &trace and decides how and what to trace */ 1737 1738 dcl 1 tracing, 1739 2 types, 1740 3 (command, input, control, comment) bit (1), 1741 2 (on, off, output_switch, prefix_sw) bit (1), 1742 2 expand fixed bin, 1743 2 prefix char (32) varying, 1744 2 iocb ptr; 1745 dcl arg char (arg_len) based (arg_ptr); 1746 dcl switch_name char (32); 1747 dcl token char (128) varying; 1748 dcl arg_ptr ptr; 1749 dcl arg_len fixed bin (21); 1750 dcl i fixed bin; 1751 dcl pos fixed bin (21); 1752 1753 unspec (tracing) = "0"b; 1754 1755 if unspec (xd.parsed_args_ptr) = "0"b then go to NO_TRACE_ARG; 1756 else if xd.parsed_args_ptr = null then go to NO_TRACE_ARG; 1757 else parsed_args_ptr = xd.parsed_args_ptr; 1758 1759 if parsed_args.count = 0 then do; 1760 NO_TRACE_ARG: call warning (0, "Missing &trace keyword; ""&command on"" assumed."); 1761 tracing.command, tracing.on = "1"b; 1762 end; 1763 1764 else do i = 1 to parsed_args.count; 1765 1766 arg_ptr = parsed_args.ptr (i); 1767 arg_len = parsed_args.len (i); 1768 1769 do token = first_token (arg, pos) repeat (next_token (arg, pos)) while (token ^= ""); 1770 1771 if token = "&command" then tracing.command = "1"b; 1772 else if token = "&input" then tracing.input = "1"b; 1773 else if token = "&control" then tracing.control = "1"b; 1774 else if token = "&comment" then tracing.comment = "1"b; 1775 else if token = "&all_types" then 1776 tracing.command, tracing.comment, tracing.control, tracing.input = "1"b; 1777 1778 else if token = "on" | token = "true" then do; 1779 tracing.on = "1"b; 1780 tracing.off = "0"b; 1781 end; 1782 else if token = "off" | token = "false" then do; 1783 tracing.off = "1"b; 1784 tracing.on = "0"b; 1785 end; 1786 1787 else if token = "&unexpanded" then do; 1788 tracing.on = "1"b; 1789 tracing.expand = UNEXPANDED; 1790 end; 1791 else if token = "&expanded" then do; 1792 tracing.on = "1"b; 1793 tracing.expand = EXPANDED; 1794 end; 1795 else if token = "&all" | token = "&all_expansions" then do; 1796 tracing.on = "1"b; 1797 tracing.expand = ALL; 1798 end; 1799 1800 else if token = "&both" then do; 1801 tracing.on = "1"b; 1802 tracing.expand = BOTH; 1803 end; 1804 1805 else if token = "&prefix" then do; 1806 tracing.prefix_sw = "1"b; 1807 tracing.prefix = get_value ("&prefix"); 1808 end; 1809 1810 else if token = "&output_switch" | token = "&osw" then do; 1811 switch_name = get_value ("&output_switch"); 1812 call iox_$find_iocb (switch_name, tracing.iocb, code); 1813 if code ^= 0 then call error (code, "Finding I/O switch ""^a""", switch_name); 1814 tracing.output_switch = "1"b; 1815 end; 1816 1817 else call error (0, "Invalid &trace keyword ^a", token); 1818 end; 1819 end; 1820 1821 if ^tracing.on & ^tracing.off then tracing.on = "1"b; 1822 1823 if unspec (tracing.types) = "0"b then unspec (tracing.types) = "1111"b; 1824 1825 if tracing.command then call set_one_trace (abs_data.command_line, "COMMAND"); 1826 1827 if tracing.input then call set_one_trace (abs_data.input_line, "INPUT"); 1828 1829 if tracing.control then call set_one_trace (abs_data.control_line, "CONTROL"); 1830 1831 if tracing.comment then call set_one_trace (abs_data.comment_line, "COMMENT"); 1832 1833 1834 get_value: proc (P_arg_name) returns (char (128) varying); 1835 1836 dcl P_arg_name char (*); 1837 1838 token = next_token (arg, pos); 1839 do while (token = ""); 1840 i = i + 1; 1841 if i > parsed_args.count then 1842 call error (0, "No value specified for &trace " || P_arg_name); 1843 arg_ptr = parsed_args (i).ptr; 1844 arg_len = parsed_args (i).len; 1845 token = first_token (arg, pos); 1846 end; 1847 return (token); 1848 1849 end get_value; 1850 1851 1852 set_one_trace: proc (P_line, P_type); 1853 1854 dcl 1 P_line aligned like abs_data.command_line; 1855 dcl P_type char (*); 1856 1857 if P_line.by_control_arg then return; /* ec control args override &trace */ 1858 1859 if tracing.on then do; 1860 P_line.on = "1"b; 1861 if P_line.expand = 0 then /* apply defaults for tracing mode */ 1862 if xd.is_absin then P_line.expand = EXPANDED; /* expanded for absentee */ 1863 else if P_type = "COMMENT" | P_type = "CONTROL" then P_line.expand = UNEXPANDED; 1864 else P_line.expand = EXPANDED; /* expanded for comand and input lines */ 1865 end; 1866 if tracing.off then P_line.on = "0"b; 1867 if tracing.expand ^= 0 then P_line.expand = tracing.expand; 1868 if tracing.prefix_sw then P_line.prefix = tracing.prefix; 1869 if tracing.output_switch then P_line.iocb = tracing.iocb; 1870 1871 end set_one_trace; 1872 1873 end set_trace; 1874 1875 test_end_of_if: proc; 1876 1877 dcl (saved_this_action, saved_next_action) fixed bin; 1878 1879 saved_this_action = abs_data.this_action; 1880 saved_next_action = abs_data.next_action; 1881 TEST: 1882 if (abs_data.clause_type = ELSE_TYPE & 1883 (saved_this_action ^= ELSE_ACTION | saved_next_action = ELSE_ACTION)) 1884 /* statement following an &else */ 1885 | (abs_data.clause_type = THEN_TYPE & saved_this_action ^= THEN_ACTION & 1886 saved_next_action ^= ELSE_ACTION) then do; 1887 /* or stmt following &then, not followed by &else */ 1888 if saved_this_action = IF_ACTION | saved_this_action = DO_ACTION then return; 1889 /* More nesting: &then &if, &then &do, same for &else */ 1890 /* End of the &if-&then-&else compound statement */ 1891 1892 if abs_data.prev_if_ptr ^= null then do; /* nested inside another &if */ 1893 abs_data.if_info = abs_data.prev_if_ptr -> saved_if_info; 1894 go to TEST; /* see if the outer &if is ended too, and so on */ 1895 end; 1896 1897 else do; 1898 abs_data.if_sw = "0"b; /* back to normal text */ 1899 abs_data.clause_type = 0; /* we have seen the stmt after the &then or &else */ 1900 1901 if abs_data.skip_block_level = 0 then abs_data.skip_sw = "0"b; 1902 /* stop skipping unless inside a &do being skipped */ 1903 end; 1904 end; 1905 1906 end test_end_of_if; 1907 1908 1 1 /* START OF: abs_io_block.incl.pl1 */ 1 2 1 3 /* Initial coding: 07/15/80 by J. Spencer Love */ 1 4 1 5 1 6 declare block_ptr ptr; 1 7 1 8 declare 1 block aligned based (block_ptr), 1 9 2 prev_block_ptr ptr, /* to find them all; null = global global */ 1 10 2 containing_lex_block_ptr ptr, /* null = proc block */ 1 11 2 args_ptr ptr, /* ptr to parsed_args */ 1 12 2 containing_proc_block_ptr ptr, /* null = outer block */ 1 13 2 keyword_pos fixed bin (21), /* position of &if, &do, etc. */ 1 14 2 if_info aligned like abs_data.if_info, /* &if-&then-&else nesting information */ 1 15 2 statement_end_pos fixed bin (21), /* to skip the statement */ 1 16 2 identifier fixed bin, /* type of block */ 1 17 2 dependent, 1 18 3 else_clause_pos fixed bin (21), /* for &if block */ 1 19 3 elif_level fixed bin (21); /* 0 = &if */ 1 20 1 21 /* END INCLUDE FILE abs_io_block.incl.pl1 */ 1909 1910 2 1 /* START OF: abs_io_data.incl.pl1 * * * * * * * * * * * * * * * * * * * */ 2 2 2 3 2 4 /****^ HISTORY COMMENTS: 2 5* 1) change(87-02-20,Parisek), approve(87-07-23,MCR7716), 2 6* audit(87-07-30,Fawcett), install(87-08-11,MR12.1-1080): 2 7* Added the noabort flag for determining whether or not to abort after 2 8* exec_com error occurs. 2 9* END HISTORY COMMENTS */ 2 10 2 11 2 12 /* Initial coding: 25 June 79 by J. Spencer Love */ 2 13 /* login_channel option flag BIM 11/81 */ 2 14 /* Added this_action and next_action 04/20/82 S. Herbst */ 2 15 /* Added on_info, goto_statement_(pos len) 01/06/83 S. Herbst */ 2 16 /* Added output_file.turn_off_ssw 05/16/83 S. Herbst */ 2 17 /* Added attach.trim_whitespace_sw 06/02/83 S. Herbst */ 2 18 /* Added listener_pl1_label and get_line_pl1_label 11/17/83 S. Herbst */ 2 19 /* Added (command comment control input)_line.by_control_arg 03/20/84 S. Herbst */ 2 20 2 21 declare abs_data_ptr ptr; 2 22 2 23 declare 1 abs_data aligned based (abs_data_ptr), 2 24 2 version fixed bin, /* Version = 1 */ 2 25 2 io_module_name char (32) varying, /* either "abs_io_" or "ec_input_" */ 2 26 2 open_description char (24) varying, /* either "stream_input" or "stream_input_output" */ 2 27 2 unique_name char (15) varying, /* &! -- either blank or 15 char unique string */ 2 28 /* */ 2 29 2 ec_data_ptr ptr, /* -> communication area for exec_com */ 2 30 2 expand_data_ptr ptr, /* -> structure for abs_io_expand_ */ 2 31 /* */ 2 32 2 instance_chain, /* two way linked chain of abs_data blocks for debugging */ 2 33 3 prev_ptr ptr, /* -> next older abs_data instance */ 2 34 3 next_ptr ptr, /* -> next newer abs_data instance */ 2 35 3 level fixed bin, /* level of ec invocation in chain for debugging */ 2 36 3 pad bit (36), /* */ 2 37 /* */ 2 38 2 arg_info, /* */ 2 39 3 ec_path_ptr ptr, /* Ptr to allocated &ec_path string */ 2 40 3 ec_path_len fixed bin (21), /* Length of allocated &ec_path (&0) string */ 2 41 3 ec_path_quotes fixed bin (21), /* Number of quote chars in &ec_path, -1 if not yet counted */ 2 42 3 ec_name_ptr ptr, /* Ptr to allocated &ec_name string */ 2 43 3 ec_name_len fixed bin (21), /* Length of allocated &ec_name string */ 2 44 3 ec_name_quotes fixed bin (21), /* Number of quote chars in &ec_name, -1 if not yet counted */ 2 45 3 arg_ptr ptr, /* pointer to allocated structure containing args */ 2 46 3 arg_count fixed bin, /* number of arguments passed */ 2 47 3 args_copied bit (1), /* 1 indicates arguments were copied into work_area */ 2 48 3 default_arg_ptr ptr, /* pointer to allocated &default args */ 2 49 3 default_arg_count fixed bin, /* number of &default args */ 2 50 3 pad bit (36), /* */ 2 51 /* */ 2 52 2 input_string, /* data about input segment or archive component */ 2 53 3 ptr ptr, /* pointer to input file */ 2 54 3 len fixed bin (21), /* number of characters in input file */ 2 55 3 start fixed bin (21), /* initial value for input_pos, set beyond &version, if any */ 2 56 3 position fixed bin (21), /* current index into input file */ 2 57 3 limit fixed bin (21), /* farthest point yet reached...begin &label search here */ 2 58 /* */ 2 59 2 open_data, /* data saved at attach time for open time */ 2 60 3 output_dir char (168) unal, /* directory pathname of output file (if specified) */ 2 61 3 output_entry char (32) unal, /* entryname of output file (if specified) */ 2 62 3 parser_version fixed bin, /* indicates version of parser (get_line) for open */ 2 63 3 si bit (1) unal, /* 1 indicates opening for stream_input permitted */ 2 64 3 sio bit (1) unal, /* 1 indicates opening for stream_input_output permitted */ 2 65 3 ssf bit (1) unal, /* 1 indicates output file cannot be MSF */ 2 66 3 truncate bit (1) unal, /* 1 indicates output file truncated at open */ 2 67 3 no_set_bc bit (1) unal, /* 1 to set absout bitcount only at close */ 2 68 3 login_channel bit (1) unal, /* 1 to fish arguments from PIT */ 2 69 3 pad bit (30) unal, /* */ 2 70 /* */ 2 71 2 output_file, /* data for abs_io_put_chars */ 2 72 3 fcb_ptr ptr, /* -> File Control Block for msf_manager_, null if SSF */ 2 73 3 seg_ptr ptr, /* -> base of current component of output file */ 2 74 3 current_len fixed bin (21), /* number of characters in current component */ 2 75 3 max_len fixed bin (21), /* max number of characters in a component */ 2 76 3 MSF_seg_idx fixed bin, /* index of current MSF component. Used to get new ones */ 2 77 3 switches aligned, 2 78 4 may_be_MSF bit (1) unaligned, /* 1 indicates absout can become an MSF */ 2 79 4 turn_off_ssw bit (1) unaligned, /* 1 means safety switch of absout was off originally */ 2 80 4 mbz bit (34) unaligned, 2 81 /* */ 2 82 2 command_line, /* substructure dealing with tracing command lines */ 2 83 3 by_control_arg bit (1) unaligned, /* 1 if trace modes specified by ec control arg */ 2 84 3 on bit (1) unaligned, /* 1 to print tracing information */ 2 85 3 expand fixed bin (3) unal, /* 1 to print unexpanded, 2 expanded, 3 all, 4 both */ 2 86 3 pad1 bit (66) unaligned, /* pad to double word */ 2 87 3 iocb ptr, /* I/O switch to put trace out on */ 2 88 3 prefix char (32) varying, /* prefix for &trace tracing, eg. "COMMAND: " */ 2 89 3 pad2 bit (36), /* */ 2 90 2 (comment_line, /* for tracing comments..always unexpanded */ 2 91 control_line, /* for tracing control lines */ 2 92 input_line) /* for tracing input lines in &attach mode */ 2 93 like abs_data.command_line, 2 94 /* */ 2 95 2 attach, /* */ 2 96 3 victim_ptr ptr, /* -> IOCB affected by &attach (usually iox_$user_input */ 2 97 3 target_ptr ptr, /* -> IOCB &attached to (created by exec_com command) */ 2 98 3 save_ptr ptr, /* -> IOCB used to save previous victim_ptr -> IOCB */ 2 99 3 switches, 2 100 4 trim_whitespace_sw bit (1) unaligned, /* OFF for &attach &trim off, ON by default */ 2 101 4 noabort bit (1) unaligned, /* ON if continue after severity 1 error */ 2 102 4 pad bit (34) unaligned, 2 103 /* */ 2 104 2 allocated_chars_ptr ptr, /* -> allocated buffer for freeing */ 2 105 2 chars_ptr ptr, /* -> characters in buffer waiting to be returned */ 2 106 2 else_clause_ptr ptr, /* -> characters in deferred else clause */ 2 107 2 allocated_chars_len fixed bin (21), /* total length of allocated buffer */ 2 108 2 chars_len fixed bin (21), /* characters left in buffer to be returned */ 2 109 2 else_clause_len fixed bin (21), /* length of deferred else clause */ 2 110 /* */ 2 111 2 absentee bit (1), /* 1 indicates logout on &quit */ 2 112 2 quit bit (1), /* 1 indicates orderly exit, quit or return */ 2 113 /* */ 2 114 2 active bit (1), /* 1 indicates get_line is busy, for recursion check */ 2 115 2 eof bit (1), /* 1 indicates &quit found or no more input */ 2 116 2 last_input_line_sw bit (1), /* previous line returned was an input line */ 2 117 2 label_search_sw bit (1), /* ON when searching for target of &goto */ 2 118 2 nest_level fixed bin, /* V1: depth of &if-&then-&else nesting */ 2 119 2 expected_nest_level fixed bin, /* V1: depth that must be reached to resume execution */ 2 120 /* */ 2 121 2 goto_statement_pos fixed bin (21), /* position of last &goto stmt, for error msgs */ 2 122 2 goto_statement_len fixed bin (21), /* length of the &goto stmt */ 2 123 2 124 2 if_info aligned, /* &if-&then-&else nesting info */ 2 125 3 if_sw bit (1), /* ON if inside an &if-&then-&else construct */ 2 126 3 true_sw bit (1), /* ON after "&if true" */ 2 127 3 got_then_sw bit (1), /* ON after the &then has been seen */ 2 128 3 got_else_sw bit (1), /* ON after the &else has been seen */ 2 129 3 clause_type fixed bin, /* previous &then or &else */ 2 130 3 skip_sw bit (1), /* ON if skipping a &then or &else clause */ 2 131 3 skip_block_level fixed bin, /* how many levels of &do we are inside while skipping */ 2 132 3 prev_if_ptr ptr, /* ptr to if_info (saved) of &if we are nested inside */ 2 133 3 this_action fixed bin, /* copy of expand_data.this_statement.action */ 2 134 3 next_action fixed bin, /* copy of expand_data.next_statement.action */ 2 135 2 136 2 on_info aligned, /* info pertaining to &on units in the ec */ 2 137 3 cleanup_handler_ptr ptr, /* -> node for cleanup handler if any */ 2 138 3 first_handler_ptr ptr, /* -> top of chain of nodes for other handlers */ 2 139 3 switches aligned, 2 140 4 was_attached_sw bit (1) unal, /* 1 indicates parent ec was &attach'ed */ 2 141 4 in_handler_sw bit (1) unal, /* 1 indicates we are now executing some handler text */ 2 142 4 exit_sw bit (1) unal, /* 1 indicates ready to exit the handler via &exit or &goto */ 2 143 4 goto_sw bit (1) unal, /* 1 means this exit is accomplished by a nonlocal &goto */ 2 144 4 continue_to_signal_sw bit (1) unal, /* 1 means &continue_to_signal was executed */ 2 145 4 pad bit (31) unal, 2 146 3 handler_node_ptr ptr, /* -> parent's handler_node for this condition */ 2 147 3 parent_abs_data_ptr ptr, /* -> abs_data structure of parent ec */ 2 148 3 condition_info aligned, /* selected condition info if in_handler_sw is ON */ 2 149 4 condition_name char (32), /* name of condition signalled */ 2 150 4 mc_ptr ptr, /* machine conditions ptr for signal_ */ 2 151 4 info_ptr ptr, /* ptr to specific condition info, for signal_ */ 2 152 4 wc_ptr ptr, /* machine conditions for lower ring fault, for signal_ */ 2 153 3 goto_label_ptr ptr, /* -> &goto label if goto_sw is on */ 2 154 3 goto_label_len fixed bin (21), /* length of the &goto label */ 2 155 3 listener_pl1_label label variable, /* for nonlocal goto to parent ec's listener's stack frame */ 2 156 3 get_line_pl1_label label variable, /* for nonlocal goto to parent ec's get_line's stack frame */ 2 157 /* */ 2 158 2 saved_state_ptr ptr, /* -> top of parser stack */ 2 159 2 current_lex_block_ptr ptr, /* -> lex_block for current block position */ 2 160 2 current_proc_block_ptr ptr, /* -> proc block for current procedure */ 2 161 2 last_block_ptr ptr, /* -> last lex or proc block that has been allocated */ 2 162 2 current_loop_ptr ptr, /* -> loop_block for current active loop */ 2 163 2 last_loop_ptr ptr, /* -> last loop block that has been allocated */ 2 164 /* */ 2 165 2 labels_ptr ptr, /* hash table ptr for label hash table */ 2 166 2 first_xlabel_ptr ptr, /* first expandable label */ 2 167 2 last_xlabel_ptr ptr, /* last expandable label */ 2 168 2 variables_ptr ptr, /* hash table ptr for variable hash table */ 2 169 /* */ 2 170 2 timed_input bit (1), /* 1 indicates input requests may be delayed */ 2 171 2 low_sleep_time fixed bin (35), /* low sleep time for timed input */ 2 172 2 sleep_time_range fixed bin (35), /* high sleep time for timed input */ 2 173 2 seed fixed bin (35), /* seed for timed input random numbers */ 2 174 /* */ 2 175 2 work_area area (800); /* extensible area for args, etc. */ 2 176 2 177 declare abs_data_version_1 fixed bin static options (constant) initial (1), 2 178 Work_area_size fixed bin static options (constant) initial (800); 2 179 2 180 dcl (UNEXPANDED init (1), EXPANDED init (2), ALL init (3), BOTH init (4)) 2 181 fixed bin int static options (constant); 2 182 2 183 /* END OF: abs_io_data.incl.pl1 * * * * * * * * * * * * * * * * * * * */ 1911 1912 3 1 /* BEGIN INCLUDE FILE -- abs_io_expand.incl.pl1 -- 07/07/80 S. Herbst */ 3 2 3 3 /* Added label_search_values 10/06/82 S. Herbst */ 3 4 /* Added next_begin_pos 04/29/83 S. Herbst */ 3 5 /* Added trace_lines.by_control_arg 03/20/84 S. Herbst */ 3 6 3 7 3 8 dcl expand_data_ptr ptr; 3 9 /* In comments, (Input), (Output) and (I/O) refer 3 10* to how abs_io_expand_ sees the item. */ 3 11 dcl 1 expand_data aligned based (expand_data_ptr), 3 12 2 version fixed bin, /* = 1 */ 3 13 2 abs_data_ptr ptr, /* ptr back to abs_data for this invocation of ec */ 3 14 2 expand_data_ptr ptr, /* ptr to data maintained by abs_io_expand_ */ 3 15 2 next_expand_data_ptr ptr, /* ptr to this structure for next &proc or &fcn */ 3 16 2 last_expand_data_ptr ptr, /* ptr to this structure for outer proc or fcn */ 3 17 2 area_ptr ptr, /* ptr to area in which to allocate args */ 3 18 3 19 2 input_pos fixed bin (21), /* current character position in input file (I/O) */ 3 20 2 caller_buffer_info, 3 21 3 caller_buffer_ptr ptr, /* caller's buffer for returned line (Input) */ 3 22 3 caller_buffer_len fixed bin (21), /* character size of buffer (Input) */ 3 23 3 caller_actual_len fixed bin (21), /* number of chars returned (Output) */ 3 24 2 allocated_buffer_info, 3 25 3 allocated_ptr ptr, /* ptr to expand_'s allocated rest-of-line (I/O) */ 3 26 3 allocated_len fixed bin (21), /* length of rest-of-line (I/O) */ 3 27 3 allocated_buffer_len fixed bin (21), /* original allocated size (Output) */ 3 28 3 29 2 trace_lines, /* tracing info for command or input lines */ 3 30 3 by_control_arg bit (1) unaligned, /* ON if trace mode was specified by ec control arg */ 3 31 3 on bit (1) unaligned, /* ON to trace at all */ 3 32 3 expand fixed bin (3) unaligned, /* 1=unexpanded, 2=expanded, 3=all, 4=both */ 3 33 3 pad1 bit (66) unaligned, /* pad to double word */ 3 34 3 iocb ptr, /* IOCB to put trace on */ 3 35 3 prefix char (32) varying, /* prefix for &trace tracing, eg. "COMMAND: " */ 3 36 3 pad2 bit (36), 3 37 3 38 2 predicate_values, 3 39 3 is_absin bit (1), /* &is_absin, ON if absentee (Input) */ 3 40 3 is_af bit (1), /* &is_af, ON if ec active function (Input) */ 3 41 3 is_input bit (1), /* &is_input_line, ON if input line */ 3 42 3 pad bit (33), 3 43 2 first_loop_ptr ptr, /* ptr to first iteration loop activation (I/O) */ 3 44 2 first_block_ptr ptr, /* ptr to first &do block (I/O) */ 3 45 3 46 2 label_search_values, 3 47 3 searching_for char (200), /* label being searched for ($skip) */ 3 48 3 (next_begin_pos, /* position of next &begin */ 3 49 next_do_pos, /* position of next &do */ 3 50 next_end_pos, /* position of next &end */ 3 51 next_label_pos, /* position of next &label */ 3 52 next_quote_pos, /* position of next &" */ 3 53 next_comment_pos) fixed bin (21), /* position of next &- */ 3 54 3 55 2 expander_output, /* returned by abs_io_expand_ after parsing */ 3 56 3 this_statement, 3 57 4 pos fixed bin (21), /* beginning of current (parsed) statement */ 3 58 4 len fixed bin (21), /* length of entire statement */ 3 59 4 keyword_len fixed bin (21), /* length of just the keyword portion */ 3 60 4 action fixed bin, /* semantic number of this keyword */ 3 61 3 semant_info, 3 62 4 semantics fixed bin, /* additional information for the code that implements */ 3 63 4 modifier fixed bin, /* and more info for certain ones */ 3 64 4 flag fixed bin, /* what can I say? */ 3 65 3 arg_info, 3 66 4 arg_ptr ptr, /* ptr to single arg if keyword takes only one (Output) */ 3 67 4 arg_len fixed bin (21), /* length of single arg (Output) */ 3 68 4 parsed_args_ptr ptr, /* points to parsed_args structure if >1 args (Output) */ 3 69 3 next_statement like expand_data.this_statement, /* next statement info (look-ahead) (Output) */ 3 70 3 expanded_sw bit (1), /* ON if expand_ had to expand label stmt (Output) */ 3 71 3 error_msg char (168) aligned; /* diagnosis if abs_io_expand returns code ^= 0 */ 3 72 3 73 3 74 dcl parsed_args_count fixed bin; 3 75 dcl parsed_args_ptr ptr; 3 76 3 77 dcl 1 parsed_args aligned based (parsed_args_ptr), 3 78 2 count fixed bin, /* number of arguments */ 3 79 2 array (parsed_args_count refer (parsed_args.count)), 3 80 3 ptr ptr unaligned, /* ptr to the argument */ 3 81 3 len fixed bin (21), /* length of the argument */ 3 82 3 quote_count fixed bin, /* number of internal quote chars (for allocating &r) */ 3 83 3 flags bit (36) aligned; /* reserved for specific types of args */ 3 84 3 85 dcl expand_data_version_2 fixed bin int static options (constant) init (2); 3 86 3 87 /* END INCLUDE FILE abs_io_expand.incl.pl1 */ 1913 1914 4 1 /* START OF: abs_io_handler_node.incl.pl1 */ 4 2 4 3 /* Contains info on one exec_com &on unit */ 4 4 /* Initially coded 01/06/83 S. Herbst */ 4 5 4 6 dcl handler_node_ptr ptr; 4 7 4 8 dcl 1 handler_node aligned based (handler_node_ptr), 4 9 2 ptr ptr, /* -> text of &on unit */ 4 10 2 len fixed bin (21), /* length of &on unit text */ 4 11 2 condition_name char (32), 4 12 2 next_ptr ptr; /* forward thread */ 4 13 4 14 /* END OF: abs_io_handler_node.incl.pl1 */ 1915 1916 5 1 /* START OF: abs_io_hash.incl.pl1 * * * * * * * * * * * * * * * * * * * */ 5 2 5 3 /* Written: 10 June 1980 by J. Spencer Love */ 5 4 5 5 declare hash_table (0:60) ptr unaligned based initial ((61) (null ())); 5 6 5 7 declare label_ptr ptr, 5 8 current_label_len fixed bin (21), 5 9 current_label_ptr ptr, 5 10 current_label char (current_label_len) based (current_label_ptr); 5 11 5 12 declare 1 label aligned based (label_ptr), 5 13 2 next_ptr ptr unaligned, 5 14 2 statement_pos fixed bin (21), 5 15 2 statement_len fixed bin (21), 5 16 2 len fixed bin (21), 5 17 2 lex_block_ptr ptr unaligned, 5 18 2 name char (current_label_len refer (label.len)) initial (current_label); 5 19 5 20 /* END OF: abs_io_hash.incl.pl1 * * * * * * * * * * * * * * * * * * * */ 1917 1918 6 1 /* START OF: ec_data.incl.pl1 * * * * * * * * * * * * * * * * * * * */ 6 2 6 3 declare ec_data_ptr ptr; 6 4 6 5 declare 1 ec_data aligned based (ec_data_ptr), 6 6 2 version_id char (4), /* " ec " */ 6 7 2 version fixed bin, /* 1 */ 6 8 2 active_function bit (1), /* This affects &is_af and &return */ 6 9 2 return_len fixed bin (21), /* maximum length and pointer to varying character string */ 6 10 2 return_ptr ptr, /* for active function return value */ 6 11 2 execute_line entry (ptr, fixed bin (21), fixed bin (35)), 6 12 2 eval_string entry (ptr, char (*), fixed bin, char (*) var, fixed bin (35)), 6 13 2 set_ready_mode entry (1 aligned, 2 bit (1) unal, 2 bit (35) unal), 6 14 2 error entry () options (variable), 6 15 2 switch_ptr ptr, /* switch affected by &attach */ 6 16 2 id_string char (19), /* name string for &attach save switch should contain this */ 6 17 2 input_line bit (1), /* this makes the command_line/input_line distinction */ 6 18 2 call_ready_proc bit (1), /* this implements the &ready_proc keyword */ 6 19 2 who_am_i char (72) varying; /* for error messages. It's 72 chars for subsystem requests */ 6 20 6 21 declare ec_data_version_id char (4) aligned static options (constant) initial (" ec "), 6 22 ec_data_version_1 fixed bin static options (constant) initial (1); 6 23 6 24 /* END OF: ec_data.incl.pl1 * * * * * * * * * * * * * * * * * * * */ 1919 1920 7 1 /* BEGIN INCLUDE FILE iocbx.incl.pl1 */ 7 2 /* written 27 Dec 1973, M. G. Smith */ 7 3 /* returns attributes removed, hashing support BIM Spring 1981 */ 7 4 /* version made character string June 1981 BIM */ 7 5 /* Modified 11/29/82 by S. Krupp to add new entries and to change 7 6* version number to IOX2. */ 7 7 /* format: style2 */ 7 8 7 9 dcl 1 iocb aligned based, /* I/O control block. */ 7 10 2 version character (4) aligned, /* IOX2 */ 7 11 2 name char (32), /* I/O name of this block. */ 7 12 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 7 13 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 7 14 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 7 15 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 7 16 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 7 17 2 event_channel bit (72), /* Event channel for asynchronous I/O. */ 7 18 2 detach_iocb entry (ptr, fixed bin (35)), 7 19 /* detach_iocb(p) */ 7 20 2 open entry (ptr, fixed, bit (1) aligned, fixed bin (35)), 7 21 /* open(p,mode,not_used) */ 7 22 2 close entry (ptr, fixed bin (35)), 7 23 /* close(p) */ 7 24 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed bin (35)), 7 25 /* get_line(p,bufptr,buflen,actlen) */ 7 26 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed bin (35)), 7 27 /* get_chars(p,bufptr,buflen,actlen) */ 7 28 2 put_chars entry (ptr, ptr, fixed (21), fixed bin (35)), 7 29 /* put_chars(p,bufptr,buflen) */ 7 30 2 modes entry (ptr, char (*), char (*), fixed bin (35)), 7 31 /* modes(p,newmode,oldmode) */ 7 32 2 position entry (ptr, fixed, fixed (21), fixed bin (35)), 7 33 /* position(p,u1,u2) */ 7 34 2 control entry (ptr, char (*), ptr, fixed bin (35)), 7 35 /* control(p,order,infptr) */ 7 36 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed bin (35)), 7 37 /* read_record(p,bufptr,buflen,actlen) */ 7 38 2 write_record entry (ptr, ptr, fixed (21), fixed bin (35)), 7 39 /* write_record(p,bufptr,buflen) */ 7 40 2 rewrite_record entry (ptr, ptr, fixed (21), fixed bin (35)), 7 41 /* rewrite_record(p,bufptr,buflen) */ 7 42 2 delete_record entry (ptr, fixed bin (35)), 7 43 /* delete_record(p) */ 7 44 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed bin (35)), 7 45 /* seek_key(p,key,len) */ 7 46 2 read_key entry (ptr, char (256) varying, fixed (21), fixed bin (35)), 7 47 /* read_key(p,key,len) */ 7 48 2 read_length entry (ptr, fixed (21), fixed bin (35)), 7 49 /* read_length(p,len) */ 7 50 2 open_file entry (ptr, fixed bin, char (*), bit (1) aligned, fixed bin (35)), 7 51 /* open_file(p,mode,desc,not_used,s) */ 7 52 2 close_file entry (ptr, char (*), fixed bin (35)), 7 53 /* close_file(p,desc,s) */ 7 54 2 detach entry (ptr, char (*), fixed bin (35)), 7 55 /* detach(p,desc,s) */ 7 56 /* Hidden information, to support SYN attachments. */ 7 57 2 ios_compatibility ptr, /* Ptr to old DIM's IOS transfer vector. */ 7 58 2 syn_inhibits bit (36), /* Operations inhibited by SYN. */ 7 59 2 syn_father ptr, /* IOCB immediately SYNed to. */ 7 60 2 syn_brother ptr, /* Next IOCB SYNed as this one is. */ 7 61 2 syn_son ptr, /* First IOCB SYNed to this one. */ 7 62 2 hash_chain_ptr ptr; /* Next IOCB in hash bucket */ 7 63 7 64 declare iox_$iocb_version_sentinel 7 65 character (4) aligned external static; 7 66 7 67 /* END INCLUDE FILE iocbx.incl.pl1 */ 1921 1922 1923 end abs_io_v2_get_line; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/04/88 1311.8 abs_io_v2_get_line.pl1 >spec>install>1128>abs_io_v2_get_line.pl1 1909 1 06/24/81 1744.3 abs_io_block.incl.pl1 >ldd>include>abs_io_block.incl.pl1 1911 2 08/11/87 2007.9 abs_io_data.incl.pl1 >ldd>include>abs_io_data.incl.pl1 1913 3 10/23/84 0848.6 abs_io_expand.incl.pl1 >ldd>include>abs_io_expand.incl.pl1 1915 4 08/01/83 1107.8 abs_io_handler_node.incl.pl1 >ldd>include>abs_io_handler_node.incl.pl1 1917 5 06/24/81 1744.4 abs_io_hash.incl.pl1 >ldd>include>abs_io_hash.incl.pl1 1919 6 04/13/82 1620.2 ec_data.incl.pl1 >ldd>include>ec_data.incl.pl1 1921 7 06/03/83 1008.5 iocbx.incl.pl1 >ldd>include>iocbx.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. ALL constant fixed bin(17,0) initial dcl 2-180 ref 1797 ALPHA 000124 constant char(52) initial packed unaligned dcl 107 ref 734 A_abs_data_ptr parameter pointer dcl 82 ref 378 384 A_buffer_len parameter fixed bin(21,0) dcl 84 set ref 40 220* 240 276 1509 A_buffer_ptr parameter pointer dcl 83 set ref 40 220* 275 1508 A_code 000106 automatic fixed bin(35,0) dcl 86 set ref 214* 220* 221 254* 266 365* 370* 1322* 1671* A_ec_data_ptr parameter pointer dcl 82 ref 378 385 A_goto_label parameter char packed unaligned dcl 80 ref 378 395 397 A_iocb_ptr parameter pointer dcl 81 set ref 40 1497 1501* 1503 A_return_len parameter fixed bin(21,0) dcl 85 set ref 40 220* 264* 429* BEGIN_ACTION constant fixed bin(17,0) initial dcl 92 ref 668 BEGIN_TYPE constant fixed bin(17,0) initial dcl 101 ref 1337 BOTH constant fixed bin(17,0) initial dcl 2-180 ref 1802 DIGITS 000121 constant char(10) initial packed unaligned dcl 108 ref 950 DO_ACTION constant fixed bin(17,0) initial dcl 93 ref 1888 DO_TYPE constant fixed bin(17,0) initial dcl 100 ref 1356 ELSE_ACTION constant fixed bin(17,0) initial dcl 94 ref 334 334 1401 1411 1881 1881 1881 ELSE_TYPE constant fixed bin(17,0) initial dcl 103 ref 496 1046 1354 1881 EXPANDED constant fixed bin(17,0) initial dcl 2-180 ref 1793 1861 1864 IF_ACTION constant fixed bin(17,0) initial dcl 95 ref 304 1725 1888 LABEL constant fixed bin(17,0) initial dcl 109 ref 421 587 600 NL 015350 constant char(1) initial packed unaligned dcl 110 ref 297 302 361 368 714 736 1291 1725 NO_UPDATE constant bit(1) initial packed unaligned dcl 105 set ref 216* P_arg_name parameter char packed unaligned dcl 1836 ref 1834 1841 P_args_ptr parameter pointer dcl 1683 ref 1679 1686 1687 1688 P_hash parameter fixed bin(17,0) dcl 1572 set ref 1566 1579* 1581 P_label_name parameter char packed unaligned dcl 1129 set ref 1125 1132* 1133* 1135* 1138 1139 1147 P_labels_ptr parameter pointer dcl 1570 set ref 1566 1577 1577* 1581 P_line parameter structure level 1 dcl 1854 set ref 1852 P_name parameter char packed unaligned dcl 1571 ref 1566 1579 1579 1584 1605 P_pos parameter fixed bin(21,0) dcl 1455 in procedure "first_token" set ref 1452 1460* 1466* 1467* 1470* 1474* P_pos parameter fixed bin(21,0) dcl 1615 in procedure "next_token" set ref 1612 1617 1621* 1626* 1630* P_str parameter char packed unaligned dcl 1454 in procedure "first_token" set ref 1452 1457 1458 1460 1461 1463 1467* 1470 1471 1475 P_str parameter char packed unaligned dcl 1614 in procedure "next_token" ref 1612 1618 1619 1621 1622 1624 1626 1627 1631 P_sw parameter bit(1) dcl 1723 ref 1721 1730 P_type parameter char packed unaligned dcl 1855 ref 1852 1863 1863 P_update_sw parameter bit(1) packed unaligned dcl 1495 ref 1489 1499 THEN_ACTION constant fixed bin(17,0) initial dcl 96 ref 334 334 1411 1881 THEN_TYPE constant fixed bin(17,0) initial dcl 102 ref 987 1074 1354 1881 UNEXPANDED constant fixed bin(17,0) initial dcl 2-180 ref 1789 1863 WHITE_SPACE 000120 constant char(4) initial packed unaligned dcl 112 ref 297 395 548 598 796 950 1201 1202 1458 1463 1619 1624 abs_data based structure level 1 dcl 2-23 abs_data_ptr 000646 automatic pointer dcl 2-21 in procedure "abs_io_v2_get_line" set ref 218 218 220 224 226 226 229 230 232 234 235 236 236 236 240 246 249 249 252 252 252 253 253 257 258 258 258 261 262 282 283 285 297 297 302 302 304 305 306 306 309 316 324 329 329 330 334 334 334 334 334 334 340 341 341 344 344 346 346 348 355 363 363 364 364 384* 392 393 396 406 408 410 412 412 413 414 427 431 431 439* 443 444 449 454 455 460 460 465 475 475 475 475 496 511 517 544 546 549 552 558 563 569 570 572 572 573 584 588 600 605 611 616 617 617 618 620 624 624 625 625 627 633 633 635 636 639 648 652* 668 695 711 711 714 714 717 721 722 724 725 726 730 730 734 734 736 736 741 742 742 743 744 746 747 753 754 757 761 767 778 779 897 907 911 914 919 921 960 963 974 974 978 983 987 1013 1018 1018 1020 1022 1034 1034 1043 1043 1046 1074 1091 1093 1094 1097 1115 1141 1148 1160 1161 1276 1278 1279 1280 1284 1285 1301 1313 1313 1315 1315 1315 1320 1334 1335 1339 1340 1341 1343 1351 1352 1354 1354 1354 1358 1359 1360 1362 1368 1368 1370 1372 1372 1372 1379 1379 1387 1390 1391 1393 1395 1396 1398 1401 1405 1411 1411 1414 1420 1422 1423 1426 1427 1427 1429 1429 1431 1437 1437 1437 1440 1446 1446 1446 1448 1448 1500 1501 1511* 1512 1552 1554 1558 1562 1594 1594 1594 1645 1667* 1672 1672 1689 1700 1700 1701 1701 1701 1710 1713 1714 1715 1725 1725 1725 1725 1725 1730 1825 1827 1829 1831 1879 1880 1881 1881 1892 1893 1893 1898 1899 1901 1901 abs_data_ptr 2 000112 automatic pointer level 2 in structure "xd" dcl 149 in procedure "abs_io_v2_get_line" set ref 1552* abs_io_control$attach 000022 constant entry external dcl 179 ref 439 abs_io_control$detach 000024 constant entry external dcl 180 ref 1667 abs_io_expand_ 000026 constant entry external dcl 181 ref 319 abs_io_expand_$delete 000032 constant entry external dcl 183 ref 960 abs_io_expand_$expand_label 000030 constant entry external dcl 182 ref 1602 abs_io_expand_$label_search 000036 constant entry external dcl 184 ref 310 abs_io_expand_$set 000034 constant entry external dcl 183 ref 963 abs_io_expand_$skip 000040 constant entry external dcl 185 ref 316 abs_io_list_vars 000042 constant entry external dcl 186 ref 652 absentee 273 based bit(1) level 2 dcl 2-23 ref 431 1558 active 275 based bit(1) level 2 dcl 2-23 set ref 218 224* 262* active_fnc_err_ 000044 constant entry external dcl 187 ref 1304 1648 active_function 2 based bit(1) level 2 dcl 6-5 ref 1304 1485 1648 active_string based char packed unaligned dcl 1170 set ref 1183 1185 1189* 1193* 1201 1202 1204 1206 1210 1210 1215 1215 1220 1224* 1228* 1232 active_string_len 000100 automatic fixed bin(21,0) dcl 1171 set ref 1180* 1183 1183 1185 1185 1189 1193 1198* 1201 1202* 1202 1202 1204 1206 1210 1210 1215 1215 1215 1220 1221* 1221 1224 1224 1228 1228 1232 1232 active_string_pos 000612 automatic fixed bin(21,0) dcl 161 set ref 1201* 1210 1210 1215 1220 active_string_ptr 000102 automatic pointer dcl 1172 set ref 1183 1185* 1189 1193 1197* 1201 1202 1204 1206 1210 1210 1215 1215 1219 1220* 1220 1224 1228 1231* 1232 actual_iocb_ptr 12 based pointer level 2 dcl 7-9 ref 1497 1503 actual_len 000105 automatic fixed bin(21,0) dcl 85 set ref 242* 246* 249 249 252 253 264 362* 369* 1321* 1671* addcharno builtin function dcl 208 ref 717 addr builtin function dcl 208 ref 252 413 1138 1220 1313 1553 1554 1713 alloc_len 000613 automatic fixed bin(21,0) dcl 161 set ref 353* 355 355 361 allocated_buffer based char packed unaligned dcl 132 set ref 355 361* allocated_buffer_info 22 000112 automatic structure level 2 dcl 149 allocated_buffer_len 25 000112 automatic fixed bin(21,0) level 3 dcl 149 set ref 357* allocated_chars based char packed unaligned dcl 129 ref 236 258 allocated_chars_len 270 based fixed bin(21,0) level 2 dcl 2-23 set ref 236 236 258 258 364* allocated_chars_ptr 262 based pointer level 2 dcl 2-23 set ref 236 258 363* allocated_len 24 000112 automatic fixed bin(21,0) level 3 dcl 149 set ref 280* 358* 360* 360 361 364 1180 1192 allocated_ptr 22 000112 automatic pointer level 3 dcl 149 set ref 279* 352 355* 361 363 388* 1178 1191 1556* area 000000 stack reference condition dcl 167 ref 1087 1111 1117 1132 1143 1416 1696 1703 area_ptr 12 000112 automatic pointer level 2 in structure "xd" dcl 149 in procedure "abs_io_v2_get_line" set ref 287 1554* area_ptr 000556 automatic pointer initial dcl 157 in procedure "abs_io_v2_get_line" set ref 157* 1181 1181* 1183 1185 1232 arg based char packed unaligned dcl 133 in procedure "abs_io_v2_get_line" set ref 448 448 454 454 455 455 456 517 518 548 550 598 600 609* 610 610 681 784* 789* 796 799 804 804 805 805 891 894* 905* 907 930* 969* 971* 971 arg based char packed unaligned dcl 1745 in procedure "set_trace" set ref 1769* 1818* 1838* 1845* arg based char packed unaligned dcl 1521 in procedure "get_ready_mode" set ref 1532 1532 1533 1533 1535* arg_info 40 based structure level 2 in structure "abs_data" dcl 2-23 in procedure "abs_io_v2_get_line" arg_info 154 000112 automatic structure level 3 in structure "xd" dcl 149 in procedure "abs_io_v2_get_line" arg_len 001000 automatic fixed bin(21,0) dcl 1523 in procedure "get_ready_mode" set ref 1531* 1532 1532 1533 1533 1535 1535 arg_len 001210 automatic fixed bin(21,0) dcl 1749 in procedure "set_trace" set ref 1767* 1769 1769 1818 1818 1838 1838 1844* 1845 1845 arg_len 156 000112 automatic fixed bin(21,0) level 4 in structure "xd" dcl 149 in procedure "abs_io_v2_get_line" set ref 447* 448 448 453* 454 454 455 455 456 516* 517 518 548 548* 550 598* 598 600 609 609 610 610 680* 681 784 784 789 789 796 798 799 804 804 805 805 886 886* 891 894 894 903* 905 905 907 930 930 969 969 971 971 971 1198 arg_ptr 154 000112 automatic pointer level 4 in structure "xd" dcl 149 in procedure "abs_io_v2_get_line" set ref 290* 446* 448 448 452* 454 454 455 455 456 515* 517 518 548 550 598 600 609 610 610 679* 681 784 789 796 799 804 804 805 805 891 894 902* 905 907 930 969 971 971 1197 arg_ptr 001206 automatic pointer dcl 1748 in procedure "set_trace" set ref 1766* 1769 1818 1838 1843* 1845 arg_ptr 000776 automatic pointer dcl 1522 in procedure "get_ready_mode" set ref 1530* 1532 1532 1533 1533 1535 args_ptr 4 based pointer level 2 dcl 1-8 set ref 1336* 1353* array 1 based structure array level 2 dcl 3-77 attach 252 based structure level 2 dcl 2-23 attach_data_ptr 16 based pointer level 2 dcl 7-9 ref 1500 1511 bad_area_format 000000 stack reference condition dcl 167 ref 1088 1112 1118 1133 1144 1417 1697 1704 bad_area_initialization 000000 stack reference condition dcl 167 ref 1089 1113 1119 1135 1145 1418 1698 1705 bars_len 000110 automatic fixed bin(21,0) dcl 1173 set ref 1210* 1212* 1213* 1215 1220 1221 1224 1228 based_area based area(1024) dcl 143 ref 1183 1185 1232 based_ec_len 000102 automatic fixed bin(21,0) dcl 1249 set ref 1279* 1285* 1291 based_ec_ptr 000100 automatic pointer dcl 1248 set ref 1278* 1280 1284* 1291 based_ec_string based char packed unaligned dcl 1247 ref 1291 begin_line_sw 000550 automatic bit(1) packed unaligned dcl 155 set ref 301* 302* 304 334 binary builtin function dcl 208 ref 610 1579 block based structure level 1 dcl 1-8 set ref 1091 block_ptr 000100 automatic pointer dcl 1085 in procedure "allocate_block" set ref 1091* 1093 1094 1096 1097 1098 1100 block_ptr 000644 automatic pointer dcl 1-6 in procedure "abs_io_v2_get_line" set ref 1332* 1334 1335 1336 1337 1339 1343 1349* 1351 1352 1353 1354 1356 1358 1362 1387* 1388 1393 1400 1401 1403 1405 buffer based char packed unaligned dcl 134 set ref 249* 368* buffer_len 000104 automatic fixed bin(21,0) dcl 84 set ref 242 249 368 1509* 1671* buffer_ptr 000102 automatic pointer dcl 83 set ref 249 368 1508* 1671* by_control_arg parameter bit(1) level 2 packed packed unaligned dcl 1854 ref 1857 call_ready_proc 36 based bit(1) level 2 dcl 6-5 set ref 859* caller_actual_len 21 000112 automatic fixed bin(21,0) level 3 dcl 149 set ref 351 362 368 369 835 1180 1188 1193 caller_buffer_info 16 000112 automatic structure level 2 dcl 149 caller_buffer_len 20 000112 automatic fixed bin(21,0) level 3 dcl 149 set ref 276* 351 caller_buffer_ptr 16 000112 automatic pointer level 3 dcl 149 set ref 275* 388* 1187 char builtin function dcl 208 ref 610 1579 charno builtin function dcl 208 ref 1280 1280 chars_len 271 based fixed bin(21,0) level 2 dcl 2-23 set ref 232 235* 240 246 249 252 253* 253 257* 364* chars_ptr 264 based pointer level 2 dcl 2-23 set ref 249 252* 252 363* clause_type 312 based fixed bin(17,0) level 3 dcl 2-23 set ref 496* 987* 1046* 1074* 1354 1354 1354 1881 1881 1899* cleanup 000000 stack reference condition dcl 167 ref 1183 cleanup_handler_ptr 322 based pointer level 3 dcl 2-23 set ref 741 742* 743 744 746 747 907 911* code 000637 automatic fixed bin(35,0) dcl 165 set ref 310* 311 311 313* 316* 319* 321 321 327* 439* 440 440* 652* 653 653* 801* 802 802* 960* 963* 964 964* 1224* 1228* 1235 1235* 1667* 1668 1668* 1812* 1813 1813* codeptr builtin function dcl 208 ref 845 1222 1304 1648 com_err_ 000046 constant entry external dcl 187 ref 1300 1306 1644 1650 command 001116 automatic bit(1) level 3 packed packed unaligned dcl 1738 set ref 1761* 1771* 1775* 1825 command_line 162 based structure level 2 dcl 2-23 set ref 283 1825* comment 0(03) 001116 automatic bit(1) level 3 packed packed unaligned dcl 1738 set ref 1774* 1775* 1831 comment_line 200 based structure level 2 dcl 2-23 set ref 1831* complain 001044 automatic entry variable dcl 1640 in procedure "recurse_error" set ref 1644* 1648* 1650* 1651* 1655 complain 000110 automatic entry variable dcl 1251 in procedure "error" set ref 1300* 1304* 1306* 1307* 1315 cond_string 000100 automatic varying char dcl 676 set ref 677* 681* 681 683* 683 686 689 690 691 698 700 701 701 704 706 707 cond_string_len 000614 automatic fixed bin(21,0) dcl 161 set ref 671* 673* 673 676 687 690 699 706 condition_array based char(32) array packed unaligned dcl 117 set ref 695 704* 740 755 763 768 condition_array_ptr 000560 automatic pointer dcl 158 set ref 695* 704 740 755 763 768 condition_count 000631 automatic fixed bin(17,0) dcl 164 set ref 685* 688* 688 695 697* 703* 703 704 738 condition_info 334 based structure level 3 dcl 2-23 condition_name 3 based char(32) level 2 in structure "handler_node" dcl 4-8 in procedure "abs_io_v2_get_line" set ref 743* 755* 763 768* 917 condition_name 334 based char(32) level 4 in structure "abs_data" dcl 2-23 in procedure "abs_io_v2_get_line" ref 410 974 containing_lex_block_ptr 2 based pointer level 2 dcl 1-8 set ref 567 1334* 1351* 1405 containing_proc_block_ptr 6 based pointer level 2 dcl 1-8 set ref 1335* 1352* continue_to_signal_sw 326(04) based bit(1) level 4 packed packed unaligned dcl 2-23 set ref 517* control 0(02) 001116 automatic bit(1) level 3 packed packed unaligned dcl 1738 set ref 1773* 1775* 1829 control_line 216 based structure level 2 dcl 2-23 set ref 1829* count based fixed bin(17,0) level 2 dcl 3-77 ref 287 444 449 450 514 666 672 678 901 939 941 942 943 947 954 1528 1539 1689 1692 1707 1759 1764 1841 cu_$arg_list_ptr 000052 constant entry external dcl 189 ref 1274 1274 cu_$arg_ptr 000054 constant entry external dcl 190 ref 1273 cu_$evaluate_active_string 000050 constant entry external dcl 188 ref 1228 cu_$set_ready_mode 000056 constant entry external dcl 191 ref 851 current_label based char packed unaligned dcl 5-7 ref 1141 current_label_len 000656 automatic fixed bin(21,0) dcl 5-7 set ref 1139* 1141 1141 1141 current_label_ptr 000660 automatic pointer dcl 5-7 set ref 1138* 1141 current_lex_block_ptr 370 based pointer level 2 dcl 2-23 set ref 563 569* 611 1334 1343* 1351 1362* 1387 1398 1405* current_proc_block_ptr 372 based pointer level 2 dcl 2-23 ref 1335 1352 default_arg_count 56 based fixed bin(17,0) level 3 dcl 2-23 set ref 1689* 1700 1701 default_arg_ptr 54 based pointer level 3 dcl 2-23 set ref 1701* 1710 1713 1714 1715 default_args based structure array level 1 unaligned dcl 121 set ref 1701 default_values based char array packed unaligned dcl 127 set ref 1700 1712* 1713 default_values_ptr 000110 automatic pointer dcl 126 set ref 1700* 1712 1713 dependent 30 based structure level 2 dcl 1-8 ec_data based structure level 1 dcl 6-5 ec_data_ptr 000662 automatic pointer dcl 6-3 in procedure "abs_io_v2_get_line" set ref 385* 437 845 845 847 859 859 886 886 891 891 1222 1222 1224 1299 1304 1304 1307 1308 1484 1485 1512* 1643 1648 1648 1651 1652 ec_data_ptr 26 based pointer level 2 in structure "abs_data" dcl 2-23 in procedure "abs_io_v2_get_line" ref 229 230 1512 ec_path based char packed unaligned dcl 130 set ref 1315* ec_path_len 42 based fixed bin(21,0) level 3 dcl 2-23 ref 1315 1315 ec_path_ptr 40 based pointer level 3 dcl 2-23 ref 1315 else_clause_pos 30 based fixed bin(21,0) level 3 dcl 1-8 set ref 1401* 1403* end_ec 002142 automatic bit(1) packed unaligned dcl 1257 set ref 1271* 1293* 1319 eof 276 based bit(1) level 2 dcl 2-23 set ref 427* error 22 based entry variable level 2 dcl 6-5 ref 1304 1307 1648 1651 error_msg 167 000112 automatic char(168) level 3 dcl 149 set ref 313* 327* 964* error_pos 000103 automatic fixed bin(21,0) dcl 1250 set ref 1280* 1286* 1290 1294 error_table_$badsyntax 000010 external static fixed bin(35,0) dcl 172 ref 1311 error_table_$command_line_overflow 000012 external static fixed bin(35,0) dcl 173 set ref 886* error_table_$end_of_info 000014 external static fixed bin(35,0) dcl 174 ref 311 321 433 error_table_$long_record 000016 external static fixed bin(35,0) dcl 175 ref 254 365 error_table_$noalloc 000640 automatic fixed bin(35,0) dcl 176 set ref 1087* 1111* 1132* 1416* 1696* error_table_$notalloc 000020 external static fixed bin(35,0) dcl 177 set ref 1088* 1089* 1112* 1113* 1133* 1135* 1417* 1418* 1697* 1698* eval_string 12 based entry variable level 2 dcl 6-5 ref 1222 1224 exit_sw 326(02) based bit(1) level 4 packed packed unaligned dcl 2-23 set ref 412* expand 0(02) parameter fixed bin(3,0) level 2 in structure "P_line" packed packed unaligned dcl 1854 in procedure "set_one_trace" set ref 1861 1861* 1863* 1864* 1867* expand 1 001116 automatic fixed bin(17,0) level 2 in structure "tracing" dcl 1738 in procedure "set_trace" set ref 1789* 1793* 1797* 1802* 1867 1867 expand_data based structure level 1 dcl 3-11 expand_data_ptr 4 000112 automatic pointer level 2 dcl 149 set ref 1553* expand_data_version_2 constant fixed bin(17,0) initial dcl 3-85 ref 1551 expanded_sw 166 000112 automatic bit(1) level 3 dcl 149 set ref 622 expander_output 144 000112 automatic structure level 2 in structure "xd" dcl 149 in procedure "abs_io_v2_get_line" set ref 289* expander_output 144 based structure level 2 in structure "expand_data" dcl 3-11 in procedure "abs_io_v2_get_line" first_block_ptr 52 000112 automatic pointer level 2 dcl 149 set ref 1557* first_handler_ptr 324 based pointer level 3 dcl 2-23 set ref 753 757* 761 914 919* first_loop_ptr 50 000112 automatic pointer level 2 dcl 149 set ref 1557* first_xlabel_ptr 404 based pointer level 2 dcl 2-23 set ref 624 624* 1594 1594 1594 flag 000641 automatic bit(1) level 2 packed packed unaligned dcl 202 set ref 841* found_label_ptr 001016 automatic pointer dcl 1574 set ref 1585* 1591* 1600 1608 free_sw 000111 automatic bit(1) packed unaligned dcl 1174 set ref 1182* 1196* 1229 get_line_pl1_label 362 based label variable level 3 dcl 2-23 set ref 226* get_system_free_area_ 000060 constant entry external dcl 192 ref 1181 got_else_sw 311 based bit(1) level 3 dcl 2-23 set ref 1368 1370* 1427* 1437 got_then_sw 310 based bit(1) level 3 dcl 2-23 set ref 1427* 1437 1440* goto_entry_sw 000551 automatic bit(1) packed unaligned dcl 155 set ref 211* 264 273 382* 408 429 571 616 639 1276 goto_label_len 354 based fixed bin(21,0) level 3 dcl 2-23 set ref 414* goto_label_ptr 352 based pointer level 3 dcl 2-23 set ref 413* goto_name based char packed unaligned dcl 135 set ref 396 397* 549 550* 552* 570 579* 586 588 goto_name_len 000615 automatic fixed bin(21,0) dcl 161 set ref 395* 396 396 397 548* 549 549 550 552 552 570 570 579 579 586 588 588 goto_name_ptr 000562 automatic pointer dcl 158 set ref 396* 397 549* 550 552 570 579 586 588 goto_statement_len 304 based fixed bin(21,0) level 2 dcl 2-23 set ref 393 546* goto_statement_pos 303 based fixed bin(21,0) level 2 dcl 2-23 set ref 392 544* goto_sw 326(03) based bit(1) level 4 packed packed unaligned dcl 2-23 set ref 412* handler_len 000616 automatic fixed bin(21,0) dcl 161 set ref 735* 747 774 handler_node based structure level 1 dcl 4-8 set ref 742 754 767 921 handler_node_ptr 330 based pointer level 3 in structure "abs_data" dcl 2-23 in procedure "abs_io_v2_get_line" ref 1280 handler_node_ptr 000652 automatic pointer dcl 4-6 in procedure "abs_io_v2_get_line" set ref 754* 755 756 757 761* 761* 763 764* 765 767* 768 769 770 773 774 handler_ptr 000564 automatic pointer dcl 158 set ref 717* 746 773 handler_start 000617 automatic fixed bin(21,0) dcl 161 set ref 716* 735 hash 000632 automatic fixed bin(17,0) dcl 164 set ref 552* 580 603* 610* 635 636 hash_table based pointer initial array packed unaligned dcl 5-5 set ref 635 636* 1115 1115* 1581 i 000752 automatic fixed bin(21,0) dcl 1455 in procedure "first_token" set ref 1458* 1459 1463 1464 1474 1475 i 001032 automatic fixed bin(21,0) dcl 1615 in procedure "next_token" set ref 1619* 1620 1624 1630 1631 i 001211 automatic fixed bin(17,0) dcl 1750 in procedure "set_trace" set ref 1764* 1766 1767* 1840* 1840 1841 1843 1844 i 000633 automatic fixed bin(17,0) dcl 164 in procedure "abs_io_v2_get_line" set ref 296* 297* 301 302 514* 515 516* 672* 673* 678* 679 680* 686* 687 687 689* 689 689 690 690* 691* 691 691 698* 699 699 700 701 701 704 705* 705 706 706* 707* 707 707 711* 712 713 730* 730* 732 734 735 738* 740 755 763 768* 796* 798 798* 799 804 804 805 805 901* 902 903* 947* 948 949* 954* 955 956 957 958* i 000100 automatic fixed bin(17,0) dcl 1684 in procedure "set_defaults" set ref 1692* 1693* 1707* 1708 1709 1710 1712 1713 1713 1714 1715 1715* identifier 27 based fixed bin(17,0) level 2 dcl 1-8 set ref 1337* 1354* 1356* if_info 12 based structure level 2 in structure "block" dcl 1-8 in procedure "abs_io_v2_get_line" set ref 558 1097* 1339* 1358* 1393 if_info 306 based structure level 2 in structure "abs_data" dcl 2-23 in procedure "abs_io_v2_get_line" set ref 558* 722 778* 1097 1339 1358 1393* 1422 1893* if_sw 306 based bit(1) level 3 dcl 2-23 set ref 285 305* 334 340* 1013 1340* 1359* 1368 1414 1426* 1437 1898* in_handler_sw 326(01) based bit(1) level 4 packed packed unaligned dcl 2-23 ref 226 408 431 511 897 974 1276 index builtin function dcl 208 ref 302 689 700 711 734 1291 input 0(01) 001116 automatic bit(1) level 3 packed packed unaligned dcl 1738 set ref 1772* 1775* 1827 input_line 234 based structure level 2 in structure "abs_data" dcl 2-23 in procedure "abs_io_v2_get_line" set ref 282 1827* input_line 35 based bit(1) level 2 in structure "ec_data" dcl 6-5 in procedure "abs_io_v2_get_line" ref 230 input_linep 000642 automatic bit(1) dcl 206 set ref 229* 230* 234 261 282 1560 1669 input_pos 14 000112 automatic fixed bin(21,0) level 2 dcl 149 set ref 297 297 302 329 330 460 556* 572 573 604* 617 618 620 711 713* 713 714 714* 714 716 717 730 736 736* 736 978 983* 1562* 1672 1725 input_string 60 based structure level 2 in structure "abs_data" dcl 2-23 in procedure "abs_io_v2_get_line" input_string based char packed unaligned dcl 136 in procedure "abs_io_v2_get_line" set ref 297 302 475 475 711 714 730 734 736 1313 1725 io_module_name 1 based varying char(32) level 2 dcl 2-23 ref 1301 1501 1645 ioa_ 000062 constant entry external dcl 193 ref 648 784 894 ioa_$general_rs 000066 constant entry external dcl 193 ref 1274 ioa_$ioa_switch 000070 constant entry external dcl 193 ref 805 ioa_$ioa_switch_nnl 000072 constant entry external dcl 193 ref 804 ioa_$nnl 000064 constant entry external dcl 193 ref 789 iocb based structure level 1 dcl 7-9 in procedure "abs_io_v2_get_line" iocb 2 parameter pointer level 2 in structure "P_line" dcl 1854 in procedure "set_one_trace" set ref 1869* iocb 14 001116 automatic pointer level 2 in structure "tracing" dcl 1738 in procedure "set_trace" set ref 1812* 1869 iocb_ptr 000100 automatic pointer dcl 81 set ref 801* 804* 805* 1497* 1500 1503* 1511 iox_$find_iocb 000074 constant entry external dcl 194 ref 1812 iox_$get_line 000076 constant entry external dcl 195 ref 220 1671 iox_$look_iocb 000100 constant entry external dcl 196 ref 801 iox_$user_input 000102 external static pointer dcl 197 set ref 1671* is_absin 44 000112 automatic bit(1) level 3 dcl 149 set ref 1558* 1861 is_af 45 000112 automatic bit(1) level 3 dcl 149 set ref 1559* is_input 46 000112 automatic bit(1) level 3 dcl 149 set ref 1560* j 001033 automatic fixed bin(21,0) dcl 1615 in procedure "next_token" set ref 1624* 1625 1630 j 000753 automatic fixed bin(21,0) dcl 1455 in procedure "first_token" set ref 1463* 1465 1466 1469 1474 keyword_len 146 000112 automatic fixed bin(21,0) level 4 dcl 149 set ref 475 475 keyword_pos 10 based fixed bin(21,0) level 2 dcl 1-8 set ref 1096* label based structure level 1 dcl 5-12 set ref 1141 label_ptr 000654 automatic pointer dcl 5-7 in procedure "abs_io_v2_get_line" set ref 552* 555 556 556 557 558 563 569 602* 609* 611 613 614 624 625 627 628 635 636 label_ptr 000100 automatic pointer dcl 1130 in procedure "allocate_label" set ref 1141* 1147 1148 1149 1150 1152 label_ptr 001020 automatic pointer dcl 1574 in procedure "lookup_label" set ref 1581* 1581* 1584 1585 1586 1586* 1589 1594* 1594* 1600 1602 1602 1605* 1606 label_search_sw 300 based bit(1) level 2 dcl 2-23 set ref 309 348 406 465 584* 600 605* 616 639 label_search_values 54 000112 automatic structure level 2 dcl 149 set ref 585* label_val based char packed unaligned dcl 137 ref 1605 label_val_len 000620 automatic fixed bin(21,0) dcl 162 set ref 1602* 1605 label_val_ptr 000566 automatic pointer dcl 158 set ref 1602* 1605 labels_ptr 000100 automatic pointer dcl 1109 in procedure "allocate_hash_table" set ref 1115* 1121 labels_ptr 402 based pointer level 2 in structure "abs_data" dcl 2-23 in procedure "abs_io_v2_get_line" set ref 552* 633 633* 635 636 last_block_ptr 374 based pointer level 2 dcl 2-23 set ref 1093 1094* last_expand_data_ptr 10 000112 automatic pointer level 2 dcl 149 set ref 1556* last_input_line_sw 277 based bit(1) level 2 dcl 2-23 set ref 234 261* last_node_ptr 000570 automatic pointer dcl 158 set ref 764* 770 last_xlabel_ptr 406 based pointer level 2 dcl 2-23 set ref 625 625 627* lastp 000572 automatic pointer dcl 158 set ref 915* 919 920 925* len 62 based fixed bin(21,0) level 3 in structure "abs_data" dcl 2-23 in procedure "abs_io_v2_get_line" ref 297 302 324 475 475 711 714 730 734 736 1279 1285 1313 1725 len 145 000112 automatic fixed bin(21,0) level 4 in structure "xd" dcl 149 in procedure "abs_io_v2_get_line" set ref 393* 419* 546 582 604 614 1315 1315 len 2 based fixed bin(21,0) array level 2 in structure "default_args" dcl 121 in procedure "abs_io_v2_get_line" set ref 1714* len 3 based fixed bin(21,0) level 2 in structure "label" dcl 5-12 in procedure "abs_io_v2_get_line" set ref 413 414 424 424 600 1141* 1141 1147 1584 len 2 based fixed bin(21,0) level 2 in structure "handler_node" dcl 4-8 in procedure "abs_io_v2_get_line" set ref 747* 774* len 2 based fixed bin(21,0) array level 3 in structure "parsed_args" dcl 3-77 in procedure "abs_io_v2_get_line" ref 447 453 516 673 680 903 943 949 956 958 1531 1693 1709 1767 1844 length builtin function dcl 208 ref 395 548 598 610 713 1139 1457 1460 1470 1579 1618 1621 1626 lex_block_ptr 4 based pointer level 2 packed packed unaligned dcl 5-12 set ref 557 558 563 569 611* limit 65 based fixed bin(21,0) level 3 dcl 2-23 set ref 329* 329 460* 460 572* 572 617* 617 620* 1672* 1672 limit_pos 001022 automatic fixed bin(21,0) dcl 1575 set ref 1586* 1592* 1600 line_len 000104 automatic fixed bin(21,0) dcl 1250 set ref 1291* 1292 1294* 1297 line_number 000105 automatic fixed bin(21,0) dcl 1250 set ref 1289* 1296* 1296 1315* line_start 000106 automatic fixed bin(21,0) dcl 1250 set ref 1290* 1290* 1291 1294* 1297 logout 000104 constant entry external dcl 198 ref 431 max builtin function dcl 208 ref 329 460 572 617 1672 1693 max_default_len 000621 automatic fixed bin(21,0) dcl 162 set ref 1691* 1693* 1693 1700 1700 1712 1712 1712 1713 1713 1713 message 000353 automatic char(168) packed unaligned dcl 151 in procedure "abs_io_v2_get_line" set ref 421* 422* 424* 652* 653* message 000116 automatic char(4096) packed unaligned dcl 1254 in procedure "error" set ref 1274* 1315* mod builtin function dcl 208 ref 610 941 1579 mode_sw 001001 automatic bit(1) packed unaligned dcl 1524 set ref 1532* 1533* 1536* 1542 name 5 based char initial level 2 dcl 5-12 set ref 413 424* 600 1141* 1147* 1584 name_len 000622 automatic fixed bin(21,0) dcl 162 set ref 700* 701 701 701 704 705 next_action 321 based fixed bin(17,0) level 3 dcl 2-23 set ref 304 334 334 668 1391 1396* 1401 1411 1411 1725 1880 next_expand_data_ptr 6 000112 automatic pointer level 2 dcl 149 set ref 1556* next_ptr based pointer level 2 in structure "label" packed packed unaligned dcl 5-12 in procedure "abs_io_v2_get_line" set ref 625* 628* 635* 1150* 1589 1606 next_ptr 14 based pointer level 2 in structure "handler_node" dcl 4-8 in procedure "abs_io_v2_get_line" set ref 744* 756* 765 769* 770* 919 920* 920 926 next_statement 162 000112 automatic structure level 3 dcl 149 nnl_sw 000552 automatic bit(1) packed unaligned dcl 155 set ref 794* 804 809* noabort 260(01) based bit(1) level 4 packed packed unaligned dcl 2-23 ref 1320 null builtin function dcl 208 ref 157 218 229 279 287 290 352 388 437 439 439 443 513 555 557 566 624 625 628 633 648 663 741 744 753 756 761 769 845 845 859 899 907 911 915 916 919 936 1115 1150 1160 1161 1178 1181 1222 1222 1224 1224 1228 1228 1299 1304 1336 1341 1353 1360 1372 1388 1398 1446 1484 1526 1555 1556 1557 1577 1581 1591 1594 1594 1643 1648 1667 1667 1687 1710 1756 1892 off 0(05) 001116 automatic bit(1) level 2 packed packed unaligned dcl 1738 set ref 1780* 1783* 1821 1866 on 0(04) 001116 automatic bit(1) level 2 in structure "tracing" packed packed unaligned dcl 1738 in procedure "set_trace" set ref 1761* 1779* 1784* 1788* 1792* 1796* 1801* 1821 1821* 1859 on 0(01) parameter bit(1) level 2 in structure "P_line" packed packed unaligned dcl 1854 in procedure "set_one_trace" set ref 1860* 1866* on_info 322 based structure level 2 dcl 2-23 on_saved_if_ptr 000574 automatic pointer dcl 159 set ref 721* 722 778 779 output_switch 0(06) 001116 automatic bit(1) level 2 packed packed unaligned dcl 1738 set ref 1814* 1869 p 000576 automatic pointer dcl 159 set ref 914* 916 917 919 920 921 925 926* 926 pad 0(01) 000641 automatic bit(35) level 2 packed packed unaligned dcl 202 set ref 844* parent_abs_data_ptr 332 based pointer level 3 dcl 2-23 ref 1278 1279 parsed_args based structure level 1 dcl 3-77 ref 287 parsed_args_ptr 000650 automatic pointer dcl 3-75 in procedure "abs_io_v2_get_line" set ref 332* 443 444 446 447 449 450 452 453 513 514 515 516 652* 663 666 672 673 678 679 680 899 901 902 903 936 939 941 942 942 943 943 947 948 949 954 955 956 957 958 1526 1528 1530 1531 1539 1688* 1689 1692 1693 1707 1708 1709 1715 1757* 1759 1764 1766 1767 1841 1843 1844 parsed_args_ptr 160 000112 automatic pointer level 4 in structure "xd" dcl 149 in procedure "abs_io_v2_get_line" set ref 287 287 290* 332 480* 1555* 1755 1756 1757 pos 001212 automatic fixed bin(21,0) dcl 1751 in procedure "set_trace" set ref 1769* 1818* 1838* 1845* pos 144 000112 automatic fixed bin(21,0) level 4 in structure "xd" dcl 149 in procedure "abs_io_v2_get_line" set ref 294 323* 324 324* 392* 418* 475 475 544 581 604 613 1096 1280 1286 1313 1400 1592 pos 162 000112 automatic fixed bin(21,0) level 4 in structure "xd" dcl 149 in procedure "abs_io_v2_get_line" set ref 1401 position 64 based fixed bin(21,0) level 3 dcl 2-23 set ref 330* 573* 618* 978* 983 1148 1562 predicate_values 44 000112 automatic structure level 2 dcl 149 prefix 4 parameter varying char(32) level 2 in structure "P_line" dcl 1854 in procedure "set_one_trace" set ref 1868* prefix 2 001116 automatic varying char(32) level 2 in structure "tracing" dcl 1738 in procedure "set_trace" set ref 1807* 1868 prefix_sw 0(07) 001116 automatic bit(1) level 2 packed packed unaligned dcl 1738 set ref 1806* 1868 prev_block_ptr based pointer level 2 dcl 1-8 set ref 1093* prev_if_ptr 316 based pointer level 3 dcl 2-23 set ref 1341* 1360* 1372 1379 1423* 1446 1448 1892 1893 ptr 1 based pointer array level 3 in structure "parsed_args" packed packed unaligned dcl 3-77 in procedure "abs_io_v2_get_line" ref 446 452 515 679 902 942 948 955 957 1530 1708 1766 1843 ptr based pointer array level 2 in structure "default_args" dcl 121 in procedure "abs_io_v2_get_line" set ref 1710* 1713* ptr 60 based pointer level 3 in structure "abs_data" dcl 2-23 in procedure "abs_io_v2_get_line" ref 297 302 475 475 711 714 717 730 734 736 1278 1284 1313 1725 ptr based pointer level 2 in structure "handler_node" dcl 4-8 in procedure "abs_io_v2_get_line" set ref 746* 773* 1280 quote_count 3 based fixed bin(21,0) array level 2 in structure "default_args" dcl 121 in procedure "abs_io_v2_get_line" set ref 1715* quote_count 3 based fixed bin(17,0) array level 3 in structure "parsed_args" dcl 3-77 in procedure "abs_io_v2_get_line" ref 1715 ready_mode 000641 automatic structure level 1 dcl 202 set ref 847* 851* remainder based char packed unaligned dcl 138 set ref 249 252 return_arg based varying char dcl 139 set ref 891* return_len 3 based fixed bin(21,0) level 2 dcl 6-5 set ref 886 886* 891 return_ptr 4 based pointer level 2 dcl 6-5 ref 891 reverse builtin function dcl 209 ref 1202 rtrim builtin function dcl 209 ref 395 548 598 971 974 974 1301 1645 save_ptr 256 based pointer level 3 dcl 2-23 set ref 218 220* saved_goto_pos 000623 automatic fixed bin(21,0) dcl 162 set ref 418 581* saved_hash 000634 automatic fixed bin(17,0) dcl 164 set ref 580* 603 saved_if_info based structure level 1 dcl 119 set ref 721 722* 778 779 1420 1422* 1893 saved_if_ptr 000600 automatic pointer dcl 159 set ref 1420* 1422 1423 saved_label_ptr 000602 automatic pointer dcl 159 set ref 413 414 424 579* 600 602 saved_next_action 000735 automatic fixed bin(17,0) dcl 1385 in procedure "execute_end" set ref 1391* 1396 saved_next_action 001237 automatic fixed bin(17,0) dcl 1877 in procedure "test_end_of_if" set ref 1880* 1881 1881 saved_ptr 000104 automatic pointer dcl 1172 set ref 1219* 1231 saved_skip_block_level 000635 automatic fixed bin(17,0) dcl 164 set ref 724* 1022 saved_statement_len 000624 automatic fixed bin(21,0) dcl 163 set ref 419 582* saved_statement_pos 000625 automatic fixed bin(21,0) dcl 163 set ref 294* 323 323 saved_this_action 000734 automatic fixed bin(17,0) dcl 1385 in procedure "execute_end" set ref 1390* 1395 saved_this_action 001236 automatic fixed bin(17,0) dcl 1877 in procedure "test_end_of_if" set ref 1879* 1881 1881 1888 1888 search builtin function dcl 209 ref 796 1458 1619 search_type 000636 automatic fixed bin(17,0) dcl 164 set ref 421 587* 600 searching_for 54 000112 automatic char(200) level 3 dcl 149 set ref 586* set_ready_mode 16 based entry variable level 2 dcl 6-5 ref 845 847 severity_sw 002141 automatic bit(1) packed unaligned dcl 1256 set ref 1261* 1269* 1315* 1318 signal_ 000106 constant entry external dcl 199 ref 981 signal_io_error_ 000110 constant entry external dcl 200 ref 1501 skip_block_level 314 based fixed bin(17,0) level 3 dcl 2-23 set ref 306 341 724 725* 1018 1022* 1034* 1034 1043* 1043 1372 1446 1725 1901 skip_sw 5 based bit(1) level 2 in structure "saved_if_info" dcl 119 in procedure "abs_io_v2_get_line" set ref 1379 1448 skip_sw 313 based bit(1) level 3 in structure "abs_data" dcl 2-23 in procedure "abs_io_v2_get_line" set ref 306* 316 341* 344 726* 1018* 1020 1429 1725* 1730* 1901* skipping_handler_sw 000553 automatic bit(1) packed unaligned dcl 155 set ref 211* 306 726* 1020 1021* some_left_sw 000554 automatic bit(1) packed unaligned dcl 155 set ref 241* 245* 251 start_pos 001034 automatic fixed bin(21,0) dcl 1615 set ref 1617* 1618 1619 1622 1624 1627 1630 1631 statement based char packed unaligned dcl 1253 set ref 1315* statement_end_pos 26 based fixed bin(21,0) level 2 dcl 1-8 set ref 1098* 1400* statement_len 2 based fixed bin(21,0) level 2 dcl 5-12 set ref 556 614* 1149* 1586 1602* statement_pos 1 based fixed bin(21,0) level 2 dcl 5-12 set ref 556 613* 1148* 1586 1600 1602* statement_ptr 000114 automatic pointer dcl 1252 set ref 1313* 1315 status based fixed bin(25,0) dcl 1259 set ref 1311 1311* 1315* 1315 status_ptr 002144 automatic pointer dcl 1258 set ref 1273* 1311 1311 1315 1315 substr builtin function dcl 209 set ref 249* 249 252 297 302 361* 368* 475 475 689 690 691 700 701 701 704 706 707 711 714 730 734 736 799 804 804 805 805 1189* 1193* 1210 1210 1215 1215 1220 1291 1313 1463 1471 1475 1619 1622 1624 1627 1631 1725 switch_name 000425 automatic char(168) packed unaligned dcl 151 in procedure "abs_io_v2_get_line" set ref 799* 801* 802* switch_name 001134 automatic char(32) packed unaligned dcl 1746 in procedure "set_trace" set ref 1811* 1812* 1813* switches 326 based structure level 3 in structure "abs_data" dcl 2-23 in procedure "abs_io_v2_get_line" switches 260 based structure level 3 in structure "abs_data" dcl 2-23 in procedure "abs_io_v2_get_line" target_ptr 254 based pointer level 3 dcl 2-23 ref 1161 temp_len 000101 automatic fixed bin(21,0) dcl 1171 set ref 1188* 1189 1189 1192* 1193 1193 temp_ptr 000106 automatic pointer dcl 1172 set ref 1187* 1189 1191* 1193 temp_string based char packed unaligned dcl 1175 ref 1189 1193 test_ptr 000604 automatic pointer dcl 159 set ref 563* 563* 566* 567 this_action 320 based fixed bin(17,0) level 3 dcl 2-23 set ref 334 334 334 344 346 346 1390 1395* 1879 this_statement 144 based structure level 3 in structure "expand_data" dcl 3-11 in procedure "abs_io_v2_get_line" this_statement 144 000112 automatic structure level 3 in structure "xd" dcl 149 in procedure "abs_io_v2_get_line" token 001144 automatic varying char(128) dcl 1747 in procedure "set_trace" set ref 1769* 1769* 1771 1772 1773 1774 1775 1778 1778 1782 1782 1787 1791 1795 1795 1800 1805 1810 1810 1817* 1838* 1839 1845* 1847 token 000477 automatic varying char(128) dcl 152 in procedure "abs_io_v2_get_line" set ref 905* 905* 907 917* 969* 974 974 974 980 token32 000540 automatic char(32) packed unaligned dcl 153 set ref 980* 981* tpos 000626 automatic fixed bin(21,0) dcl 163 set ref 905* 930* 969* 971* trace_lines 26 000112 automatic structure level 2 dcl 149 set ref 282* 283* 389* tracing 001116 automatic structure level 1 unaligned dcl 1738 set ref 1753* translate builtin function dcl 209 ref 683 trim_whitespace_sw 260 based bit(1) level 4 packed packed unaligned dcl 2-23 set ref 443* 444* 449* 454* 455* true_sw 307 based bit(1) level 3 dcl 2-23 set ref 1372* 1379* 1429* 1431* 1446 1448 types 001116 automatic structure level 2 packed packed unaligned dcl 1738 set ref 1823 1823* unspec builtin function dcl 209 set ref 289* 389* 585* 610 1550* 1579 1594 1686 1753* 1755 1823 1823* val_len 000627 automatic fixed bin(21,0) dcl 163 set ref 958* 960 960 963 963 1709* 1710 1710 1712 1714 val_ptr 000606 automatic pointer dcl 159 set ref 957* 960 960 963 1708* 1710 1710 1712 val_string based char packed unaligned dcl 140 set ref 960 960 963* 1710 1710 1712 value 000112 automatic varying char(8) dcl 1176 set ref 1224* 1228* 1237 1238 1239* var_len 000630 automatic fixed bin(21,0) dcl 163 set ref 943* 944 944 949* 950 950 950 956* 960 960 963 963 var_ptr 000610 automatic pointer dcl 159 set ref 942* 944 948* 950 950 955* 960 963 var_string based char packed unaligned dcl 141 set ref 944* 950 950* 960* 963* variables_ptr 410 based pointer level 2 dcl 2-23 set ref 648 960* 963* verify builtin function dcl 209 ref 297 686 690 691 698 706 707 950 1201 1202 1463 1624 version 000112 automatic fixed bin(17,0) level 2 dcl 149 set ref 1551* who 001050 automatic varying char(72) dcl 1641 in procedure "recurse_error" set ref 1645* 1652* 1655* who 002116 automatic varying char(72) dcl 1255 in procedure "error" set ref 1301* 1308* 1315* who_am_i 37 based varying char(72) level 2 dcl 6-5 ref 1308 1652 work_area 416 based area(800) level 2 dcl 2-23 set ref 355 396 549 570 588 695 721 742 754 767 779 921 1091 1115 1141 1420 1554 1700 1701 xd 000112 automatic structure level 1 dcl 149 set ref 310* 316* 319* 1550* 1553 1602* xd_area based area(1024) dcl 144 ref 287 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Work_area_size internal static fixed bin(17,0) initial dcl 2-177 abs_data_version_1 internal static fixed bin(17,0) initial dcl 2-177 ec_data_version_1 internal static fixed bin(17,0) initial dcl 6-21 ec_data_version_id internal static char(4) initial dcl 6-21 expand_data_ptr automatic pointer dcl 3-8 iox_$iocb_version_sentinel external static char(4) dcl 7-64 parsed_args_count automatic fixed bin(17,0) dcl 3-74 NAMES DECLARED BY EXPLICIT CONTEXT. ACTION 000000 constant label array(0:39) dcl 401 ref 346 BAD_KEY 002746 constant label dcl 475 ref 524 528 644 814 864 868 1000 1008 CHECK_EXPANDABLES 012261 constant label dcl 1594 ref 1587 END_OF_FILE 002252 constant label dcl 401 ref 311 325 348 521 838 895 1657 END_REVERT_LOOP 005646 constant label dcl 930 ref 922 END_STMT 003027 constant label dcl 504 ERROR_COMMON 010172 constant label dcl 1271 ref 1262 ERROR_RETURN 002366 constant label dcl 427 ref 415 1319 1320 EVALUATED 010043 constant label dcl 1229 ref 1225 EXPAND_NEXT_STMT 001536 constant label dcl 273 ref 237 462 493 571 589 639 GOTO_STMT 003214 constant label dcl 552 ref 399 GOT_HANDLER 004477 constant label dcl 730 ref 1023 GOT_LABEL 003526 constant label dcl 611 ref 606 LIST_VARIABLES_STMT 003647 constant label dcl 648 ref 659 MIGHT_SKIP 001567 constant label dcl 287 ref 1020 NO_BEGIN 003767 constant label dcl 668 ref 712 NO_HANDLER 005545 constant label dcl 907 NO_ON_ARGS 003741 constant label dcl 663 ref 666 NO_ON_END 004520 constant label dcl 732 ref 734 NO_READY_ARGS 011761 constant label dcl 1526 ref 1528 NO_SET_ARGS 005701 constant label dcl 936 ref 939 NO_TRACE_ARG 013322 constant label dcl 1760 ref 1755 1756 PRINT_SWITCH 005020 constant label dcl 796 ref 811 PROC_STMT 005216 constant label dcl 814 set ref 831 READY_STMT 005243 constant label dcl 841 ref 855 RETURN 001512 constant label dcl 261 ref 373 1323 1673 RETURN_LINE 002070 constant label dcl 351 SET_HANDLER 004732 constant label dcl 773 ref 763 SET_INPUT_LIMIT 002712 constant label dcl 460 ref 470 482 487 501 508 595 656 728 781 786 791 806 848 852 861 933 966 984 992 997 SKIP 000050 constant label array(0:39) dcl 1013 ref 344 SKIP_TEST 006521 constant label dcl 1013 ref 1028 1035 1037 1044 1051 1056 1058 1064 1066 1077 1079 START 001345 constant label dcl 211 ref 226 TEST 014414 constant label dcl 1881 ref 1894 abs_io_v2_get_line 001335 constant entry external dcl 40 allocate_block 006577 constant entry internal dcl 1083 ref 1332 1349 allocate_hash_table 006766 constant entry internal dcl 1105 ref 633 1577 allocate_label 007165 constant entry internal dcl 1125 ref 579 609 attachedp 007426 constant entry internal dcl 1156 ref 437 1665 conditional 007446 constant entry internal dcl 1165 ref 1431 error 010152 constant entry internal dcl 1243 ref 313 327 410 424 440 448 450 456 472 475 511 518 566 653 663 668 701 732 802 897 899 936 944 950 964 971 974 1004 1087 1088 1089 1111 1112 1113 1132 1133 1135 1215 1235 1239 1368 1388 1398 1411 1416 1417 1418 1437 1668 1696 1697 1698 1813 1817 1841 execute_begin 010616 constant entry internal dcl 1330 ref 468 719 1031 execute_do 010657 constant entry internal dcl 1347 ref 490 1040 execute_else 010730 constant entry internal dcl 1366 ref 499 1049 execute_end 011010 constant entry internal dcl 1383 ref 504 1053 execute_if 011121 constant entry internal dcl 1409 ref 592 1061 execute_then 011353 constant entry internal dcl 1435 ref 990 1076 first_token 011435 constant entry internal dcl 1452 ref 905 969 1769 1845 functionp 011622 constant entry internal dcl 1480 ref 884 1559 get_data_ptrs 011636 constant entry internal dcl 1489 ref 216 get_ready_mode 011753 constant entry internal dcl 1517 ref 841 859 get_value 014124 constant entry internal dcl 1834 ref 1807 1811 goto 002153 constant entry external dcl 378 init_xd 012117 constant entry internal dcl 1546 ref 271 387 lookup_label 012160 constant entry internal dcl 1566 ref 552 next_token 012355 constant entry internal dcl 1612 ref 930 971 1467 1818 1838 recurse_error 012514 constant entry internal dcl 1636 ref 223 reset_input 012634 constant entry internal dcl 1661 ref 401 485 set_defaults 012733 constant entry internal dcl 1679 ref 480 set_one_trace 014271 constant entry internal dcl 1852 ref 1825 1827 1829 1831 set_skip 013260 constant entry internal dcl 1721 ref 1372 1379 1446 1448 set_trace 013304 constant entry internal dcl 1734 ref 995 test_end_of_if 014406 constant entry internal dcl 1875 ref 285 1013 warning 010163 constant entry internal dcl 1265 ref 835 886 907 1526 1535 1539 1760 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 16222 16334 15361 16232 Length 17004 15361 112 433 640 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME abs_io_v2_get_line 1205 external procedure is an external procedure. begin block on line 675 102 begin block uses auto adjustable storage. allocate_block 84 internal procedure enables or reverts conditions. on unit on line 1087 84 on unit on unit on line 1088 84 on unit on unit on line 1089 84 on unit allocate_hash_table 84 internal procedure enables or reverts conditions. on unit on line 1111 84 on unit on unit on line 1112 84 on unit on unit on line 1113 84 on unit allocate_label 85 internal procedure enables or reverts conditions. on unit on line 1132 86 on unit on unit on line 1133 86 on unit on unit on line 1135 86 on unit attachedp internal procedure shares stack frame of external procedure abs_io_v2_get_line. conditional 142 internal procedure enables or reverts conditions. on unit on line 1183 64 on unit error 1214 internal procedure is called during a stack extension, and is declared options(variable). execute_begin internal procedure shares stack frame of external procedure abs_io_v2_get_line. execute_do internal procedure shares stack frame of external procedure abs_io_v2_get_line. execute_else internal procedure shares stack frame of external procedure abs_io_v2_get_line. execute_end internal procedure shares stack frame of external procedure abs_io_v2_get_line. execute_if 106 internal procedure enables or reverts conditions. on unit on line 1416 86 on unit on unit on line 1417 86 on unit on unit on line 1418 86 on unit execute_then internal procedure shares stack frame of external procedure abs_io_v2_get_line. first_token internal procedure shares stack frame of external procedure abs_io_v2_get_line. functionp internal procedure shares stack frame of external procedure abs_io_v2_get_line. get_data_ptrs internal procedure shares stack frame of external procedure abs_io_v2_get_line. get_ready_mode internal procedure shares stack frame of external procedure abs_io_v2_get_line. init_xd internal procedure shares stack frame of external procedure abs_io_v2_get_line. lookup_label internal procedure shares stack frame of external procedure abs_io_v2_get_line. next_token internal procedure shares stack frame of external procedure abs_io_v2_get_line. recurse_error internal procedure shares stack frame of external procedure abs_io_v2_get_line. reset_input internal procedure shares stack frame of external procedure abs_io_v2_get_line. set_defaults 88 internal procedure enables or reverts conditions. on unit on line 1696 84 on unit on unit on line 1697 84 on unit on unit on line 1698 84 on unit set_skip internal procedure shares stack frame of external procedure abs_io_v2_get_line. set_trace internal procedure shares stack frame of external procedure abs_io_v2_get_line. get_value internal procedure shares stack frame of external procedure abs_io_v2_get_line. set_one_trace internal procedure shares stack frame of external procedure abs_io_v2_get_line. test_end_of_if internal procedure shares stack frame of external procedure abs_io_v2_get_line. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME abs_io_v2_get_line 000100 iocb_ptr abs_io_v2_get_line 000102 buffer_ptr abs_io_v2_get_line 000104 buffer_len abs_io_v2_get_line 000105 actual_len abs_io_v2_get_line 000106 A_code abs_io_v2_get_line 000110 default_values_ptr abs_io_v2_get_line 000112 xd abs_io_v2_get_line 000353 message abs_io_v2_get_line 000425 switch_name abs_io_v2_get_line 000477 token abs_io_v2_get_line 000540 token32 abs_io_v2_get_line 000550 begin_line_sw abs_io_v2_get_line 000551 goto_entry_sw abs_io_v2_get_line 000552 nnl_sw abs_io_v2_get_line 000553 skipping_handler_sw abs_io_v2_get_line 000554 some_left_sw abs_io_v2_get_line 000556 area_ptr abs_io_v2_get_line 000560 condition_array_ptr abs_io_v2_get_line 000562 goto_name_ptr abs_io_v2_get_line 000564 handler_ptr abs_io_v2_get_line 000566 label_val_ptr abs_io_v2_get_line 000570 last_node_ptr abs_io_v2_get_line 000572 lastp abs_io_v2_get_line 000574 on_saved_if_ptr abs_io_v2_get_line 000576 p abs_io_v2_get_line 000600 saved_if_ptr abs_io_v2_get_line 000602 saved_label_ptr abs_io_v2_get_line 000604 test_ptr abs_io_v2_get_line 000606 val_ptr abs_io_v2_get_line 000610 var_ptr abs_io_v2_get_line 000612 active_string_pos abs_io_v2_get_line 000613 alloc_len abs_io_v2_get_line 000614 cond_string_len abs_io_v2_get_line 000615 goto_name_len abs_io_v2_get_line 000616 handler_len abs_io_v2_get_line 000617 handler_start abs_io_v2_get_line 000620 label_val_len abs_io_v2_get_line 000621 max_default_len abs_io_v2_get_line 000622 name_len abs_io_v2_get_line 000623 saved_goto_pos abs_io_v2_get_line 000624 saved_statement_len abs_io_v2_get_line 000625 saved_statement_pos abs_io_v2_get_line 000626 tpos abs_io_v2_get_line 000627 val_len abs_io_v2_get_line 000630 var_len abs_io_v2_get_line 000631 condition_count abs_io_v2_get_line 000632 hash abs_io_v2_get_line 000633 i abs_io_v2_get_line 000634 saved_hash abs_io_v2_get_line 000635 saved_skip_block_level abs_io_v2_get_line 000636 search_type abs_io_v2_get_line 000637 code abs_io_v2_get_line 000640 error_table_$noalloc abs_io_v2_get_line 000641 ready_mode abs_io_v2_get_line 000642 input_linep abs_io_v2_get_line 000644 block_ptr abs_io_v2_get_line 000646 abs_data_ptr abs_io_v2_get_line 000650 parsed_args_ptr abs_io_v2_get_line 000652 handler_node_ptr abs_io_v2_get_line 000654 label_ptr abs_io_v2_get_line 000656 current_label_len abs_io_v2_get_line 000660 current_label_ptr abs_io_v2_get_line 000662 ec_data_ptr abs_io_v2_get_line 000734 saved_this_action execute_end 000735 saved_next_action execute_end 000752 i first_token 000753 j first_token 000776 arg_ptr get_ready_mode 001000 arg_len get_ready_mode 001001 mode_sw get_ready_mode 001016 found_label_ptr lookup_label 001020 label_ptr lookup_label 001022 limit_pos lookup_label 001032 i next_token 001033 j next_token 001034 start_pos next_token 001044 complain recurse_error 001050 who recurse_error 001116 tracing set_trace 001134 switch_name set_trace 001144 token set_trace 001206 arg_ptr set_trace 001210 arg_len set_trace 001211 i set_trace 001212 pos set_trace 001236 saved_this_action test_end_of_if 001237 saved_next_action test_end_of_if allocate_block 000100 block_ptr allocate_block allocate_hash_table 000100 labels_ptr allocate_hash_table allocate_label 000100 label_ptr allocate_label begin block on line 675 000100 cond_string begin block on line 675 conditional 000100 active_string_len conditional 000101 temp_len conditional 000102 active_string_ptr conditional 000104 saved_ptr conditional 000106 temp_ptr conditional 000110 bars_len conditional 000111 free_sw conditional 000112 value conditional error 000100 based_ec_ptr error 000102 based_ec_len error 000103 error_pos error 000104 line_len error 000105 line_number error 000106 line_start error 000110 complain error 000114 statement_ptr error 000116 message error 002116 who error 002141 severity_sw error 002142 end_ec error 002144 status_ptr error set_defaults 000100 i set_defaults THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a r_ne_as alloc_char_temp unpk_to_pk cat_realloc_chars enter_begin_block leave_begin_block call_ent_var_desc call_ent_var call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc call_int_other return_mac tra_ext_1 alloc_auto_adj mdfx1 signal_op enable_op shorten_stack ext_entry ext_entry_desc int_entry int_entry_desc set_chars_eis index_chars_eis verify_eis op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. abs_io_control$attach abs_io_control$detach abs_io_expand_ abs_io_expand_$delete abs_io_expand_$expand_label abs_io_expand_$label_search abs_io_expand_$set abs_io_expand_$skip abs_io_list_vars active_fnc_err_ com_err_ cu_$arg_list_ptr cu_$arg_ptr cu_$evaluate_active_string cu_$set_ready_mode get_system_free_area_ ioa_ ioa_$general_rs ioa_$ioa_switch ioa_$ioa_switch_nnl ioa_$nnl iox_$find_iocb iox_$get_line iox_$look_iocb logout signal_ signal_io_error_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badsyntax error_table_$command_line_overflow error_table_$end_of_info error_table_$long_record error_table_$notalloc iox_$user_input LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 157 001324 40 001330 211 001345 214 001347 216 001350 218 001352 220 001361 221 001401 223 001413 224 001414 226 001417 229 001425 230 001433 232 001436 234 001440 235 001443 236 001444 237 001451 240 001452 241 001455 242 001457 243 001461 245 001462 246 001463 249 001464 251 001471 252 001473 253 001476 254 001500 255 001503 257 001504 258 001505 261 001512 262 001515 264 001516 266 001523 271 001535 273 001536 275 001540 276 001544 279 001546 280 001550 282 001551 283 001560 285 001564 287 001567 289 001600 290 001603 294 001606 296 001610 297 001611 301 001641 302 001646 304 001664 305 001672 306 001673 309 001700 310 001703 311 001714 313 001721 314 001735 316 001736 319 001752 321 001763 323 001770 324 001774 325 002002 327 002003 329 002017 330 002026 332 002030 334 002032 340 002053 341 002054 344 002057 346 002063 348 002066 351 002070 352 002073 353 002077 355 002101 357 002111 358 002113 360 002114 361 002115 362 002122 363 002124 364 002127 365 002132 366 002135 368 002136 369 002142 370 002144 373 002145 378 002146 382 002170 384 002172 385 002176 387 002201 388 002202 389 002205 392 002210 393 002213 395 002215 396 002232 397 002242 399 002251 401 002252 406 002253 408 002256 410 002263 412 002307 413 002314 414 002317 415 002322 418 002323 419 002325 421 002327 422 002336 424 002341 427 002366 429 002371 431 002375 433 002410 437 002424 439 002440 440 002455 443 002476 444 002506 446 002514 447 002517 448 002522 449 002567 450 002577 452 002622 453 002625 454 002630 455 002644 456 002660 457 002711 460 002712 462 002721 465 002722 468 002724 470 002725 472 002726 475 002746 480 003007 482 003016 485 003017 487 003020 490 003021 493 003022 496 003023 499 003025 501 003026 504 003027 508 003030 511 003031 513 003054 514 003060 515 003067 516 003073 517 003076 518 003106 519 003147 521 003152 524 003153 528 003154 544 003155 546 003157 548 003161 549 003176 550 003206 552 003214 555 003243 556 003247 557 003254 558 003257 563 003264 566 003273 567 003317 569 003323 570 003326 571 003333 572 003335 573 003344 574 003346 579 003356 580 003375 581 003377 582 003401 584 003403 585 003406 586 003411 587 003416 588 003420 589 003425 592 003426 595 003432 598 003433 600 003446 602 003462 603 003463 604 003465 605 003471 606 003472 609 003473 610 003512 611 003526 613 003532 614 003534 616 003536 617 003543 618 003551 619 003553 620 003554 622 003557 624 003562 625 003567 627 003574 628 003575 629 003577 633 003600 635 003612 636 003623 639 003631 644 003646 648 003647 652 003671 653 003715 656 003733 659 003734 663 003735 666 003761 668 003763 671 004007 672 004010 673 004017 674 004026 675 004030 676 004033 677 004044 678 004045 679 004056 680 004062 681 004065 682 004122 683 004125 685 004144 686 004146 687 004161 688 004167 689 004170 690 004211 691 004234 692 004237 695 004240 697 004251 698 004252 699 004266 700 004273 701 004311 703 004346 704 004351 705 004363 706 004365 707 004411 708 004414 709 004415 711 004416 712 004436 713 004437 714 004442 716 004447 717 004451 719 004454 721 004455 722 004463 724 004467 725 004471 726 004473 728 004476 730 004477 731 004513 732 004516 734 004541 735 004554 736 004557 738 004567 740 004577 741 004606 742 004613 743 004622 744 004625 746 004627 747 004632 748 004635 753 004636 754 004643 755 004651 756 004660 757 004662 758 004664 761 004665 763 004674 764 004705 765 004706 767 004711 768 004717 769 004726 770 004730 773 004732 774 004734 776 004737 778 004741 779 004746 781 004750 784 004751 786 004773 789 004774 791 005016 794 005017 796 005020 798 005034 799 005040 801 005044 802 005065 804 005111 805 005152 806 005211 809 005213 811 005215 814 005216 831 005217 835 005220 838 005242 841 005243 844 005245 845 005247 847 005262 848 005270 851 005271 852 005300 855 005301 859 005302 861 005314 864 005315 868 005316 884 005317 886 005324 891 005357 892 005372 894 005373 895 005415 897 005416 899 005441 901 005465 902 005475 903 005501 905 005504 907 005533 911 005601 914 005605 915 005610 916 005612 917 005616 919 005624 920 005634 921 005637 922 005641 925 005642 926 005643 928 005645 930 005646 932 005672 933 005674 936 005675 939 005721 941 005723 942 005726 943 005733 944 005736 947 005764 948 005775 949 006001 950 006004 952 006046 954 006051 955 006061 956 006065 957 006071 958 006073 960 006075 963 006137 964 006173 965 006211 966 006214 969 006215 971 006240 974 006335 978 006444 980 006450 981 006454 983 006465 984 006470 987 006471 990 006473 992 006474 995 006475 997 006476 1000 006477 1004 006500 1008 006520 1013 006521 1018 006526 1020 006531 1021 006536 1022 006537 1023 006541 1028 006542 1031 006543 1034 006544 1035 006546 1037 006547 1040 006550 1043 006551 1044 006553 1046 006554 1049 006556 1051 006557 1053 006560 1056 006561 1058 006562 1061 006563 1064 006567 1066 006570 1074 006571 1076 006573 1077 006574 1079 006575 1083 006576 1087 006604 1088 006643 1089 006700 1091 006735 1093 006744 1094 006750 1096 006753 1097 006755 1098 006761 1100 006762 1105 006765 1111 006773 1112 007032 1113 007067 1115 007124 1117 007155 1118 007156 1119 007157 1121 007160 1125 007164 1132 007200 1133 007246 1135 007312 1138 007356 1139 007362 1141 007364 1143 007405 1144 007406 1145 007407 1147 007410 1148 007416 1149 007421 1150 007422 1152 007424 1156 007426 1160 007430 1161 007436 1165 007445 1178 007453 1180 007460 1181 007463 1182 007475 1183 007477 1185 007522 1187 007532 1188 007535 1189 007540 1191 007544 1192 007546 1193 007550 1194 007555 1196 007556 1197 007557 1198 007561 1201 007563 1202 007600 1204 007616 1206 007626 1210 007635 1212 007651 1213 007654 1215 007655 1219 007711 1220 007713 1221 007721 1222 007726 1224 007741 1225 010001 1228 010002 1229 010043 1231 010045 1232 010047 1235 010054 1237 010077 1238 010110 1239 010120 1241 010145 1243 010151 1261 010157 1262 010161 1265 010162 1269 010170 1271 010172 1273 010173 1274 010214 1276 010272 1278 010301 1279 010304 1280 010306 1282 010330 1284 010331 1285 010333 1286 010335 1289 010337 1290 010340 1291 010345 1292 010361 1293 010362 1294 010364 1296 010367 1297 010370 1299 010374 1300 010401 1301 010406 1302 010430 1304 010431 1306 010450 1307 010456 1308 010462 1311 010467 1313 010474 1315 010503 1318 010567 1319 010572 1320 010577 1321 010607 1322 010611 1323 010612 1328 010615 1330 010616 1332 010617 1334 010625 1335 010631 1336 010635 1337 010640 1339 010643 1340 010647 1341 010651 1343 010653 1345 010656 1347 010657 1349 010660 1351 010666 1352 010672 1353 010676 1354 010701 1356 010712 1358 010715 1359 010720 1360 010722 1362 010724 1364 010727 1366 010730 1368 010731 1370 010756 1372 010761 1379 010776 1381 011007 1383 011010 1387 011011 1388 011014 1390 011040 1391 011043 1393 011045 1395 011051 1396 011054 1398 011056 1400 011102 1401 011105 1403 011114 1405 011115 1407 011117 1409 011120 1411 011126 1414 011156 1416 011162 1417 011221 1418 011256 1420 011313 1422 011323 1423 011327 1426 011331 1427 011334 1429 011336 1431 011343 1433 011352 1435 011353 1437 011354 1440 011403 1446 011406 1448 011423 1450 011434 1452 011435 1457 011446 1458 011454 1459 011470 1460 011471 1461 011474 1463 011506 1464 011523 1465 011526 1466 011533 1467 011535 1469 011566 1470 011570 1471 011573 1474 011605 1475 011607 1480 011622 1484 011624 1485 011632 1489 011636 1497 011640 1499 011645 1500 011652 1501 011657 1503 011730 1504 011736 1505 011737 1508 011740 1509 011743 1511 011745 1512 011750 1515 011752 1517 011753 1526 011755 1528 012001 1530 012003 1531 012006 1532 012011 1533 012024 1535 012036 1536 012064 1539 012066 1542 012111 1546 012117 1550 012120 1551 012123 1552 012125 1553 012127 1554 012131 1555 012134 1556 012136 1557 012142 1558 012145 1559 012150 1560 012152 1562 012154 1564 012157 1566 012160 1577 012171 1579 012204 1581 012221 1584 012234 1585 012245 1586 012246 1587 012251 1589 012252 1591 012255 1592 012257 1594 012261 1600 012300 1602 012310 1605 012332 1606 012346 1608 012351 1612 012355 1617 012366 1618 012371 1619 012376 1620 012417 1621 012420 1622 012423 1624 012435 1625 012456 1626 012457 1627 012462 1630 012475 1631 012500 1636 012514 1643 012515 1644 012521 1645 012526 1646 012550 1648 012551 1650 012570 1651 012576 1652 012602 1655 012607 1657 012633 1661 012634 1665 012635 1667 012642 1668 012657 1669 012700 1671 012702 1672 012721 1673 012730 1677 012731 1679 012732 1686 012740 1687 012746 1688 012752 1689 012756 1691 012761 1692 012762 1693 012771 1694 013002 1696 013004 1697 013043 1698 013100 1700 013135 1701 013150 1703 013162 1704 013163 1705 013164 1707 013165 1708 013175 1709 013203 1710 013206 1712 013224 1713 013240 1714 013247 1715 013252 1717 013255 1719 013257 1721 013260 1725 013262 1730 013300 1732 013303 1734 013304 1753 013305 1755 013310 1756 013312 1757 013316 1759 013320 1760 013322 1761 013342 1762 013346 1764 013347 1766 013355 1767 013361 1769 013364 1771 013413 1772 013423 1773 013433 1774 013443 1775 013453 1778 013471 1779 013503 1780 013505 1781 013507 1782 013510 1783 013522 1784 013524 1785 013526 1787 013527 1788 013534 1789 013536 1790 013540 1791 013541 1792 013546 1793 013550 1794 013552 1795 013553 1796 013565 1797 013567 1798 013571 1800 013572 1801 013577 1802 013601 1803 013603 1805 013604 1806 013611 1807 013613 1808 013630 1810 013631 1811 013643 1812 013656 1813 013677 1814 013724 1815 013726 1817 013727 1818 013753 1819 013777 1821 014001 1823 014006 1825 014013 1827 014035 1829 014057 1831 014101 1873 014123 1834 014124 1838 014135 1839 014160 1840 014165 1841 014166 1843 014225 1844 014233 1845 014236 1846 014260 1847 014261 1852 014271 1857 014302 1859 014307 1860 014312 1861 014314 1863 014330 1864 014347 1866 014353 1867 014360 1868 014366 1869 014377 1871 014405 1875 014406 1879 014407 1880 014412 1881 014414 1888 014437 1892 014445 1893 014451 1894 014455 1898 014456 1899 014457 1901 014460 1906 014463 ----------------------------------------------------------- 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