COMPILATION LISTING OF SEGMENT teco Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1743.6 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 /* format: style3,^indattr,linecom,^indnoniterdo,indnoniterend,indcomtxt,indend,indcom,dclind5,idind23 */ 12 TECO: 13 teco: 14 procedure; 15 16 goto declarations; 17 18 19 20 /**** This program was written by: 21* Richard H. Gumpertz 22* 4 Ames Street 23* Cambridge, Mass. 02142 24* 25* It is modelled after the TECO in use on the Digital Equipment Corp. PDP-10 26* which was originally written at the MIT Artificial Intelligence project. 27* 28* The syntax is as close to the PDP-10 syntax as the Multics environment will 29* allow, with the one major exception being the file I/O commands. 30* 31* 32* Dates modified and reasons: 33* 07/08/82 by G. Palter to call cu_$evaluate_active_string instead of command_processor_$af 34* 05/11/81 by C R Davis to fix bug in P command. 35* 11/30/77 by David S. Levin: fix bug in n-command. 36* 11/01/77 by David S. Levin: call command_processor_$af instead of command_processor_$return_val; 37* and to print message if too many input args to teco. 38* 07/27/77 by Larry Johnson for teco$set_prompt entry 39* 07/30/76 by RGB: to add :J, :R, :C, :F<, F<, and F; 40* 07/29/76 by RGB: to add :< (errset), :;, :"M, and :M 41* 07/26/76 by RGB: to add "M command , := command, and :(backslash) command 42* 07/26/76 by RGB: to ignore tabs between commands, to remove 7000 labels 43* 07/24/76 by RGB: to add ea, to speed up, and to cleanup 44* 06/21/76 by MJG: add P "append" request like X. 45* 03/05/76 by DSL (& RGB): add teco$macro entry point;fix bug in -s;fix temp seg usage count for em. 46* 04/23/75 by DSL: fix introduced bugs; use index and search bifs to speed scanning. 47* 02/26/75 at 1238 by DSL: 1) add N-search; 2) use internal procedures; 3) bug fixes. 48* 02/07/75 at 1622 by DSL to: 1) fix ; skip over >, 2) any length seg, 3) fast reverse searching, 4) fast \. 49* 04/21/72 at 1900 by PBB to change teco_no_ES entry to just be another entry for teco that doesn't have 50* the ES command implemented 51* 04/21/72 at 1800 by PBB to fix bug in ES command 52* 04/19/72 at 1300 by PBB to add ES command 53* 03/25/72 at 1400 by PBB to make S with two args use arg1 as a line limit for search and 54* :' to skip to the next ' - this makes :' an else command 55* 03/25/72 at 1035 by PBB to make U with no args use 34359738367. 56* 03/25/72 at 1005 by PBB to fix bugs in \ and improve error messages 57* 03/24/72 at 1355 by PBB to fix bug in T command 58* 03/23/72 at 1710 by PBB to add better error messages and prevent % from incrementing a text register 59* 03/23/72 at 1230 by PBB to add backslash command 60* 03/23/72 at 1030 by PBB to fix bug in g command when converting numeric register and to 61* implement :T command 62* 10/18/71 at 1245 by RHG to fix bug in restoring base_iteration_level in :X 63* 07/21/71 at 0016 by RHG to fix bug in EO caused by separation out of EO_X_common (7/18/71) 64* 07/18/71 at 1720 by RHG to use new get_temp_seg_ and to implement :X 65* 07/10/71 at 1704 by RHG to call get_temporary_segment_ and release_temporary_segment_ 66* to add more use of "hbound" builtin 67* 06/29/71 at 0332 by RHG to rename startup as start_up 68* 06/28/71 at 1434 by RHG to fix bug in EI//J, to allow command_buffer 100000 chars 69* to put args in _r_e_a_l Q-registers. 70* 06/28/71 at 0349 by RHG to fix bugs in EM, get_args, 0<..> 71* 06/28/71 at 0052 by RHG to add EM, optimization of EI/name/J, startup EM, 72* to allow quoted string in Q-register 73* to move scratch_segment out to a temp seg 74* to allow "%" to work on Q-register containing text 75* 06/08/71 at 0145 by RHG to fix bugs in U, ?, and : 76* 06/07/71 at 2335 by RHG to handle pl1_bug about char(262144) 77* to allow commands within parentheses 78* to implement get_character_fail_handler 79* to allow U to take multiple arguments 80* 02/18/71 at 1644 by RHG to fix the last fix to % 81* 02/18/71 at 1459 by RHG to implement :VW and let U take 0 args 82* 02/18/71 at 1429 by RHG to neaten file_errors 83* 02/18/71 at 1408 by RHG to fix bug in question_mark 84* 02/16/71 at 1326 by RHG to fix bug in % 85* to use fixed_to_char_offset 86* to use trace off during skip 87* to call com_err_ on file errors 88* 02/02/71 at 1325 by RHG to fix potential bug in O which unwinds 89* 02/02/71 at 0337 by RHG to use the variable "max_Q_register_length" in :I 90* to fix a bug in "revert_command_level" 91* 02/02/71 at 0214 by RHG to allow O to unwind command level 92* to make M at end of one macro do a "goto" not a "call" 93* to fix a bug in M with no args 94* 01/31/71 at 0510 by RHG to fix bug in get_character if only nl is typed 95* 01/31/71 at 0230 by RHG to fix bug in :S and rename TED as TECO 96* 01/25/72 at 1525 by RHG to fix bug in M 97* 01/24/71 at 2305 by RHG to add the M, [, and ] commands 98* 01/23/71 at 0300 by RHG to add the G, :I, X, VW, and ? commands 99* earlier changes by RHG went unrecorded. 100*****/ 101 102 /* condition names */ 103 104 declare (cleanup, fixedoverflow, program_interrupt, teco_abort) condition; 105 106 /* builtin functions */ 107 108 declare (addr, bit, convert, copy, divide, fixed, hbound, index, lbound, length, max, min, multiply, null, reverse, 109 search, substr, unspec, verify) builtin; 110 111 /* automatic variables */ 112 113 declare EO_X_common_return label variable; 114 declare get_character_fail_handler label variable; 115 declare (arg_address, b1, b2, command_line_address, file_address, io_char_address, p) pointer; 116 declare 1 error_structure aligned, 117 2 error_message char (8), 118 2 nl char (1); 119 declare cvb picture "(11)-9"; 120 declare string char (12); 121 declare (backup_flag, immediate_interrupt_ok, no_ES_flag, no_number, match, program_interrupt_flag, search_successful, 122 trace_flag, trace_flag_copy) bit (1) aligned; 123 declare my_id bit (36) aligned; 124 declare (current_character, delimiter, io_char) char (1) aligned; 125 declare search_chars char (2) aligned; 126 declare (Q_register_pushdown_level, arg_length, command_level) fixed bin (17); 127 declare arg1_stack (0:20) fixed bin (17); 128 declare colon_stack (0:20) fixed bin (17); 129 declare command_char_stack (0:20) fixed bin (17); 130 declare command_iteration_stack (0:20) fixed bin (17); 131 declare command_length_stack (0:20) fixed bin (17); 132 declare command_seg_stack (0:20) fixed bin (17); 133 declare macro_entry fixed bin (17); 134 declare num_arg_stack (0:20) fixed bin (17); 135 declare pushdown_Q_register_seg_number (1:20) fixed bin (17); 136 declare pushdown_Q_register_value (1:20) fixed bin (17); 137 declare arg (0:2) fixed bin (24); 138 declare (backup_command_line_1_char, base_iteration_level, colon_X_save_command_level, colon_flag, tag_char_number, 139 command_char_number, command_line_length, count, current_Q_register_number, current_expression, current_sign, 140 dot1, dot2, end_buffer, i, iteration_level, return_iteration_level, j, max_seg_size, max_dot1, min_dot2, n1, n2, 141 num_arg, number, octal_number, paren_level, start, read_count, search_answer, iteration_answer, search_length, 142 skip_count, temp_dot, which_operator) fixed bin (24); 143 declare expression_stack (1:20) fixed bin (24); 144 declare operator_stack (1:20) fixed bin (24); 145 declare sign_stack (1:20) fixed bin (24); 146 declare error_code fixed bin (35); 147 declare 1 iteration (1:20) aligned, 148 2 begin fixed bin (24), 149 2 end fixed bin (24), 150 2 count fixed bin (24), 151 2 begin_tag fixed bin (24), 152 2 errset bit (1); 153 declare 1 temp_seg_info structure aligned, 154 2 Q_register_value (32:127) fixed bin (24), 155 2 Q_register_seg_number (32:127) fixed bin (17), 156 2 temp_seg_address (-100:100) pointer, 157 2 temp_seg_usage_count (-100:100) fixed bin (17); 158 159 /* based variables */ 160 161 declare argument based (arg_address) char (arg_length); 162 declare current_Q_register based (current_Q_register_address) aligned char (current_Q_register_value); 163 declare file based (file_address) aligned char (count); 164 declare quoted_string based (quoted_string_address) aligned char (quoted_string_length); 165 declare buffer1 based (b1) aligned char (dot1); 166 declare buffer2 based (b2) aligned char (end_buffer); 167 declare command_line based (command_line_address) aligned char (command_line_length); 168 169 /* external entries */ 170 171 declare assign_temp_seg_id_ entry (char (*) aligned, bit (36) aligned, fixed bin (35)); 172 declare com_err_ entry options (variable); 173 declare cu_$arg_count entry () returns (fixed bin (17)); 174 declare cu_$arg_ptr entry (fixed bin (17), pointer, fixed bin (17), fixed bin (35)); 175 declare cu_$cp entry (pointer, fixed bin (24), fixed bin (35)); 176 declare cu_$ptr_call entry options (variable); 177 declare cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed binary (24)); 178 declare find_command_$fc_no_message entry (pointer, fixed bin (24), pointer, fixed bin (35)); 179 declare get_seg_ptr_ entry (char (*) aligned, bit (6) aligned, fixed bin (24), pointer, fixed bin (35)); 180 declare get_temp_seg_ entry (bit (36) aligned, bit (5) aligned, pointer, fixed bin (35)); 181 declare ( 182 ioa_, 183 ioa_$rsnnl 184 ) entry options (variable); 185 declare iox_$get_chars entry (pointer, pointer, fixed bin (24), fixed bin (24), fixed bin (35)); 186 declare iox_$get_line entry (pointer, pointer, fixed bin (24), fixed bin (24), fixed bin (35)); 187 declare iox_$put_chars entry (pointer, pointer, fixed bin (24), fixed bin (35)); 188 declare release_seg_ptr_ entry (pointer, fixed bin (17), fixed bin (35)); 189 declare release_temp_segs_all_ entry (bit (36) aligned, fixed bin (35)); 190 declare search_file_ 191 entry (pointer, fixed bin (24), fixed bin (24), pointer, fixed bin (24), fixed bin (24), fixed bin (24), 192 fixed bin (24), fixed bin (24)); 193 declare teco_backup_file_ entry (char (*) aligned); 194 declare teco_error entry (char (*) aligned); 195 declare teco_get_macro_ entry (char (*) aligned, pointer, fixed bin (24), fixed bin (35)); 196 197 /* defined variables */ 198 199 declare current_Q_register_seg_number fixed bin (17) defined (Q_register_seg_number (current_Q_register_number)); 200 declare current_Q_register_value fixed bin (24) defined (Q_register_value (current_Q_register_number)); 201 declare current_Q_register_address pointer defined (temp_seg_address (current_Q_register_seg_number)); 202 declare current_Q_register_usage_count fixed bin (17) defined (temp_seg_usage_count (current_Q_register_seg_number)); 203 declare quoted_string_seg_number fixed bin (17) defined (Q_register_seg_number (34)); 204 declare quoted_string_length fixed bin (24) defined (Q_register_value (34)); 205 declare quoted_string_address pointer defined (temp_seg_address (Q_register_seg_number (34))); 206 declare arg1 defined (arg (1)) fixed bin (24); 207 declare arg2 defined (arg (2)) fixed bin (24); 208 209 /* external static */ 210 211 declare error_table_$too_many_args fixed bin (35) ext static; 212 declare sys_info$max_seg_size external static fixed bin (24); 213 declare iox_$user_input external static pointer; 214 declare iox_$user_output external static pointer; 215 216 /* constants */ 217 218 declare new_line_char int static options (constant) char (1) aligned initial (" 219 "); 220 declare blanks int static options (constant) char (12) aligned initial (""); 221 declare white_space int static options (constant) char (2) aligned initial (" "); 222 /* space & tab */ 223 declare start_up_name int static options (constant) char (8) aligned initial ("start_up"); 224 declare char_0_code int static options (constant) fixed bin (09) initial (000110000b); 225 declare dummy_Q_register_number int static options (constant) fixed bin (17) initial (127); 226 declare number_reserved_temp_segs int static options (constant) fixed bin (17) initial (2); 227 declare quoted_string_Q_register_number int static options (constant) fixed bin (17) initial (34); 228 declare radix int static options (constant) fixed bin (17) initial (10); 229 declare max_positive_integer int static options (constant) fixed bin (35) 230 initial (11111111111111111111111111111111111b); 231 declare rwa_access int static options (constant) bit (5) aligned initial ("01011"b); 232 declare r_access int static options (constant) bit (6) aligned initial ("010000"b); 233 declare rwac_access int static options (constant) bit (6) aligned initial ("010111"b); 234 declare program_name int static options (constant) char (4) aligned initial ("teco"); 235 236 /* internal static */ 237 238 declare signature_length int static fixed bin (24) init (3); 239 declare signature int static char (8) aligned initial ("NZ"); 240 declare error_mode int static char (4) aligned initial ("shor"); 241 1 1 /* BEGIN INCLUDE FILE ... cp_active_string_types.incl.pl1 */ 1 2 /* Created: 5 May 1980 by G. Palter */ 1 3 1 4 /* Types of active strings recognized by active string evaluation entries of the Multics command processor */ 1 5 1 6 dcl (DEFAULT_ACTIVE_STRING initial (0), /* default type: same as NORMAL_ACTIVE_STRING */ 1 7 NORMAL_ACTIVE_STRING initial (1), /* normal active string: [...] */ 1 8 TOKENS_ONLY_ACTIVE_STRING initial (2), /* rescan active string for whitespace and quotes: |[...] */ 1 9 ATOMIC_ACTIVE_STRING initial (3)) /* do not rescan anything in value: ||[...] */ 1 10 fixed binary static options (constant); 1 11 1 12 /* END INCLUDE FILE ... cp_active_string_types.incl.pl1 */ 242 243 244 teco_error_mode: 245 entry (new_error_mode); 246 dcl new_error_mode char (*) unal; 247 error_mode = new_error_mode; 248 return; 249 250 /* entry to set the prompt string */ 251 252 set_prompt: 253 entry; 254 255 call cu_$arg_ptr (1, arg_address, arg_length, error_code); 256 if error_code = 0 257 then do; 258 signature = argument; 259 signature_length = min (length (argument), length (signature)); 260 end; 261 else do; 262 signature = "NZ"; 263 signature_length = 3; 264 end; 265 return; 266 267 teco_no_ES: 268 entry; 269 no_ES_flag = "1"b; 270 macro_entry = 0; 271 goto no_ES_declarations; 272 273 abort: 274 ABORT: 275 entry; 276 signal teco_abort; 277 278 macro: 279 entry; 280 no_ES_flag = "0"b; 281 macro_entry = 1; 282 goto no_ES_declarations; 283 284 declarations: 285 no_ES_flag = "0"b; 286 macro_entry = 0; 287 288 no_ES_declarations: 289 command_level = 0; 290 Q_register_pushdown_level = 0; 291 io_char_address = addr (io_char); 292 error_structure.nl = new_line_char; 293 unspec (temp_seg_info) = ""b; 294 temp_seg_address (*) = null; /* If this is removed, the marked line */ 295 /* in "allocate_Q_register" must be changed. */ 296 max_seg_size = sys_info$max_seg_size * 4; 297 read_count = cu_$arg_count (); 298 299 /* If number of args exceeds size of pushdown stack, this invokation of teco is aborted. */ 300 301 if read_count - macro_entry > hbound (pushdown_Q_register_value, 1) - 1 302 then do; 303 call com_err_ (error_table_$too_many_args, program_name, "Maximum number of arguments is ^d.", 304 hbound (pushdown_Q_register_value, 1) - 1); 305 return; 306 end; 307 308 call assign_temp_seg_id_ (program_name, my_id, error_code); 309 if error_code ^= 0 310 then do; 311 call com_err_ (error_code, program_name, "temporary_segment_id"); 312 return; 313 end; 314 on cleanup call release_bufs; 315 do i = 0 to number_reserved_temp_segs + (read_count - macro_entry) + 1; 316 call get_temp_seg_ (my_id, rwa_access, p, error_code); 317 if error_code ^= 0 318 then do; 319 call com_err_ (error_code, program_name, "temporary segment number ^d", (i)); 320 goto EQ; 321 end; 322 temp_seg_address (i) = p; 323 end; 324 command_line_address = temp_seg_address (0); 325 Q_register_pushdown_level = (read_count - macro_entry) + 1; 326 pushdown_Q_register_seg_number (Q_register_pushdown_level) = 0; 327 pushdown_Q_register_value (Q_register_pushdown_level) = (read_count - macro_entry); 328 do i = 1 to read_count - macro_entry; 329 call cu_$arg_ptr (read_count - i + 1, arg_address, arg_length, error_code); 330 temp_seg_address (i + 3) -> argument = arg_address -> argument; 331 temp_seg_usage_count (i + 3) = 1; 332 pushdown_Q_register_value (i) = arg_length; 333 pushdown_Q_register_seg_number (i) = i + 3; 334 end; 335 command_seg_stack (0) = -1; 336 temp_seg_usage_count (-1) = 1; 337 temp_seg_address (-1) = command_line_address; 338 quoted_string_seg_number = 3; 339 temp_seg_usage_count (3) = 1; 340 n1, n2 = 0; 341 b1 = null; 342 dot1, dot2, end_buffer = 0; 343 max_dot1, min_dot2 = 0; 344 base_iteration_level = 0; 345 paren_level = 0; 346 trace_flag, trace_flag_copy = "0"b; 347 command_char_number, command_line_length, backup_command_line_1_char = 0; 348 search_answer = 0; 349 iteration_level = 0; 350 immediate_interrupt_ok = "1"b; 351 num_arg = 0; 352 colon_flag = 0; 353 which_operator = -1; 354 program_interrupt_flag = "0"b; 355 on program_interrupt 356 begin; 357 if immediate_interrupt_ok 358 then goto command_abort; 359 else program_interrupt_flag = "1"b; 360 end; 361 on teco_abort goto command_abort; 362 current_Q_register_number = quoted_string_Q_register_number; 363 /* determine initial macro. */ 364 if macro_entry = 0 /* Use default. */ 365 then do; 366 quoted_string_length = length (start_up_name); 367 quoted_string = start_up_name; 368 end; 369 else do; 370 call cu_$arg_ptr (1, arg_address, arg_length, error_code); 371 if error_code ^= 0 372 then do; 373 call com_err_ (error_code, program_name); 374 goto EQ; 375 end; 376 quoted_string_length = arg_length; 377 quoted_string = arg_address -> argument; 378 end; 379 goto EM_have_name; 380 381 command_abort: 382 program_interrupt_flag = "0"b; 383 immediate_interrupt_ok = "0"b; 384 do while (command_level > 0); /* Handle each command level separately. */ 385 call unwind_command_level; 386 end; 387 base_iteration_level, iteration_level = 0; 388 paren_level = 0; 389 command_line_length, backup_command_line_1_char = 0; 390 if macro_entry ^= 0 /* Error while in macro mode is fatal. */ 391 then do; 392 call com_err_ (0, program_name, "Command aborted."); 393 goto EQ; 394 end; 395 trace_flag = trace_flag_copy; 396 command_complete: 397 COMMAND (36): 398 COMMAND (10): /* NEWLINE and $ - Do Nothing */ 399 num_arg = 0; 400 command_return_value: 401 colon_flag = 0; 402 if num_arg = 0 403 then 404 new_arg: 405 which_operator = -1; 406 else 407 arg_loop: 408 which_operator = 0; 409 M_return: 410 if program_interrupt_flag 411 then goto command_abort; 412 immediate_interrupt_ok = "1"b; 413 get_character_fail_handler = command_string_completed; 414 get_number: /* computes number, current_sign, no_number */ 415 current_sign = 0; 416 number = 0; 417 no_number = "0"b; 418 COMMAND_PREFIX (1): 419 COMMAND_PREFIX (24): /* Blank and Tab - ignored between commands */ 420 continue_scan: 421 call get_character; 422 goto COMMAND_PREFIX (index (" (:?0123456789-.zZqQ%bB ", current_character)); 423 424 COMMAND_PREFIX (0): /* Not a Numeric Argument */ 425 if current_sign = 0 426 then if which_operator < 0 427 then goto check_command; 428 else if which_operator = 0 429 then goto check_operator; 430 number = 1; 431 no_number = "1"b; 432 backup_com_line: 433 backup_command_line_1_char = 1; 434 435 436 got_number: 437 COMMAND_PREFIX (22): 438 COMMAND_PREFIX (23): /* B - Note: value all set */ 439 if current_sign < 0 440 then number = -number; 441 goto OPERATOR (which_operator); 442 443 command_string_completed: 444 if iteration_level ^= 0 445 then goto unfinished_iteration; 446 if paren_level ^= 0 447 then goto unbalanced_parentheses; 448 macro_entry = 0; /* If we reach teco cmd level, macro mode is ended. */ 449 450 if signature_length > 0 451 then call WRITE (addr (signature), 0, signature_length); 452 do while (Q_register_pushdown_level ^= 0); 453 Q_register_pushdown_level = Q_register_pushdown_level - 1; 454 temp_seg_usage_count (pushdown_Q_register_seg_number (Q_register_pushdown_level + 1)) = 455 temp_seg_usage_count (pushdown_Q_register_seg_number (Q_register_pushdown_level + 1)) - 1; 456 end; 457 command_line_length = 0; 458 command_char_number = 0; 459 search_answer = 0; 460 call read_line; 461 go to command_complete; 462 463 COMMAND_PREFIX (15): 464 if which_operator = 0 465 then goto COMMAND_PREFIX (0); /* unary minus */ 466 current_sign = -current_sign; 467 if current_sign = 0 468 then current_sign = -1; 469 goto continue_scan; 470 471 472 COMMAND (43): /* Leading Plus */ 473 current_sign = 1; 474 goto continue_scan; 475 476 477 COMMAND_PREFIX (5): 478 COMMAND_PREFIX (6): 479 COMMAND_PREFIX (7): 480 COMMAND_PREFIX (8): 481 COMMAND_PREFIX (9): 482 COMMAND_PREFIX (10): 483 COMMAND_PREFIX (11): 484 COMMAND_PREFIX (12): 485 COMMAND_PREFIX (13): 486 COMMAND_PREFIX (14): /* 0,1,2,3,4,5,6,7,8,9 */ 487 octal_number = 0; 488 do i = fixed (unspec (io_char), 9, 0) - char_0_code repeat (fixed (unspec (io_char), 9, 0) - char_0_code) 489 while (i >= 0 & i < radix); 490 number = multiply (number, radix, 15, 0) + i; 491 octal_number = octal_number * 8 + i; 492 call get_character; 493 end; 494 if current_character ^= "." 495 then goto backup_com_line; 496 number = octal_number; 497 goto got_number; 498 499 500 COMMAND_PREFIX (16): /* . - Get Dot Value */ 501 number = dot1; 502 goto got_number; 503 504 505 COMMAND_PREFIX (17): 506 COMMAND_PREFIX (18): /* Z - End Value */ 507 number = dot1 + end_buffer - dot2; 508 goto got_number; 509 510 511 COMMAND_PREFIX (19): 512 COMMAND_PREFIX (20): /* Q - Q Register value */ 513 current_Q_register_number = get_Q_register_number (); 514 number = current_Q_register_value; 515 goto got_number; 516 517 518 COMMAND_PREFIX (21): /* % - Increment Command */ 519 current_Q_register_number = get_Q_register_number (); 520 if current_Q_register_seg_number ^= 0 521 then goto percent_cant_increment; 522 current_Q_register_value, number = current_Q_register_value + 1; 523 goto got_number; 524 525 526 COMMAND_PREFIX (3): /* : - Command Modifier */ 527 colon_flag = 1; 528 goto continue_scan; 529 530 COMMAND_PREFIX (4): /* ? - Trace */ 531 trace_flag = "1"b; 532 get_character_fail_handler = question_mark_alone; 533 call get_character; 534 if current_character = "?" 535 then trace_flag = "0"b; 536 else backup_command_line_1_char = 1; 537 question_mark_alone: 538 trace_flag_copy = trace_flag; 539 get_character_fail_handler = command_string_completed; 540 goto continue_scan; 541 542 OPERATOR (-1): 543 which_operator = 0; 544 two_commas: 545 if num_arg >= hbound (arg, 1) 546 then goto too_many_args; 547 num_arg = num_arg + 1; 548 current_expression = number; 549 goto arg_loop; 550 OPERATOR (0): 551 OPERATOR (1): 552 current_expression = current_expression + number; 553 goto arg_loop; 554 555 556 OPERATOR (2): 557 current_expression = current_expression - number; 558 goto arg_loop; 559 560 561 OPERATOR (3): 562 if no_number 563 then goto missing_right_operand; 564 current_expression = current_expression * number; 565 goto arg_loop; 566 567 568 OPERATOR (4): 569 if no_number 570 then goto missing_right_operand; 571 current_expression = divide (current_expression, number, 15, 0); 572 goto arg_loop; 573 574 575 OPERATOR (5): 576 if no_number 577 then goto missing_right_operand; 578 unspec (current_expression) = unspec (current_expression) & unspec (number); 579 goto arg_loop; 580 581 582 OPERATOR (6): 583 if no_number 584 then goto missing_right_operand; 585 unspec (current_expression) = unspec (current_expression) | unspec (number); 586 goto arg_loop; 587 588 COMMAND_PREFIX (2): /* ( */ 589 if paren_level >= hbound (expression_stack, 1) 590 then goto parenthesis_overflow; 591 operator_stack (paren_level + 1) = which_operator; 592 sign_stack (paren_level + 1) = current_sign; 593 expression_stack (paren_level + 1) = current_expression; 594 num_arg_stack (paren_level + 1) = num_arg; 595 colon_stack (paren_level + 1) = colon_flag; 596 arg1_stack (paren_level + 1) = arg1; /* we don't have to save arg2 because max 2 args anyways */ 597 paren_level = paren_level + 1; 598 goto command_complete; 599 600 601 COMMAND (41): /* ) */ 602 if paren_level = 0 603 then goto unbalanced_parentheses; 604 if num_arg >= 2 605 then goto strange_parentheses; 606 paren_level = paren_level - 1; 607 number = arg1; 608 which_operator = operator_stack (paren_level + 1); 609 current_sign = sign_stack (paren_level + 1); 610 current_expression = expression_stack (paren_level + 1); 611 arg1 = arg1_stack (paren_level + 1); 612 colon_flag = colon_stack (paren_level + 1); 613 i = num_arg; 614 num_arg = num_arg_stack (paren_level + 1); 615 if i = 0 616 then goto get_number; 617 goto got_number; 618 619 620 check_operator: /* OPERATOR DISPATCH */ 621 which_operator = index ("+-*/&|", current_character); 622 if which_operator ^= 0 623 then goto get_number; 624 625 check_command: /* COMMAND DISPATCH */ 626 arg (num_arg) = current_expression; 627 goto COMMAND (fixed (unspec (current_character) & "001111111"b, 9)); 628 629 630 COMMAND (44): /* , - Next Argument Separator */ 631 if which_operator >= 0 632 then goto new_arg; 633 number = 0; 634 goto two_commas; 635 636 637 COMMAND (61): /* = - Print Value Command */ 638 if colon_flag = 1 639 then call ioa_ ("^v(^o^x^)", num_arg, arg1, arg2); 640 else call ioa_ ("^v(^d^x^)", num_arg, arg1, arg2); 641 goto command_complete; 642 643 COMMAND (60): /* < - Open Iteration */ 644 tag_char_number = 0; 645 iteration_common: 646 if num_arg >= 2 647 then goto too_many_args; 648 if num_arg = 0 649 then arg1 = max_positive_integer; 650 if arg1 < 0 651 then goto bad_negative_argument; 652 if iteration_level >= hbound (iteration.count, 1) 653 then goto iteration_overflow; 654 iteration.errset (iteration_level + 1) = (colon_flag ^= 0); 655 iteration.begin_tag (iteration_level + 1) = tag_char_number; 656 if arg1 = 0 657 then do; 658 call skip ("<>"); 659 goto iteration_done; 660 end; 661 iteration_level = iteration_level + 1; 662 iteration.begin (iteration_level) = command_char_number; 663 iteration.end (iteration_level) = -1; 664 iteration.count (iteration_level) = arg1; 665 goto command_complete; 666 667 668 669 COMMAND (62): /* > - End Iteration */ 670 if num_arg ^= 0 671 then goto too_many_args; 672 if iteration_level = base_iteration_level 673 then goto iteration_underflow; 674 iteration.count (iteration_level) = iteration.count (iteration_level) - 1; 675 if iteration.count (iteration_level) ^= 0 676 then do; 677 iteration.end (iteration_level) = command_char_number; 678 command_char_number = iteration.begin (iteration_level); 679 goto command_complete; 680 end; 681 iteration_level = iteration_level - 1; 682 iteration_done: 683 iteration_answer = -1; /* succeed */ 684 get_out_of_iteration: 685 if iteration.errset (iteration_level + 1) | iteration.begin_tag (iteration_level + 1) ^= 0 686 then do; 687 num_arg = 1; 688 current_expression = iteration_answer; 689 goto command_return_value; 690 end; 691 else goto command_complete; 692 693 694 COMMAND (59): /* ; - Return if Positive */ 695 if num_arg >= 2 696 then goto too_many_args; 697 if iteration_level = 0 698 then goto semi_colon_out_of_iteration; 699 if num_arg = 0 700 then arg1 = search_answer; 701 if colon_flag = 0 702 then if arg1 < 0 703 then goto command_complete; 704 else ; 705 else if arg1 >= 0 706 then goto command_complete; 707 call unwind_iteration (iteration_level - 1); 708 goto iteration_done; 709 710 COMMAND (34): /* " - Quote Command Dispatch */ 711 if num_arg >= 3 712 then goto too_many_args; 713 if num_arg = 1 714 then arg2 = 0; 715 get_character_fail_handler = missing_double_quote_command; 716 call get_character; 717 goto QUOTE_COMMAND (index ("cCeEgGlLnNmM", current_character)); 718 719 720 QUOTE_COMMAND (1): 721 QUOTE_COMMAND (2): /* "C */ 722 if num_arg = 0 723 then goto too_few_args; 724 if num_arg = 2 725 then goto too_many_args; 726 unspec (io_char) = bit (fixed (arg1, 9, 0)); 727 if io_char >= "a" 728 then if io_char <= "z" 729 then goto command_complete; 730 if io_char >= "A" 731 then if io_char <= "Z" 732 then goto command_complete; 733 if io_char >= "0" 734 then if io_char <= "9" 735 then goto command_complete; 736 if io_char = "_" 737 then goto command_complete; 738 if io_char = "$" 739 then goto command_complete; 740 if io_char = "." 741 then goto command_complete; 742 goto quote_skip; 743 744 QUOTE_COMMAND (3): 745 QUOTE_COMMAND (4): /* "E Equal Command */ 746 if num_arg = 0 747 then goto too_few_args; 748 if arg1 = arg2 749 then goto command_complete; 750 else goto quote_skip; 751 752 QUOTE_COMMAND (5): 753 QUOTE_COMMAND (6): /* "G - Greater Than Command */ 754 if num_arg = 0 755 then goto too_few_args; 756 if arg1 > arg2 757 then goto command_complete; 758 else goto quote_skip; 759 760 QUOTE_COMMAND (7): 761 QUOTE_COMMAND (8): /* "L - Less Than Command */ 762 if num_arg = 0 763 then goto too_few_args; 764 if arg1 < arg2 765 then goto command_complete; 766 else goto quote_skip; 767 768 QUOTE_COMMAND (9): 769 QUOTE_COMMAND (10): /* "N - Not Equal Command */ 770 if num_arg = 0 771 then goto too_few_args; 772 if arg1 ^= arg2 773 then goto command_complete; 774 else goto quote_skip; 775 776 777 QUOTE_COMMAND (11): 778 QUOTE_COMMAND (12): /* "M - Match String Command */ 779 if num_arg ^= 0 780 then goto too_many_args; 781 call get_quoted_string; 782 if end_buffer - dot2 < quoted_string_length 783 then match = "0"b; 784 else match = quoted_string = substr (buffer2, dot2 + 1, quoted_string_length); 785 if colon_flag ^= 0 786 then match = ^match; 787 if match 788 then goto command_complete; 789 else goto quote_skip; 790 791 792 793 quote_skip: 794 call skip ("""'"); 795 goto command_complete; 796 797 798 COMMAND (39): /* ' - Apostrophe */ 799 if colon_flag = 1 800 then goto quote_skip; /* a :' forms an else statement */ 801 goto command_complete; /* Ignore any apostrophes we are just passing by. */ 802 803 804 COMMAND (33): /* ! - Label Delimiter */ 805 call skip_with_trace ("!!"); 806 goto command_complete; 807 808 809 COMMAND (91): /* [ - Push */ 810 if Q_register_pushdown_level >= hbound (pushdown_Q_register_value, 1) 811 then goto Q_register_pushdown_overflow; 812 current_Q_register_number = get_Q_register_number (); 813 pushdown_Q_register_value (Q_register_pushdown_level + 1) = current_Q_register_value; 814 pushdown_Q_register_seg_number (Q_register_pushdown_level + 1) = current_Q_register_seg_number; 815 immediate_interrupt_ok = "0"b; 816 if current_Q_register_seg_number ^= 0 817 then current_Q_register_usage_count = current_Q_register_usage_count + 1; 818 Q_register_pushdown_level = Q_register_pushdown_level + 1; 819 goto command_complete; 820 821 822 COMMAND (93): /* ] - Pop */ 823 if Q_register_pushdown_level = 0 824 then goto Q_register_pushdown_underflow; 825 current_Q_register_number = get_Q_register_number (); 826 i = current_Q_register_seg_number; 827 immediate_interrupt_ok = "0"b; 828 Q_register_pushdown_level = Q_register_pushdown_level - 1; 829 current_Q_register_value = pushdown_Q_register_value (Q_register_pushdown_level + 1); 830 current_Q_register_seg_number = pushdown_Q_register_seg_number (Q_register_pushdown_level + 1); 831 if i ^= 0 832 then temp_seg_usage_count (i) = temp_seg_usage_count (i) - 1; 833 goto command_complete; 834 835 COMMAND (65): 836 COMMAND (97): /* A - Ascii Command */ 837 if num_arg >= 2 838 then goto too_many_args; 839 if num_arg = 0 840 then goto unimplemented_feature; 841 if arg1 > 0 842 then do; 843 i = dot2 + arg1 - 1; 844 if i >= end_buffer 845 then goto A_1_arg_beyond_Z; 846 io_char = substr (buffer2, i + 1, 1); 847 end; 848 else do; 849 i = dot1 + arg1 - 1; 850 if i < 0 851 then goto A_1_arg_before_0; 852 io_char = substr (buffer1, i + 1, 1); 853 end; 854 current_expression = fixed (unspec (io_char), 9, 0); 855 num_arg = 1; 856 goto command_return_value; 857 858 859 COMMAND (67): 860 COMMAND (99): /* C - Characters Forward Command */ 861 if num_arg = 0 862 then arg1 = 1; 863 C_check: 864 if num_arg > 1 865 then goto too_many_args; 866 call move_dot (arg1, (colon_flag ^= 0)); 867 goto command_complete; 868 869 870 COMMAND (68): 871 COMMAND (100): 872 if num_arg = 0 873 then arg1 = 1; /* D - Delete */ 874 if num_arg >= 2 875 then goto too_many_args; 876 call delete_chars (min (dot1, dot1 + arg1), max (dot2, dot2 + arg1)); 877 goto command_complete; 878 879 COMMAND (69): 880 COMMAND (101): /* E command dispach */ 881 get_character_fail_handler = EXTERNAL_COMMAND (0); 882 call get_character; 883 goto EXTERNAL_COMMAND (index ("oOiImMcCaAsSbBgGqQ", current_character)); 884 885 886 EXTERNAL_COMMAND (9): 887 EXTERNAL_COMMAND (10): /* EA - External Active Function */ 888 dcl ret_string char (10000) varying based (current_Q_register_address), 889 cu_$evaluate_active_string entry (ptr, char (*), fixed bin, char (*) var, fixed bin (35)); 890 891 current_Q_register_number = get_Q_register_number (); 892 call get_quoted_string; 893 call allocate_Q_register_have_number (current_Q_register_number); 894 895 ret_string = ""; 896 begin; 897 dcl quoted_string_unal char (quoted_string_length) based (quoted_string_address); 898 call cu_$evaluate_active_string (null (), quoted_string_unal, NORMAL_ACTIVE_STRING, ret_string, error_code) 899 ; 900 end; 901 if error_code ^= 0 902 then do; 903 call com_err_ (error_code, program_name, """^a""", quoted_string); 904 goto command_abort; 905 end; 906 907 current_Q_register_value = length (ret_string); 908 909 current_Q_register = copy (ret_string, 1); 910 goto command_complete; 911 912 913 EXTERNAL_COMMAND (13): 914 EXTERNAL_COMMAND (14): /* EB - External Backup */ 915 backup_flag = "1"b; 916 goto EO_EB_common; 917 918 919 EXTERNAL_COMMAND (7): 920 EXTERNAL_COMMAND (8): /* EC - External Command */ 921 call get_quoted_string; 922 call cu_$cp (quoted_string_address, quoted_string_length, error_code); 923 goto command_complete; 924 925 EXTERNAL_COMMAND (15): 926 EXTERNAL_COMMAND (16): /* EG - ??? */ 927 goto unimplemented_feature; 928 929 EXTERNAL_COMMAND (3): 930 EXTERNAL_COMMAND (4): /* EI - External Input */ 931 if num_arg ^= 0 932 then goto too_many_args; 933 num_arg = colon_flag; /* indicate if returning a value */ 934 call get_quoted_string; 935 call get_seg_ptr_ (quoted_string, r_access, read_count, file_address, error_code); 936 if error_code ^= 0 937 then if colon_flag = 1 938 then do; 939 current_expression = 0; /* fail */ 940 goto command_return_value; 941 end; 942 else goto file_error; 943 count = divide (read_count + 8, 9, 17, 0); 944 945 if dot1 + end_buffer - dot2 > 0 /* Text in buffer, cannot use source seg. */ 946 then do; 947 call add_chars (file_address, count); 948 call close_file (file_address); 949 end; 950 else do; /* Buffer is empty, don't copy, use source seg. */ 951 immediate_interrupt_ok = "0"b; 952 b1, b2 = file_address; 953 n1, n2 = 0; 954 dot1, dot2, end_buffer, max_dot1 = count; 955 min_dot2 = 0; 956 end; 957 if colon_flag = 1 958 then do; 959 current_expression = -1; /* good */ 960 goto command_return_value; 961 end; 962 else goto command_complete; 963 964 965 EXTERNAL_COMMAND (5): 966 EXTERNAL_COMMAND (6): /* EM - External Macro */ 967 call get_quoted_string; 968 EM_have_name: 969 call teco_get_macro_ (quoted_string, file_address, read_count, error_code); 970 if error_code ^= 0 971 then goto EM_macro_not_found; 972 j = 0; 973 do i = -1 to lbound (temp_seg_address, 1) by -1; 974 if temp_seg_address (i) = file_address 975 then goto EM_have_slot; 976 977 if j = 0 978 then if temp_seg_usage_count (i) = 0 979 then j = i; 980 end; 981 if j = 0 982 then goto EM_no_slot; 983 i = j; 984 985 EM_have_slot: 986 temp_seg_address (i) = file_address; 987 current_Q_register_number = dummy_Q_register_number; 988 Q_register_value (dummy_Q_register_number) = read_count; 989 Q_register_seg_number (dummy_Q_register_number) = i; 990 goto M_have_reg; 991 992 EXTERNAL_COMMAND (1): 993 EXTERNAL_COMMAND (2): /* EO - External Output */ 994 backup_flag = "0"b; 995 EO_EB_common: 996 if num_arg >= 3 997 then goto too_many_args; 998 do; 999 call get_quoted_string; 1000 if backup_flag 1001 then call teco_backup_file_ (quoted_string); 1002 call get_seg_ptr_ (quoted_string, rwac_access, read_count, file_address, error_code); 1003 if file_address = null 1004 then goto file_error; 1005 end; 1006 immediate_interrupt_ok = "0"b; 1007 if b1 = file_address 1008 then call copy_source; 1009 start = 1; 1010 EO_X_common_return = EO_close_file; 1011 if num_arg ^= 0 1012 then goto EO_X_common; 1013 else do; 1014 arg1 = 0; 1015 count = dot1 + end_buffer - dot2; 1016 goto EO_X_around_dot; 1017 end; 1018 EO_close_file: 1019 call release_seg_ptr_ (file_address, 9 * count, error_code); 1020 if error_code ^= 0 1021 then goto file_error; 1022 goto command_complete; 1023 1024 EO_X_common: 1025 if num_arg < 2 1026 then if arg1 >= 1 1027 then do; 1028 call find_line_forward; 1029 arg1 = dot1; 1030 goto EO_X_after_dot; 1031 end; 1032 else do; 1033 call find_line_reverse; 1034 arg1 = temp_dot; 1035 count = dot1 - temp_dot; 1036 goto EO_X_before_dot; 1037 end; 1038 else do; /* (num_arg = 2) */ 1039 if arg1 < 0 1040 then arg1 = 0; 1041 if arg2 > dot1 + end_buffer - dot2 1042 then arg2 = dot1 + end_buffer - dot2; 1043 count = arg2 - arg1; 1044 if count < 0 1045 then goto args_wrong_order; 1046 if start + count > max_seg_size 1047 then goto dot_beyond_Z; /* will overflow Q reg */ 1048 if dot1 >= arg2 1049 then 1050 EO_X_before_dot: 1051 do; 1052 if count ^= 0 1053 then substr (file, start, count) = substr (buffer1, arg1 + 1, count); 1054 goto EO_X_common_return; 1055 end; 1056 if arg1 >= dot1 1057 then 1058 EO_X_after_dot: 1059 do; 1060 if count ^= 0 1061 then substr (file, start, count) = substr (buffer2, (arg1 + dot2 - dot1) + 1, count); 1062 goto EO_X_common_return; 1063 end; 1064 else /* (arg1<. 1 1140 then goto too_many_args; 1141 if num_arg < 1 1142 then goto too_few_args; 1143 call get_quoted_string; 1144 if iteration_level = 0 1145 then goto semi_colon_out_of_iteration; 1146 do return_iteration_level = iteration_level by -1 to 1; 1147 do while (return_iteration_level <= base_iteration_level); 1148 call unwind_command_level; 1149 end; 1150 if iteration.begin_tag (return_iteration_level) ^= 0 1151 then if quoted_string 1152 = 1153 substr (command_line, iteration.begin_tag (return_iteration_level) + 1, 1154 iteration.begin (return_iteration_level) - 1 - iteration.begin_tag (return_iteration_level)) 1155 then do; 1156 call unwind_iteration (return_iteration_level - 1); 1157 iteration_answer = arg1; 1158 goto get_out_of_iteration; 1159 end; 1160 end; 1161 goto label_not_found; 1162 1163 COMMAND (71): 1164 COMMAND (103): /* G - Get Q Register Command */ 1165 if num_arg ^= 0 1166 then goto too_many_args; 1167 current_Q_register_number = get_Q_register_number (); 1168 if current_Q_register_seg_number ^= 0 1169 then do; 1170 call add_chars (current_Q_register_address, current_Q_register_value); 1171 goto command_complete; 1172 end; 1173 else do; /* (Q_reg contains a number -- convert it to text) */ 1174 num_arg = 1; 1175 arg1 = current_Q_register_value; 1176 goto backslash; 1177 end; 1178 1179 1180 COMMAND (72): 1181 COMMAND (104): /* H - wHole Syntax Krock */ 1182 if num_arg ^= 0 1183 then goto too_many_args; 1184 arg1 = 0; 1185 current_expression = dot1 + end_buffer - dot2; 1186 num_arg = 2; 1187 goto command_return_value; 1188 1189 COMMAND (73): 1190 COMMAND (105): /* I - Insert Command */ 1191 if num_arg >= 2 1192 then goto too_many_args; 1193 if colon_flag = 0 1194 then do; 1195 if num_arg = 0 1196 then do; 1197 call get_quoted_string; 1198 call add_chars (quoted_string_address, quoted_string_length); 1199 goto command_complete; 1200 end; 1201 else do; 1202 unspec (io_char) = bit (fixed (arg1, 9, 0)); 1203 call add_chars (io_char_address, 1); 1204 goto command_complete; 1205 end; 1206 end; 1207 else do; 1208 current_Q_register_number = get_Q_register_number (); 1209 if num_arg = 0 1210 then do; 1211 call get_quoted_string; 1212 immediate_interrupt_ok = "0"b; 1213 temp_seg_usage_count (quoted_string_seg_number) = temp_seg_usage_count (quoted_string_seg_number) + 1; 1214 i = current_Q_register_seg_number; 1215 current_Q_register_seg_number = quoted_string_seg_number; 1216 current_Q_register_value = quoted_string_length; 1217 if i ^= 0 1218 then temp_seg_usage_count (i) = temp_seg_usage_count (i) - 1; 1219 goto command_complete; 1220 end; 1221 else do; 1222 immediate_interrupt_ok = "0"b; 1223 call allocate_Q_register_have_number (current_Q_register_number); 1224 unspec (substr (current_Q_register_address -> file, 1, 1)) = bit (fixed (arg1, 9, 0)); 1225 current_Q_register_value = 1; 1226 goto command_complete; 1227 end; 1228 end; 1229 1230 1231 COMMAND (74): 1232 COMMAND (106): /* J- Jump Command */ 1233 if num_arg = 0 1234 then arg1 = 0; 1235 arg1 = arg1 - dot1; 1236 goto C_check; 1237 1238 COMMAND (75): 1239 COMMAND (107): /* K - Kill Command */ 1240 if num_arg > 2 1241 then goto too_many_args; 1242 if num_arg < 2 1243 then do; 1244 if num_arg = 0 1245 then arg1 = 1; 1246 if arg1 > 0 1247 then do; 1248 call must_find_line_forward; 1249 call delete_chars (dot1, temp_dot); 1250 goto command_complete; 1251 end; 1252 else do; 1253 call must_find_line_reverse; 1254 call delete_chars (temp_dot, dot2); 1255 goto command_complete; 1256 end; 1257 end; 1258 if arg1 > arg2 1259 then goto args_wrong_order; 1260 call move_dot_forward (arg1 - dot1); /* If dot < arg1; move dot to arg1, else no move. */ 1261 call move_dot_backward (arg2 - dot1); /* If arg2 < dot; move dot to arg2, else no move. */ 1262 call delete_chars (arg1, dot2 + arg2 - dot1); 1263 goto command_complete; 1264 1265 1266 COMMAND (76): 1267 COMMAND (108): /* L - Lines Command */ 1268 if num_arg > 1 1269 then goto too_many_args; 1270 if num_arg = 0 1271 then arg1 = 1; 1272 if arg1 > 0 1273 then do; 1274 call must_find_line_forward; 1275 call move_dot_forward (count - colon_flag); 1276 end; 1277 else do; 1278 call must_find_line_reverse; 1279 call move_dot_backward (temp_dot - dot1 - colon_flag); 1280 end; 1281 goto command_complete; 1282 1283 COMMAND (77): 1284 COMMAND (109): /* M - Macro Command */ 1285 current_Q_register_number = get_Q_register_number (); 1286 if current_Q_register_seg_number = 0 1287 then goto M_numeric_Q_register; 1288 M_have_reg: 1289 if (command_level ^= 0 & command_char_number = command_line_length) | colon_flag ^= 0 1290 then do; 1291 call revert_command_level; 1292 goto M_get_new_line; 1293 end; 1294 if command_level >= hbound (command_char_stack, 1) 1295 then goto command_level_overflow; 1296 command_char_stack (command_level) = command_char_number; 1297 command_length_stack (command_level) = command_line_length; 1298 command_iteration_stack (command_level) = base_iteration_level; 1299 M_get_new_line: 1300 command_seg_stack (command_level + 1) = current_Q_register_seg_number; 1301 immediate_interrupt_ok = "0"b; 1302 command_line_length = current_Q_register_value; 1303 current_Q_register_usage_count = current_Q_register_usage_count + 1; 1304 command_line_address = current_Q_register_address; 1305 command_char_number = 0; 1306 base_iteration_level = iteration_level; 1307 command_level = command_level + 1; 1308 goto M_return; 1309 1310 COMMAND (78): 1311 COMMAND (110): /* N - QEDX type string search. Sets Q". */ 1312 if num_arg = 0 1313 then arg1 = 1; /* default is one forward search. */ 1314 if num_arg > 2 1315 then goto too_many_args; 1316 if num_arg = 2 /* arg1- line count; arg2- search count. */ 1317 then do; 1318 if arg1 <= 0 | arg2 < 0 1319 then goto unimplemented_feature; /* Can't reverse regular expr. */ 1320 call find_line_forward; 1321 arg1 = arg2; /* make it look like one arg case. */ 1322 arg2 = temp_dot; /* Set search limit. */ 1323 end; 1324 else if arg1 >= 0 /* One arg. arg1- search count. */ 1325 then arg2 = end_buffer; /* Search remainder by default. */ 1326 else goto unimplemented_feature; /* Can't reverse regular expr. */ 1327 num_arg = colon_flag; /* Indicate whether we return a value. */ 1328 call get_quoted_string; /* Get the regular expr. */ 1329 if quoted_string_length = 0 1330 then goto command_complete; /* Zero len string matches anything. */ 1331 if arg1 = 0 1332 then goto command_complete; /* search count = 0. */ 1333 temp_dot = dot2; 1334 i = quoted_string_length; 1335 if n1 ^= n2 /* search_file_ requires context for its search. */ 1336 then if dot1 > 0 /* Move char only if there is one. */ 1337 then do; /* Copy one character from before dot. */ 1338 call move_dot_backward (-1); /* This should handle exceptional cases. */ 1339 dot1 = dot1 + 1; /* This should be transparent. */ 1340 dot2 = dot2 + 1; /* This should be transparent. */ 1341 end; 1342 else if dot2 > 0 /* Must convince search_file_ we have beginning of line. */ 1343 then substr (buffer2, dot2, 1) = new_line_char; 1344 /* search_file_ knows about offsets. */ 1345 do arg1 = 1 to arg1; 1346 if temp_dot >= arg2 1347 then goto S_fail; 1348 call search_file_ (quoted_string_address, 1, i, b2, temp_dot + 1, arg2, j, temp_dot, count); 1349 if count ^= 0 1350 then do; 1351 current_Q_register_number = quoted_string_Q_register_number; 1352 call allocate_Q_register_have_number (current_Q_register_number); 1353 quoted_string_length = 0; 1354 goto S_fail; 1355 end; 1356 i = 0; /* Speed up search time. */ 1357 end; 1358 current_Q_register_number = quoted_string_Q_register_number; 1359 call allocate_Q_register_have_number (current_Q_register_number); 1360 count = temp_dot - j + 1; /* Length of matched string. */ 1361 if count = 0 1362 then goto S_succeed_forward; 1363 substr (quoted_string, 1, count) = substr (buffer2, j, count); 1364 quoted_string_length = count; 1365 goto S_succeed_forward; 1366 1367 COMMAND (79): 1368 COMMAND (111): /* O - gOto Command */ 1369 call get_quoted_string; 1370 count = quoted_string_length + 1; 1371 substr (quoted_string, count, 1) = "!"; 1372 O_have_label: 1373 command_char_number = 1; 1374 do while ("1"b); 1375 if command_char_number + count >= command_line_length 1376 then goto O_unwind_command; 1377 i = index (substr (command_line, command_char_number + 1), substr (quoted_string, 1, count)); 1378 if i = 0 1379 then 1380 O_unwind_command: 1381 do; 1382 if command_level = 0 1383 then goto label_not_found; 1384 call revert_command_level; 1385 goto O_have_label; 1386 end O_unwind_command; 1387 command_char_number = command_char_number + i + quoted_string_length; 1388 if substr (command_line, command_char_number - count, 1) = "!" 1389 then goto command_complete; 1390 end; 1391 1392 1393 COMMAND (80): 1394 COMMAND (112): /* P - aPpend to Q Register */ 1395 immediate_interrupt_ok = "0"b; 1396 current_Q_register_number = get_Q_register_number (); 1397 if num_arg = 0 1398 then arg1 = 1; 1399 if current_Q_register_seg_number ^= 0 1400 then do; 1401 if current_Q_register_usage_count > 1 1402 then do; 1403 file_address = current_Q_register_address; 1404 count = current_Q_register_value; 1405 call allocate_Q_register_have_number (current_Q_register_number); 1406 current_Q_register_value = count; 1407 current_Q_register = file; /* Copy the string */ 1408 end; 1409 file_address = current_Q_register_address; 1410 start = current_Q_register_value + 1; 1411 EO_X_common_return = normal_P_close_Q_reg; 1412 goto EO_X_common; 1413 1414 normal_P_close_Q_reg: 1415 current_Q_register_value = current_Q_register_value + count; 1416 end; 1417 else do; 1418 call allocate_Q_register_have_number (current_Q_register_number); 1419 file_address = current_Q_register_address; 1420 EO_X_common_return = null_P_close_Q_reg; 1421 start = 1; 1422 goto EO_X_common; 1423 null_P_close_Q_reg: 1424 current_Q_register_value = count; 1425 end; 1426 goto command_complete; 1427 1428 1429 COMMAND (82): 1430 COMMAND (114): /* R - Reverse Characters */ 1431 if num_arg = 0 1432 then arg1 = 1; 1433 arg1 = -arg1; 1434 goto C_check; 1435 1436 COMMAND (83): 1437 COMMAND (115): 1438 do; /* S - Search Text */ 1439 if num_arg = 0 1440 then arg1 = 1; 1441 if num_arg > 2 1442 then goto too_many_args; 1443 if num_arg = 2 1444 then do; 1445 if arg1 >= 1 /* arg1 is the number of lines to search over */ 1446 then do; 1447 if arg2 < 0 1448 then goto S_fail; 1449 call find_line_forward; 1450 end; 1451 else do; 1452 if arg2 > 0 1453 then goto S_fail; 1454 call find_line_reverse; 1455 end; 1456 arg1 = arg2; /* move search count to arg1. */ 1457 arg2 = temp_dot; /* put search limit in arg2. */ 1458 end; 1459 else /* num_arg < 2 */ 1460 if arg1 >= 0 1461 then arg2 = end_buffer; 1462 else arg2 = 0; 1463 num_arg = colon_flag; /* indicate whether a value is being returned or not */ 1464 do; 1465 call get_quoted_string; 1466 if quoted_string_length = 0 1467 then goto command_complete; 1468 if arg1 = 0 1469 then goto command_complete; 1470 if arg1 >= 0 1471 then do; 1472 temp_dot = dot2; 1473 plus_S_loop: 1474 do; 1475 if arg2 = temp_dot 1476 then goto S_fail; 1477 j = index (substr (buffer2, temp_dot + 1, arg2 - temp_dot), quoted_string); 1478 if j = 0 1479 then 1480 S_fail: 1481 do; 1482 search_answer = 0; 1483 if colon_flag = 0 1484 then goto fatal_S_fail; 1485 else do; 1486 current_expression = search_answer; 1487 goto command_return_value; 1488 end; 1489 end S_fail; 1490 temp_dot = temp_dot + (j - 1 + quoted_string_length); 1491 arg1 = arg1 - 1; 1492 if arg1 ^= 0 1493 then goto plus_S_loop; 1494 end plus_S_loop; 1495 S_succeed_forward: 1496 arg1 = temp_dot - dot2; 1497 S_succeed: 1498 search_answer = -1; 1499 current_expression = search_answer; 1500 call move_dot (arg1, "0"b); 1501 goto command_return_value; 1502 end; 1503 1504 /* Minus search is done in line. The following code takes advantage of the PL/I compiler's optimizer. */ 1505 /* index(reverse(substr(something)), reverse(char_1_or_2)) is inline if char_1_or_2 is aligned & constant length. */ 1506 /* Also, the reverse(substr(something)) does not move any characters. */ 1507 1508 else do; /* (arg1 < 0) */ 1509 temp_dot = dot1; 1510 search_chars = substr (quoted_string, 1, 2); 1511 if quoted_string_length = 1 1512 then do while (arg1 < 0); 1513 if temp_dot = arg2 1514 then goto S_fail; 1515 j = index (reverse (substr (buffer1, arg2 + 1, temp_dot - arg2)), 1516 substr (search_chars, 1, 1)); 1517 if j = 0 1518 then goto S_fail; 1519 temp_dot = temp_dot - j; 1520 arg1 = arg1 + 1; 1521 end; 1522 else do; 1523 minus_S_iterate: 1524 if temp_dot - arg2 < 2 1525 then go to S_fail; /* Must have room to search. */ 1526 j = index (reverse (substr (buffer1, arg2 + 1, temp_dot - arg2)), reverse (search_chars)); 1527 if j = 0 1528 then go to S_fail; 1529 temp_dot = temp_dot - j; 1530 if (temp_dot - 1) + quoted_string_length > dot1 1531 then go to minus_S_iterate; 1532 if quoted_string_length > 2 1533 then if substr (buffer1, temp_dot + 2, quoted_string_length - 2) 1534 ^= substr (quoted_string, 3, quoted_string_length - 2) 1535 then goto minus_S_iterate; 1536 temp_dot = temp_dot - 1; 1537 arg1 = arg1 + 1; 1538 if arg1 < 0 1539 then goto minus_S_iterate; 1540 end; 1541 arg1 = temp_dot - dot1; 1542 goto S_succeed; 1543 end; 1544 end; 1545 end; 1546 1547 COMMAND (84): 1548 COMMAND (116): /* T - Type Text */ 1549 if colon_flag = 0 1550 then do; 1551 if num_arg = 0 1552 then arg1 = 1; 1553 if num_arg > 2 1554 then goto too_many_args; 1555 if num_arg < 2 1556 then if arg1 >= 1 1557 then do; 1558 call find_line_forward; 1559 arg1 = dot1; 1560 arg2 = dot1 + count; 1561 end; 1562 else /* (arg1 < 1) */ 1563 do; 1564 call find_line_reverse; 1565 arg1 = temp_dot; 1566 arg2 = dot1; 1567 end; 1568 else do; /* (num_arg = 2) */ 1569 if arg1 < 0 1570 then arg1 = 0; 1571 if arg2 > dot1 + end_buffer - dot2 1572 then arg2 = dot1 + end_buffer - dot2; 1573 end; 1574 count = arg2 - arg1; 1575 if count < 0 1576 then goto args_wrong_order; 1577 if count = 0 1578 then goto command_complete; 1579 i = arg2 - dot1; /* Number of characters after DOT. */ 1580 j = dot1 - arg1; /* Number of characters before DOT. */ 1581 if j > 0 /* Print characters before DOT. */ 1582 then do; 1583 j = 0; /* In case there are characters after DOT. */ 1584 if i < 0 1585 then i = 0; /* Negative numbers don't work. */ 1586 call WRITE (b1, arg1, count - i); 1587 end; 1588 if i > 0 1589 then call WRITE (b2, dot2 - j, i + j); 1590 goto command_complete; 1591 end; 1592 else do; /* (colon_flag = 1) */ 1593 if num_arg ^= 0 1594 then goto too_many_args; 1595 call get_quoted_string; 1596 call WRITE (quoted_string_address, 0, quoted_string_length); 1597 goto command_complete; 1598 end; 1599 1600 COMMAND (85): 1601 COMMAND (117): /* U - Update Q Register */ 1602 current_Q_register_number = get_Q_register_number (); 1603 immediate_interrupt_ok = "0"b; 1604 i = current_Q_register_seg_number; 1605 current_Q_register_seg_number = 0; 1606 if num_arg = 0 1607 then do; 1608 num_arg = 1; 1609 arg1 = max_positive_integer; 1610 end; 1611 current_Q_register_value = arg (num_arg); 1612 if i ^= 0 1613 then temp_seg_usage_count (i) = temp_seg_usage_count (i) - 1; 1614 num_arg = num_arg - 1; 1615 current_expression = arg (num_arg); 1616 goto command_return_value; 1617 1618 1619 COMMAND (86): 1620 COMMAND (118): /* V - who knows? */ 1621 /* V not implemented, but let VW work anyways */ 1622 get_character_fail_handler = command_complete; 1623 call get_character; 1624 if current_character = "w" 1625 then goto VW; 1626 if current_character = "W" 1627 then goto VW; 1628 backup_command_line_1_char = 1; 1629 goto command_complete; 1630 1631 1632 VW: 1633 if colon_flag = 0 1634 then do; 1635 call READ_CHAR; 1636 current_expression = fixed (unspec (io_char), 9, 0); 1637 num_arg = 1; 1638 goto command_return_value; 1639 end; 1640 else do; 1641 call allocate_Q_register (current_Q_register_number); 1642 call READ (current_Q_register_address, 0); 1643 current_Q_register_value = read_count; 1644 goto command_complete; 1645 end; 1646 1647 1648 COMMAND (87): 1649 COMMAND (119): 1650 goto command_complete; /* W - Wipe */ 1651 1652 COMMAND (88): 1653 COMMAND (120): /* X - eXtract to Q Register */ 1654 if colon_flag = 0 1655 then do; 1656 if num_arg = 0 1657 then arg1 = 1; 1658 immediate_interrupt_ok = "0"b; 1659 call allocate_Q_register (current_Q_register_number); 1660 file_address = current_Q_register_address; 1661 EO_X_common_return = normal_X_close_Q_register; 1662 start = 1; 1663 goto EO_X_common; 1664 normal_X_close_Q_register: 1665 current_Q_register_value = count; 1666 goto command_complete; 1667 end; 1668 else do; 1669 if num_arg ^= 0 1670 then goto too_many_args; 1671 current_Q_register_number = get_Q_register_number (); 1672 if command_level = 0 1673 then goto colon_X_not_in_macro; 1674 colon_X_save_command_level = command_level; 1675 command_char_stack (command_level) = command_char_number; 1676 command_length_stack (command_level) = command_line_length; 1677 command_iteration_stack (command_level) = iteration_level; 1678 iteration_level = base_iteration_level; 1679 temp_seg_usage_count (command_seg_stack (command_level)) = 1680 temp_seg_usage_count (command_seg_stack (command_level)) + 1; 1681 call revert_command_level; 1682 call get_quoted_string; 1683 command_char_stack (command_level) = command_char_number; 1684 i, command_seg_stack (command_level + 1) = command_seg_stack (colon_X_save_command_level); 1685 immediate_interrupt_ok = "0"b; 1686 command_line_address = temp_seg_address (i); 1687 command_char_number = command_char_stack (colon_X_save_command_level); 1688 command_line_length = command_length_stack (colon_X_save_command_level); 1689 base_iteration_level = iteration_level; 1690 iteration_level = command_iteration_stack (colon_X_save_command_level); 1691 command_level = command_level + 1; 1692 temp_seg_usage_count (quoted_string_seg_number) = temp_seg_usage_count (quoted_string_seg_number) + 1; 1693 i = current_Q_register_seg_number; 1694 current_Q_register_seg_number = quoted_string_seg_number; 1695 current_Q_register_value = quoted_string_length; 1696 if i ^= 0 1697 then temp_seg_usage_count (i) = temp_seg_usage_count (i) - 1; 1698 goto command_complete; 1699 end; 1700 1701 backslash: 1702 COMMAND (92): 1703 do; 1704 if num_arg = 0 1705 then /* read the decimal number found to the right of the pointer */ 1706 do; 1707 num_arg = 1; 1708 current_expression = 0; 1709 if dot2 = end_buffer 1710 then goto backslash_0_args_number_not_found; 1711 j = verify (substr (buffer2, dot2 + 1, end_buffer - dot2), white_space) - 1; 1712 if j < 0 1713 then goto backslash_0_args_number_not_found; 1714 temp_dot, i = dot2 + j; 1715 current_sign = 1; 1716 j = index ("+-", substr (buffer2, i + 1, 1)); 1717 if j ^= 0 1718 then do; 1719 i = i + 1; 1720 if colon_flag ^= 0 1721 then do; 1722 temp_dot = i; 1723 if j = 2 1724 then current_sign = -1; 1725 end; 1726 if i = end_buffer 1727 then goto backslash_0_args_number_not_found; 1728 end; 1729 if colon_flag = 0 1730 then j = verify (substr (buffer2, i + 1, end_buffer - i), "0123456789") - 1; 1731 else j = verify (substr (buffer2, i + 1, end_buffer - i), "01234567") - 1; 1732 if j < 0 1733 then j = end_buffer - i; 1734 if j = 0 1735 then goto backslash_0_args_number_not_found; 1736 i = i + j; 1737 if colon_flag = 0 1738 then do; 1739 on fixedoverflow 1740 begin; 1741 current_expression = max_positive_integer; 1742 goto backslash_0_args_done; 1743 end; 1744 current_expression = convert (current_expression, substr (buffer2, temp_dot + 1, i - temp_dot)); 1745 backslash_0_args_done: 1746 revert fixedoverflow; 1747 end; 1748 else do; 1749 current_expression = cv_oct_check_ (substr (buffer2, temp_dot + 1, i - temp_dot), error_code); 1750 if error_code ^= 0 1751 then do; 1752 error_code = 0; 1753 current_expression = max_positive_integer; 1754 end; 1755 if current_sign < 0 1756 then current_expression = -current_expression; 1757 end; 1758 call move_dot_forward (i - dot2); 1759 goto command_return_value; 1760 end; 1761 else do; /* insert arg1 into text and pad with arg2-length(arg1) spaces */ 1762 if colon_flag = 0 1763 then do; 1764 cvb = arg1; 1765 i = length (cvb) - verify (cvb, white_space) + 1; 1766 if num_arg = 2 1767 then i = min (max (i, arg2), length (cvb)); 1768 call add_chars (addr (substr (cvb, length (cvb) - i + 1, i)), i); 1769 end; 1770 else do; 1771 call ioa_$rsnnl ("^o", string, i, arg1); 1772 if num_arg = 2 1773 then call add_chars (addr (blanks), min (arg2 - i, length (blanks))); 1774 call add_chars (addr (string), i); 1775 end; 1776 go to command_complete; 1777 end; 1778 end backslash; 1779 1780 no_room: 1781 error_message = "NO ROOM "; 1782 goto print_error_message; 1783 unimplemented_feature: 1784 error_message = "NOT IMPL"; 1785 goto print_error_message; 1786 label_not_found: 1787 error_message = "NO LABEL"; 1788 goto print_error_message; 1789 backslash_0_args_number_not_found: 1790 error_message = "\:NUMBR?"; 1791 goto print_error_message; 1792 A_1_arg_beyond_Z: 1793 dot_beyond_Z: 1794 error_message = "TOO BIG "; 1795 goto print_error_message; 1796 A_1_arg_before_0: 1797 bad_negative_argument: 1798 dot_before_0: 1799 error_message = "NEGATIVE"; 1800 goto print_error_message; 1801 unbalanced_parentheses: 1802 strange_parentheses: 1803 parenthesis_overflow: 1804 error_message = "PARENS "; 1805 goto print_error_message; 1806 skip_fail: 1807 error_message = "BAD SKIP"; 1808 goto print_error_message; 1809 iteration_overflow: 1810 iteration_underflow: 1811 unfinished_iteration: 1812 semi_colon_out_of_iteration: 1813 error_message = "BAD LOOP"; 1814 goto print_error_message; 1815 too_many_args: 1816 error_message = "MANY ARG"; 1817 goto print_error_message; 1818 too_few_args: 1819 error_message = "FEW ARGS"; 1820 goto print_error_message; 1821 Q_register_pushdown_underflow: 1822 error_message = "CANT POP"; 1823 goto print_error_message; 1824 Q_register_pushdown_overflow: 1825 command_level_overflow: 1826 string_too_long: 1827 EM_no_slot: 1828 error_message = "IMP.RES."; 1829 goto print_error_message; 1830 numeric_quoted_in_Q: 1831 ES_numeric_Q: 1832 M_numeric_Q_register: 1833 error_message = "numericQ"; 1834 goto print_error_message; 1835 percent_cant_increment: 1836 error_message = "% ? "; 1837 goto print_error_message; 1838 missing_double_quote_command: 1839 QUOTE_COMMAND (0): 1840 error_message = "BAD "" "; 1841 goto print_error_message; 1842 EXTERNAL_COMMAND (0): 1843 error_message = "BAD E "; 1844 goto print_error_message; 1845 missing_Q_register_name: 1846 illegal_Q_register_name: 1847 error_message = "Qreg ? "; 1848 goto print_error_message; 1849 COMMAND (0): 1850 COMMAND (1): 1851 COMMAND (2): 1852 COMMAND (3): 1853 COMMAND (4): 1854 COMMAND (5): 1855 COMMAND (6): 1856 COMMAND (7): 1857 COMMAND (8): 1858 COMMAND (9): 1859 COMMAND (11): 1860 COMMAND (12): 1861 COMMAND (13): 1862 COMMAND (14): 1863 COMMAND (15): 1864 COMMAND (16): 1865 COMMAND (17): 1866 COMMAND (18): 1867 COMMAND (19): 1868 COMMAND (20): 1869 COMMAND (21): 1870 COMMAND (22): 1871 COMMAND (23): 1872 COMMAND (24): 1873 COMMAND (25): 1874 COMMAND (26): 1875 COMMAND (27): 1876 COMMAND (28): 1877 COMMAND (29): 1878 COMMAND (30): 1879 COMMAND (31): 1880 COMMAND (32): 1881 COMMAND (35): 1882 COMMAND (37): 1883 COMMAND (38): 1884 COMMAND (40): 1885 COMMAND (42): 1886 COMMAND (45): 1887 COMMAND (46): 1888 COMMAND (47): 1889 COMMAND (48): 1890 COMMAND (49): 1891 COMMAND (50): 1892 COMMAND (51): 1893 COMMAND (52): 1894 COMMAND (53): 1895 COMMAND (54): 1896 COMMAND (55): 1897 COMMAND (56): 1898 COMMAND (57): 1899 COMMAND (58): 1900 COMMAND (63): 1901 COMMAND (64): 1902 COMMAND (66): 1903 COMMAND (81): 1904 COMMAND (89): 1905 COMMAND (90): 1906 COMMAND (94): 1907 COMMAND (95): 1908 COMMAND (96): 1909 COMMAND (98): 1910 COMMAND (113): 1911 COMMAND (121): 1912 COMMAND (122): 1913 COMMAND (123): 1914 COMMAND (124): 1915 COMMAND (125): 1916 COMMAND (126): 1917 COMMAND (127): 1918 error_message = current_character || ": ? "; /* illegal command */ 1919 goto print_error_message; 1920 illegal_delimiter: 1921 error_message = delimiter || ":DELIM?"; 1922 goto print_error_message; 1923 tty_no_read: 1924 no_more_temp_segs: 1925 error_message = "DISASTER"; 1926 goto print_error_message; 1927 args_wrong_order: 1928 error_message = "ORDER ? "; 1929 goto print_error_message; 1930 missing_right_operand: 1931 colon_X_not_in_macro: 1932 error_message = "? "; 1933 goto print_error_message; 1934 F_COMMAND (0): 1935 error_message = "BAD F "; 1936 goto print_error_message; 1937 EM_macro_not_found: 1938 ES_subroutine_not_found: 1939 file_error: 1940 call check_errset; 1941 call com_err_ (error_code, program_name, quoted_string); 1942 goto command_abort; 1943 fatal_S_fail: 1944 error_message = "S: fail "; 1945 goto print_error_message; 1946 print_error_message: 1947 call check_errset; 1948 if error_mode = "long" 1949 then call teco_error (error_message); 1950 else call WRITE (addr (error_structure), 0, length (error_message) + 1); 1951 goto command_abort; 1952 1953 read_line: 1954 procedure; 1955 do while ("1"b); 1956 call READ (command_line_address, command_line_length); 1957 command_line_length = command_line_length + read_count; 1958 if command_line_length >= 2 /* See if this line ended with "$". */ 1959 then if substr (command_line, command_line_length - 1, 1) = "$" 1960 then do; 1961 command_line_length = command_line_length - 2; 1962 /* leave out the $ */ 1963 return; 1964 end; 1965 end; 1966 end read_line; 1967 1968 get_character: 1969 procedure; /* modifies current_character, io_char, and */ 1970 /* command_char_number. */ 1971 command_char_number = command_char_number - backup_command_line_1_char; 1972 do while (command_char_number >= command_line_length); 1973 if command_level = 0 1974 then goto get_character_fail_handler; 1975 call revert_command_level; 1976 end; 1977 current_character = substr (command_line, command_char_number + 1, 1); 1978 io_char = current_character; 1979 if trace_flag 1980 then if backup_command_line_1_char = 0 1981 then call WRITE (io_char_address, 0, 1); 1982 command_char_number = command_char_number + 1; 1983 backup_command_line_1_char = 0; 1984 return; 1985 1986 print_command_line: 1987 entry; 1988 search_successful = search_length ^= 0; 1989 if ^search_successful 1990 then search_length = command_line_length - command_char_number; 1991 if trace_flag 1992 then call WRITE (command_line_address, command_char_number, search_length); 1993 command_char_number = command_char_number + search_length; 1994 return; 1995 1996 find_character: 1997 entry; 1998 do while (command_char_number >= command_line_length); 1999 if command_level = 0 2000 then goto get_character_fail_handler; 2001 call revert_command_level; 2002 end; 2003 end get_character; 2004 2005 check_errset: 2006 procedure; 2007 if iteration_level > 0 2008 then do; 2009 do return_iteration_level = iteration_level by -1 to 1 while (^iteration.errset (return_iteration_level)); 2010 end; 2011 if return_iteration_level = 0 2012 then return; 2013 do while (return_iteration_level <= base_iteration_level); 2014 call unwind_command_level; 2015 end; 2016 call unwind_iteration (return_iteration_level - 1); 2017 iteration_answer = 0; 2018 goto get_out_of_iteration; 2019 end; 2020 return; 2021 end check_errset; 2022 2023 revert_command_level: 2024 procedure; 2025 dcl save_interrupt_ok bit (1) aligned; 2026 if iteration_level ^= base_iteration_level 2027 then goto unfinished_iteration; 2028 unwind_command_level: 2029 entry; 2030 save_interrupt_ok = immediate_interrupt_ok; 2031 immediate_interrupt_ok = "0"b; 2032 command_level = command_level - 1; 2033 temp_seg_usage_count (command_seg_stack (command_level + 1)) = 2034 temp_seg_usage_count (command_seg_stack (command_level + 1)) - 1; 2035 command_line_address = temp_seg_address (command_seg_stack (command_level)); 2036 command_char_number = command_char_stack (command_level); 2037 command_line_length = command_length_stack (command_level); 2038 base_iteration_level = command_iteration_stack (command_level); 2039 immediate_interrupt_ok = save_interrupt_ok; 2040 end revert_command_level; 2041 2042 2043 unwind_iteration: 2044 procedure (return_iteration_level); 2045 dcl return_iteration_level fixed bin (24); 2046 iteration_level = return_iteration_level; 2047 if iteration_level < base_iteration_level 2048 then goto unfinished_iteration; 2049 if iteration.end (iteration_level + 1) >= 0 2050 then command_char_number = iteration.end (iteration_level + 1); 2051 else do; 2052 command_char_number = iteration.begin (iteration_level + 1); 2053 call skip ("<>"); 2054 end; 2055 return; 2056 end unwind_iteration; 2057 2058 2059 skip: 2060 procedure (search_chars); 2061 dcl search_chars char (2) aligned; 2062 trace_flag = "0"b; 2063 skip_with_trace: 2064 entry (search_chars); 2065 skip_count = 0; 2066 get_character_fail_handler = skip_fail; 2067 do while ("1"b); 2068 search_length = search (substr (command_line, command_char_number + 1), search_chars); 2069 call print_command_line; 2070 if search_successful 2071 then if substr (command_line, command_char_number, 1) = substr (search_chars, 2, 1) 2072 then do; /* Must search ending character first or "!" search fails. */ 2073 skip_count = skip_count - 1; 2074 if skip_count < 0 /* First unmatched end wins. */ 2075 then do; 2076 trace_flag = trace_flag_copy; 2077 return; 2078 end; 2079 end; 2080 else skip_count = skip_count + 1; 2081 call find_character; 2082 end; 2083 end skip; 2084 2085 /* These entry points count lines either forward or in reverse. They change j, arg1, temp_dot, and count. */ 2086 2087 must_find_line_forward: 2088 procedure; 2089 dcl must_find bit (1) aligned; 2090 2091 must_find = "1"b; 2092 if "0"b 2093 then do; 2094 find_line_forward: 2095 entry; 2096 must_find = "0"b; 2097 end; 2098 temp_dot = dot2; 2099 count = end_buffer - dot2; /* Length if not all lines are found. */ 2100 do arg1 = 1 to arg1; /* arg1 is count of lines. */ 2101 if temp_dot >= end_buffer /* Obviously no more lines. */ 2102 then if must_find 2103 then goto dot_beyond_Z; 2104 else return; 2105 j = index (substr (buffer2, temp_dot + 1, end_buffer - temp_dot), new_line_char); 2106 2107 if j = 0 2108 then temp_dot = end_buffer; 2109 else temp_dot = temp_dot + j; 2110 end; 2111 count = temp_dot - dot2; /* Length of characters included. */ 2112 return; 2113 2114 must_find_line_reverse: 2115 entry; 2116 must_find = "1"b; 2117 if "0"b 2118 then do; 2119 find_line_reverse: 2120 entry; 2121 must_find = "0"b; 2122 end; 2123 temp_dot = dot1; 2124 do arg1 = 1 to 1 - arg1; /* arg1 is negative count. */ 2125 j = 1; 2126 if temp_dot > 0 2127 then do; 2128 j = index (reverse (substr (buffer1, 1, temp_dot)), new_line_char); 2129 if j = 0 2130 then j = temp_dot + 1; 2131 end; 2132 temp_dot = temp_dot - j; 2133 end; 2134 temp_dot = temp_dot + 1; 2135 if temp_dot >= 0 2136 then return; 2137 if must_find 2138 then goto dot_before_0; 2139 temp_dot = 0; 2140 end /* find_line */; 2141 2142 get_quoted_string: 2143 procedure; /* procedure returns quoted_string */ 2144 dcl save_immediate_interrupt_ok bit (1) aligned, 2145 (quote_name, quote_seg, old_seg) fixed bin (24); 2146 2147 call get_character; 2148 delimiter = current_character; 2149 if delimiter = "q" 2150 then goto quoted_string_in_Q_register; 2151 if delimiter = "Q" 2152 then goto quoted_string_in_Q_register; 2153 if delimiter >= "a" 2154 then if delimiter <= "z" 2155 then goto illegal_delimiter; 2156 if delimiter >= "0" 2157 then if delimiter <= "9" 2158 then goto illegal_delimiter; 2159 if delimiter >= "A" 2160 then if delimiter <= "Z" 2161 then goto illegal_delimiter; 2162 quote_name = quoted_string_Q_register_number; 2163 call allocate_Q_register_have_number (quote_name); 2164 get_character_fail_handler = no_quoting_delimiter; 2165 do while ("1"b); 2166 j = command_char_number; /* command_char_number is changed by "print_command_line". */ 2167 search_length = index (substr (command_line, j + 1, command_line_length - j), delimiter); 2168 call print_command_line; 2169 i = search_length - fixed (search_successful, 1, 0); 2170 /* Don't count delimiter. */ 2171 if i > 0 2172 then do; 2173 if quoted_string_length + i > max_seg_size 2174 then goto string_too_long; 2175 substr (quoted_string, quoted_string_length + 1, i) = substr (command_line, j + 1, i); 2176 quoted_string_length = quoted_string_length + i; 2177 end; 2178 if search_successful 2179 then return; 2180 call find_character; 2181 if "0"b 2182 then do; 2183 no_quoting_delimiter: 2184 command_line_length = command_line_length + 2; 2185 call read_line; 2186 end; 2187 end; 2188 2189 quoted_string_in_Q_register: 2190 quote_name = get_Q_register_number (); 2191 quote_seg = Q_register_seg_number (quote_name); 2192 if quote_seg = 0 2193 then goto numeric_quoted_in_Q; 2194 save_immediate_interrupt_ok = immediate_interrupt_ok; 2195 immediate_interrupt_ok = "0"b; 2196 temp_seg_usage_count (quote_seg) = temp_seg_usage_count (quote_seg) + 1; 2197 old_seg = quoted_string_seg_number; 2198 quoted_string_seg_number = quote_seg; 2199 quoted_string_length = Q_register_value (quote_name); 2200 temp_seg_usage_count (old_seg) = temp_seg_usage_count (old_seg) - 1; 2201 immediate_interrupt_ok = save_immediate_interrupt_ok; 2202 end get_quoted_string; 2203 2204 /* Procedure gets and checks the Q-register specified. */ 2205 get_Q_register_number: 2206 procedure () returns (fixed bin (24)); 2207 dcl Q_number fixed bin (24); 2208 get_character_fail_handler = missing_Q_register_name; 2209 call get_character; 2210 Q_number = fixed (unspec (io_char), 9, 0); 2211 if Q_number < lbound (Q_register_value, 1) 2212 then goto illegal_Q_register_name; 2213 if Q_number >= hbound (Q_register_value, 1) 2214 then goto illegal_Q_register_name; 2215 return (Q_number); 2216 end get_Q_register_number; 2217 2218 2219 /* procedure allocates a string register when required. */ 2220 allocate_Q_register: 2221 procedure (alloc_name); /* Enter here if Q-reg name is unknown. */ 2222 dcl (alloc_name, alloc_seg) fixed bin (24), 2223 save_immediate_interrupt_ok bit (1) aligned; 2224 alloc_name = get_Q_register_number (); 2225 2226 allocate_Q_register_have_number: 2227 entry (alloc_name); /* Enter here if Q-reg name is known. */ 2228 save_immediate_interrupt_ok = immediate_interrupt_ok; 2229 immediate_interrupt_ok = "0"b; 2230 alloc_seg = Q_register_seg_number (alloc_name); 2231 if alloc_seg = 0 2232 then goto must_allocate_Q_register; 2233 temp_seg_usage_count (alloc_seg) = temp_seg_usage_count (alloc_seg) - 1; 2234 if temp_seg_usage_count (alloc_seg) ^= 0 2235 then do; 2236 must_allocate_Q_register: 2237 alloc_seg = number_reserved_temp_segs; 2238 find_free_seg: 2239 do; 2240 if alloc_seg >= hbound (temp_seg_address, 1) 2241 then goto no_more_temp_segs; 2242 alloc_seg = alloc_seg + 1; 2243 if temp_seg_usage_count (alloc_seg) ^= 0 2244 then goto find_free_seg; 2245 end find_free_seg; 2246 Q_register_seg_number (alloc_name) = alloc_seg; 2247 if temp_seg_address (alloc_seg) = null 2248 then /* Formerly test for zero. See its dcl. */ 2249 do; 2250 call get_temp_seg_ (my_id, rwa_access, temp_seg_address (alloc_seg), error_code); 2251 if error_code ^= 0 2252 then goto no_more_temp_segs; 2253 end; 2254 end; 2255 temp_seg_usage_count (alloc_seg) = 1; 2256 Q_register_value (alloc_name) = 0; 2257 immediate_interrupt_ok = save_immediate_interrupt_ok; 2258 end allocate_Q_register; 2259 2260 READ: 2261 procedure (buffer_pointer, offset); 2262 dcl buffer_pointer ptr, 2263 (offset, length) fixed bin (24); 2264 2265 p = buffer_pointer; 2266 if offset ^= 0 2267 then p = addr (substr (p -> file, offset + 1, 1)); 2268 call iox_$get_line (iox_$user_input, p, max_seg_size - offset, read_count, error_code); 2269 in_chk: 2270 if error_code ^= 0 2271 then goto io_diaster; 2272 if read_count = 0 2273 then goto tty_no_read; 2274 return; 2275 2276 READ_CHAR: 2277 entry; 2278 call iox_$get_chars (iox_$user_input, io_char_address, 1, read_count, error_code); 2279 goto in_chk; 2280 2281 WRITE: 2282 entry (buffer_pointer, offset, length); 2283 p = buffer_pointer; 2284 if offset ^= 0 2285 then p = addr (substr (p -> file, offset + 1, 1)); 2286 call iox_$put_chars (iox_$user_output, p, length, error_code); 2287 if error_code = 0 2288 then return; 2289 io_diaster: 2290 call com_err_ (error_code, program_name); 2291 goto tty_no_read; 2292 end READ; 2293 2294 2295 move_dot: 2296 procedure (char_count, a_accept_error); 2297 dcl a_accept_error bit (1) aligned, 2298 accept_error bit (1) aligned init ("0"b), 2299 (char_count, cc, tc) fixed bin (24); 2300 accept_error = a_accept_error; 2301 if char_count > 0 /* Move forward if positive, backward if negative. */ 2302 then do; 2303 move_dot_forward: 2304 entry (char_count); /* Count must be positive or a nop. */ 2305 cc = char_count; 2306 if dot2 + cc > end_buffer 2307 then if accept_error 2308 then cc = end_buffer - dot2; 2309 else goto dot_beyond_Z; 2310 if cc <= 0 2311 then return; 2312 immediate_interrupt_ok = "0"b; 2313 if max_dot1 - dot1 < cc /* Range of shared chars less than move count? */ 2314 then do; /* Yes, must move some or all of them. */ 2315 if max_dot1 - dot1 > 0 /* Some chars already moved? */ 2316 then do; /* Yes, indicate they were moved. */ 2317 tc = max_dot1 - dot1; 2318 dot1 = max_dot1; 2319 dot2 = dot2 + tc; 2320 cc = cc - tc; 2321 end; 2322 substr (buffer1, dot1 + 1, cc) = substr (buffer2, dot2 + 1, cc); 2323 max_dot1 = dot1 + cc; /* Increase upper bound of shared chars. */ 2324 if dot2 + cc = end_buffer 2325 then goto move_to_b1; /* If move empties buf2, share buf1. */ 2326 end; 2327 end; 2328 else do; /* Move count is <0 */ 2329 move_dot_backward: 2330 entry (char_count); /* Count must be negative or nop. */ 2331 cc = char_count; 2332 if -cc > dot1 2333 then if accept_error 2334 then cc = -dot1; 2335 else goto dot_before_0; 2336 if cc >= 0 2337 then return; 2338 immediate_interrupt_ok = "0"b; 2339 if dot2 - min_dot2 < -cc /* Range of shared chars less than move count? */ 2340 then do; /* Yes, must move some or all of them. */ 2341 if -cc <= dot2 /* Enough room in buf2 to make move? */ 2342 then do; /* Yes, prefix text to buf2. */ 2343 if dot2 - min_dot2 > 0 /* Some chars already moved? */ 2344 then do; /* Yes, indicate they were moved. */ 2345 tc = dot2 - min_dot2; 2346 dot1 = dot1 - tc; 2347 dot2 = min_dot2; 2348 cc = cc + tc; 2349 end; 2350 substr (buffer2, dot2 + (cc + 1), -cc) = substr (buffer1, dot1 + (cc + 1), -cc); 2351 min_dot2 = dot2 + cc; /* Decrease lower bound of shared chars. */ 2352 if min_dot2 + (dot1 + cc) = 0 /* Is buf1 empty and new buf2 offset zero? */ 2353 then do; /* Yes, share buffer2. */ 2354 max_dot1 = end_buffer; 2355 b1 = b2; 2356 n1 = n2; 2357 end; 2358 end; 2359 else do; /* No, move all of buf2 to buf1 and share buf1. */ 2360 if end_buffer - dot2 > 0 2361 then substr (buffer1, dot1 + 1, end_buffer - dot2) = 2362 substr (buffer2, dot2 + 1, end_buffer - dot2); 2363 move_to_b1: 2364 end_buffer, max_dot1 = dot1 + (end_buffer - dot2); 2365 /* Share buffer1. */ 2366 b2 = b1; 2367 n2 = n1; 2368 min_dot2 = 0; 2369 dot2 = dot1; 2370 end; 2371 end; 2372 end; 2373 dot1 = dot1 + cc; /* Indicate move is complete. */ 2374 dot2 = dot2 + cc; 2375 end move_dot; 2376 2377 /* Only call this entry to copy from the original segment to teco buffers. */ 2378 copy_source: 2379 procedure; 2380 dcl ichar char (ic) based unaligned, 2381 (source, in_ptr) ptr, 2382 (new_dot1, new_dot2, insert_count, n0, s1, s2, nd2, ic, new_end) fixed bin (24); 2383 2384 ic = 0; /* Just copy segment without adding text and */ 2385 s1 = dot1; /* without deleting text. */ 2386 nd2 = dot2; 2387 goto copy_text; 2388 2389 /* Call this entry to delete characters. */ 2390 delete_chars: 2391 entry (new_dot1, new_dot2); 2392 s1 = new_dot1; /* Number of characters to be left in buffer1. */ 2393 if s1 < 0 2394 then goto dot_before_0; /* Validate our input. */ 2395 nd2 = new_dot2; /* New value of dot2. */ 2396 if nd2 > end_buffer 2397 then goto dot_beyond_Z; /* Validate our input. */ 2398 if s1 = dot1 & nd2 = dot2 2399 then return; /* Delete count is zero. Do not change anything. */ 2400 ic = 0; /* Not adding text. */ 2401 goto copy_text; 2402 2403 /* Call this entry to add characters. */ 2404 add_chars: 2405 entry (in_ptr, insert_count); 2406 ic = insert_count; /* Pick up length of text to be added. */ 2407 if ic = 0 2408 then return; /* Length is zero. Do not change anything. */ 2409 s1 = dot1; /* Existing text will not be changed. */ 2410 nd2 = dot2; 2411 if s1 + end_buffer - nd2 + ic > max_seg_size 2412 then goto no_room; /* Can't add if segment size exceeded. */ 2413 2414 copy_text: /* Text is moved only if b1 = b2. (Shared segment) */ 2415 s2 = end_buffer - nd2; /* Number of characters to be left in buffer2. */ 2416 immediate_interrupt_ok = "0"b; 2417 n0 = n1; /* Useful only if n1 = n2. (b1 = b2) */ 2418 if s2 = 0 | (s1 + ic + nd2) = 0 /* Buf2 empty or (buf1 empty and buf2 starts at 0). */ 2419 then do; 2420 n0 = n1; /* Indicates whether a close is required. */ 2421 end_buffer, max_dot1 = s1 + s2 + ic; /* Prepare to share a segment. */ 2422 min_dot2 = 0; /* Set total length and range of shared characters. */ 2423 if n1 = 0 /* Segment is user's segment. Copy it. */ 2424 then do; /* The copy will be shared. */ 2425 n1, n2 = 1; /* Pick an arbitrary temp seg. */ 2426 source = b1; /* Save pointer to user's segment. */ 2427 b1, b2 = temp_seg_address (1); /* Get pointer to new buffer. */ 2428 substr (b1 -> buffer1, 1, s1 + s2) = substr (source -> buffer1, 1, s1 + s2); 2429 /* Copy text. */ 2430 end; 2431 else do; /* Text is in two temp segs. Share one. */ 2432 if s2 > 0 /* All text in second buffer? */ 2433 then n1 = n2; /* Yes, share it. */ 2434 else n2 = n1; /* No, all in first so share it. */ 2435 b1, b2 = temp_seg_address (n1); /* Set both buffer pointers. */ 2436 end; 2437 end; 2438 else do; /* Text in both buffers or can't share buffer2. */ 2439 max_dot1 = s1 + ic; /* Shared text limits are current text position. */ 2440 min_dot2 = nd2; /* nd2 is still correct (end_buffer has not changed). */ 2441 if n1 = n2 /* Text must be move only if sharing a segment. */ 2442 then do; 2443 if n1 = 0 /* Shared segment is not temp seg. Move all text. */ 2444 then do; 2445 n1 = 1; 2446 n2 = 2; 2447 end; 2448 else if s1 < s2 /* Otherwise, move shorter piece of text. */ 2449 then n1 = 3 - n2; 2450 else n2 = 3 - n1; 2451 source = b1; /* Save pointer to original segment. */ 2452 b1 = temp_seg_address (n1); /* Assign new temp segments. */ 2453 b2 = temp_seg_address (n2); 2454 if s1 > 0 & n0 ^= n1 /* New seg for buf1 and text in buf1. */ 2455 then do; 2456 substr (b1 -> buffer1, 1, s1) = substr (source -> buffer1, 1, s1); 2457 end; 2458 if s2 > 0 & n0 ^= n2 /* New seg for buf2 and text in buf2. */ 2459 then do; 2460 new_end = min (divide (s1 + s2 + ic + 512 + 4095, 4096, 17, 0) * 4096, max_seg_size); 2461 if n1 ^= n2 2462 then min_dot2 = new_end - s2; /* Change shared limit only if not shared. */ 2463 substr (b2 -> buffer2, new_end - s2 + 1, s2) = 2464 substr (source -> buffer2, end_buffer - s2 + 1, s2); 2465 end_buffer = new_end; 2466 end; 2467 end; 2468 end; 2469 2470 dot1 = s1 + ic; 2471 dot2 = end_buffer - s2; /* Works even if end_buffer is changed. */ 2472 2473 if ic > 0 2474 then substr (b1 -> buffer1, s1 + 1, ic) = substr (in_ptr -> ichar, 1, ic); 2475 2476 if n0 = 0 2477 then goto close_a_file; 2478 return; 2479 2480 close_file: 2481 entry (in_ptr); 2482 source = in_ptr; 2483 2484 close_a_file: 2485 if source = null 2486 then return; 2487 call release_seg_ptr_ (source, -1, error_code); 2488 if error_code ^= 0 2489 then goto file_error; 2490 end copy_source; 2491 end TECO; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1453.6 teco.pl1 >dumps>old>recomp>teco.pl1 242 1 09/22/80 1256.7 cp_active_string_types.incl.pl1 >ldd>include>cp_active_string_types.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. EO_X_common_return 000130 automatic label variable dcl 113 set ref 1010* 1054 1062 1073 1411* 1420* 1661* NORMAL_ACTIVE_STRING 000343 constant fixed bin(17,0) initial dcl 1-6 set ref 898* Q_number 002554 automatic fixed bin(24,0) dcl 2207 set ref 2210* 2211 2213 2215 Q_register_pushdown_level 000205 automatic fixed bin(17,0) dcl 126 set ref 290* 325* 326 327 452 453* 453 454 454 809 813 814 818* 818 822 828* 828 829 830 Q_register_seg_number 140 001014 automatic fixed bin(17,0) array level 2 dcl 153 set ref 338* 338 367 377 520 520 784 814 814 816 816 816 816 816 816 826 826 830* 830 895 895 898 898 898 903 907 907 909 909 909 909 922 935 968 989* 1000 1002 1108 1108 1111 1115 1115 1150 1168 1168 1170 1170 1198 1213 1213 1213 1213 1214 1214 1215* 1215 1215 1215 1224 1224 1286 1286 1299 1299 1303 1303 1303 1303 1304 1304 1348 1363 1371 1377 1399 1399 1401 1401 1403 1403 1407 1407 1409 1409 1419 1419 1477 1510 1532 1596 1604 1604 1605* 1605 1642 1642 1660 1660 1692 1692 1692 1692 1693 1693 1694* 1694 1694 1694 1941 2175 2191 2197 2197 2198* 2198 2230 2246* Q_register_value 001014 automatic fixed bin(24,0) array level 2 dcl 153 set ref 366* 366 367 367 376* 376 377 377 514 514 522 522 522* 522 782 782 784 784 784 784 813 813 829* 829 898 898 898 898 903 903 903 903 907* 907 909 909 922 922 935 935 935 935 968 968 968 968 988* 1000 1000 1000 1000 1002 1002 1002 1002 1111 1111 1115 1115 1115 1115 1150 1150 1170 1170 1175 1175 1198 1198 1216* 1216 1216 1216 1225* 1225 1302 1302 1329 1329 1334 1334 1353* 1353 1363 1363 1364* 1364 1370 1370 1371 1371 1377 1377 1387 1387 1404 1404 1406* 1406 1407 1407 1410 1410 1414* 1414 1414 1414 1423* 1423 1466 1466 1477 1477 1490 1490 1510 1510 1511 1511 1530 1530 1532 1532 1532 1532 1532 1532 1532 1532 1596 1596 1611* 1611 1643* 1643 1664* 1664 1695* 1695 1695 1695 1941 1941 1941 1941 2173 2173 2175 2175 2175 2175 2176* 2176 2176 2176 2199* 2199 2199 2211 2213 2256* a_accept_error parameter bit(1) dcl 2297 ref 2295 2300 accept_error 002602 automatic bit(1) initial dcl 2297 set ref 2297* 2300* 2306 2332 addr builtin function dcl 108 ref 291 450 450 1768 1768 1772 1772 1774 1774 1950 1950 2266 2284 alloc_name parameter fixed bin(24,0) dcl 2222 set ref 2220 2224* 2226 2230 2246 2256 alloc_seg 002564 automatic fixed bin(24,0) dcl 2222 set ref 2230* 2231 2233 2233 2234 2236* 2240 2242* 2242 2243 2246 2247 2250 2255 arg 000504 automatic fixed bin(24,0) array dcl 137 set ref 544 596 596 607 607 611* 611 625* 637 637 637 637 640 640 640 640 648* 648 650 650 656 656 664 664 699* 699 701 701 705 705 713* 713 726 726 748 748 748 748 756 756 756 756 764 764 764 764 772 772 772 772 841 841 843 843 849 849 859* 859 866 866 870* 870 876 876 876 876 876 876 876 876 1014* 1014 1024 1024 1029* 1029 1034* 1034 1039 1039 1039* 1039 1041 1041 1041* 1041 1043 1043 1043 1043 1048 1048 1052 1052 1056 1056 1060 1060 1067 1067 1068 1068 1103* 1103 1105* 1105 1115 1115 1115 1115 1157 1157 1175* 1175 1184* 1184 1202 1202 1224 1224 1231* 1231 1235* 1235 1235 1235 1244* 1244 1246 1246 1258 1258 1258 1258 1260 1260 1261 1261 1262 1262 1262 1262 1270* 1270 1272 1272 1310* 1310 1318 1318 1318 1318 1321* 1321 1321 1321 1322* 1322 1324 1324 1324* 1324 1331 1331 1345* 1345 1345 1345 1346 1346 1348 1348 1397* 1397 1429* 1429 1433* 1433 1433 1433 1439* 1439 1445 1445 1447 1447 1452 1452 1456* 1456 1456 1456 1457* 1457 1459 1459 1459* 1459 1462* 1462 1468 1468 1470 1470 1475 1475 1477 1477 1491* 1491 1491 1491 1492 1492 1495* 1495 1500 1500 1511 1511 1513 1513 1515 1515 1515 1515 1520* 1520 1520 1520 1523 1523 1526 1526 1526 1526 1537* 1537 1537 1537 1538 1538 1541* 1541 1551* 1551 1555 1555 1559* 1559 1560* 1560 1565* 1565 1566* 1566 1569 1569 1569* 1569 1571 1571 1571* 1571 1574 1574 1574 1574 1579 1579 1580 1580 1586 1586 1609* 1609 1611 1615 1656* 1656 1764 1764 1766 1766 1771 1771 1772 1772 1772 1772 2100* 2100 2100 2100 2124* 2124 2124 2124 arg1 defined fixed bin(24,0) dcl 206 set ref 596 607 611* 637* 640* 648* 650 656 664 699* 701 705 726 748 756 764 772 841 843 849 859* 866* 870* 876 876 876 876 1014* 1024 1029* 1034* 1039 1039* 1043 1052 1056 1060 1067 1068 1103* 1115* 1157 1175* 1184* 1202 1224 1231* 1235* 1235 1244* 1246 1258 1260 1262* 1270* 1272 1310* 1318 1321* 1324 1331 1345* 1345* 1397* 1429* 1433* 1433 1439* 1445 1456* 1459 1468 1470 1491* 1491 1492 1495* 1500* 1511 1520* 1520 1537* 1537 1538 1541* 1551* 1555 1559* 1565* 1569 1569* 1574 1580 1586* 1609* 1656* 1764 1771* 2100* 2100* 2124* 2124* arg1_stack 000210 automatic fixed bin(17,0) array dcl 127 set ref 596* 611 arg2 defined fixed bin(24,0) dcl 207 set ref 637* 640* 713* 748 756 764 772 1041 1041* 1043 1048 1105* 1115* 1258 1261 1262 1318 1321 1322* 1324* 1346 1348* 1447 1452 1456 1457* 1459* 1462* 1475 1477 1513 1515 1515 1523 1526 1526 1560* 1566* 1571 1571* 1574 1579 1766 1772 1772 arg_address 000140 automatic pointer dcl 115 set ref 255* 258 259 329* 330 370* 377 arg_length 000206 automatic fixed bin(17,0) dcl 126 set ref 255* 258 259 329* 330 330 332 370* 376 377 argument based char unaligned dcl 161 set ref 258 259 330* 330 377 assign_temp_seg_id_ 000016 constant entry external dcl 171 ref 308 b1 000142 automatic pointer dcl 115 set ref 341* 852 952* 1007 1052 1068 1094 1094* 1515 1526 1532 1586* 2128 2322 2350 2355* 2360 2366 2426 2427* 2428 2435* 2451 2452* 2456 2473 b2 000144 automatic pointer dcl 115 set ref 784 846 952* 1060 1071 1342 1348* 1363 1477 1588* 1711 1716 1729 1731 1744 1749 1749 2105 2322 2350 2355 2360 2366* 2427* 2435* 2453* 2463 backup_command_line_1_char 000507 automatic fixed bin(24,0) dcl 138 set ref 347* 389* 432* 536* 1628* 1971 1979 1983* backup_flag 000167 automatic bit(1) dcl 121 set ref 913* 992* 1000 base_iteration_level 000510 automatic fixed bin(24,0) dcl 138 set ref 344* 387* 672 1147 1298 1306* 1678 1689* 2013 2026 2038* 2047 begin 000647 automatic fixed bin(24,0) array level 2 dcl 147 set ref 662* 678 1150 2052 begin_tag 3 000647 automatic fixed bin(24,0) array level 2 dcl 147 set ref 655* 684 1150 1150 1150 bit builtin function dcl 108 ref 726 1202 1224 blanks 011437 constant char(12) initial dcl 220 set ref 1772 1772 1772 1772 buffer1 based char dcl 165 set ref 852 1052 1068 1515 1526 1532 2128 2322* 2350 2360* 2428* 2428 2456* 2456 2473* buffer2 based char dcl 166 set ref 784 846 1060 1071 1342* 1363 1477 1711 1716 1729 1731 1744 1749 1749 2105 2322 2350* 2360 2463* 2463 buffer_pointer parameter pointer dcl 2262 ref 2260 2265 2281 2283 cc 002603 automatic fixed bin(24,0) dcl 2297 set ref 2305* 2306 2306* 2310 2313 2320* 2320 2322 2322 2323 2324 2331* 2332 2332* 2336 2339 2341 2348* 2348 2350 2350 2350 2350 2351 2352 2373 2374 char_0_code constant fixed bin(9,0) initial dcl 224 ref 488 493 char_count parameter fixed bin(24,0) dcl 2297 ref 2295 2301 2303 2305 2329 2331 cleanup 000100 stack reference condition dcl 104 ref 314 colon_X_save_command_level 000511 automatic fixed bin(24,0) dcl 138 set ref 1674* 1684 1687 1688 1690 colon_flag 000512 automatic fixed bin(24,0) dcl 138 set ref 352* 400* 526* 595 612* 637 654 701 785 798 866 933 936 957 1193 1275 1279 1288 1327 1463 1483 1547 1632 1652 1720 1729 1737 1762 colon_stack 000235 automatic fixed bin(17,0) array dcl 128 set ref 595* 612 com_err_ 000020 constant entry external dcl 172 ref 303 311 319 373 392 903 1092 1941 2289 command_char_number 000514 automatic fixed bin(24,0) dcl 138 set ref 347* 458* 662 677 678* 1133 1288 1296 1305* 1372* 1375 1377 1387* 1387 1388 1675 1683 1687* 1971* 1971 1972 1977 1982* 1982 1989 1991* 1993* 1993 1998 2036* 2049* 2052* 2068 2070 2166 command_char_stack 000262 automatic fixed bin(17,0) array dcl 129 set ref 1294 1296* 1675* 1683* 1687 2036 command_iteration_stack 000307 automatic fixed bin(17,0) array dcl 130 set ref 1298* 1677* 1690 2038 command_length_stack 000334 automatic fixed bin(17,0) array dcl 131 set ref 1297* 1676* 1688 2037 command_level 000207 automatic fixed bin(17,0) dcl 126 set ref 288* 384 1288 1294 1296 1297 1298 1299 1307* 1307 1382 1672 1674 1675 1676 1677 1679 1679 1683 1684 1691* 1691 1973 1999 2032* 2032 2033 2033 2035 2036 2037 2038 command_line based char dcl 167 ref 1150 1377 1388 1958 1977 2068 2070 2167 2175 command_line_address 000146 automatic pointer dcl 115 set ref 324* 337 1150 1304* 1377 1388 1686* 1956* 1958 1977 1991* 2035* 2068 2070 2167 2175 command_line_length 000515 automatic fixed bin(24,0) dcl 138 set ref 347* 389* 457* 1150 1288 1297 1302* 1375 1377 1388 1676 1688* 1956* 1957* 1957 1958 1958 1958 1961* 1961 1972 1977 1989 1998 2037* 2068 2070 2167 2167 2175 2183* 2183 command_seg_stack 000361 automatic fixed bin(17,0) array dcl 132 set ref 335* 1299* 1679 1679 1684 1684* 2033 2033 2035 convert builtin function dcl 108 ref 1744 copy builtin function dcl 108 ref 909 count 000516 automatic fixed bin(24,0) dcl 138 in procedure "teco" set ref 943* 947* 954 1015* 1018 1035* 1043* 1044 1046 1052 1052 1052 1052 1060 1060 1060 1060 1068 1070 1071 1224 1275 1348* 1349 1360* 1361 1363 1363 1364 1370* 1371 1375 1377 1388 1404* 1406 1407 1414 1423 1560 1574* 1575 1577 1586 1664 2099* 2111* 2266 2284 count 2 000647 automatic fixed bin(24,0) array level 2 in structure "iteration" dcl 147 in procedure "teco" set ref 652 664* 674* 674 675 cu_$arg_count 000022 constant entry external dcl 173 ref 297 cu_$arg_ptr 000024 constant entry external dcl 174 ref 255 329 370 cu_$cp 000026 constant entry external dcl 175 ref 922 cu_$evaluate_active_string 000100 constant entry external dcl 886 ref 898 cu_$ptr_call 000030 constant entry external dcl 176 ref 1115 current_Q_register based char dcl 162 set ref 909* 1115* 1407* current_Q_register_address defined pointer dcl 201 set ref 895 898 907 909 909 1115 1170* 1224 1304 1403 1407 1409 1419 1642* 1660 current_Q_register_number 000517 automatic fixed bin(24,0) dcl 138 set ref 362* 511* 514 518* 520 522 522 812* 813 814 816 816 816 825* 826 829 830 891* 893* 895 898 907 907 909 909 909 987* 1107* 1108 1115 1115 1115 1167* 1168 1170 1170 1175 1208* 1214 1215 1216 1223* 1224 1225 1283* 1286 1299 1302 1303 1303 1304 1351* 1352* 1358* 1359* 1396* 1399 1401 1403 1404 1405* 1406 1407 1407 1409 1410 1414 1414 1418* 1419 1423 1600* 1604 1605 1611 1641* 1642 1643 1659* 1660 1664 1671* 1693 1694 1695 current_Q_register_seg_number defined fixed bin(17,0) dcl 199 set ref 520 814 816 816 816 826 830* 895 898 907 909 909 1108 1115 1168 1170 1214 1215* 1224 1286 1299 1303 1303 1304 1399 1401 1403 1407 1409 1419 1604 1605* 1642 1660 1693 1694* current_Q_register_usage_count defined fixed bin(17,0) dcl 202 set ref 816* 816 1303* 1303 1401 current_Q_register_value defined fixed bin(24,0) dcl 200 set ref 514 522 522* 813 829* 907* 909 1115 1115 1170* 1175 1216* 1225* 1302 1404 1406* 1407 1410 1414* 1414 1423* 1611* 1643* 1664* 1695* current_character 000201 automatic char(1) dcl 124 set ref 422 494 534 620 627 717 883 1123 1128 1131 1624 1626 1849 1977* 1978 2148 current_expression 000520 automatic fixed bin(24,0) dcl 138 set ref 548* 550* 550 556* 556 564* 564 571* 571 578* 578 585* 585 593 610* 625 688* 854* 939* 959* 1114* 1115* 1185* 1486* 1499* 1615* 1636* 1708* 1741* 1744* 1744 1749* 1753* 1755* 1755 current_sign 000521 automatic fixed bin(24,0) dcl 138 set ref 414* 424 436 466* 466 467 467* 472* 592 609* 1715* 1723* 1755 cv_oct_check_ 000032 constant entry external dcl 177 ref 1749 cvb 000161 automatic picture(12) unaligned dcl 119 set ref 1764* 1765 1765 1766 1768 1768 1768 1768 delimiter 000202 automatic char(1) dcl 124 set ref 1920 2148* 2149 2151 2153 2153 2156 2156 2159 2159 2167 divide builtin function dcl 108 ref 571 943 2460 dot1 000522 automatic fixed bin(24,0) dcl 138 set ref 342* 500 505 849 852 876 876 876 876 945 954* 1015 1029 1035 1041 1041 1048 1052 1056 1060 1067 1068 1185 1235 1249* 1260 1261 1262 1279 1335 1339* 1339 1509 1515 1526 1530 1532 1541 1559 1560 1566 1571 1571 1579 1580 2123 2128 2313 2315 2317 2318* 2322 2322 2323 2332 2332 2346* 2346 2350 2350 2352 2360 2360 2363 2369 2373* 2373 2385 2398 2409 2428 2428 2456 2456 2470* 2473 dot2 000523 automatic fixed bin(24,0) dcl 138 set ref 342* 505 782 784 843 876 876 876 876 945 954* 1015 1041 1041 1060 1071 1185 1254* 1262 1333 1340* 1340 1342 1342 1472 1495 1571 1571 1588 1709 1711 1711 1714 1758 2098 2099 2111 2306 2306 2319* 2319 2322 2324 2339 2341 2343 2345 2347* 2350 2351 2360 2360 2360 2360 2363 2369* 2374* 2374 2386 2398 2410 2471* dummy_Q_register_number constant fixed bin(17,0) initial dcl 225 ref 987 988 989 end 1 000647 automatic fixed bin(24,0) array level 2 dcl 147 set ref 663* 677* 2049 2049 end_buffer 000524 automatic fixed bin(24,0) dcl 138 set ref 342* 505 782 784 844 846 945 954* 1015 1041 1041 1060 1071 1185 1324 1342 1363 1459 1477 1571 1571 1709 1711 1711 1716 1726 1729 1729 1731 1731 1732 1744 1749 1749 2099 2101 2105 2105 2107 2306 2306 2322 2324 2350 2354 2360 2360 2360 2360 2363 2363* 2396 2411 2414 2421* 2463 2463 2463 2465* 2471 error_code 000646 automatic fixed bin(35,0) dcl 146 set ref 255* 256 308* 309 311* 316* 317 319* 329* 370* 371 373* 898* 901 903* 922* 935* 936 968* 970 1002* 1018* 1020 1091* 1092 1092* 1094* 1111* 1112 1749* 1750 1752* 1941* 2250* 2251 2268* 2269 2278* 2286* 2287 2289* 2487* 2488 error_message 000156 automatic char(8) level 2 dcl 116 set ref 1780* 1783* 1786* 1789* 1792* 1796* 1801* 1806* 1809* 1815* 1818* 1821* 1824* 1830* 1835* 1838* 1842* 1845* 1849* 1920* 1923* 1927* 1930* 1934* 1943* 1948* 1950 error_mode 000014 internal static char(4) initial dcl 240 set ref 247* 1948 error_structure 000156 automatic structure level 1 dcl 116 set ref 1950 1950 error_table_$too_many_args 000070 external static fixed bin(35,0) dcl 211 set ref 303* errset 4 000647 automatic bit(1) array level 2 dcl 147 set ref 654* 684 2009 expression_stack 000552 automatic fixed bin(24,0) array dcl 143 set ref 588 593* 610 file based char dcl 163 set ref 1052* 1060* 1068* 1071* 1224* 1407 2266 2284 file_address 000150 automatic pointer dcl 115 set ref 935* 947* 948* 952 968* 974 985 1002* 1003 1007 1018* 1052 1060 1068 1071 1111* 1115* 1403* 1407 1409* 1419* 1660* find_command_$fc_no_message 000034 constant entry external dcl 178 ref 1111 fixed builtin function dcl 108 ref 488 493 627 726 854 1202 1224 1636 2169 2210 fixedoverflow 000106 stack reference condition dcl 104 ref 1739 1745 get_character_fail_handler 000134 automatic label variable dcl 114 set ref 413* 532* 539* 715* 879* 1119* 1619* 1973 1999 2066* 2164* 2208* get_seg_ptr_ 000036 constant entry external dcl 179 ref 935 1002 get_temp_seg_ 000040 constant entry external dcl 180 ref 316 2250 hbound builtin function dcl 108 ref 301 303 544 588 652 809 1294 2213 2240 i 000525 automatic fixed bin(24,0) dcl 138 set ref 315* 319 322* 328* 329 330 331 332 333 333* 488* 488 488* 490 491* 613* 615 826* 831 831 831 843* 844 846 849* 850 852 973* 974 977 977* 983* 985 989 1067* 1068 1068 1068 1070 1071 1214* 1217 1217 1217 1334* 1348* 1356* 1377* 1378 1387 1579* 1584 1584* 1586 1588 1588 1604* 1612 1612 1612 1684* 1686 1693* 1696 1696 1696 1714* 1716 1719* 1719 1722 1726 1729 1729 1731 1731 1732 1736* 1736 1744 1749 1749 1758 1765* 1766* 1766 1768 1768 1768 1768 1768* 1771* 1772 1772 1774* 2169* 2171 2173 2175 2175 2176 ic 002622 automatic fixed bin(24,0) dcl 2380 set ref 2384* 2400* 2406* 2407 2411 2418 2421 2439 2460 2470 2473 2473 2473 2473 ichar based char unaligned dcl 2380 ref 2473 immediate_interrupt_ok 000170 automatic bit(1) dcl 121 set ref 350* 357 383* 412* 815* 827* 951* 1006* 1090* 1212* 1222* 1301* 1393* 1603* 1658* 1685* 2030 2031* 2039* 2194 2195* 2201* 2228 2229* 2257* 2312* 2338* 2416* in_ptr parameter pointer dcl 2380 ref 2404 2473 2480 2482 index builtin function dcl 108 ref 422 620 717 883 1123 1128 1377 1477 1515 1526 1716 2105 2128 2167 insert_count parameter fixed bin(24,0) dcl 2380 ref 2404 2406 io_char 000203 automatic char(1) dcl 124 set ref 291 488 493 726* 727 727 730 730 733 733 736 738 740 846* 852* 854 1082* 1202* 1636 1978* 2210 io_char_address 000152 automatic pointer dcl 115 set ref 291* 1083* 1203* 1979* 2278* ioa_ 000042 constant entry external dcl 181 ref 637 640 ioa_$rsnnl 000044 constant entry external dcl 181 ref 1771 iox_$get_chars 000046 constant entry external dcl 185 ref 2278 iox_$get_line 000050 constant entry external dcl 186 ref 2268 iox_$put_chars 000052 constant entry external dcl 187 ref 2286 iox_$user_input 000074 external static pointer dcl 213 set ref 2268* 2278* iox_$user_output 000076 external static pointer dcl 214 set ref 2286* iteration 000647 automatic structure array level 1 dcl 147 iteration_answer 000545 automatic fixed bin(24,0) dcl 138 set ref 682* 688 1157* 2017* iteration_level 000526 automatic fixed bin(24,0) dcl 138 set ref 349* 387* 443 652 654 655 661* 661 662 663 664 672 674 674 675 677 678 681* 681 684 684 697 707 1144 1146 1306 1677 1678* 1689 1690* 2007 2009 2026 2046* 2047 2049 2049 2052 j 000530 automatic fixed bin(24,0) dcl 138 set ref 972* 977 977* 981 983 1070* 1071 1071 1071 1348* 1360 1363 1477* 1478 1490 1515* 1517 1519 1526* 1527 1529 1580* 1581 1583* 1588 1588 1711* 1712 1714 1716* 1717 1723 1729* 1731* 1732 1732* 1734 1736 2105* 2107 2109 2125* 2128* 2129 2129* 2132 2166* 2167 2167 2175 lbound builtin function dcl 108 ref 973 2211 length parameter fixed bin(24,0) dcl 2262 in procedure "READ" set ref 2281 2286* length builtin function dcl 108 in procedure "teco" ref 259 259 366 907 1765 1766 1768 1768 1772 1772 1950 macro_entry 000406 automatic fixed bin(17,0) dcl 133 set ref 270* 281* 286* 301 315 325 327 328 364 390 448* match 000173 automatic bit(1) dcl 121 set ref 782* 784* 785* 785 787 max builtin function dcl 108 ref 876 876 1766 max_dot1 000532 automatic fixed bin(24,0) dcl 138 set ref 343* 954* 2313 2315 2317 2318 2323* 2354* 2363* 2421* 2439* max_positive_integer 000307 constant fixed bin(35,0) initial dcl 229 ref 648 1103 1105 1609 1741 1753 max_seg_size 000531 automatic fixed bin(24,0) dcl 138 set ref 296* 1046 2173 2268 2411 2460 min builtin function dcl 108 ref 259 876 876 1766 1772 1772 2460 min_dot2 000533 automatic fixed bin(24,0) dcl 138 set ref 343* 955* 2339 2343 2345 2347 2351* 2352 2368* 2422* 2440* 2461* multiply builtin function dcl 108 ref 490 must_find 002530 automatic bit(1) dcl 2089 set ref 2091* 2096* 2101 2116* 2121* 2137 my_id 000200 automatic bit(36) dcl 123 set ref 308* 316* 1091* 2250* n0 002616 automatic fixed bin(24,0) dcl 2380 set ref 2417* 2420* 2454 2458 2476 n1 000534 automatic fixed bin(24,0) dcl 138 set ref 340* 953* 1094 1335 2356* 2367 2417 2420 2423 2425* 2432* 2434 2435 2441 2443 2445* 2448* 2450 2452 2454 2461 n2 000535 automatic fixed bin(24,0) dcl 138 set ref 340* 953* 1335 2356 2367* 2425* 2432 2434* 2441 2446* 2448 2450* 2453 2458 2461 nd2 002621 automatic fixed bin(24,0) dcl 2380 set ref 2386* 2395* 2396 2398 2410* 2411 2414 2418 2440 new_dot1 parameter fixed bin(24,0) dcl 2380 ref 2390 2392 new_dot2 parameter fixed bin(24,0) dcl 2380 ref 2390 2395 new_end 002623 automatic fixed bin(24,0) dcl 2380 set ref 2460* 2461 2463 2465 new_error_mode parameter char unaligned dcl 246 ref 244 247 new_line_char constant char(1) initial dcl 218 ref 292 1082 1342 2105 2128 nl 2 000156 automatic char(1) level 2 dcl 116 set ref 292* no_ES_flag 000171 automatic bit(1) dcl 121 set ref 269* 280* 284* 1099 no_number 000172 automatic bit(1) dcl 121 set ref 417* 431* 561 568 575 582 null builtin function dcl 108 ref 294 341 898 898 1003 1094 2247 2484 num_arg 000536 automatic fixed bin(24,0) dcl 138 set ref 351* 396* 402 544 547* 547 594 604 613 614* 625 637* 640* 645 648 669 687* 694 699 710 713 720 724 744 752 760 768 777 835 839 855* 859 863 870 874 929 933* 995 1011 1024 1103 1105 1116* 1138 1141 1163 1174* 1180 1186* 1189 1195 1209 1231 1238 1242 1244 1266 1270 1310 1314 1316 1327* 1397 1429 1439 1441 1443 1463* 1551 1553 1555 1593 1606 1608* 1611 1614* 1614 1615 1637* 1656 1669 1704 1707* 1766 1772 num_arg_stack 000407 automatic fixed bin(17,0) array dcl 134 set ref 594* 614 number 000537 automatic fixed bin(24,0) dcl 138 set ref 416* 430* 436* 436 490* 490 496* 500* 505* 514* 522* 548 550 556 564 571 578 585 607* 633* number_reserved_temp_segs constant fixed bin(17,0) initial dcl 226 ref 315 2236 octal_number 000540 automatic fixed bin(24,0) dcl 138 set ref 477* 491* 491 496 offset parameter fixed bin(24,0) dcl 2262 ref 2260 2266 2266 2268 2281 2284 2284 old_seg 002545 automatic fixed bin(24,0) dcl 2144 set ref 2197* 2200 2200 operator_stack 000576 automatic fixed bin(24,0) array dcl 144 set ref 591* 608 p 000154 automatic pointer dcl 115 set ref 316* 322 2265* 2266* 2266 2268* 2283* 2284* 2284 2286* paren_level 000541 automatic fixed bin(24,0) dcl 138 set ref 345* 388* 446 588 591 592 593 594 595 596 597* 597 601 606* 606 608 609 610 611 612 614 program_interrupt 000114 stack reference condition dcl 104 ref 355 program_interrupt_flag 000174 automatic bit(1) dcl 121 set ref 354* 359* 381* 409 program_name 000452 constant char(4) initial dcl 234 set ref 303* 308* 311* 319* 373* 392* 903* 1092* 1941* 2289* pushdown_Q_register_seg_number 000434 automatic fixed bin(17,0) array dcl 135 set ref 326* 333* 454 454 814* 830 pushdown_Q_register_value 000460 automatic fixed bin(17,0) array dcl 136 set ref 301 303 327* 332* 809 813* 829 quote_name 002543 automatic fixed bin(24,0) dcl 2144 set ref 2162* 2163* 2189* 2191 2199 quote_seg 002544 automatic fixed bin(24,0) dcl 2144 set ref 2191* 2192 2196 2196 2198 quoted_string based char dcl 164 set ref 367* 377* 784 903* 935* 968* 1000* 1002* 1150 1363* 1371* 1377 1477 1510 1532 1941* 2175* quoted_string_Q_register_number constant fixed bin(17,0) initial dcl 227 ref 362 1351 1358 2162 quoted_string_address defined pointer dcl 205 set ref 367 377 784 898 903 922* 935 968 1000 1002 1111* 1150 1198* 1348* 1363 1371 1377 1477 1510 1532 1596* 1941 2175 quoted_string_length defined fixed bin(24,0) dcl 204 set ref 366* 367 376* 377 782 784 784 898 898 903 903 922* 935 935 968 968 1000 1000 1002 1002 1111* 1150 1198* 1216 1329 1334 1353* 1363 1364* 1370 1371 1377 1387 1466 1477 1490 1510 1511 1530 1532 1532 1532 1532 1596* 1695 1941 1941 2173 2175 2175 2176* 2176 2199* quoted_string_seg_number defined fixed bin(17,0) dcl 203 set ref 338* 1213 1213 1215 1692 1692 1694 2197 2198* quoted_string_unal based char unaligned dcl 897 set ref 898* r_access 000305 constant bit(6) initial dcl 232 set ref 935* radix constant fixed bin(17,0) initial dcl 228 ref 488 490 read_count 000543 automatic fixed bin(24,0) dcl 138 set ref 297* 301 315 325 327 328 329 935* 943 968* 988 1002* 1643 1957 2268* 2272 2278* release_seg_ptr_ 000054 constant entry external dcl 188 ref 1018 1094 2487 release_temp_segs_all_ 000056 constant entry external dcl 189 ref 1091 ret_string based varying char(10000) dcl 886 set ref 895* 898* 907 909 return_iteration_level parameter fixed bin(24,0) dcl 2045 in procedure "unwind_iteration" ref 2043 2046 return_iteration_level 000527 automatic fixed bin(24,0) dcl 138 in procedure "teco" set ref 1146* 1147 1150 1150 1150 1150 1156* 2009* 2009* 2011 2013 2016 reverse builtin function dcl 108 ref 1515 1526 1526 2128 rwa_access 000306 constant bit(5) initial dcl 231 set ref 316* 2250* rwac_access 000304 constant bit(6) initial dcl 233 set ref 1002* s1 002617 automatic fixed bin(24,0) dcl 2380 set ref 2385* 2392* 2393 2398 2409* 2411 2418 2421 2428 2428 2439 2448 2454 2456 2456 2460 2470 2473 s2 002620 automatic fixed bin(24,0) dcl 2380 set ref 2414* 2418 2421 2428 2428 2432 2448 2458 2460 2461 2463 2463 2463 2463 2471 save_immediate_interrupt_ok 002565 automatic bit(1) dcl 2222 in procedure "allocate_Q_register" set ref 2228* 2257 save_immediate_interrupt_ok 002542 automatic bit(1) dcl 2144 in procedure "get_quoted_string" set ref 2194* 2201 save_interrupt_ok 002504 automatic bit(1) dcl 2025 set ref 2030* 2039 search builtin function dcl 108 ref 2068 search_answer 000544 automatic fixed bin(24,0) dcl 138 set ref 348* 459* 699 1482* 1486 1497* 1499 search_chars parameter char(2) dcl 2061 in procedure "skip" ref 2059 2063 2068 2070 search_chars 000204 automatic char(2) dcl 125 in procedure "teco" set ref 1510* 1515 1526 search_file_ 000060 constant entry external dcl 190 ref 1348 search_length 000546 automatic fixed bin(24,0) dcl 138 set ref 1988 1989* 1991* 1993 2068* 2167* 2169 search_successful 000175 automatic bit(1) dcl 121 set ref 1988* 1989 2070 2169 2178 sign_stack 000622 automatic fixed bin(24,0) array dcl 145 set ref 592* 609 signature 000012 internal static char(8) initial dcl 239 set ref 258* 259 262* 450 450 signature_length 000010 internal static fixed bin(24,0) initial dcl 238 set ref 259* 263* 450 450* skip_count 000547 automatic fixed bin(24,0) dcl 138 set ref 2065* 2073* 2073 2074 2080* 2080 source 002614 automatic pointer dcl 2380 set ref 2426* 2428 2451* 2456 2463 2482* 2484 2487* start 000542 automatic fixed bin(24,0) dcl 138 set ref 1009* 1046 1052 1060 1068 1071 1410* 1421* 1662* start_up_name 000310 constant char(8) initial dcl 223 ref 366 367 string 000164 automatic char(12) unaligned dcl 120 set ref 1771* 1774 1774 substr builtin function dcl 108 set ref 784 846 852 1052* 1052 1060* 1060 1068* 1068 1071* 1071 1150 1224 1342* 1363* 1363 1371* 1377 1377 1388 1477 1510 1515 1515 1526 1532 1532 1711 1716 1729 1731 1744 1749 1749 1768 1768 1958 1977 2068 2070 2070 2105 2128 2167 2175* 2175 2266 2284 2322* 2322 2350* 2350 2360* 2360 2428* 2428 2456* 2456 2463* 2463 2473* 2473 sys_info$max_seg_size 000072 external static fixed bin(24,0) dcl 212 ref 296 tag_char_number 000513 automatic fixed bin(24,0) dcl 138 set ref 643* 655 1133* tc 002604 automatic fixed bin(24,0) dcl 2297 set ref 2317* 2319 2320 2345* 2346 2348 teco_abort 000122 stack reference condition dcl 104 ref 276 361 teco_backup_file_ 000062 constant entry external dcl 193 ref 1000 teco_error 000064 constant entry external dcl 194 ref 1948 teco_get_macro_ 000066 constant entry external dcl 195 ref 968 temp_dot 000550 automatic fixed bin(24,0) dcl 138 set ref 1034 1035 1249* 1254* 1279 1322 1333* 1346 1348 1348* 1360 1457 1472* 1475 1477 1477 1490* 1490 1495 1509* 1513 1515 1519* 1519 1523 1526 1529* 1529 1530 1532 1536* 1536 1541 1565 1714* 1722* 1744 1744 1749 1749 1749 1749 2098* 2101 2105 2105 2107* 2109* 2109 2111 2123* 2126 2128 2129 2132* 2132 2134* 2134 2135 2139* temp_seg_address 300 001014 automatic pointer array level 2 dcl 153 set ref 294* 322* 324 330 337* 367 367 377 377 784 784 895 895 898 898 898 898 903 903 907 907 909 909 909 909 922 922 935 935 968 968 973 974 985* 1000 1000 1002 1002 1111 1111 1115 1115 1150 1150 1170 1170 1198 1198 1224 1224 1304 1304 1348 1348 1363 1363 1371 1371 1377 1377 1403 1403 1407 1407 1409 1409 1419 1419 1477 1477 1510 1510 1532 1532 1596 1596 1642 1642 1660 1660 1686 1941 1941 2035 2175 2175 2240 2247 2250* 2427 2435 2452 2453 temp_seg_info 001014 automatic structure level 1 dcl 153 set ref 293* temp_seg_usage_count 1122 001014 automatic fixed bin(17,0) array level 2 dcl 153 set ref 331* 336* 339* 454* 454 816* 816 816 816 831* 831 977 1213* 1213 1217* 1217 1303* 1303 1303 1303 1401 1401 1612* 1612 1679* 1679 1692* 1692 1696* 1696 2033* 2033 2196* 2196 2200* 2200 2233* 2233 2234 2243 2255* trace_flag 000176 automatic bit(1) dcl 121 set ref 346* 395* 530* 534* 537 1077 1979 1991 2062* 2076* trace_flag_copy 000177 automatic bit(1) dcl 121 set ref 346* 395 537* 2076 unspec builtin function dcl 108 set ref 293* 488 493 578* 578 578 585* 585 585 627 726* 854 1202* 1224* 1636 2210 verify builtin function dcl 108 ref 1711 1729 1731 1765 which_operator 000551 automatic fixed bin(24,0) dcl 138 set ref 353* 402* 406* 424 428 441 463 542* 591 608* 620* 622 630 white_space 011436 constant char(2) initial dcl 221 ref 1128 1711 1765 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ATOMIC_ACTIVE_STRING internal static fixed bin(17,0) initial dcl 1-6 DEFAULT_ACTIVE_STRING internal static fixed bin(17,0) initial dcl 1-6 TOKENS_ONLY_ACTIVE_STRING internal static fixed bin(17,0) initial dcl 1-6 NAMES DECLARED BY EXPLICIT CONTEXT. ABORT 000673 constant entry external dcl 273 A_1_arg_before_0 006277 constant label dcl 1796 ref 850 A_1_arg_beyond_Z 006274 constant label dcl 1792 ref 844 COMMAND 000000 constant label array(0:127) dcl 396 set ref 627 COMMAND_PREFIX 000200 constant label array(0:24) dcl 418 set ref 422 463 C_check 002712 constant label dcl 863 ref 1236 1434 EM_have_name 003270 constant label dcl 968 ref 379 EM_have_slot 003354 constant label dcl 985 ref 974 EM_macro_not_found 006374 constant label dcl 1937 ref 970 EM_no_slot 006324 constant label dcl 1824 ref 981 EO_EB_common 003371 constant label dcl 995 ref 916 EO_X_after_dot 003613 constant label dcl 1056 ref 1030 EO_X_around_dot 003634 constant label dcl 1064 ref 1016 EO_X_before_dot 003572 constant label dcl 1048 ref 1036 EO_X_common 003523 constant label dcl 1024 ref 1011 1412 1422 1663 EO_close_file 003502 constant label dcl 1018 ref 1010 EQ 003674 constant label dcl 1077 ref 320 374 393 ES_numeric_Q 006327 constant label dcl 1830 ref 1108 ES_subroutine_not_found 006374 constant label dcl 1937 ref 1112 EXTERNAL_COMMAND 000256 constant label array(0:18) dcl 886 ref 879 883 F_COMMAND 000301 constant label array(0:2) dcl 1126 ref 1119 1123 1131 M_get_new_line 004444 constant label dcl 1299 set ref 1292 M_have_reg 004421 constant label dcl 1288 ref 990 M_numeric_Q_register 006327 constant label dcl 1830 ref 1286 M_return 001564 constant label dcl 409 ref 1308 OPERATOR 000231 constant label array(-1:6) dcl 542 ref 441 O_have_label 004674 constant label dcl 1372 ref 1385 O_unwind_command 004720 constant label dcl 1378 ref 1375 QUOTE_COMMAND 000241 constant label array(0:12) dcl 720 ref 717 Q_register_pushdown_overflow 006324 constant label dcl 1824 ref 809 Q_register_pushdown_underflow 006321 constant label dcl 1821 ref 822 READ 007510 constant entry internal dcl 2260 ref 1642 1956 READ_CHAR 007552 constant entry internal dcl 2276 ref 1635 S_fail 005136 constant label dcl 1478 ref 1346 1354 1447 1452 1475 1513 1517 1523 1527 S_succeed 005156 constant label dcl 1497 ref 1542 S_succeed_forward 005153 constant label dcl 1495 ref 1361 1365 TECO 000553 constant entry external dcl 12 VW 005523 constant label dcl 1632 ref 1624 1626 WRITE 007575 constant entry internal dcl 2281 ref 450 1083 1586 1588 1596 1950 1979 1991 abort 000702 constant entry external dcl 273 add_chars 010146 constant entry internal dcl 2404 ref 947 1170 1198 1203 1768 1772 1774 allocate_Q_register 007404 constant entry internal dcl 2220 ref 1641 1659 allocate_Q_register_have_number 007415 constant entry internal dcl 2226 ref 893 1223 1352 1359 1405 1418 2163 arg_loop 001563 constant label dcl 406 ref 549 553 558 565 572 579 586 args_wrong_order 006363 constant label dcl 1927 ref 1044 1258 1575 backslash 005676 constant label dcl 1701 ref 1176 backslash_0_args_done 006061 constant label dcl 1745 ref 1742 backslash_0_args_number_not_found 006271 constant label dcl 1789 ref 1709 1712 1726 1734 backup_com_line 001621 constant label dcl 432 ref 494 bad_negative_argument 006277 constant label dcl 1796 ref 650 check_command 002155 constant label dcl 625 ref 424 check_errset 006664 constant entry internal dcl 2005 ref 1937 1946 check_operator 002143 constant label dcl 620 ref 428 close_a_file 010422 constant label dcl 2484 ref 2476 close_file 010414 constant entry internal dcl 2480 ref 948 colon_X_not_in_macro 006366 constant label dcl 1930 ref 1672 command_abort 001504 constant label dcl 381 ref 357 361 409 904 1942 1951 command_complete 001554 constant label dcl 396 ref 461 598 641 665 679 684 701 705 727 730 733 736 738 740 748 756 764 772 787 795 801 806 819 833 867 877 910 923 957 1022 1171 1199 1204 1219 1226 1250 1255 1263 1281 1329 1331 1388 1426 1466 1468 1577 1590 1597 1619 1629 1644 1648 1666 1698 1776 command_level_overflow 006324 constant label dcl 1824 set ref 1294 command_return_value 001555 constant label dcl 400 ref 689 856 940 960 1117 1187 1487 1501 1616 1638 1759 command_string_completed 001631 constant label dcl 443 ref 413 539 continue_scan 001576 constant label dcl 418 set ref 469 474 528 540 copy_source 010114 constant entry internal dcl 2378 ref 1007 copy_text 010167 constant label dcl 2414 ref 2387 2401 declarations 000725 constant label dcl 284 ref 16 delete_chars 010123 constant entry internal dcl 2390 ref 876 1249 1254 1262 dot_before_0 006277 constant label dcl 1796 ref 2137 2332 2393 dot_beyond_Z 006274 constant label dcl 1792 ref 1046 2101 2306 2396 fatal_S_fail 006424 constant label dcl 1943 ref 1483 file_error 006374 constant label dcl 1937 ref 936 1003 1020 2488 find_character 006651 constant entry internal dcl 1996 ref 2081 2180 find_free_seg 007436 constant label dcl 2238 ref 2243 find_line_forward 007062 constant entry internal dcl 2094 ref 1028 1320 1449 1558 find_line_reverse 007144 constant entry internal dcl 2119 ref 1033 1454 1564 get_Q_register_number 007364 constant entry internal dcl 2205 ref 511 518 812 825 891 1107 1167 1208 1283 1396 1600 1671 2189 2224 get_character 006573 constant entry internal dcl 1968 ref 418 492 533 716 882 1122 1126 1129 1623 2147 2209 get_number 001573 constant label dcl 414 ref 615 622 get_out_of_iteration 002350 constant label dcl 684 ref 1158 2018 get_quoted_string 007216 constant entry internal dcl 2142 ref 781 892 919 934 965 999 1110 1143 1197 1211 1328 1367 1465 1595 1682 got_number 001623 constant label dcl 436 ref 497 502 508 515 523 617 illegal_Q_register_name 006343 constant label dcl 1845 ref 2211 2213 illegal_delimiter 006353 constant label dcl 1920 ref 2153 2156 2159 in_chk 007545 constant label dcl 2269 ref 2279 io_diaster 007630 constant label dcl 2289 ref 2269 iteration_common 002256 constant label dcl 645 ref 1135 iteration_done 002346 constant label dcl 682 ref 659 708 iteration_overflow 006310 constant label dcl 1809 ref 652 iteration_underflow 006310 constant label dcl 1809 ref 672 label_not_found 006266 constant label dcl 1786 ref 1161 1382 macro 000714 constant entry external dcl 278 minus_S_iterate 005240 constant label dcl 1523 ref 1530 1532 1538 missing_Q_register_name 006343 constant label dcl 1845 ref 2208 missing_double_quote_command 006335 constant label dcl 1838 ref 715 missing_right_operand 006366 constant label dcl 1930 ref 561 568 575 582 move_dot 007652 constant entry internal dcl 2295 ref 866 1500 move_dot_backward 007750 constant entry internal dcl 2329 ref 1261 1279 1338 move_dot_forward 007664 constant entry internal dcl 2303 ref 1260 1275 1758 move_to_b1 010074 constant label dcl 2363 ref 2324 must_allocate_Q_register 007434 constant label dcl 2236 ref 2231 must_find_line_forward 007054 constant entry internal dcl 2087 ref 1248 1274 must_find_line_reverse 007136 constant entry internal dcl 2114 ref 1253 1278 new_arg 001560 constant label dcl 402 ref 630 no_ES_declarations 000727 constant label dcl 288 ref 271 282 no_more_temp_segs 006360 constant label dcl 1923 ref 2240 2251 no_quoting_delimiter 007333 constant label dcl 2183 ref 2164 no_room 006260 constant label dcl 1780 ref 2411 normal_P_close_Q_reg 005012 constant label dcl 1414 ref 1411 normal_X_close_Q_register 005603 constant label dcl 1664 ref 1661 null_P_close_Q_reg 005033 constant label dcl 1423 ref 1420 numeric_quoted_in_Q 006327 constant label dcl 1830 ref 2192 parenthesis_overflow 006302 constant label dcl 1801 ref 588 percent_cant_increment 006332 constant label dcl 1835 ref 520 plus_S_loop 005115 constant label dcl 1473 ref 1492 print_command_line 006632 constant entry internal dcl 1986 ref 2069 2168 print_error_message 006427 constant label dcl 1946 ref 1782 1785 1788 1791 1795 1800 1805 1808 1814 1817 1820 1823 1829 1834 1837 1841 1844 1848 1919 1922 1926 1929 1933 1936 1945 question_mark_alone 002014 constant label dcl 537 ref 532 quote_skip 002562 constant label dcl 793 ref 742 750 758 766 774 789 798 quoted_string_in_Q_register 007337 constant label dcl 2189 ref 2149 2151 read_line 006551 constant entry internal dcl 1953 ref 460 2185 release_bufs 006456 constant entry internal dcl 1088 ref 314 1085 revert_command_level 006720 constant entry internal dcl 2023 ref 1291 1384 1681 1975 2001 semi_colon_out_of_iteration 006310 constant label dcl 1809 ref 697 1144 set_prompt 000610 constant entry external dcl 252 skip 007001 constant entry internal dcl 2059 ref 658 793 2053 skip_fail 006305 constant label dcl 1806 ref 2066 skip_with_trace 007005 constant entry internal dcl 2063 ref 804 1134 strange_parentheses 006302 constant label dcl 1801 ref 604 string_too_long 006324 constant label dcl 1824 ref 2173 teco 000544 constant entry external dcl 12 teco_error_mode 000564 constant entry external dcl 244 teco_no_ES 000661 constant entry external dcl 267 too_few_args 006316 constant label dcl 1818 ref 720 744 752 760 768 1141 too_many_args 006313 constant label dcl 1815 ref 544 645 669 694 710 724 777 835 863 874 929 995 1138 1163 1180 1189 1238 1266 1314 1441 1553 1593 1669 tty_no_read 006360 constant label dcl 1923 ref 2272 2291 two_commas 002023 constant label dcl 544 ref 634 unbalanced_parentheses 006302 constant label dcl 1801 ref 446 601 unfinished_iteration 006310 constant label dcl 1809 ref 443 2026 2047 unimplemented_feature 006263 constant label dcl 1783 ref 839 925 1099 1318 1324 unwind_command_level 006725 constant entry internal dcl 2028 ref 385 1148 2014 unwind_iteration 006755 constant entry internal dcl 2043 ref 707 1156 2016 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 12076 12200 11447 12106 Length 12466 11447 102 252 426 6 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME teco 1722 external procedure is an external procedure. on unit on line 314 64 on unit on unit on line 355 64 on unit on unit on line 361 64 on unit begin block on line 896 begin block shares stack frame of external procedure teco. release_bufs 94 internal procedure is called by several nonquick procedures. on unit on line 1739 64 on unit read_line internal procedure shares stack frame of external procedure teco. get_character internal procedure shares stack frame of external procedure teco. check_errset internal procedure shares stack frame of external procedure teco. revert_command_level internal procedure shares stack frame of external procedure teco. unwind_iteration internal procedure shares stack frame of external procedure teco. skip internal procedure shares stack frame of external procedure teco. must_find_line_forward internal procedure shares stack frame of external procedure teco. get_quoted_string internal procedure shares stack frame of external procedure teco. get_Q_register_number internal procedure shares stack frame of external procedure teco. allocate_Q_register internal procedure shares stack frame of external procedure teco. READ internal procedure shares stack frame of external procedure teco. move_dot internal procedure shares stack frame of external procedure teco. copy_source internal procedure shares stack frame of external procedure teco. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 signature_length teco 000012 signature teco 000014 error_mode teco STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME teco 000130 EO_X_common_return teco 000134 get_character_fail_handler teco 000140 arg_address teco 000142 b1 teco 000144 b2 teco 000146 command_line_address teco 000150 file_address teco 000152 io_char_address teco 000154 p teco 000156 error_structure teco 000161 cvb teco 000164 string teco 000167 backup_flag teco 000170 immediate_interrupt_ok teco 000171 no_ES_flag teco 000172 no_number teco 000173 match teco 000174 program_interrupt_flag teco 000175 search_successful teco 000176 trace_flag teco 000177 trace_flag_copy teco 000200 my_id teco 000201 current_character teco 000202 delimiter teco 000203 io_char teco 000204 search_chars teco 000205 Q_register_pushdown_level teco 000206 arg_length teco 000207 command_level teco 000210 arg1_stack teco 000235 colon_stack teco 000262 command_char_stack teco 000307 command_iteration_stack teco 000334 command_length_stack teco 000361 command_seg_stack teco 000406 macro_entry teco 000407 num_arg_stack teco 000434 pushdown_Q_register_seg_number teco 000460 pushdown_Q_register_value teco 000504 arg teco 000507 backup_command_line_1_char teco 000510 base_iteration_level teco 000511 colon_X_save_command_level teco 000512 colon_flag teco 000513 tag_char_number teco 000514 command_char_number teco 000515 command_line_length teco 000516 count teco 000517 current_Q_register_number teco 000520 current_expression teco 000521 current_sign teco 000522 dot1 teco 000523 dot2 teco 000524 end_buffer teco 000525 i teco 000526 iteration_level teco 000527 return_iteration_level teco 000530 j teco 000531 max_seg_size teco 000532 max_dot1 teco 000533 min_dot2 teco 000534 n1 teco 000535 n2 teco 000536 num_arg teco 000537 number teco 000540 octal_number teco 000541 paren_level teco 000542 start teco 000543 read_count teco 000544 search_answer teco 000545 iteration_answer teco 000546 search_length teco 000547 skip_count teco 000550 temp_dot teco 000551 which_operator teco 000552 expression_stack teco 000576 operator_stack teco 000622 sign_stack teco 000646 error_code teco 000647 iteration teco 001014 temp_seg_info teco 002504 save_interrupt_ok revert_command_level 002530 must_find must_find_line_forward 002542 save_immediate_interrupt_ok get_quoted_string 002543 quote_name get_quoted_string 002544 quote_seg get_quoted_string 002545 old_seg get_quoted_string 002554 Q_number get_Q_register_number 002564 alloc_seg allocate_Q_register 002565 save_immediate_interrupt_ok allocate_Q_register 002602 accept_error move_dot 002603 cc move_dot 002604 tc move_dot 002614 source copy_source 002616 n0 copy_source 002617 s1 copy_source 002620 s2 copy_source 002621 nd2 copy_source 002622 ic copy_source 002623 new_end copy_source THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as alloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return tra_ext tra_label_var signal enable shorten_stack ext_entry ext_entry_desc int_entry repeat set_cs_eis index_cs_eis search_eis any_to_any_tr THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. assign_temp_seg_id_ com_err_ cu_$arg_count cu_$arg_ptr cu_$cp cu_$evaluate_active_string cu_$ptr_call cv_oct_check_ find_command_$fc_no_message get_seg_ptr_ get_temp_seg_ ioa_ ioa_$rsnnl iox_$get_chars iox_$get_line iox_$put_chars release_seg_ptr_ release_temp_segs_all_ search_file_ teco_backup_file_ teco_error teco_get_macro_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$too_many_args iox_$user_input iox_$user_output sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 12 000543 16 000560 244 000561 247 000577 248 000606 252 000607 255 000615 256 000634 258 000636 259 000644 260 000651 262 000652 263 000655 265 000657 267 000660 269 000666 270 000670 271 000671 273 000672 276 000707 278 000712 280 000721 281 000722 282 000724 284 000725 286 000726 288 000727 290 000730 291 000731 292 000733 293 000735 294 000740 296 000753 297 000757 301 000767 303 000775 305 001027 308 001030 309 001051 311 001053 312 001102 314 001103 315 001125 316 001135 317 001152 319 001154 320 001206 322 001207 323 001213 324 001215 325 001217 326 001223 327 001224 328 001230 329 001240 330 001261 331 001271 332 001274 333 001276 334 001301 335 001303 336 001305 337 001307 338 001311 339 001313 340 001315 341 001317 342 001321 343 001324 344 001326 345 001327 346 001330 347 001332 348 001335 349 001336 350 001337 351 001341 352 001342 353 001343 354 001345 355 001346 357 001362 359 001370 360 001373 361 001374 362 001413 364 001415 366 001417 367 001421 368 001430 370 001431 371 001450 373 001452 374 001467 376 001470 377 001472 379 001503 381 001504 383 001505 384 001506 385 001510 386 001511 387 001512 388 001514 389 001515 390 001517 392 001521 393 001551 395 001552 396 001554 400 001555 402 001556 406 001563 409 001564 412 001566 413 001570 414 001573 416 001574 417 001575 418 001576 422 001577 424 001610 428 001614 430 001615 431 001617 432 001621 436 001623 441 001627 443 001631 446 001633 448 001635 450 001636 452 001656 453 001660 454 001662 456 001666 457 001667 458 001670 459 001671 460 001672 461 001673 463 001674 466 001676 467 001700 469 001703 472 001704 474 001706 477 001707 488 001710 490 001720 491 001724 492 001730 493 001731 494 001736 496 001741 497 001743 500 001744 502 001746 505 001747 508 001753 511 001754 514 001756 515 001761 518 001762 520 001764 522 001767 523 001773 526 001774 528 001776 530 001777 532 002001 533 002004 534 002005 536 002012 537 002014 539 002016 540 002021 542 002022 544 002023 547 002026 548 002027 549 002031 550 002032 553 002034 556 002035 558 002037 561 002040 564 002042 565 002045 568 002046 571 002050 572 002053 575 002054 578 002056 579 002060 582 002061 585 002063 586 002065 588 002066 591 002071 592 002074 593 002076 594 002100 595 002102 596 002104 597 002106 598 002107 601 002110 604 002112 606 002115 607 002117 608 002121 609 002124 610 002126 611 002130 612 002132 613 002134 614 002136 615 002140 617 002142 620 002143 622 002154 625 002155 627 002160 630 002165 633 002167 634 002170 637 002171 640 002225 641 002254 643 002255 645 002256 648 002261 650 002265 652 002267 654 002272 655 002277 656 002301 658 002303 659 002307 661 002310 662 002311 663 002316 664 002320 665 002322 669 002323 672 002325 674 002330 675 002334 677 002337 678 002341 679 002343 681 002344 682 002346 684 002350 687 002357 688 002361 689 002363 694 002364 697 002367 699 002371 701 002375 704 002401 705 002402 707 002404 708 002411 710 002412 713 002415 715 002420 716 002423 717 002424 720 002435 724 002437 726 002441 727 002446 730 002455 733 002462 736 002467 738 002471 740 002473 742 002475 744 002476 748 002500 750 002503 752 002504 756 002506 758 002511 760 002512 764 002514 766 002517 768 002520 772 002522 774 002525 777 002526 781 002530 782 002531 784 002537 785 002552 787 002557 789 002561 793 002562 795 002566 798 002567 801 002572 804 002573 806 002577 809 002600 812 002603 813 002605 814 002611 815 002613 816 002614 818 002616 819 002617 822 002620 825 002622 826 002624 827 002627 828 002630 829 002632 830 002635 831 002637 833 002644 835 002645 839 002650 841 002652 843 002654 844 002657 846 002661 847 002666 849 002667 850 002672 852 002673 854 002700 855 002703 856 002705 859 002706 863 002712 866 002715 867 002730 870 002731 874 002735 876 002740 877 002756 879 002757 882 002762 883 002763 891 002774 892 002776 893 002777 895 003001 898 003005 901 003052 903 003054 904 003107 907 003110 909 003116 910 003131 913 003133 916 003135 919 003136 922 003137 923 003154 925 003155 929 003156 933 003160 934 003162 935 003163 936 003221 939 003226 940 003227 943 003230 945 003234 947 003240 948 003242 949 003244 951 003245 952 003246 953 003251 954 003253 955 003260 957 003261 959 003264 960 003266 965 003267 968 003270 970 003322 972 003324 973 003325 974 003332 977 003337 980 003346 981 003351 983 003353 985 003354 987 003360 988 003362 989 003365 990 003367 992 003370 995 003371 999 003374 1000 003375 1002 003415 1003 003453 1006 003457 1007 003460 1009 003465 1010 003467 1011 003472 1014 003474 1015 003475 1016 003501 1018 003502 1020 003520 1022 003522 1024 003523 1028 003531 1029 003532 1030 003534 1033 003535 1034 003536 1035 003540 1036 003543 1039 003544 1041 003547 1043 003560 1044 003563 1046 003564 1048 003567 1052 003572 1054 003607 1056 003611 1060 003613 1062 003632 1067 003634 1068 003637 1070 003653 1071 003656 1073 003672 1077 003674 1082 003676 1083 003700 1085 003705 1086 003711 1099 003712 1103 003714 1105 003720 1107 003725 1108 003727 1110 003732 1111 003733 1112 003752 1114 003754 1115 003755 1116 004012 1117 004014 1119 004015 1122 004020 1123 004021 1126 004032 1128 004033 1129 004044 1130 004045 1131 004046 1133 004051 1134 004053 1135 004057 1138 004060 1141 004063 1143 004064 1144 004065 1146 004067 1147 004073 1148 004076 1149 004077 1150 004100 1156 004127 1157 004134 1158 004136 1160 004137 1161 004142 1163 004143 1167 004145 1168 004147 1170 004152 1171 004163 1174 004164 1175 004166 1176 004170 1180 004171 1184 004173 1185 004174 1186 004200 1187 004202 1189 004203 1193 004206 1195 004210 1197 004212 1198 004213 1199 004225 1202 004226 1203 004233 1204 004237 1208 004240 1209 004242 1211 004244 1212 004245 1213 004246 1214 004250 1215 004253 1216 004255 1217 004257 1219 004264 1222 004265 1223 004266 1224 004270 1225 004300 1226 004302 1231 004303 1235 004306 1236 004310 1238 004311 1242 004314 1244 004315 1246 004321 1248 004323 1249 004324 1250 004326 1253 004327 1254 004330 1255 004332 1258 004333 1260 004336 1261 004342 1262 004347 1263 004363 1266 004364 1270 004367 1272 004373 1274 004375 1275 004376 1276 004403 1278 004404 1279 004405 1281 004413 1283 004414 1286 004416 1288 004421 1291 004430 1292 004431 1294 004432 1296 004435 1297 004440 1298 004442 1299 004444 1301 004450 1302 004451 1303 004453 1304 004455 1305 004461 1306 004462 1307 004464 1308 004465 1310 004466 1314 004472 1316 004475 1318 004476 1320 004502 1321 004503 1322 004505 1323 004507 1324 004510 1327 004514 1328 004516 1329 004517 1331 004521 1333 004523 1334 004525 1335 004527 1338 004534 1339 004540 1340 004541 1341 004542 1342 004543 1345 004551 1346 004560 1348 004563 1349 004622 1351 004624 1352 004626 1353 004630 1354 004631 1356 004632 1357 004633 1358 004635 1359 004637 1360 004641 1361 004645 1363 004646 1364 004657 1365 004660 1367 004661 1370 004662 1371 004665 1372 004674 1375 004676 1377 004702 1378 004717 1382 004720 1384 004722 1385 004723 1387 004724 1388 004727 1390 004735 1393 004736 1396 004737 1397 004741 1399 004745 1401 004750 1403 004753 1404 004757 1405 004761 1406 004763 1407 004766 1409 004777 1410 005003 1411 005006 1412 005011 1414 005012 1416 005015 1418 005016 1419 005020 1420 005025 1421 005030 1422 005032 1423 005033 1426 005036 1429 005037 1433 005043 1434 005045 1439 005046 1441 005052 1443 005055 1445 005056 1447 005061 1449 005063 1450 005064 1452 005065 1454 005067 1456 005070 1457 005072 1458 005074 1459 005075 1462 005102 1463 005103 1465 005105 1466 005106 1468 005110 1470 005112 1472 005113 1475 005115 1477 005120 1478 005135 1482 005136 1483 005137 1486 005141 1487 005143 1490 005144 1491 005147 1492 005151 1495 005153 1497 005156 1499 005160 1500 005161 1501 005173 1509 005174 1510 005176 1511 005203 1513 005210 1515 005213 1517 005230 1519 005231 1520 005233 1521 005236 1523 005240 1526 005244 1527 005257 1529 005260 1530 005262 1532 005267 1536 005305 1537 005307 1538 005310 1541 005312 1542 005315 1547 005316 1551 005320 1553 005324 1555 005327 1558 005333 1559 005334 1560 005336 1561 005340 1564 005341 1565 005342 1566 005344 1567 005346 1569 005347 1571 005352 1574 005363 1575 005366 1577 005367 1579 005370 1580 005373 1581 005376 1583 005377 1584 005400 1586 005403 1588 005420 1590 005432 1593 005433 1595 005435 1596 005436 1597 005453 1600 005454 1603 005456 1604 005457 1605 005462 1606 005463 1608 005465 1609 005467 1611 005471 1612 005474 1614 005501 1615 005503 1616 005506 1619 005507 1623 005512 1624 005513 1626 005516 1628 005520 1629 005522 1632 005523 1635 005525 1636 005526 1637 005531 1638 005533 1641 005534 1642 005536 1643 005552 1644 005555 1648 005556 1652 005557 1656 005561 1658 005565 1659 005566 1660 005570 1661 005575 1662 005600 1663 005602 1664 005603 1666 005606 1669 005607 1671 005611 1672 005613 1674 005615 1675 005616 1676 005621 1677 005623 1678 005625 1679 005627 1681 005631 1682 005632 1683 005633 1684 005636 1685 005642 1686 005643 1687 005646 1688 005650 1689 005652 1690 005654 1691 005656 1692 005657 1693 005661 1694 005664 1695 005666 1696 005670 1698 005675 1704 005676 1707 005700 1708 005702 1709 005703 1711 005706 1712 005723 1714 005724 1715 005727 1716 005731 1717 005743 1719 005744 1720 005745 1722 005747 1723 005751 1726 005756 1729 005761 1731 006000 1732 006014 1734 006020 1736 006021 1737 006022 1739 006024 1741 006040 1742 006043 1744 006046 1745 006061 1747 006062 1749 006063 1750 006116 1752 006121 1753 006122 1755 006124 1758 006130 1759 006135 1762 006136 1764 006140 1765 006147 1766 006165 1768 006200 1769 006207 1771 006210 1772 006236 1774 006253 1776 006257 1780 006260 1782 006262 1783 006263 1785 006265 1786 006266 1788 006270 1789 006271 1791 006273 1792 006274 1795 006276 1796 006277 1800 006301 1801 006302 1805 006304 1806 006305 1808 006307 1809 006310 1814 006312 1815 006313 1817 006315 1818 006316 1820 006320 1821 006321 1823 006323 1824 006324 1829 006326 1830 006327 1834 006331 1835 006332 1837 006334 1838 006335 1841 006337 1842 006340 1844 006342 1845 006343 1848 006345 1849 006346 1919 006352 1920 006353 1922 006357 1923 006360 1926 006362 1927 006363 1929 006365 1930 006366 1933 006370 1934 006371 1936 006373 1937 006374 1941 006375 1942 006423 1943 006424 1945 006426 1946 006427 1948 006430 1950 006445 1951 006454 1088 006455 1090 006463 1091 006465 1092 006475 1094 006524 1096 006550 1953 006551 1956 006552 1957 006554 1958 006556 1961 006566 1963 006570 1965 006571 1966 006572 1968 006573 1971 006574 1972 006576 1973 006601 1975 006605 1976 006606 1977 006607 1978 006614 1979 006616 1982 006627 1983 006630 1984 006631 1986 006632 1988 006633 1989 006636 1991 006642 1993 006646 1994 006650 1996 006651 1998 006652 1999 006655 2001 006661 2002 006662 2003 006663 2005 006664 2007 006665 2009 006667 2010 006676 2011 006701 2013 006704 2014 006707 2015 006710 2016 006711 2017 006715 2018 006716 2020 006717 2023 006720 2026 006721 2028 006724 2030 006726 2031 006730 2032 006731 2033 006733 2035 006737 2036 006744 2037 006746 2038 006750 2039 006752 2040 006754 2043 006755 2046 006757 2047 006761 2049 006763 2052 006771 2053 006774 2055 007000 2059 007001 2062 007003 2063 007004 2065 007007 2066 007010 2068 007013 2069 007025 2070 007026 2073 007040 2074 007042 2076 007044 2077 007046 2079 007047 2080 007050 2081 007051 2082 007052 2083 007053 2087 007054 2091 007055 2092 007057 2094 007061 2096 007063 2098 007064 2099 007066 2100 007071 2101 007100 2104 007105 2105 007106 2107 007123 2109 007127 2110 007130 2111 007132 2112 007135 2114 007136 2116 007137 2117 007141 2119 007143 2121 007145 2123 007146 2124 007150 2125 007160 2126 007162 2128 007164 2129 007176 2132 007202 2133 007204 2134 007206 2135 007207 2137 007212 2139 007214 2140 007215 2142 007216 2147 007217 2148 007220 2149 007222 2151 007224 2153 007226 2156 007233 2159 007240 2162 007245 2163 007247 2164 007251 2166 007254 2167 007256 2168 007273 2169 007274 2171 007302 2173 007303 2175 007306 2176 007322 2178 007325 2180 007330 2181 007331 2183 007333 2185 007335 2187 007336 2189 007337 2191 007341 2192 007344 2194 007345 2195 007347 2196 007350 2197 007351 2198 007353 2199 007355 2200 007357 2201 007362 2202 007363 2205 007364 2208 007366 2209 007371 2210 007372 2211 007375 2213 007377 2215 007401 2220 007404 2224 007406 2226 007414 2228 007417 2229 007421 2230 007422 2231 007426 2233 007427 2234 007432 2236 007434 2240 007436 2242 007441 2243 007442 2246 007445 2247 007451 2250 007457 2251 007475 2255 007477 2256 007502 2257 007505 2258 007507 2260 007510 2265 007512 2266 007515 2268 007522 2269 007545 2272 007547 2274 007551 2276 007552 2278 007553 2279 007574 2281 007575 2283 007577 2284 007603 2286 007610 2287 007625 2289 007630 2291 007645 2297 007647 2295 007652 2300 007655 2301 007661 2303 007663 2305 007667 2306 007672 2310 007702 2312 007705 2313 007706 2315 007712 2317 007714 2318 007717 2319 007721 2320 007723 2322 007725 2323 007737 2324 007742 2327 007746 2329 007747 2331 007753 2332 007756 2336 007765 2338 007770 2339 007771 2341 007777 2343 010003 2345 010005 2346 010010 2347 010012 2348 010014 2350 010016 2351 010041 2352 010044 2354 010050 2355 010052 2356 010053 2358 010055 2360 010056 2363 010074 2366 010101 2367 010103 2368 010105 2369 010106 2373 010110 2374 010112 2375 010113 2378 010114 2384 010115 2385 010116 2386 010120 2387 010122 2390 010123 2392 010125 2393 010130 2395 010131 2396 010133 2398 010135 2400 010144 2401 010145 2404 010146 2406 010150 2407 010153 2409 010155 2410 010157 2411 010161 2414 010167 2416 010172 2417 010173 2418 010175 2421 010203 2422 010211 2423 010212 2425 010214 2426 010217 2427 010221 2428 010224 2430 010232 2432 010233 2434 010240 2435 010242 2437 010246 2439 010247 2440 010252 2441 010254 2443 010257 2445 010261 2446 010263 2447 010265 2448 010266 2450 010275 2451 010300 2452 010302 2453 010306 2454 010312 2456 010317 2458 010325 2460 010332 2461 010344 2463 010352 2465 010367 2470 010371 2471 010374 2473 010377 2476 010411 2478 010413 2480 010414 2482 010416 2484 010422 2487 010427 2488 010444 2490 010446 ----------------------------------------------------------- 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