COMPILATION LISTING OF SEGMENT dfast_line_edit_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1554.9 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 dfast_line_edit_: proc (line, arg_edit_info_ptr, sort, code); 12 13 dcl line char (256) var; /* input line with edit request */ 14 dcl arg_edit_info_ptr ptr; /* ptr to edit_info structure */ 15 dcl sort bit (1) unal; /* ON for edit; OFF for editns */ 16 dcl code fixed bin (35); /* fast error code */ 17 18 /* automatic */ 19 20 dcl edit_info_ptr ptr; /* ptr to edit_info structure */ 21 dcl start_index fixed bin (21); /* index in the line table "t" to first number in block */ 22 dcl num_1 fixed bin (21); 23 dcl num_2 fixed bin (21); 24 dcl end_index fixed bin (21); /* index in the line table "t" to last number in block */ 25 dcl line_start fixed bin (21); 26 dcl line_end fixed bin (21); 27 dcl num_3 fixed bin (21); 28 dcl t_index fixed bin (21); /* index into line table */ 29 dcl seq_number fixed bin (21); /* sequence number for move, sequence, and resequence commands */ 30 dcl line_number fixed bin (21); 31 dcl string char (10); 32 dcl line_length fixed bin (21); /* length of the line */ 33 dcl last_index fixed bin (21); 34 dcl block_length fixed bin (21); /* number of characters in the block */ 35 dcl block_start fixed bin (21); 36 dcl block_end fixed bin (21); 37 dcl basic_resq_tbl_ptr ptr ; 38 dcl temp_ptr ptr; 39 dcl cur_ptr ptr; 40 dcl cur_length fixed bin (21); 41 dcl request char (3); /* EDIT request */ 42 dcl arg char (256) var; /* argument for dfast_get_arg_ */ 43 dcl num_pic pic "zzzzz9"; 44 dcl temp_length fixed bin (21); 45 dcl (i, j) fixed bin (21); 46 dcl k fixed bin (21); /* temporary used in request routines: list, move, etc. */ 47 dcl print_message bit (1) unal; /* ON if the error message should be printed */ 48 dcl increment fixed bin (21); 49 50 dcl old_string char (256) var; 51 dcl new_string char (256) var; 52 dcl length_old_string fixed bin (21); 53 dcl length_new_string fixed bin (21); 54 dcl check bit (1); /* ON To prevent substitution of line number */ 55 dcl replace_OK bit (1); /* ON if replace is allowed; OFF if replace would 56* change the line number */ 57 58 59 dcl 1 block (16), 60 2 start fixed bin (21), 61 2 end fixed bin (21); 62 63 dcl 1 seq (16), 64 2 number fixed bin (21), 65 2 incr fixed bin (21); 66 dcl num_blocks fixed bin (21); 67 68 dcl 1 copy_info aligned, 69 2 copy_ptr ptr, /* ptr to base of target segment */ 70 2 old_length fixed bin (21), /* length of segment before the copy */ 71 2 new_length fixed bin (21); /* length of segment after the copy */ 72 73 dcl cleanup condition; 74 75 76 /* constants */ 77 78 dcl max_digits_line_num fixed bin int static options (constant) init (5); /* must match number_pic */ 79 dcl number_pic pic "99999"; /* used to convert number strings to fixed binary */ 80 dcl new_line char (1) int static options (constant) init (" 81 "); 82 dcl white_space char (2) int static options (constant) init (" "); /* tab & blank */ 83 dcl arg_delimiter char (4) int static options (constant) init (" ,;"); /* tab & blank & comma & semi-colon */ 84 dcl digit char (10) int static options (constant) init ("0123456789"); 85 dcl blank char (1) int static options (constant) init (" "); 86 dcl COPY fixed bin int static options (constant) init (5); 87 dcl REPLACE fixed bin int static options (constant) init (0); /* replace: simple replace */ 88 dcl PREFIX fixed bin int static options (constant) init (1); /* replace: prefix request */ 89 dcl SUFFIX fixed bin int static options (constant) init (2); /* replace: suffix request */ 90 91 /* based */ 92 93 dcl 1 f aligned based (edit_info_ptr) like dfast_edit_info; 94 dcl temp_seg char (f.max_seg_size) based (temp_ptr); 95 dcl cur_seg char (cur_length) based (cur_ptr); 96 dcl 1 basic_resq_tbl aligned based (basic_resq_tbl_ptr), 97 2 num_lines fixed bin (21), 98 2 t (2) aligned, 99 3 old_number fixed bin (17) unal, 100 3 new_number fixed bin (17) unal; 101 dcl based_arr (1) ptr based; 102 103 dcl (addr, divide, index, length, null, ptr, reverse, search, substr, translate, verify) builtin; 104 105 /* external */ 106 107 dcl iox_$user_output ptr ext; 108 109 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin); 110 dcl ioa_$rsnnl entry options (variable); 111 dcl get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); 112 dcl release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); 113 dcl dfast_directory_ entry (fixed bin, char (*), ptr, ptr, fixed bin (35)); 114 dcl dfast_merge_ entry (bit (1) unal, ptr, fixed bin (35)); 115 dcl dfast_explain_ entry (char (*) var, char (*), fixed bin (35)); 116 dcl dfast_error_ entry (fixed bin (35), char (*), char (*)); 117 dcl dfast_get_arg_ entry (char (256) var, char (256) var) returns (bit (1) unal); 118 dcl dfast_basic_resequence_ entry (fixed bin (21), ptr, char (*), bit (1), ptr, fixed bin (21), fixed bin (35)); 119 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 120 121 /* include files */ 122 1 1 /* BEGIN INCLUDE ... dfast_error_codes.incl.pl1 */ 1 2 1 3 dcl error_alt_empty fixed bin (35) int static init (1)options (constant); 1 4 dcl error_max_size fixed bin (35) int static init (2)options (constant); 1 5 dcl error_cur_empty fixed bin (35) int static init (3)options (constant); 1 6 dcl error_not_saved fixed bin (35) int static init (4)options (constant); 1 7 dcl error_name_dup fixed bin (35) int static init (5)options (constant); 1 8 dcl error_long_rec fixed bin (35) int static init (6)options (constant); 1 9 dcl error_unknown_arg fixed bin (35) int static init (7)options (constant); 1 10 dcl error_no_expl fixed bin (35) int static init (8)options (constant); 1 11 dcl error_bad_name fixed bin (35) int static init (9)options (constant); 1 12 dcl error_bad_req fixed bin (35) int static init (10)options (constant); 1 13 dcl error_syntax_string fixed bin (35) int static init (11)options (constant); 1 14 dcl error_name_miss fixed bin (35) int static init (12)options (constant); 1 15 dcl error_no_comp fixed bin (35) int static init (13)options (constant); 1 16 dcl error_no_main fixed bin (35) int static init (14)options (constant); 1 17 dcl error_block_spec fixed bin (35) int static init (15)options (constant); 1 18 dcl error_obj_nop fixed bin (35) int static init (16)options (constant); 1 19 dcl error_sav_cur fixed bin (35) int static init (17)options (constant); 1 20 dcl error_bad_type fixed bin (35) int static init (18)options (constant); 1 21 dcl error_unkn_sys fixed bin (35) int static init (19)options (constant); 1 22 dcl error_no_suffix fixed bin (35) int static init (20)options (constant); 1 23 dcl error_no_nl fixed bin (35) int static init (21)options (constant); 1 24 dcl error_bad_sort fixed bin (35) int static init (22)options (constant); 1 25 dcl error_no_num fixed bin (35) int static init (23)options (constant); 1 26 dcl error_line_miss fixed bin (35) int static init (24)options (constant); 1 27 dcl error_request_miss fixed bin (35) int static init (25)options (constant); 1 28 dcl error_bad_line fixed bin (35) int static init (26)options (constant); 1 29 dcl error_no_string fixed bin (35) int static init (27)options (constant); 1 30 dcl error_line_order fixed bin (35) int static init (28)options (constant); 1 31 dcl error_max_lines fixed bin (35) int static init (29)options (constant); 1 32 dcl error_bad_pathname fixed bin (35) int static init (30)options (constant); 1 33 dcl error_access_mode fixed bin (35) int static init (31)options (constant); 1 34 dcl error_delimiter_miss fixed bin (35) int static init (32)options (constant); 1 35 dcl error_size_fixed_record fixed bin (35) int static init (33)options (constant); 1 36 dcl error_bad_rec_len fixed bin (35) int static init (34)options (constant); 1 37 dcl error_string_size fixed bin (35) int static init (35)options (constant); 1 38 dcl error_max_line_number fixed bin (35) int static init (36)options (constant); 1 39 dcl error_max_args fixed bin (35) int static init (37)options (constant); 1 40 dcl error_name_sys fixed bin (35) int static init (38)options (constant); 1 41 dcl error_dprint_map fixed bin (35) int static init (39)options (constant); 1 42 dcl error_max_num fixed bin (35) int static options (constant) init (40); 1 43 dcl error_edit_max_num fixed bin (35) int static options (constant) init (41); 1 44 dcl error_un_num_text fixed bin (35) int static options (constant) init (42); 1 45 dcl error_no_new_line fixed bin (35) int static options (constant) init (43); 1 46 1 47 /* END INCLUDE ... dfast_error_codes.incl.pl1 */ 123 2 1 /* BEGIN INCLUDE FILE -- dfast_edit_info.incl.pl1 2 2* written 5/75 by S.E.Barr 2 3**/ 2 4 dcl 1 dfast_edit_info aligned based (edit_info_ptr), 2 5 2 flags aligned, 2 6 3 brief_mode bit (1) unal, /* ON if short messages to be used */ 2 7 3 build_mode bit (1) unal, /* On if in build mode */ 2 8 3 source_segment bit (1) unal, /* ON if segment is source */ 2 9 3 edit_done bit (1) unal, /* ON if current segment has been edited since save */ 2 10 3 basic_system bit (1) unal, /* ON if basic, OFF if fortran */ 2 11 3 caps_mode bit (1) unal, /* ON if running in CAPS mode */ 2 12 3 dbasic bit (1) unal, /* ON if double prec basic */ 2 13 3 pad bit (29) unal, 2 14 2 system_info aligned, 2 15 3 max_seg_size fixed bin (21), /* maximum segment size in characters */ 2 16 3 user_name char (32) aligned, /* person id */ 2 17 3 tty_id char (6) unal, /* terminal id of the form "ttynnn" */ 2 18 3 current_name char (256) var aligned, /* name of current segment */ 2 19 3 current_length fixed bin (21), /* length in characters of current segment */ 2 20 3 alter_length fixed bin (21), /* length in characters of the alter segment */ 2 21 3 current_ptr ptr, /* ptr to current segment */ 2 22 3 alter_ptr ptr, 2 23 3 home_dir char (168) var, /* home directory from pit */ 2 24 3 user_id char (32) var, /* login id */ 2 25 3 project_id char (32) var, /* login home directory */ 2 26 3 source_directory char (168) aligned, /* directory of where the source was. For COMPILE. */ 2 27 3 source_entryname char (32); /* name of the source. For COMPILE. */ 2 28 2 29 /* END INCLUDE FILE -- dfast_edit_info.incl.pl1 */ 124 125 /* */ 126 127 edit_info_ptr = arg_edit_info_ptr; 128 print_message = "1"b; 129 basic_resq_tbl_ptr = null; 130 131 if dfast_get_arg_ (line, arg) then do; 132 request = arg; 133 request = translate (request, "abcdefghijklmnopqrstuvwxyz", "ABCDEFGHIJKLMNOPQRSTUVWXYZ"); 134 135 if f.alter_length > 0 then call dfast_merge_ ("0"b, edit_info_ptr, code); 136 137 if code = 0 then do; 138 cur_ptr = f.current_ptr; 139 cur_length = f.current_length; 140 141 142 if request = "loc" then call locate; 143 else if request = "lis" then call list; 144 else if request = "exp" then call dfast_explain_ (line, "edit", code); 145 else do; 146 temp_length = 0; 147 temp_ptr = f.alter_ptr; 148 on cleanup begin; 149 if basic_resq_tbl_ptr ^= null then call free_buffers; 150 end; 151 if request = "joi" then call join ("0"b); 152 else if request = "mer" then call merge; 153 else if request = "app" then call append; 154 else if cur_length > 0 then do; /* following request edit current segment */ 155 if request = "ins" then call insert; 156 else if request = "rep" then call replace (REPLACE); 157 else if request = "pre" then call replace (PREFIX); 158 else if request = "suf" then call replace (SUFFIX); 159 else if request = "des" then call desequence; 160 else if request = "del" then call delete; 161 else if request = "ext" then call extract; 162 else if request = "mov" then call move; 163 else if request = "res" then call resequence; 164 else if request = "seq" then call sequence; 165 else if request = "str" then call string_request; 166 else code = error_unknown_arg; 167 if code = 0 then f.edit_done = "1"b; 168 end; 169 else code = error_cur_empty; 170 end; 171 end; 172 end; 173 else do; 174 code = error_request_miss; 175 arg = ""; 176 end; 177 178 if code ^= 0 then if print_message then do; 179 if code = error_no_num then arg = ""; 180 call dfast_error_ (code, "edit", (arg)); 181 end; 182 183 if basic_resq_tbl_ptr ^= null then call free_buffers; 184 return; 185 186 /* */ 187 free_buffers: proc; 188 189 dcl acode fixed bin (35); 190 191 if basic_resq_tbl_ptr ^= null then call release_temp_segments_ ("fast", addr (basic_resq_tbl_ptr) -> based_arr, acode); 192 if acode ^= 0 then call dfast_error_ (acode, "edit", "resequence_table"); 193 194 return; 195 196 end free_buffers; 197 198 /* */ 199 /* * This procedure deletes lines from the current segment. The current segment is copied in portions (excluding 200* * the line blocks) into a temporary segment. 201* * 202* * delete [] 203* * 204* * code = 0 Lines were deleted. 205* * code ^= 0 Error code from parse_block_spec 206* * 207* * In case of error, the current segment is not changed. 208**/ 209 delete: proc; 210 211 call parse_line_list; 212 if code = 0 then do; 213 if num_blocks > 0 then do; 214 last_index = 0; 215 do k = 1 to num_blocks ; 216 call copy_block (last_index + 1, block (k).start - 1); 217 last_index = block (k).end; 218 end; 219 if code = 0 then do; 220 call copy_block (last_index + 1, f.current_length); 221 call switch_buffers; 222 end; 223 end; 224 end; 225 else code = error_no_num; 226 227 return; 228 229 end delete; 230 231 /* */ 232 /* * This procedure extracts lines from the current segment. The lines to be extracted are copied into a temporary 233* * buffer which becomes the current buffer if there are no errors. 234* * 235* * extract [] 236* * 237* * code = 0 Lines were extracted. 238* * code = error_no_num No lines were requested. 239* * code ^= 0 Error code from parse_block_spec 240* * 241* * 242**/ 243 extract: proc; 244 245 call parse_line_list; 246 if code ^= 0 then return; 247 if num_blocks > 0 then do; 248 do k = 1 to num_blocks; 249 250 call copy_block ((block (k).start), (block (k).end)); 251 if code ^= 0 then return; 252 end; 253 254 call switch_buffers; 255 end; 256 257 else code = error_line_miss; 258 259 return; 260 261 end extract; 262 263 /* */ 264 /* * This procedure lists the lines requested. 265* * 266* * list [] 267* * 268* * code = 0 Lines were printed 269* * code ^= 0 Error code from parse_block_spec 270* * 271* * Lines will be listed until the line list is exhausted or until the first error. 272* * 273**/ 274 275 list: proc; 276 277 if cur_length > 0 then do; 278 279 call parse_line_list; 280 if code ^= 0 then return; 281 if num_blocks = 0 then do; 282 num_blocks = 1; 283 block (1).start = 1; 284 block (1).end = cur_length; 285 end; 286 287 do k = 1 to num_blocks; 288 289 call iox_$put_chars (iox_$user_output, addr (substr (cur_seg, block (k).start, 1)), block (k).end - 290 block (k).start + 1, code); 291 call iox_$put_chars (iox_$user_output, addr (new_line), 1, code); 292 end; 293 end; 294 else code = error_cur_empty; 295 296 return; 297 298 end list; 299 300 /* */ 301 /* * This procedure parses a list of segment pathnames and appends the segments onto the end of the current segment. 302**/ 303 join: proc (fill_block_table); 304 305 dcl fill_block_table bit (1) unal; /* ON if should fill in block structure */ 306 307 copy_info.copy_ptr = temp_ptr; 308 copy_info.old_length = 0; 309 num_blocks = 0; 310 311 do while (copy_seg ()); 312 if fill_block_table then do; 313 if num_blocks < 16 then do; 314 num_blocks = num_blocks + 1; 315 block (num_blocks).start = copy_info.old_length + 1; 316 block (num_blocks).end = copy_info.new_length; 317 end; 318 else do; 319 code = error_max_lines; 320 return; 321 end; 322 end; 323 copy_info.old_length = copy_info.new_length; 324 end; 325 326 if code = 0 then do; 327 temp_length = copy_info.old_length; 328 call switch_buffers; 329 end; 330 331 return; 332 333 end join; 334 335 /* */ 336 /* * The append command reads one or more segments and resequences them. 337* * 338* * append seg_1 [, seg_2>] . . . 339**/ 340 append: proc; 341 342 call join (f.basic_system); 343 if code = 0 then do; 344 temp_length = 0; 345 seq_number = 100; 346 increment = 10; 347 348 cur_ptr = f.current_ptr; /* re-initialize, since JOIN called switched buffers */ 349 temp_ptr = f.alter_ptr; 350 cur_length = f.current_length; 351 if ^f.basic_system then do; 352 call renumber (1, cur_length, seq_number, increment); 353 if code = 0 then call switch_buffers; 354 end; 355 else do; 356 call get_temp_segments_ ("fast", addr (basic_resq_tbl_ptr) -> based_arr, code); 357 if code = 0 then do; 358 do i = 1 to num_blocks while (code = 0); 359 num_lines = 0; 360 call fill_basic_tbl (basic_resq_tbl_ptr, "0"b, block (i).start, block (i).end, seq_number, increment); 361 if code = 0 then call copy_resq ("1"b, block (i).start, block (i).end); 362 end; 363 if code = 0 then call switch_buffers; 364 end; 365 end; 366 end; 367 368 return; 369 370 end append; 371 372 /* */ 373 /* This procedure merges one or more segments. The segments are copied into a tempory buffer and then sorted 374* using the edit rules of dfast_merge_. 375**/ 376 merge: proc; 377 378 call join ("0"b); 379 380 if code = 0 then call dfast_merge_ ("1"b, edit_info_ptr, code); 381 382 return; 383 384 end merge; 385 386 /* */ 387 /* This procedure copies all the segments into the current segment. It then copies and renumbers the entire segment. 388* * 389* * insert seg_name [;seg_name, line_number] 390**/ 391 insert: proc; 392 393 dcl index_arr (16) fixed bin (21); 394 dcl second_tbl_ptr ptr; 395 396 dcl k fixed bin (21); 397 dcl 1 second_tbl aligned based (second_tbl_ptr) like basic_resq_tbl; 398 399 call get_temp_segments_ ("fast", addr (basic_resq_tbl_ptr) -> based_arr, code); 400 seq_number = 100; 401 increment = 10; 402 num_blocks = 0; 403 basic_resq_tbl.num_lines = 0; 404 last_index = 0; 405 copy_info.copy_ptr = cur_ptr; 406 copy_info.old_length = 0; 407 408 if copy_seg () then do; 409 cur_length, copy_info.old_length = copy_info.new_length; 410 411 do while (copy_seg () & code = 0); 412 if num_blocks < 16 then do; 413 num_blocks = num_blocks + 1; 414 if find_line ((0), index_arr (num_blocks)) then do; 415 if index_arr (num_blocks) >= last_index then do; 416 block (num_blocks).start = copy_info.old_length + 1; 417 block (num_blocks).end = copy_info.new_length; 418 copy_info.old_length = copy_info.new_length; 419 if f.basic_system then do; 420 call fill_basic_tbl (basic_resq_tbl_ptr, "0"b, last_index + 1, index_arr (num_blocks), 421 seq_number, increment); 422 423 seq (num_blocks).number = seq_number; 424 i = block (num_blocks).start; 425 do while (i <= block (num_blocks).end); 426 j = index (substr (cur_seg, i, block (num_blocks).end - i + 1), new_line); 427 if j > 0 then do; 428 seq_number = seq_number + increment; 429 i = i + j; 430 end; 431 else i = block (num_blocks).end + 1; 432 end; 433 end; 434 last_index = index_arr (num_blocks); 435 end; 436 else code = error_line_order; 437 end; 438 end; 439 else code = error_max_lines; 440 end; 441 if num_blocks = 0 then code = error_request_miss; 442 443 end; 444 else code = error_request_miss; 445 if code ^= 0 then return; 446 447 if f.basic_system then call fill_basic_tbl (basic_resq_tbl_ptr, "0"b, last_index + 1, cur_length, seq_number, increment); 448 k = cur_length; 449 cur_length = block (num_blocks).end; 450 last_index = 0; 451 452 /* If the system is not basic the segment is just copied and renumbered */ 453 454 if ^f.basic_system then do; 455 do i = 1 to num_blocks while (code = 0); 456 call renumber (last_index + 1, index_arr (i), seq_number, increment); 457 call renumber (block (i).start, block (i).end, seq_number, increment); 458 last_index = index_arr (i); 459 end; 460 call renumber (last_index + 1, k, seq_number, increment); 461 if code = 0 then call switch_buffers; 462 return; 463 end; 464 465 466 second_tbl_ptr = addr (basic_resq_tbl_ptr -> basic_resq_tbl.t (basic_resq_tbl.num_lines + 1).old_number); 467 second_tbl.num_lines = 0; 468 do i = 1 to num_blocks while (code = 0); 469 if last_index < index_arr (i) then call copy_resq ("1"b, last_index + 1, index_arr (i)); 470 last_index = index_arr (i); 471 second_tbl.num_lines = 0; 472 call fill_basic_tbl (second_tbl_ptr, "0"b, block (i).start, block (i).end, seq (i).number, increment); 473 call dfast_basic_resequence_ (f.max_seg_size, second_tbl_ptr, substr (cur_seg, block (i).start, block (i).end - block (i).start + 1), 474 "1"b, temp_ptr, temp_length, code); 475 end; 476 477 if code = 0 then do; 478 if last_index < k then call copy_resq ("1"b, last_index + 1, k); 479 if code = 0 then call switch_buffers; 480 end; 481 482 return; 483 484 end insert; 485 486 /* */ 487 /* This procedure moves one block of lines to a position following a given line number 488* * 489* * move num_1 - num_2, num_3 490* * 491* * If line_num is not present, the block is moved to a position following the logical spot for line_num. 492* * The block that was moved is resequence with an initial value of line_num + 1 and an increment of 1. 493* * Lines following the block are resequenced if the block renumbering caused duplicate line numbers. 494* * 495* * code = 0 successful 496* * line_num is within the range of the block. 497* * = error_block_spec the block contains no numbers 498**/ 499 move: proc; 500 501 if parse_block_spec (1, start_index, end_index) then do; 502 if find_line (line_start, line_end) then do; 503 504 seq_number = num_3 +1; 505 506 if f.basic_system then call basic_move; 507 else do; 508 if num_3 < num_1 then do; 509 call copy_block (1, line_end); 510 call renumber (start_index, end_index, seq_number, 1); 511 call renumber_if_necessary (line_end + 1, start_index -1, seq_number); 512 call renumber_if_necessary (end_index +1, cur_length, seq_number); 513 end; 514 515 else if num_2 < num_3 then do; 516 call copy_block (1, start_index -1); 517 call copy_block (end_index + 1, line_end); 518 if end_index > start_index then call renumber (start_index, end_index, seq_number, 1); 519 call renumber_if_necessary (line_end + 1, cur_length, seq_number); 520 end; 521 522 else code = error_block_spec; 523 end; 524 if code = 0 then call switch_buffers; 525 end; 526 else code = error_no_num; 527 end; 528 else code = error_request_miss; 529 530 return; 531 532 end move; 533 534 /* */ 535 /* * This procedure resequences the file and edits the source code to reflect the new numbers. 536* * There are two types of editing done. 537* * "0"b the line keeps its line number, but line references are changed. 538* * "1"b both the line and any line references are changed. 539**/ 540 basic_move: proc; 541 542 543 call get_temp_segments_ ("fast", addr (basic_resq_tbl_ptr) -> based_arr, code); 544 if code ^= 0 then return; 545 num_lines = 0; 546 547 call fill_basic_tbl (basic_resq_tbl_ptr, "0"b, start_index, end_index, seq_number, 1); 548 549 if num_3 < num_1 then do; 550 call fill_basic_tbl (basic_resq_tbl_ptr, "1"b, line_end +1, start_index -1, seq_number, 1); 551 call fill_basic_tbl (basic_resq_tbl_ptr, "1"b, end_index + 1, cur_length, seq_number, 1); 552 553 if sort then do; 554 call copy_resq ("0"b, 1, line_end); 555 call copy_resq ("1"b, start_index, end_index); 556 call copy_resq ("1"b, line_end + 1, start_index -1); 557 call copy_resq ("1"b, end_index +1, cur_length); 558 end; 559 560 else call copy_resq ("1"b, 1, cur_length); 561 end; 562 563 else if num_2 < num_3 then do; 564 call fill_basic_tbl (basic_resq_tbl_ptr, "1"b, line_end + 1, cur_length, seq_number, 1); 565 566 if sort then do; 567 call copy_resq ("0"b, 1, start_index -1); 568 call copy_resq ("0"b, end_index + 1, line_end); 569 if end_index > start_index then call copy_resq ("1"b, start_index, end_index); 570 call copy_resq ("1"b, line_end + 1, cur_length); 571 end; 572 573 else call copy_resq ("1"b, 1, cur_length); 574 end; 575 576 else code = error_block_spec; 577 578 579 return; 580 581 end basic_move; 582 583 /* */ 584 /* * This procedure calls dfast_basic_resequence_. It operates in two ways. 585* * 586* * "1"b Both the line number and any line references are changed. 587* * "0"b Just the line references are changed. 588**/ 589 copy_resq: proc (resequence_lines, start, end); 590 591 dcl resequence_lines bit (1); 592 dcl start fixed bin (21); 593 dcl end fixed bin (21); 594 595 call dfast_basic_resequence_ (f.max_seg_size, basic_resq_tbl_ptr, substr (cur_seg, start, end - start + 1), 596 resequence_lines, temp_ptr, temp_length, code); 597 598 return; 599 end copy_resq; 600 601 /* */ 602 /* This procedure prints all lines that contain the given string. 603* * 604* * locate /old_string/ [] 605* * 606* * (Any character except blank or tab may be used as a delimiter.) 607* * 608* * code = 0 At least one string found. 609* * = error_no_string String was not found. 610* * = error_no_nl Segment does not end in a new_line. (presumably not source) 611**/ 612 locate: proc; 613 614 dcl string_found bit (1) unal; /* ON if string was found at least once */ 615 616 if cur_length > 0 then do; 617 if parse_string_args ("1"b) then do; 618 619 string_found = "0"b; 620 do k = 1 to num_blocks; 621 start_index = block (k).start; 622 block_length = block (k).end - block (k).start + 1; 623 624 do while (block_length > 0 & code = 0); 625 i = index (substr (cur_seg, start_index, block_length), old_string); 626 if i > 0 then do; 627 j = index (reverse (substr (cur_seg, start_index, i)), new_line); 628 if j > 0 then do; 629 block_length = block_length +j -i -1; 630 start_index = start_index +i -j +1; 631 end; 632 j = index (substr (cur_seg, start_index, block_length), new_line); 633 if j > 0 then do; 634 call iox_$put_chars (iox_$user_output, addr (substr (cur_seg, start_index, 1)), j, code); 635 start_index = start_index + j; 636 block_length = block_length - j; 637 string_found = "1"b; 638 end; 639 else code = error_no_nl; 640 end; 641 else block_length = 0; 642 643 end; 644 end; 645 646 if code = 0 then if ^string_found then code = error_no_string; 647 end; 648 end; 649 else code = error_cur_empty; 650 651 return; 652 653 end locate; 654 655 656 657 /* */ 658 /* * This procedure replaces old_string with new_string for a given block of lines. 659* * The line numbers can not be changed. 660* * 661* * replace /// [] (REPLACE) 662* * 663* * prefix /// [] (PREFIX) 664* * 665* * suffix /// [] (SUFFIX) 666* * 667* * (Any character except blank or tab may be used as a delimiter) 668**/ 669 replace: proc (replace_type); 670 671 dcl replace_type fixed bin; 672 673 if parse_string_args ("0"b) then do; 674 if replace_type ^= REPLACE then do; 675 length_new_string = length_new_string + length_old_string; 676 if length_new_string <= 256 then do; 677 if replace_type = PREFIX then new_string = new_string || old_string; 678 else new_string = old_string || new_string; 679 end; 680 else do; 681 code = error_string_size; 682 return; 683 end; 684 end; 685 686 687 /* Search through blocks of lines and replace the string. The new code is stored in temp_seg */ 688 689 last_index = 0; 690 do k = 1 to num_blocks; 691 start_index = block (k).start; 692 block_length = block (k).end - block (k).start; 693 do while (block_length > 0); 694 i = index (substr (cur_seg, start_index, block_length), old_string) -1; 695 if i > - 1 then do; 696 697 /* This check is done if old_string begins with a digit. It searches back for the first non-digit. 698* * It sets replace_OK = 1, if the replacement would not change a line number. 699* * 700* * j = 0 A line number at the start of a block. 701* * j > 0 & character = new_line The first non-digit is new_line. 702* * j > 0 & character ^= new_line A string inside a line. 703**/ 704 705 if check then do; 706 j = verify (reverse (substr (cur_seg, 1, start_index + i -1)), digit); 707 if j > 0 then do; 708 if substr (cur_seg, start_index + i - j, 1) = new_line then replace_OK = "0"b; 709 else replace_OK = "1"b; 710 end; 711 else replace_OK = "0"b; 712 end; 713 714 if replace_OK then do; 715 i = start_index + i - 1; 716 call copy_block (last_index + 1, i); 717 substr (temp_seg, temp_length +1, length_new_string) = new_string; 718 temp_length = temp_length + length_new_string; 719 last_index = i + length_old_string; 720 block_length = block_length - last_index + start_index - 1; 721 start_index = last_index + 1; 722 end; 723 else do; 724 replace_OK = "1"b; 725 start_index = start_index + i + length_old_string; 726 block_length = block_length - i - length_old_string + 1; 727 end; 728 end; 729 else block_length = 0; 730 end; 731 end; 732 733 if last_index ^= 0 then do; 734 call copy_block (last_index + 1, cur_length); 735 call switch_buffers; 736 end; 737 738 else do; 739 code = error_no_string; 740 arg = old_string; 741 end; 742 743 end; 744 745 return; 746 747 end replace; 748 749 /* */ 750 /* * This procedure parses the argument list for LOCATE, REPLACE, PREFIX, SUFFIX 751* * 752* * /old_string/new_string/ line_list 753* * 754* * If line_list is missing, LOCATE uses the entire text. The line_list must be present for 755* * REPLACE, PREFIX and SUFFIX. These global variables are set: 756* * 757* * old_string 758* * old_string_length 759* * new_string 760* * new_string_length 761* * num_blocks 762* * block (1, num_block) 763* */ 764 parse_string_args: proc (one_string_sw) returns (bit (1)); 765 766 dcl one_string_sw bit (1) unal; /* ON if only one string is expected -- LOCATE */ 767 768 dcl (i, j) fixed bin; 769 dcl delimiter char (1); 770 771 i = verify (line, white_space); 772 if i > 0 then do; 773 delimiter = substr (line, i, 1); 774 arg = delimiter; 775 j = index (substr (line, i + 1), delimiter); 776 if j > 1 then do; 777 old_string = substr (line, i +1, j - 1); 778 arg = old_string; /* for error message */ 779 length_old_string = j -1; 780 i = i + j + 1; 781 if one_string_sw then line = substr (line, i); 782 else do; 783 j = index (substr (line, i), delimiter); 784 if j > 0 then do; 785 new_string = substr (line, i, j-1); 786 length_new_string = j -1; 787 line = substr (line, i +j); 788 end; 789 else code = error_delimiter_miss; 790 end; 791 end; 792 else if j = 1 then code = error_syntax_string; 793 else code = error_delimiter_miss; 794 end; 795 else do; 796 code = error_delimiter_miss; 797 arg = ""; 798 end; 799 800 if code = 0 then do; 801 call parse_line_list; 802 if code = 0 then do; 803 804 if index (digit, substr (old_string, 1, 1)) ^= 0 then check = "1"b; 805 else if index (digit, substr (new_string, 1, 1)) ^= 0 then check = "1"b; 806 else check = "0"b; 807 replace_OK = "1"b; 808 809 if num_blocks > 0 then return ("1"b); 810 else if request = "loc" then do; 811 num_blocks = 1; 812 block (1).start = 1; 813 block (1).end = cur_length; 814 return ("1"b); 815 end; 816 else code = error_no_num; 817 end; 818 end; 819 return ("0"b); 820 821 end parse_string_args; 822 823 /* */ 824 /* * This procedure removes a number followed by a blank on each line. If there is no number present, the 825* * line is copied as is. If there is no blank following the number, just the number is removed. 826* * 827* * desequence 828* * 829**/ 830 desequence: proc; 831 832 start_index = 1; 833 834 do while (start_index <= cur_length & code = 0); 835 836 i = verify (substr (cur_seg, start_index), digit) -1; 837 if i > -1 then do; 838 if i > 0 then if substr (cur_seg, start_index + i, 1) = blank then i = i + 1; 839 start_index = start_index + i; 840 841 j = index (substr (cur_seg, start_index), new_line); 842 if j > 0 then do; 843 call copy_block (start_index, start_index + j -1); 844 start_index = start_index + j; 845 end; 846 847 else code = error_no_nl; 848 end; 849 else code = error_no_nl; 850 end; 851 852 if code = 0 then call switch_buffers; 853 854 return; 855 856 end desequence; 857 858 /* */ 859 /* * This procedure adds a sequence number and one blank to each line. It uses new_number for the first line 860* * and adds increment to get the next line number. The default is to start with 100 and increment 861* * by 10. 862* * 863* * sequence new_number, increment 864* * 865**/ 866 867 sequence: proc; 868 869 seq_number = 100; 870 increment = 10; 871 872 if parse_number (seq_number) then if parse_number (increment) then; 873 874 if code = 0 then do; 875 if cur_length > 0 then do; 876 877 start_index = 1; 878 879 do while (start_index <= cur_length); 880 881 i = index (substr (cur_seg, start_index), new_line); 882 if i > 0 then do; 883 call ioa_$rsnnl ("^d ", string, j, seq_number); 884 if temp_length + j + i <= f.max_seg_size then do; 885 886 substr (temp_seg, temp_length + 1, j) = string; 887 temp_length = temp_length + j; 888 substr (temp_seg, temp_length + 1, i) = substr (cur_seg, start_index, i); 889 temp_length = temp_length + i; 890 start_index = start_index + i; 891 seq_number = seq_number + increment; 892 end; 893 894 else do; 895 code = error_max_size; 896 return; 897 end; 898 end; 899 else code = error_no_nl; 900 end; 901 if code = 0 then call switch_buffers; 902 end; 903 else code = error_cur_empty; 904 end; 905 906 return; 907 908 end sequence; 909 910 /* */ 911 /* This procedure has an optional argument list: 912* * 913* * resequence [] [,] [,] 914* * 915* * new number Line number to use for the resequencing. 916* * line_number Line at which to begin resequencing. 917* * increment Increment added each time to new_number. 918* * 919**/ 920 resequence: proc; 921 922 call resequence_args; 923 924 last_index = 0; 925 926 if f.basic_system then do; 927 call get_temp_segments_ ("fast", addr (basic_resq_tbl_ptr) -> based_arr, code); 928 if code ^= 0 then return; 929 num_lines = 0; 930 931 do k = 1 to num_blocks; 932 call fill_basic_tbl (basic_resq_tbl_ptr, "0"b, block (k).start, block (k).end, seq (k).number, seq (k).incr); 933 end; 934 935 do k = 1 to num_blocks while (code = 0); 936 937 call copy_resq ("0"b, last_index + 1, block (k).start -1); 938 call copy_resq ("1"b, block (k).start, block (k).end); 939 940 last_index = block (k).end; 941 end; 942 943 if code = 0 then call copy_resq ("0"b, last_index + 1, cur_length); 944 945 end; 946 947 else do; 948 do k = 1 to num_blocks while (code = 0); 949 950 if block (k).start > last_index then do; 951 call copy_block (last_index + 1, block (k).start -1); 952 call renumber (block (k).start, block (k).end, seq (k).number, seq (k).incr); 953 last_index = block (k).end; 954 end; 955 else code = error_line_order; 956 end; 957 958 if code = 0 then call copy_block (last_index + 1, cur_length); 959 960 end; 961 962 if code = 0 then do; 963 call switch_buffers; 964 if sort then call dfast_merge_ ("1"b, edit_info_ptr, code); 965 end; 966 967 return; 968 969 end resequence; 970 971 /* */ 972 /* This procedure parses the user's input line for a resequence spceifcation. 973* It returns "1"b if some of the block specification was found and returns "0"b if the argument list 974* is exhausted. If errors occur code is set and "0"b is returned. 975* 976**/ 977 resequence_args: proc (); 978 979 num_blocks = 0; 980 do while (code = 0); 981 if parse_number (seq_number) then do; 982 if get_numbers (num_1, num_2) then do; 983 if get_equal_lower_line (1, num_1, block_start, block_end) then do; 984 if block_start = 0 then block_start = 1; 985 if num_1 = num_2 then block_end = cur_length; 986 else if ^get_equal_lower_line (1, num_2, block_start, block_end) then code = error_line_miss; 987 if ^parse_number (increment) then increment = 10; 988 989 end; 990 else code = error_line_miss; 991 end; 992 else do; 993 if num_blocks = 0 then block_start = 1; 994 else block_start = block_end + 1; 995 block_end = cur_length; 996 increment = 10; 997 end; 998 end; 999 1000 else do; 1001 if num_blocks > 0 then return; 1002 block_start = 1; 1003 block_end = cur_length; 1004 seq_number = 100; 1005 increment = 10; 1006 end; 1007 1008 num_blocks = num_blocks + 1; 1009 if num_blocks <= 16 then do; 1010 block (num_blocks).start = block_start; 1011 block (num_blocks).end = block_end; 1012 seq (num_blocks).number = seq_number; 1013 seq (num_blocks).incr = increment; 1014 end; 1015 end; 1016 1017 return; 1018 1019 end resequence_args; 1020 1021 /* */ 1022 /* * This request converts the segment into fixed record format. 1023* * 1024* * string 1025**/ 1026 string_request: proc; 1027 1028 dcl bit_count fixed bin (24); 1029 dcl directory char (168) ; 1030 dcl directory_length fixed bin; 1031 dcl entry_name char (32) ; 1032 dcl iocb_ptr ptr; /* ptr to iocb in creating blocked file */ 1033 dcl record_length fixed bin (21); /* length of records in new file */ 1034 1035 dcl cleanup condition; 1036 dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); 1037 dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); 1038 dcl hcs_$status_mins entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35)); 1039 dcl iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35)); 1040 dcl iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35)); 1041 dcl iox_$write_record entry (ptr, ptr, fixed bin (21), fixed bin (35)); 1042 1043 arg = ""; 1044 1045 if parse_number (record_length) then do; 1046 if record_length ^= 0 then do; 1047 call hcs_$fs_get_path_name (temp_ptr, directory, directory_length, entry_name, code); 1048 if code = 0 then do; 1049 call hcs_$set_bc_seg (temp_ptr, 0, code); 1050 if code ^= 0 then call dfast_error_ (code, "string",""); 1051 num_pic = record_length; 1052 iocb_ptr = null; 1053 on cleanup call cleanup_iocb (iocb_ptr); 1054 call iox_$attach_ioname ("string", iocb_ptr, "vfile_ " || substr (directory, 1, directory_length) 1055 || ">" || entry_name || " -blocked " || num_pic || " -ssf", code); 1056 if code = 0 then do; 1057 call iox_$open (iocb_ptr, 5, "0"b, code); 1058 1059 start_index = 1; 1060 do while (start_index <= cur_length & code = 0); 1061 i = index (substr (cur_seg, start_index), new_line) -1; 1062 if i >= 0 then do; 1063 if i <= record_length then do; 1064 call iox_$write_record (iocb_ptr, addr (substr (cur_seg, start_index,1)), 1065 i, code); 1066 start_index = start_index + i +1; 1067 end; 1068 else do; 1069 code = error_size_fixed_record; 1070 num_pic = i; 1071 arg = num_pic; 1072 end; 1073 end; 1074 else code = error_no_nl; 1075 end; 1076 call cleanup_iocb (iocb_ptr); 1077 if code = 0 then do; 1078 call hcs_$status_mins (temp_ptr, 0, bit_count, code); 1079 temp_length = divide (bit_count + 8, 9, 21, 0); 1080 end; 1081 end; 1082 end; 1083 end; 1084 1085 else code = error_bad_rec_len; 1086 end; 1087 else code = error_bad_rec_len; 1088 1089 if code = 0 then call switch_buffers; 1090 1091 return; 1092 1093 end string_request; 1094 1095 cleanup_iocb: proc (iocb_ptr); 1096 1097 dcl iocb_ptr ptr; 1098 1099 dcl code fixed bin (35); 1100 1101 dcl iox_$close entry (ptr, fixed bin (35)); 1102 dcl iox_$destroy_iocb entry (ptr, fixed bin (35)); 1103 dcl iox_$detach_iocb entry (ptr, fixed bin (35)); 1104 3 1 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 3 2 /* format: style2 */ 3 3 3 4 dcl 1 iocb aligned based, /* I/O control block. */ 3 5 2 version character (4) aligned, 3 6 2 name char (32), /* I/O name of this block. */ 3 7 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 3 8 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 3 9 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 3 10 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 3 11 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 3 12 2 reserved bit (72), /* Reserved for future use. */ 3 13 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 3 14 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 3 15 /* open(p,mode,not_used,s) */ 3 16 2 close entry (ptr, fixed (35)),/* close(p,s) */ 3 17 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 3 18 /* get_line(p,bufptr,buflen,actlen,s) */ 3 19 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 3 20 /* get_chars(p,bufptr,buflen,actlen,s) */ 3 21 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 3 22 /* put_chars(p,bufptr,buflen,s) */ 3 23 2 modes entry (ptr, char (*), char (*), fixed (35)), 3 24 /* modes(p,newmode,oldmode,s) */ 3 25 2 position entry (ptr, fixed, fixed (21), fixed (35)), 3 26 /* position(p,u1,u2,s) */ 3 27 2 control entry (ptr, char (*), ptr, fixed (35)), 3 28 /* control(p,order,infptr,s) */ 3 29 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 3 30 /* read_record(p,bufptr,buflen,actlen,s) */ 3 31 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 3 32 /* write_record(p,bufptr,buflen,s) */ 3 33 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 3 34 /* rewrite_record(p,bufptr,buflen,s) */ 3 35 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 3 36 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 3 37 /* seek_key(p,key,len,s) */ 3 38 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 3 39 /* read_key(p,key,len,s) */ 3 40 2 read_length entry (ptr, fixed (21), fixed (35)); 3 41 /* read_length(p,len,s) */ 3 42 3 43 declare iox_$iocb_version_sentinel 3 44 character (4) aligned external static; 3 45 3 46 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 1105 1106 1107 /* */ 1108 1109 code = 0; 1110 if iocb_ptr ^= null then do; 1111 if iocb_ptr -> iocb.open_descrip_ptr ^= null then call iox_$close (iocb_ptr, code); 1112 if code = 0 then do; 1113 call iox_$detach_iocb (iocb_ptr, code); 1114 call iox_$destroy_iocb (iocb_ptr, code); 1115 end; 1116 end; 1117 1118 if code ^= 0 then call dfast_error_ (code, "string",""); 1119 1120 return; 1121 1122 1123 end cleanup_iocb; 1124 1125 /* */ 1126 /* This procedure copies a block of characters from the current segment into the temporary segment. 1127* If the procedure is called with end_index > start_index no coping is done. 1128**/ 1129 copy_block: proc (start_index, end_index); 1130 1131 dcl start_index fixed bin (21); 1132 dcl end_index fixed bin (21); 1133 1134 dcl block_length fixed bin (21); 1135 1136 if start_index <= end_index then do; 1137 block_length = end_index - start_index + 1; 1138 if temp_length + i <= f.max_seg_size then do; 1139 substr (temp_seg, temp_length + 1, block_length) = 1140 substr (cur_seg, start_index, block_length); 1141 temp_length = temp_length + block_length; 1142 end; 1143 1144 else code = error_max_size; 1145 end; 1146 1147 return; 1148 1149 end copy_block; 1150 1151 /* */ 1152 /* This procedure renumbers a block of lines and copies the lines into the temporary segment. 1153**/ 1154 renumber: proc (start_index, end_index, new_number, increment); 1155 1156 dcl start_index fixed bin (21); 1157 dcl end_index fixed bin (21); 1158 dcl new_number fixed bin (21); 1159 dcl increment fixed bin (21); 1160 1161 dcl (i, j) fixed bin (21); 1162 1163 t_index = start_index; 1164 do while (t_index <= end_index); 1165 1166 line_length = index (substr (cur_seg, t_index, end_index - t_index + 1), new_line); 1167 if line_length > 0 then do; 1168 i = verify (substr (cur_seg, t_index, line_length), digit); 1169 call ioa_$rsnnl ("^d", string, j, new_number); 1170 line_length = line_length - i + 1; 1171 substr (temp_seg, temp_length + 1, j) = string; 1172 temp_length = temp_length + j; 1173 substr (temp_seg, temp_length + 1, line_length) = 1174 substr (cur_seg, t_index + i -1, line_length); 1175 temp_length = temp_length + line_length; 1176 new_number = new_number + increment; 1177 t_index = t_index + line_length + i; 1178 end; 1179 end; 1180 1181 return; 1182 1183 end renumber; 1184 1185 /* */ 1186 renumber_if_necessary: proc (start_index, end_index, new_number); 1187 1188 dcl start_index fixed bin (21); 1189 dcl end_index fixed bin (21); 1190 dcl new_number fixed bin (21); 1191 t_index = start_index; 1192 do while (t_index <= end_index); 1193 i = verify (substr (cur_seg, t_index, end_index - t_index + 1), digit); 1194 if i > 1 then do; 1195 num_1 = cv_dec_check_ (substr (cur_seg, t_index, i-1), code); 1196 if code = 0 then do; 1197 line_length = index (substr (cur_seg, t_index, end_index - t_index + 1), new_line); 1198 if num_1 < new_number then call renumber (t_index, line_length, new_number, 1); 1199 1200 else do; 1201 call copy_block (t_index, end_index); 1202 return; 1203 end; 1204 t_index = t_index + line_length; 1205 end; 1206 end; 1207 end; 1208 1209 return; 1210 1211 end renumber_if_necessary; 1212 1213 /* */ 1214 /* This procedure switches the pointers so that the temporary buffer becomes the current segment */ 1215 1216 switch_buffers: proc; 1217 1218 f.current_ptr = temp_ptr; 1219 f.current_length = temp_length; 1220 f.alter_ptr = cur_ptr; 1221 1222 return; 1223 1224 end switch_buffers; 1225 1226 /* */ 1227 /* * The procedure parses the line for a line number or block specification. 1228* * There are two forms: 1229* * 1230* * 1. One line number: [] 1231* * block_start, block_end = the index in the line. 1232* * 1233* * 2. Block specification: [ - ] 1234* * 1235* * block_start The index of the line OR the next higher line that is <= the block_end. 1236* * block_end The index of the end of the line OR the next lower line that is >= block_start. 1237* * 1238* * code = 0 The line index was found. 1239* * = error_line_miss The line could not be found. 1240* * = error_bad_line Format error in line specification. 1241* */ 1242 1243 parse_block_spec: proc (search_start, block_start, block_end) returns (bit (1)); 1244 1245 dcl search_start fixed bin (21); 1246 dcl block_start fixed bin (21); 1247 dcl block_end fixed bin (21); 1248 1249 dcl line_start fixed bin (21); /* beginning of line being looked at */ 1250 dcl num_chars fixed bin (21); /* num characters in line */ 1251 1252 arg = line; 1253 if ^parse_two_numbers (num_1, num_2) then return ("0"b); 1254 1255 line_start = search_start; 1256 do while (line_start <= cur_length); 1257 call get_line_number (line_start, num_chars, line_number); 1258 if num_1 <= line_number then do; 1259 block_start = line_start; 1260 block_end = line_start + num_chars -1; 1261 if num_1 = num_2 then do; 1262 if num_1 = line_number then return ("1"b); 1263 else code = error_line_miss; 1264 end; 1265 if line_number <= num_2 then do; 1266 if get_equal_lower_line (block_end + 1, num_2, (0), block_end) then return ("1"b); 1267 if code = 0 then return ("1"b); 1268 end; 1269 else code = error_line_miss; 1270 return ("0"b); 1271 end; 1272 line_start = line_start + num_chars; 1273 end; 1274 1275 if code = 0 then code = error_line_miss; 1276 return ("0"b); 1277 1278 end parse_block_spec; 1279 1280 /* */ 1281 parse_two_numbers: proc (num_1, num_2) returns (bit (1) unal); 1282 1283 dcl num_1 fixed bin (21); 1284 dcl num_2 fixed bin (21); 1285 1286 if parse_number (num_1) then do; 1287 line_start = verify (line, white_space); 1288 if line_start > 0 then do; 1289 if substr (line, line_start, 1) = "-" then do; 1290 if line_start < length (line) then do; 1291 line = substr (line, line_start + 1); 1292 if parse_number (num_2) then do; 1293 if num_1 > num_2 then code = error_block_spec; 1294 end; 1295 else code = error_block_spec; 1296 end; 1297 else code = error_block_spec; 1298 end; 1299 else num_2 = num_1; 1300 end; 1301 else num_2 = num_1; 1302 end; 1303 else return ("0"b); 1304 1305 if code = 0 then return ("1"b); 1306 1307 end parse_two_numbers; 1308 1309 1310 /* */ 1311 get_equal_lower_line: proc (search_start, num, line_start, line_end) returns (bit (1) unal); 1312 1313 dcl search_start fixed bin (21); 1314 dcl num fixed bin (21); 1315 dcl line_start fixed bin (21); 1316 dcl line_end fixed bin (21); 1317 1318 i = search_start; 1319 1320 do while (i <= cur_length); 1321 call get_line_number (i, j, line_number); 1322 if code = 0 then do; 1323 if line_number > num then do; 1324 if i = search_start then return ("0"b); 1325 line_start, line_end = i -1; 1326 return ("1"b); 1327 end; 1328 1329 else if line_number = num then do; 1330 line_start = i; 1331 line_end = i + j -1; 1332 return ("1"b); 1333 end; 1334 i = i + j; 1335 end; 1336 1337 else return ("0"b); 1338 end; 1339 1340 line_start, line_end = cur_length; 1341 1342 return ("1"b); 1343 1344 end get_equal_lower_line; 1345 1346 1347 /* */ 1348 /* * This procedure parses the input line for a line number. It returns the indices of the start and end of 1349* * of the line. 1350* * 1351* * 1. The line exists: 1352* * line_start index of start of the line. 1353* * line_end index of end of the line. 1354* * 1355* * 2. The line does not exits: 1356* * line_start the index of the end of the line which would logically preceed the 1357* * missing line. 1358* * line_end = line_start 1359**/ 1360 find_line: proc (line_start, line_end) returns (bit (1)); 1361 1362 dcl line_start fixed bin (21); 1363 dcl line_end fixed bin (21); 1364 1365 if parse_number (num_3) then do; 1366 if get_equal_lower_line (1, num_3, line_start, line_end) then return ("1"b); 1367 1368 else if code = 0 then do; 1369 line_start, line_end = 0; 1370 return ("1"b); 1371 end; 1372 end; 1373 1374 else if code = 0 then code = error_request_miss; 1375 1376 return ("0"b); 1377 1378 end find_line; 1379 1380 /* */ 1381 /* After the first number is found, a search is made for a minus sign preceeded by blanks or tabs. 1382* * 1383* * 1. Minus sign is found: The next item must be a valid number or an error code is returned. 1384* * 1385* * 2. Minus sign is not found: The first number is returned. 1386**/ 1387 get_numbers: proc (num_1, num_2) returns (bit (1)); 1388 1389 dcl num_1 fixed bin (21); 1390 dcl num_2 fixed bin (21); 1391 1392 /* Save the current argument for an error message */ 1393 1394 i = search (line, ",;"); 1395 if i = 0 then i = length (line); 1396 arg = substr (line, 1, i); 1397 1398 if parse_number (num_1) then do; 1399 num_2 = num_1; 1400 i = verify (line, white_space); 1401 if i = 0 then return ("1"b); 1402 if substr (line, i, 1) ^= "-" then return ("1"b); 1403 1404 if length (line) > i then do; 1405 line = substr (line, i+1); 1406 if parse_number (num_2) then return ("1"b); 1407 end; 1408 else code = error_bad_line; 1409 end; 1410 1411 return ("0"b); 1412 1413 end get_numbers; 1414 1415 /* */ 1416 /* This procedure parses a line in the current segment and returns its line number. 1417* 1418* * code = 0 Line begins with a positive or 0 number. 1419* * no_nl Segment does not end with a new_line. 1420* * bad_sort Line has no number, editing can't continue. 1421**/ 1422 get_line_number: proc (start, num_chars, line_number); 1423 1424 /* parameters */ 1425 1426 dcl start fixed bin (21); 1427 dcl num_chars fixed bin (21); 1428 dcl line_number fixed bin (21); 1429 1430 1431 num_chars = verify (substr (cur_seg, start), digit) - 1; 1432 if num_chars > 0 then do; 1433 if num_chars <= max_digits_line_num then do; 1434 number_pic = 0; 1435 substr (number_pic, max_digits_line_num - num_chars + 1, num_chars) = 1436 substr (cur_seg, start, num_chars); 1437 line_number = number_pic; 1438 end; 1439 else do; 1440 code = error_max_line_number; 1441 arg = substr (cur_seg, start, num_chars); 1442 end; 1443 end; 1444 else code = error_bad_sort; 1445 num_chars = index (substr (cur_seg, start), new_line); 1446 if num_chars = 0 then code = error_no_nl; 1447 1448 return; 1449 end get_line_number; 1450 1451 /* */ 1452 /* This procedure parses the line for a number of the form: 1453* * [blank]... [] 1454**/ 1455 1456 parse_number: proc (num) returns (bit (1)); 1457 1458 dcl num fixed bin (21); 1459 1460 dcl (start, num_chars) fixed bin (21); 1461 dcl num_string char (10); 1462 1463 start = verify (line, white_space); 1464 if start > 0 then do; 1465 num_chars = verify (substr (line, start), digit); 1466 if num_chars = 0 then num_chars = length (line) - start +1; 1467 else num_chars = num_chars -1; 1468 1469 if num_chars > 0 then do; 1470 if num_chars <= max_digits_line_num then do; 1471 num_string = substr (line, start, num_chars); 1472 number_pic = 0; 1473 substr (number_pic, max_digits_line_num - num_chars + 1, num_chars) = 1474 substr (line, start, num_chars); 1475 num = number_pic; 1476 start = num_chars + start; 1477 if start <= length (line) then do; 1478 num_chars = verify (substr (line, start), arg_delimiter); 1479 if num_chars > 0 then start = start+num_chars-1; 1480 end; 1481 line = substr (line, start); 1482 return ("1"b); 1483 end; 1484 else code = error_max_line_number; 1485 end; 1486 1487 else code = error_bad_line; 1488 end; 1489 1490 return ("0"b); 1491 1492 end parse_number; 1493 1494 /* */ 1495 /* This procedure parses the user input line for a pathname and copies the segment onto the end of the current 1496* segment. 1497**/ 1498 1499 copy_seg: proc () returns (bit (1)); 1500 1501 if dfast_get_arg_ (line, arg) then do; 1502 call dfast_directory_ (COPY, (arg), edit_info_ptr, addr (copy_info), code); 1503 if code = 0 then return ("1"b); 1504 print_message = "0"b; 1505 end; 1506 1507 return ("0"b); 1508 1509 end copy_seg; 1510 1511 1512 /* */ 1513 parse_line_list: proc; 1514 1515 dcl search_start fixed bin (21); /* index in cur_seg to begin search */ 1516 dcl last_num fixed bin (21); /* highest number so far in the line list */ 1517 1518 num_blocks = 0; 1519 search_start = 1; 1520 last_num = -1; 1521 1522 do while (parse_block_spec (search_start, block_start, block_end)); 1523 1524 if num_blocks < 16 then do; 1525 if num_1 > last_num then do; 1526 num_blocks = num_blocks + 1; 1527 block (num_blocks).start = block_start; 1528 block (num_blocks).end = block_end; 1529 end; 1530 else code = error_line_order; 1531 end; 1532 1533 else code = error_max_lines; 1534 if code ^= 0 then return; 1535 1536 search_start = block_end + 1; 1537 last_num = num_2; 1538 end; 1539 1540 if code = error_line_miss then if last_num > num_1 then code = error_line_order; 1541 1542 return; 1543 1544 end parse_line_list; 1545 1546 1547 /* */ 1548 fill_basic_tbl: proc (table_ptr, conditional, start, end, seq_number, increment); 1549 1550 dcl table_ptr ptr; /* ptr to structure to be filled in */ 1551 dcl conditional bit (1); /* ON set entry only if number < seq_number */ 1552 dcl start fixed bin (21); /* index on current_segment of start of block being checked */ 1553 dcl end fixed bin (21); /* index on current_segment of end of block */ 1554 dcl seq_number fixed bin (21); /* new sequence number to use */ 1555 dcl increment fixed bin (21); /* increment for sequence number */ 1556 1557 dcl index fixed bin (21); 1558 1559 1560 dcl 1 tbl aligned based (table_ptr) like basic_resq_tbl; 1561 index = start; 1562 1563 do while (index < end & code = 0); 1564 call get_line_number (index, j, line_number); 1565 if conditional then if line_number >= seq_number then return; 1566 num_lines = num_lines + 1; 1567 t (num_lines).old_number = line_number; 1568 t (num_lines).new_number = seq_number; 1569 seq_number = seq_number + increment; 1570 index = index + j; 1571 end; 1572 1573 return; 1574 1575 end fill_basic_tbl; 1576 1577 end dfast_line_edit_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1552.4 dfast_line_edit_.pl1 >spec>on>comp-dir>dfast_line_edit_.pl1 123 1 03/27/82 0439.4 dfast_error_codes.incl.pl1 >ldd>include>dfast_error_codes.incl.pl1 124 2 03/27/82 0439.4 dfast_edit_info.incl.pl1 >ldd>include>dfast_edit_info.incl.pl1 1105 3 07/28/81 1333.4 iocb.incl.pl1 >ldd>include>iocb.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. COPY 000006 constant fixed bin(17,0) initial dcl 86 set ref 1502* PREFIX constant fixed bin(17,0) initial dcl 88 set ref 157* 677 REPLACE constant fixed bin(17,0) initial dcl 87 set ref 156* 674 SUFFIX constant fixed bin(17,0) initial dcl 89 set ref 158* acode 000100 automatic fixed bin(35,0) dcl 189 set ref 191* 192 192* addr builtin function dcl 103 ref 191 289 289 291 291 356 399 466 543 634 634 927 1064 1064 1502 1502 alter_length 117 based fixed bin(21,0) level 3 dcl 93 ref 135 alter_ptr 122 based pointer level 3 dcl 93 set ref 147 349 1220* arg 000134 automatic varying char(256) dcl 42 set ref 131* 132 175* 179* 180 740* 774* 778* 797* 1043* 1071* 1252* 1396* 1441* 1501* 1502 arg_delimiter 000003 constant char(4) initial unaligned dcl 83 ref 1478 arg_edit_info_ptr parameter pointer dcl 14 ref 11 127 based_arr based pointer array dcl 101 set ref 191* 356* 399* 543* 927* basic_resq_tbl based structure level 1 dcl 96 basic_resq_tbl_ptr 000124 automatic pointer dcl 37 set ref 129* 149 183 191 191 356 359 360* 399 403 420* 447* 466 466 543 545 547* 550* 551* 564* 595* 927 929 932* basic_system 0(04) based bit(1) level 3 packed unaligned dcl 93 set ref 342* 351 419 447 454 506 926 bit_count 000100 automatic fixed bin(24,0) dcl 1028 set ref 1078* 1079 blank 011470 constant char(1) initial unaligned dcl 85 ref 838 block 000454 automatic structure array level 1 unaligned dcl 59 block_end parameter fixed bin(21,0) dcl 1247 in procedure "parse_block_spec" set ref 1243 1260* 1266 1266* block_end 000123 automatic fixed bin(21,0) dcl 36 in procedure "dfast_line_edit_" set ref 983* 985* 986* 994 995* 1003* 1011 1522* 1528 1536 block_length 000121 automatic fixed bin(21,0) dcl 34 in procedure "dfast_line_edit_" set ref 622* 624 625 629* 629 632 636* 636 641* 692* 693 694 720* 720 726* 726 729* block_length 001020 automatic fixed bin(21,0) dcl 1134 in procedure "copy_block" set ref 1137* 1139 1139 1141 block_start parameter fixed bin(21,0) dcl 1246 in procedure "parse_block_spec" set ref 1243 1259* block_start 000122 automatic fixed bin(21,0) dcl 35 in procedure "dfast_line_edit_" set ref 983* 984 984* 986* 993* 994* 1002* 1010 1522* 1527 check 000452 automatic bit(1) unaligned dcl 54 set ref 705 804* 805* 806* cleanup 000562 stack reference condition dcl 73 in procedure "dfast_line_edit_" ref 148 cleanup 000170 stack reference condition dcl 1035 in procedure "string_request" ref 1053 code 000100 automatic fixed bin(35,0) dcl 1099 in procedure "cleanup_iocb" set ref 1109* 1111* 1112 1113* 1114* 1118 1118* code parameter fixed bin(35,0) dcl 16 in procedure "dfast_line_edit_" set ref 11 135* 137 144* 166* 167 169* 174* 178 179 180* 212 219 225* 246 251 257* 280 289* 291* 294* 319* 326 343 353 356* 357 358 361 363 380 380* 399* 411 436* 439* 441* 444* 445 455 461 468 473* 477 479 522* 524 526* 528* 543* 544 576* 595* 624 634* 639* 646 646* 649* 681* 739* 789* 792* 793* 796* 800 802 816* 834 847* 849* 852 874 895* 899* 901 903* 927* 928 935 943 948 955* 958 962 964* 980 986* 990* 1047* 1048 1049* 1050 1050* 1054* 1056 1057* 1060 1064* 1069* 1074* 1077 1078* 1085* 1087* 1089 1144* 1195* 1196 1263* 1267 1269* 1275 1275* 1293* 1295* 1297* 1305 1322 1368 1374 1374* 1408* 1440* 1444* 1446* 1484* 1487* 1502* 1503 1530* 1533* 1534 1540 1540* 1563 conditional parameter bit(1) unaligned dcl 1551 ref 1548 1565 copy_info 000556 automatic structure level 1 dcl 68 set ref 1502 1502 copy_ptr 000556 automatic pointer level 2 dcl 68 set ref 307* 405* cur_length 000132 automatic fixed bin(21,0) dcl 40 set ref 139* 154 277 284 289 289 350* 352* 409* 426 447* 448 449* 473 473 512* 519* 551* 557* 560* 564* 570* 573* 595 595 616 625 627 632 634 634 694 706 708 734* 813 834 836 838 841 875 879 881 888 943* 958* 985 995 1003 1060 1061 1064 1064 1139 1166 1168 1173 1193 1195 1195 1197 1256 1320 1340 1431 1435 1441 1445 cur_ptr 000130 automatic pointer dcl 39 set ref 138* 289 289 348* 405 426 473 473 595 595 625 627 632 634 634 694 706 708 836 838 841 881 888 1061 1064 1064 1139 1166 1168 1173 1193 1195 1195 1197 1220 1431 1435 1441 1445 cur_seg based char unaligned dcl 95 set ref 289 289 426 473 473 595 595 625 627 632 634 634 694 706 708 836 838 841 881 888 1061 1064 1064 1139 1166 1168 1173 1193 1195 1195 1197 1431 1435 1441 1445 current_length 116 based fixed bin(21,0) level 3 dcl 93 set ref 139 220* 350 1219* current_ptr 120 based pointer level 3 dcl 93 set ref 138 348 1218* cv_dec_check_ 000012 constant entry external dcl 109 ref 1195 delimiter 000754 automatic char(1) unaligned dcl 769 set ref 773* 774 775 783 dfast_basic_resequence_ 000034 constant entry external dcl 118 ref 473 595 dfast_directory_ 000022 constant entry external dcl 113 ref 1502 dfast_edit_info based structure level 1 dcl 2-4 dfast_error_ 000030 constant entry external dcl 116 ref 180 192 1050 1118 dfast_explain_ 000026 constant entry external dcl 115 ref 144 dfast_get_arg_ 000032 constant entry external dcl 117 ref 131 1501 dfast_merge_ 000024 constant entry external dcl 114 ref 135 380 964 digit 000000 constant char(10) initial unaligned dcl 84 ref 706 804 805 836 1168 1193 1431 1465 directory 000101 automatic char(168) unaligned dcl 1029 set ref 1047* 1054 directory_length 000153 automatic fixed bin(17,0) dcl 1030 set ref 1047* 1054 divide builtin function dcl 103 ref 1079 edit_done 0(03) based bit(1) level 3 packed unaligned dcl 93 set ref 167* edit_info_ptr 000100 automatic pointer dcl 20 set ref 127* 135 135* 138 139 147 167 220 342 348 349 350 351 380* 419 447 454 473 506 595 717 884 886 888 926 964* 1138 1139 1171 1173 1218 1219 1220 1502* end parameter fixed bin(21,0) dcl 1553 in procedure "fill_basic_tbl" ref 1548 1563 end 1 000454 automatic fixed bin(21,0) array level 2 in structure "block" dcl 59 in procedure "dfast_line_edit_" set ref 217 250 284* 289 316* 360* 361* 417* 425 426 431 449 457* 472* 473 473 622 692 813* 932* 938* 940 952* 953 1011* 1528* end parameter fixed bin(21,0) dcl 593 in procedure "copy_resq" ref 589 595 595 end_index parameter fixed bin(21,0) dcl 1157 in procedure "renumber" ref 1154 1164 1166 end_index parameter fixed bin(21,0) dcl 1189 in procedure "renumber_if_necessary" set ref 1186 1192 1193 1197 1201* end_index 000105 automatic fixed bin(21,0) dcl 24 in procedure "dfast_line_edit_" set ref 501* 510* 512 517 518 518* 547* 551 555* 557 568 569 569* end_index parameter fixed bin(21,0) dcl 1132 in procedure "copy_block" ref 1129 1136 1137 entry_name 000154 automatic char(32) unaligned dcl 1031 set ref 1047* 1054 error_bad_line constant fixed bin(35,0) initial dcl 1-28 ref 1408 1487 error_bad_rec_len constant fixed bin(35,0) initial dcl 1-36 ref 1085 1087 error_bad_sort constant fixed bin(35,0) initial dcl 1-24 ref 1444 error_block_spec constant fixed bin(35,0) initial dcl 1-17 ref 522 576 1293 1295 1297 error_cur_empty constant fixed bin(35,0) initial dcl 1-5 ref 169 294 649 903 error_delimiter_miss constant fixed bin(35,0) initial dcl 1-34 ref 789 793 796 error_line_miss constant fixed bin(35,0) initial dcl 1-26 ref 257 986 990 1263 1269 1275 1540 error_line_order constant fixed bin(35,0) initial dcl 1-30 ref 436 955 1530 1540 error_max_line_number constant fixed bin(35,0) initial dcl 1-38 ref 1440 1484 error_max_lines constant fixed bin(35,0) initial dcl 1-31 ref 319 439 1533 error_max_size constant fixed bin(35,0) initial dcl 1-4 ref 895 1144 error_no_nl constant fixed bin(35,0) initial dcl 1-23 ref 639 847 849 899 1074 1446 error_no_num constant fixed bin(35,0) initial dcl 1-25 ref 179 225 526 816 error_no_string constant fixed bin(35,0) initial dcl 1-29 ref 646 739 error_request_miss constant fixed bin(35,0) initial dcl 1-27 ref 174 441 444 528 1374 error_size_fixed_record constant fixed bin(35,0) initial dcl 1-35 ref 1069 error_string_size constant fixed bin(35,0) initial dcl 1-37 ref 681 error_syntax_string constant fixed bin(35,0) initial dcl 1-13 ref 792 error_unknown_arg constant fixed bin(35,0) initial dcl 1-9 ref 166 f based structure level 1 dcl 93 fill_block_table parameter bit(1) unaligned dcl 305 ref 303 312 flags based structure level 2 dcl 93 get_temp_segments_ 000016 constant entry external dcl 111 ref 356 399 543 927 hcs_$fs_get_path_name 000042 constant entry external dcl 1037 ref 1047 hcs_$set_bc_seg 000040 constant entry external dcl 1036 ref 1049 hcs_$status_mins 000044 constant entry external dcl 1038 ref 1078 i 000241 automatic fixed bin(21,0) dcl 45 in procedure "dfast_line_edit_" set ref 358* 360 360 361 361* 424* 425 426 426 429* 429 431* 455* 456 457 457 458* 468* 469 469 470 472 472 472 473 473 473 473 473 473* 625* 626 627 629 630 694* 695 706 708 715* 715 716* 719 725 726 836* 837 838 838 838* 838 839 881* 882 884 888 888 889 890 1061* 1062 1063 1064* 1066 1070 1138 1193* 1194 1195 1195 1318* 1320 1321* 1324 1325 1330 1331 1334* 1334 1394* 1395 1395* 1396 1400* 1401 1402 1404 1405 i 001030 automatic fixed bin(21,0) dcl 1161 in procedure "renumber" set ref 1168* 1170 1173 1177 i 000752 automatic fixed bin(17,0) dcl 768 in procedure "parse_string_args" set ref 771* 772 773 775 777 780* 780 781 783 785 787 incr 1 000514 automatic fixed bin(21,0) array level 2 dcl 63 set ref 932* 952* 1013* increment 000245 automatic fixed bin(21,0) dcl 48 in procedure "dfast_line_edit_" set ref 346* 352* 360* 401* 420* 428 447* 456* 457* 460* 472* 870* 872* 891 987* 987* 996* 1005* 1013 increment parameter fixed bin(21,0) dcl 1555 in procedure "fill_basic_tbl" ref 1548 1569 increment parameter fixed bin(21,0) dcl 1159 in procedure "renumber" ref 1154 1176 index 001132 automatic fixed bin(21,0) dcl 1557 in procedure "fill_basic_tbl" set ref 1561* 1563 1564* 1570* 1570 index builtin function dcl 103 in procedure "dfast_line_edit_" ref 426 625 627 632 694 775 783 804 805 841 881 1061 1166 1197 1445 index_arr 000654 automatic fixed bin(21,0) array dcl 393 set ref 414* 415 420* 434 456* 458 469 469* 470 ioa_$rsnnl 000014 constant entry external dcl 110 ref 883 1169 iocb based structure level 1 dcl 3-4 iocb_ptr parameter pointer dcl 1097 in procedure "cleanup_iocb" set ref 1095 1110 1111 1111* 1113* 1114* iocb_ptr 000164 automatic pointer dcl 1032 in procedure "string_request" set ref 1052* 1053* 1054* 1057* 1064* 1076* iox_$attach_ioname 000046 constant entry external dcl 1039 ref 1054 iox_$close 000054 constant entry external dcl 1101 ref 1111 iox_$destroy_iocb 000056 constant entry external dcl 1102 ref 1114 iox_$detach_iocb 000060 constant entry external dcl 1103 ref 1113 iox_$open 000050 constant entry external dcl 1040 ref 1057 iox_$put_chars 000036 constant entry external dcl 119 ref 289 291 634 iox_$user_output 000010 external static pointer dcl 107 set ref 289* 291* 634* iox_$write_record 000052 constant entry external dcl 1041 ref 1064 j 000753 automatic fixed bin(17,0) dcl 768 in procedure "parse_string_args" set ref 775* 776 777 779 780 783* 784 785 786 787 792 j 000242 automatic fixed bin(21,0) dcl 45 in procedure "dfast_line_edit_" set ref 426* 427 429 627* 628 629 630 632* 633 634* 635 636 706* 707 708 841* 842 843 844 883* 884 886 887 1321* 1331 1334 1564* 1570 j 001031 automatic fixed bin(21,0) dcl 1161 in procedure "renumber" set ref 1169* 1171 1172 k 000243 automatic fixed bin(21,0) dcl 46 in procedure "dfast_line_edit_" set ref 215* 216 217* 248* 250 250* 287* 289 289 289 289* 620* 621 622 622* 690* 691 692 692* 931* 932 932 932 932* 935* 937 938 938 940* 948* 950 951 952 952 952 952 953* k 000676 automatic fixed bin(21,0) dcl 396 in procedure "insert" set ref 448* 460* 478 478* last_index 000120 automatic fixed bin(21,0) dcl 33 set ref 214* 216 217* 220 404* 415 420 434* 447 450* 456 458* 460 469 469 470* 478 478 689* 716 719* 720 721 733 734 924* 937 940* 943 950 951 953* 958 last_num 001123 automatic fixed bin(21,0) dcl 1516 set ref 1520* 1525 1537* 1540 length builtin function dcl 103 ref 1290 1395 1404 1466 1477 length_new_string 000451 automatic fixed bin(21,0) dcl 53 set ref 675* 675 676 717 718 786* length_old_string 000450 automatic fixed bin(21,0) dcl 52 set ref 675 719 725 726 779* line parameter varying char(256) dcl 13 set ref 11 131* 144* 771 773 775 777 781* 781 783 785 787* 787 1252 1287 1289 1290 1291* 1291 1394 1395 1396 1400 1402 1404 1405* 1405 1463 1465 1466 1471 1473 1477 1478 1481* 1481 1501* line_end 000107 automatic fixed bin(21,0) dcl 26 in procedure "dfast_line_edit_" set ref 502* 509* 511 517* 519 550 554* 556 564 568* 570 line_end parameter fixed bin(21,0) dcl 1363 in procedure "find_line" set ref 1360 1366* 1369* line_end parameter fixed bin(21,0) dcl 1316 in procedure "get_equal_lower_line" set ref 1311 1325* 1331* 1340* line_length 000117 automatic fixed bin(21,0) dcl 32 set ref 1166* 1167 1168 1170* 1170 1173 1173 1175 1177 1197* 1198* 1204 line_number parameter fixed bin(21,0) dcl 1428 in procedure "get_line_number" set ref 1422 1437* line_number 000113 automatic fixed bin(21,0) dcl 30 in procedure "dfast_line_edit_" set ref 1257* 1258 1262 1265 1321* 1323 1329 1564* 1565 1567 line_start parameter fixed bin(21,0) dcl 1315 in procedure "get_equal_lower_line" set ref 1311 1325* 1330* 1340* line_start 000106 automatic fixed bin(21,0) dcl 25 in procedure "dfast_line_edit_" set ref 502* 1287* 1288 1289 1290 1291 line_start parameter fixed bin(21,0) dcl 1362 in procedure "find_line" set ref 1360 1366* 1369* line_start 001046 automatic fixed bin(21,0) dcl 1249 in procedure "parse_block_spec" set ref 1255* 1256 1257* 1259 1260 1272* 1272 max_digits_line_num constant fixed bin(17,0) initial dcl 78 ref 1433 1435 1470 1473 max_seg_size 2 based fixed bin(21,0) level 3 dcl 93 set ref 473* 595* 717 884 886 888 1138 1139 1171 1173 new_length 3 000556 automatic fixed bin(21,0) level 2 dcl 68 set ref 316 323 409 417 418 new_line 000004 constant char(1) initial unaligned dcl 80 set ref 291 291 426 627 632 708 841 881 1061 1166 1197 1445 new_number 1(18) based fixed bin(17,0) array level 3 in structure "tbl" packed unaligned dcl 1560 in procedure "fill_basic_tbl" set ref 1568* new_number parameter fixed bin(21,0) dcl 1190 in procedure "renumber_if_necessary" set ref 1186 1198 1198* new_number parameter fixed bin(21,0) dcl 1158 in procedure "renumber" set ref 1154 1169* 1176* 1176 new_string 000347 automatic varying char(256) dcl 51 set ref 677* 677 678* 678 717 785* 805 null builtin function dcl 103 ref 129 149 183 191 1052 1110 1111 num parameter fixed bin(21,0) dcl 1314 in procedure "get_equal_lower_line" ref 1311 1323 1329 num parameter fixed bin(21,0) dcl 1458 in procedure "parse_number" set ref 1456 1475* num_1 000103 automatic fixed bin(21,0) dcl 22 in procedure "dfast_line_edit_" set ref 508 549 982* 983* 985 1195* 1198 1253* 1258 1261 1262 1525 1540 num_1 parameter fixed bin(21,0) dcl 1283 in procedure "parse_two_numbers" set ref 1281 1286* 1293 1299 1301 num_1 parameter fixed bin(21,0) dcl 1389 in procedure "get_numbers" set ref 1387 1398* 1399 num_2 000104 automatic fixed bin(21,0) dcl 23 in procedure "dfast_line_edit_" set ref 515 563 982* 985 986* 1253* 1261 1265 1266* 1537 num_2 parameter fixed bin(21,0) dcl 1390 in procedure "get_numbers" set ref 1387 1399* 1406* num_2 parameter fixed bin(21,0) dcl 1284 in procedure "parse_two_numbers" set ref 1281 1292* 1293 1299* 1301* num_3 000110 automatic fixed bin(21,0) dcl 27 set ref 504 508 515 549 563 1365* 1366* num_blocks 000554 automatic fixed bin(21,0) dcl 66 set ref 213 215 247 248 281 282* 287 309* 313 314* 314 315 316 358 402* 412 413* 413 414 415 416 417 420 423 424 425 426 431 434 441 449 455 468 620 690 809 811* 931 935 948 979* 993 1001 1008* 1008 1009 1010 1011 1012 1013 1518* 1524 1526* 1526 1527 1528 num_chars parameter fixed bin(21,0) dcl 1427 in procedure "get_line_number" set ref 1422 1431* 1432 1433 1435 1435 1435 1441 1445* 1446 num_chars 001047 automatic fixed bin(21,0) dcl 1250 in procedure "parse_block_spec" set ref 1257* 1260 1272 num_chars 000101 automatic fixed bin(21,0) dcl 1460 in procedure "parse_number" set ref 1465* 1466 1466* 1467* 1467 1469 1470 1471 1473 1473 1473 1476 1478* 1479 1479 num_lines based fixed bin(21,0) level 2 in structure "basic_resq_tbl" dcl 96 in procedure "dfast_line_edit_" set ref 359* 403* 466 545* 929* num_lines based fixed bin(21,0) level 2 in structure "second_tbl" dcl 397 in procedure "insert" set ref 467* 471* num_lines based fixed bin(21,0) level 2 in structure "tbl" dcl 1560 in procedure "fill_basic_tbl" set ref 1566* 1566 1567 1568 num_pic 000236 automatic picture(6) unaligned dcl 43 set ref 1051* 1054 1070* 1071 num_string 000102 automatic char(10) unaligned dcl 1461 set ref 1471* number 000514 automatic fixed bin(21,0) array level 2 dcl 63 set ref 423* 472* 932* 952* 1012* number_pic 000570 automatic picture(5) unaligned dcl 79 set ref 1434* 1435* 1437 1472* 1473* 1475 old_length 2 000556 automatic fixed bin(21,0) level 2 dcl 68 set ref 308* 315 323* 327 406* 409* 416 418* old_number 1 based fixed bin(17,0) array level 3 in structure "basic_resq_tbl" packed unaligned dcl 96 in procedure "dfast_line_edit_" set ref 466 old_number 1 based fixed bin(17,0) array level 3 in structure "tbl" packed unaligned dcl 1560 in procedure "fill_basic_tbl" set ref 1567* old_string 000246 automatic varying char(256) dcl 50 set ref 625 677 678 694 740 777* 778 804 one_string_sw parameter bit(1) unaligned dcl 766 ref 764 781 open_descrip_ptr 20 based pointer level 2 dcl 3-4 ref 1111 print_message 000244 automatic bit(1) unaligned dcl 47 set ref 128* 178 1504* record_length 000166 automatic fixed bin(21,0) dcl 1033 set ref 1045* 1046 1051 1063 release_temp_segments_ 000020 constant entry external dcl 112 ref 191 replace_OK 000453 automatic bit(1) unaligned dcl 55 set ref 708* 709* 711* 714 724* 807* replace_type parameter fixed bin(17,0) dcl 671 ref 669 674 677 request 000133 automatic char(3) unaligned dcl 41 set ref 132* 133* 133 142 143 144 151 152 153 155 156 157 158 159 160 161 162 163 164 165 810 resequence_lines parameter bit(1) unaligned dcl 591 set ref 589 595* reverse builtin function dcl 103 ref 627 706 search builtin function dcl 103 ref 1394 search_start parameter fixed bin(21,0) dcl 1245 in procedure "parse_block_spec" ref 1243 1255 search_start parameter fixed bin(21,0) dcl 1313 in procedure "get_equal_lower_line" ref 1311 1318 1324 search_start 001122 automatic fixed bin(21,0) dcl 1515 in procedure "parse_line_list" set ref 1519* 1522* 1536* second_tbl based structure level 1 dcl 397 second_tbl_ptr 000674 automatic pointer dcl 394 set ref 466* 467 471 472* 473* seq 000514 automatic structure array level 1 unaligned dcl 63 seq_number parameter fixed bin(21,0) dcl 1554 in procedure "fill_basic_tbl" set ref 1548 1565 1568 1569* 1569 seq_number 000112 automatic fixed bin(21,0) dcl 29 in procedure "dfast_line_edit_" set ref 345* 352* 360* 400* 420* 423 428* 428 447* 456* 457* 460* 504* 510* 511* 512* 518* 519* 547* 550* 551* 564* 869* 872* 883* 891* 891 981* 1004* 1012 sort parameter bit(1) unaligned dcl 15 ref 11 553 566 964 start 000454 automatic fixed bin(21,0) array level 2 in structure "block" dcl 59 in procedure "dfast_line_edit_" set ref 216 250 283* 289 289 289 315* 360* 361* 416* 424 457* 472* 473 473 473 473 621 622 691 692 812* 932* 937 938* 950 951 952* 1010* 1527* start parameter fixed bin(21,0) dcl 1552 in procedure "fill_basic_tbl" ref 1548 1561 start 000100 automatic fixed bin(21,0) dcl 1460 in procedure "parse_number" set ref 1463* 1464 1465 1466 1471 1473 1476* 1476 1477 1478 1479* 1479 1481 start parameter fixed bin(21,0) dcl 1426 in procedure "get_line_number" ref 1422 1431 1435 1441 1445 start parameter fixed bin(21,0) dcl 592 in procedure "copy_resq" ref 589 595 595 595 595 start_index parameter fixed bin(21,0) dcl 1131 in procedure "copy_block" ref 1129 1136 1137 1139 start_index 000102 automatic fixed bin(21,0) dcl 21 in procedure "dfast_line_edit_" set ref 501* 510* 511 516 518 518* 547* 550 555* 556 567 569 569* 621* 625 627 630* 630 632 634 634 635* 635 691* 694 706 708 715 720 721* 725* 725 832* 834 836 838 839* 839 841 843* 843 844* 844 877* 879 881 888 890* 890 1059* 1060 1061 1064 1064 1066* 1066 start_index parameter fixed bin(21,0) dcl 1156 in procedure "renumber" ref 1154 1163 start_index parameter fixed bin(21,0) dcl 1188 in procedure "renumber_if_necessary" ref 1186 1191 string 000114 automatic char(10) unaligned dcl 31 set ref 883* 886 1169* 1171 string_found 000732 automatic bit(1) unaligned dcl 614 set ref 619* 637* 646 substr builtin function dcl 103 set ref 289 289 426 473 473 595 595 625 627 632 634 634 694 706 708 717* 773 775 777 781 783 785 787 804 805 836 838 841 881 886* 888* 888 1054 1061 1064 1064 1139* 1139 1166 1168 1171* 1173* 1173 1193 1195 1195 1197 1289 1291 1396 1402 1405 1431 1435* 1435 1441 1445 1465 1471 1473* 1473 1478 1481 system_info 2 based structure level 2 dcl 93 t 1 based structure array level 2 in structure "tbl" dcl 1560 in procedure "fill_basic_tbl" t 1 based structure array level 2 in structure "basic_resq_tbl" dcl 96 in procedure "dfast_line_edit_" t_index 000111 automatic fixed bin(21,0) dcl 28 set ref 1163* 1164 1166 1166 1168 1173 1177* 1177 1191* 1192 1193 1193 1195 1195 1197 1197 1198* 1201* 1204* 1204 table_ptr parameter pointer dcl 1550 ref 1548 1566 1566 1567 1567 1568 1568 tbl based structure level 1 dcl 1560 temp_length 000240 automatic fixed bin(21,0) dcl 44 set ref 146* 327* 344* 473* 595* 717 718* 718 884 886 887* 887 888 889* 889 1079* 1138 1139 1141* 1141 1171 1172* 1172 1173 1175* 1175 1219 temp_ptr 000126 automatic pointer dcl 38 set ref 147* 307 349* 473* 595* 717 886 888 1047* 1049* 1078* 1139 1171 1173 1218 temp_seg based char unaligned dcl 94 set ref 717* 886* 888* 1139* 1171* 1173* translate builtin function dcl 103 ref 133 verify builtin function dcl 103 ref 706 771 836 1168 1193 1287 1400 1431 1463 1465 1478 white_space constant char(2) initial unaligned dcl 82 ref 771 1287 1400 1463 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. error_access_mode internal static fixed bin(35,0) initial dcl 1-33 error_alt_empty internal static fixed bin(35,0) initial dcl 1-3 error_bad_name internal static fixed bin(35,0) initial dcl 1-11 error_bad_pathname internal static fixed bin(35,0) initial dcl 1-32 error_bad_req internal static fixed bin(35,0) initial dcl 1-12 error_bad_type internal static fixed bin(35,0) initial dcl 1-20 error_dprint_map internal static fixed bin(35,0) initial dcl 1-41 error_edit_max_num internal static fixed bin(35,0) initial dcl 1-43 error_long_rec internal static fixed bin(35,0) initial dcl 1-8 error_max_args internal static fixed bin(35,0) initial dcl 1-39 error_max_num internal static fixed bin(35,0) initial dcl 1-42 error_name_dup internal static fixed bin(35,0) initial dcl 1-7 error_name_miss internal static fixed bin(35,0) initial dcl 1-14 error_name_sys internal static fixed bin(35,0) initial dcl 1-40 error_no_comp internal static fixed bin(35,0) initial dcl 1-15 error_no_expl internal static fixed bin(35,0) initial dcl 1-10 error_no_main internal static fixed bin(35,0) initial dcl 1-16 error_no_new_line internal static fixed bin(35,0) initial dcl 1-45 error_no_suffix internal static fixed bin(35,0) initial dcl 1-22 error_not_saved internal static fixed bin(35,0) initial dcl 1-6 error_obj_nop internal static fixed bin(35,0) initial dcl 1-18 error_sav_cur internal static fixed bin(35,0) initial dcl 1-19 error_un_num_text internal static fixed bin(35,0) initial dcl 1-44 error_unkn_sys internal static fixed bin(35,0) initial dcl 1-21 iox_$iocb_version_sentinel external static char(4) dcl 3-43 ptr builtin function dcl 103 NAMES DECLARED BY EXPLICIT CONTEXT. append 001143 constant entry internal dcl 340 ref 153 basic_move 002304 constant entry internal dcl 540 ref 506 cleanup_iocb 005312 constant entry internal dcl 1095 ref 1053 1076 copy_block 005417 constant entry internal dcl 1129 ref 216 220 250 509 516 517 716 734 843 951 958 1201 copy_resq 002540 constant entry internal dcl 589 ref 361 469 478 554 555 556 557 560 567 568 569 570 573 937 938 943 copy_seg 007214 constant entry internal dcl 1499 ref 311 408 411 delete 000622 constant entry internal dcl 209 ref 160 desequence 003601 constant entry internal dcl 830 ref 159 dfast_line_edit_ 000136 constant entry external dcl 11 extract 000707 constant entry internal dcl 243 ref 161 fill_basic_tbl 007406 constant entry internal dcl 1548 ref 360 420 447 472 547 550 551 564 932 find_line 006420 constant entry internal dcl 1360 ref 414 502 free_buffers 000532 constant entry internal dcl 187 ref 149 183 get_equal_lower_line 006321 constant entry internal dcl 1311 ref 983 986 1266 1366 get_line_number 006667 constant entry internal dcl 1422 ref 1257 1321 1564 get_numbers 006516 constant entry internal dcl 1387 ref 982 insert 001362 constant entry internal dcl 391 ref 155 join 001064 constant entry internal dcl 303 ref 151 342 378 list 000753 constant entry internal dcl 275 ref 143 locate 002622 constant entry internal dcl 612 ref 142 merge 001334 constant entry internal dcl 376 ref 152 move 002150 constant entry internal dcl 499 ref 162 parse_block_spec 005777 constant entry internal dcl 1243 ref 501 1522 parse_line_list 007321 constant entry internal dcl 1513 ref 211 245 279 801 parse_number 007014 constant entry internal dcl 1456 ref 872 872 981 987 1045 1286 1292 1365 1398 1406 parse_string_args 003277 constant entry internal dcl 764 ref 617 673 parse_two_numbers 006160 constant entry internal dcl 1281 ref 1253 renumber 005456 constant entry internal dcl 1154 ref 352 456 457 460 510 518 952 1198 renumber_if_necessary 005606 constant entry internal dcl 1186 ref 511 512 519 replace 003011 constant entry internal dcl 669 ref 156 157 158 resequence 004110 constant entry internal dcl 920 ref 163 resequence_args 004413 constant entry internal dcl 977 ref 922 sequence 003714 constant entry internal dcl 867 ref 164 string_request 004566 constant entry internal dcl 1026 ref 165 switch_buffers 005757 constant entry internal dcl 1216 ref 221 254 328 353 363 461 479 524 735 852 901 963 1089 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 12032 12114 11500 12042 Length 12414 11500 62 264 332 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME dfast_line_edit_ 1057 external procedure is an external procedure. on unit on line 148 64 on unit free_buffers 94 internal procedure is called by several nonquick procedures. delete internal procedure shares stack frame of external procedure dfast_line_edit_. extract internal procedure shares stack frame of external procedure dfast_line_edit_. list internal procedure shares stack frame of external procedure dfast_line_edit_. join internal procedure shares stack frame of external procedure dfast_line_edit_. append internal procedure shares stack frame of external procedure dfast_line_edit_. merge internal procedure shares stack frame of external procedure dfast_line_edit_. insert internal procedure shares stack frame of external procedure dfast_line_edit_. move internal procedure shares stack frame of external procedure dfast_line_edit_. basic_move internal procedure shares stack frame of external procedure dfast_line_edit_. copy_resq internal procedure shares stack frame of external procedure dfast_line_edit_. locate internal procedure shares stack frame of external procedure dfast_line_edit_. replace internal procedure shares stack frame of external procedure dfast_line_edit_. parse_string_args internal procedure shares stack frame of external procedure dfast_line_edit_. desequence internal procedure shares stack frame of external procedure dfast_line_edit_. sequence internal procedure shares stack frame of external procedure dfast_line_edit_. resequence internal procedure shares stack frame of external procedure dfast_line_edit_. resequence_args internal procedure shares stack frame of external procedure dfast_line_edit_. string_request 168 internal procedure enables or reverts conditions. on unit on line 1053 70 on unit cleanup_iocb 88 internal procedure is called by several nonquick procedures. copy_block internal procedure shares stack frame of external procedure dfast_line_edit_. renumber internal procedure shares stack frame of external procedure dfast_line_edit_. renumber_if_necessary internal procedure shares stack frame of external procedure dfast_line_edit_. switch_buffers 64 internal procedure is called by several nonquick procedures. parse_block_spec internal procedure shares stack frame of external procedure dfast_line_edit_. parse_two_numbers internal procedure shares stack frame of external procedure dfast_line_edit_. get_equal_lower_line internal procedure shares stack frame of external procedure dfast_line_edit_. find_line internal procedure shares stack frame of external procedure dfast_line_edit_. get_numbers internal procedure shares stack frame of external procedure dfast_line_edit_. get_line_number internal procedure shares stack frame of external procedure dfast_line_edit_. parse_number 72 internal procedure is called by several nonquick procedures. copy_seg internal procedure shares stack frame of external procedure dfast_line_edit_. parse_line_list internal procedure shares stack frame of external procedure dfast_line_edit_. fill_basic_tbl internal procedure shares stack frame of external procedure dfast_line_edit_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cleanup_iocb 000100 code cleanup_iocb dfast_line_edit_ 000100 edit_info_ptr dfast_line_edit_ 000102 start_index dfast_line_edit_ 000103 num_1 dfast_line_edit_ 000104 num_2 dfast_line_edit_ 000105 end_index dfast_line_edit_ 000106 line_start dfast_line_edit_ 000107 line_end dfast_line_edit_ 000110 num_3 dfast_line_edit_ 000111 t_index dfast_line_edit_ 000112 seq_number dfast_line_edit_ 000113 line_number dfast_line_edit_ 000114 string dfast_line_edit_ 000117 line_length dfast_line_edit_ 000120 last_index dfast_line_edit_ 000121 block_length dfast_line_edit_ 000122 block_start dfast_line_edit_ 000123 block_end dfast_line_edit_ 000124 basic_resq_tbl_ptr dfast_line_edit_ 000126 temp_ptr dfast_line_edit_ 000130 cur_ptr dfast_line_edit_ 000132 cur_length dfast_line_edit_ 000133 request dfast_line_edit_ 000134 arg dfast_line_edit_ 000236 num_pic dfast_line_edit_ 000240 temp_length dfast_line_edit_ 000241 i dfast_line_edit_ 000242 j dfast_line_edit_ 000243 k dfast_line_edit_ 000244 print_message dfast_line_edit_ 000245 increment dfast_line_edit_ 000246 old_string dfast_line_edit_ 000347 new_string dfast_line_edit_ 000450 length_old_string dfast_line_edit_ 000451 length_new_string dfast_line_edit_ 000452 check dfast_line_edit_ 000453 replace_OK dfast_line_edit_ 000454 block dfast_line_edit_ 000514 seq dfast_line_edit_ 000554 num_blocks dfast_line_edit_ 000556 copy_info dfast_line_edit_ 000570 number_pic dfast_line_edit_ 000654 index_arr insert 000674 second_tbl_ptr insert 000676 k insert 000732 string_found locate 000752 i parse_string_args 000753 j parse_string_args 000754 delimiter parse_string_args 001020 block_length copy_block 001030 i renumber 001031 j renumber 001046 line_start parse_block_spec 001047 num_chars parse_block_spec 001122 search_start parse_line_list 001123 last_num parse_line_list 001132 index fill_basic_tbl free_buffers 000100 acode free_buffers parse_number 000100 start parse_number 000101 num_chars parse_number 000102 num_string parse_number string_request 000100 bit_count string_request 000101 directory string_request 000153 directory_length string_request 000154 entry_name string_request 000164 iocb_ptr string_request 000166 record_length string_request THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return signal enable shorten_stack ext_entry int_entry set_cs_eis index_cs_eis unpack_pic THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cv_dec_check_ dfast_basic_resequence_ dfast_directory_ dfast_error_ dfast_explain_ dfast_get_arg_ dfast_merge_ get_temp_segments_ hcs_$fs_get_path_name hcs_$set_bc_seg hcs_$status_mins ioa_$rsnnl iox_$attach_ioname iox_$close iox_$destroy_iocb iox_$detach_iocb iox_$open iox_$put_chars iox_$write_record release_temp_segments_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. iox_$user_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000131 127 000143 128 000147 129 000151 131 000153 132 000170 133 000175 135 000204 137 000225 138 000230 139 000233 142 000236 143 000243 144 000247 146 000275 147 000276 148 000300 149 000314 150 000326 151 000327 152 000337 153 000343 154 000347 155 000351 156 000355 157 000362 158 000367 159 000374 160 000400 161 000404 162 000410 163 000414 164 000420 165 000424 166 000433 167 000436 168 000443 169 000444 172 000447 174 000450 175 000453 178 000454 179 000461 180 000464 181 000517 183 000520 184 000530 187 000531 191 000537 192 000566 194 000621 209 000622 211 000623 212 000624 213 000627 214 000631 215 000632 216 000640 217 000652 218 000656 219 000660 220 000663 221 000677 224 000703 225 000704 227 000706 243 000707 245 000710 246 000711 247 000715 248 000717 250 000725 251 000735 252 000741 254 000743 255 000747 257 000750 259 000752 275 000753 277 000754 279 000756 280 000757 281 000763 282 000765 283 000767 284 000770 287 000772 289 001001 291 001033 292 001055 293 001057 294 001060 296 001063 303 001064 307 001066 308 001070 309 001071 311 001072 312 001077 313 001105 314 001110 315 001111 316 001117 317 001121 319 001122 320 001125 323 001126 324 001130 326 001131 327 001134 328 001136 331 001142 340 001143 342 001144 343 001154 344 001157 345 001160 346 001162 348 001164 349 001167 350 001172 351 001175 352 001200 353 001204 354 001213 356 001214 357 001237 358 001242 359 001254 360 001255 361 001301 362 001322 363 001324 368 001333 376 001334 378 001335 380 001341 382 001361 391 001362 399 001363 400 001407 401 001411 402 001413 403 001414 404 001415 405 001416 406 001420 408 001421 409 001426 411 001431 412 001443 413 001446 414 001447 415 001466 416 001472 417 001500 418 001502 419 001504 420 001507 423 001534 424 001541 425 001543 426 001552 427 001570 428 001571 429 001573 430 001575 431 001576 432 001601 434 001602 435 001605 436 001606 438 001611 439 001612 440 001614 441 001615 443 001621 444 001622 445 001625 447 001630 448 001642 449 001644 450 001650 454 001651 455 001654 456 001666 457 001706 458 001724 459 001727 460 001731 461 001736 462 001745 466 001746 467 001752 468 001753 469 001765 470 002007 471 002012 472 002013 473 002037 475 002121 477 002124 478 002127 479 002140 482 002147 499 002150 501 002151 502 002160 504 002165 506 002170 508 002175 509 002200 510 002204 511 002210 512 002220 513 002225 515 002226 516 002230 517 002237 518 002244 519 002253 520 002260 522 002261 524 002264 525 002273 526 002274 527 002277 528 002300 530 002303 540 002304 543 002305 544 002331 545 002335 547 002336 549 002344 550 002347 551 002363 553 002374 554 002402 555 002410 556 002414 557 002426 558 002435 560 002436 561 002444 563 002445 564 002447 566 002460 567 002466 568 002477 569 002506 570 002515 571 002524 573 002525 574 002533 576 002534 579 002537 589 002540 595 002542 598 002620 612 002622 616 002623 617 002625 619 002634 620 002635 621 002644 622 002650 624 002654 625 002661 626 002674 627 002675 628 002707 629 002710 630 002714 632 002721 633 002734 634 002735 635 002757 636 002761 637 002763 638 002765 639 002766 640 002770 641 002771 643 002772 644 002773 646 002775 648 003004 649 003005 651 003010 669 003011 673 003013 674 003022 675 003025 676 003027 677 003032 678 003050 679 003073 681 003075 682 003100 689 003101 690 003102 691 003111 692 003115 693 003120 694 003122 695 003135 705 003137 706 003141 707 003156 708 003157 709 003170 710 003172 711 003173 714 003174 715 003176 716 003202 717 003207 718 003216 719 003217 720 003222 721 003227 722 003232 724 003233 725 003235 726 003241 728 003246 729 003247 730 003250 731 003251 733 003253 734 003255 735 003261 736 003265 739 003266 740 003271 745 003276 764 003277 771 003301 772 003316 773 003317 774 003323 775 003327 776 003343 777 003345 778 003355 779 003362 780 003365 781 003371 783 003413 784 003431 785 003432 786 003442 787 003445 788 003464 789 003465 791 003467 792 003470 793 003474 794 003476 796 003477 797 003501 800 003502 801 003504 802 003505 804 003510 805 003524 806 003540 807 003541 809 003543 810 003553 811 003556 812 003560 813 003561 814 003563 816 003571 819 003573 830 003601 832 003602 834 003604 836 003612 837 003632 838 003634 839 003644 841 003646 842 003665 843 003666 844 003673 845 003675 847 003676 848 003700 849 003701 850 003703 852 003704 854 003713 867 003714 869 003715 870 003717 872 003721 874 003747 875 003752 877 003754 879 003756 881 003761 882 004000 883 004001 884 004027 886 004035 887 004043 888 004044 889 004055 890 004057 891 004061 892 004063 895 004064 896 004067 898 004070 899 004071 900 004074 901 004075 902 004104 903 004105 906 004107 920 004110 922 004111 924 004112 926 004113 927 004116 928 004142 929 004146 931 004147 932 004156 933 004201 935 004203 937 004215 938 004231 940 004247 941 004253 943 004255 945 004267 948 004270 950 004302 951 004310 952 004321 953 004337 954 004343 955 004344 956 004346 958 004350 962 004360 963 004363 964 004367 967 004412 977 004413 979 004414 980 004415 981 004420 982 004433 983 004440 984 004447 985 004453 986 004461 987 004473 989 004510 990 004511 991 004514 993 004515 994 004522 995 004525 996 004527 998 004531 1001 004532 1002 004535 1003 004537 1004 004541 1005 004543 1008 004545 1009 004546 1010 004551 1011 004555 1012 004557 1013 004561 1015 004563 1017 004564 1026 004565 1043 004573 1045 004575 1046 004611 1047 004613 1048 004646 1049 004652 1050 004666 1051 004715 1052 004726 1053 004730 1054 004755 1056 005073 1057 005100 1059 005121 1060 005124 1061 005133 1062 005152 1063 005153 1064 005155 1066 005177 1067 005204 1069 005205 1070 005207 1071 005217 1073 005224 1074 005225 1075 005227 1076 005230 1077 005237 1078 005243 1079 005261 1083 005266 1085 005267 1086 005273 1087 005274 1089 005300 1091 005310 1095 005311 1109 005317 1110 005320 1111 005325 1112 005343 1113 005345 1114 005357 1118 005371 1120 005416 1129 005417 1136 005421 1137 005424 1138 005430 1139 005435 1141 005447 1142 005451 1144 005452 1147 005455 1154 005456 1163 005460 1164 005462 1166 005466 1167 005504 1168 005505 1169 005520 1170 005546 1171 005552 1172 005560 1173 005561 1175 005573 1176 005575 1177 005600 1179 005604 1181 005605 1186 005606 1191 005610 1192 005612 1193 005616 1194 005635 1195 005637 1196 005674 1197 005700 1198 005717 1201 005741 1202 005751 1204 005752 1207 005754 1209 005755 1216 005756 1218 005764 1219 005771 1220 005774 1222 005776 1243 005777 1252 006001 1253 006010 1255 006023 1256 006026 1257 006031 1258 006033 1259 006036 1260 006041 1261 006044 1262 006047 1263 006056 1265 006061 1266 006064 1267 006117 1268 006130 1269 006131 1270 006134 1272 006142 1273 006144 1275 006145 1276 006152 1281 006160 1286 006162 1287 006175 1288 006212 1289 006213 1290 006217 1291 006221 1292 006233 1293 006247 1294 006256 1295 006257 1296 006262 1297 006263 1298 006265 1299 006266 1300 006271 1301 006272 1302 006275 1303 006276 1305 006304 1307 006315 1311 006321 1318 006323 1320 006325 1321 006330 1322 006332 1323 006335 1324 006341 1325 006351 1326 006354 1329 006361 1330 006362 1331 006364 1332 006370 1334 006375 1335 006377 1337 006400 1338 006406 1340 006407 1342 006413 1360 006420 1365 006422 1366 006435 1368 006467 1369 006472 1370 006475 1372 006502 1374 006503 1376 006510 1387 006516 1394 006520 1395 006535 1396 006540 1398 006547 1399 006562 1400 006565 1401 006602 1402 006610 1404 006621 1405 006623 1406 006635 1407 006656 1408 006657 1411 006661 1422 006667 1431 006671 1432 006711 1433 006712 1434 006714 1435 006721 1437 006733 1438 006744 1440 006745 1441 006750 1443 006761 1444 006762 1445 006765 1446 007006 1448 007012 1456 007013 1463 007021 1464 007037 1465 007040 1466 007057 1467 007065 1469 007067 1470 007071 1471 007073 1472 007076 1473 007102 1475 007113 1476 007124 1477 007126 1478 007134 1479 007153 1481 007157 1482 007174 1484 007201 1485 007203 1487 007204 1490 007206 1499 007214 1501 007216 1502 007235 1503 007300 1504 007312 1507 007313 1513 007321 1518 007322 1519 007323 1520 007325 1522 007327 1524 007334 1525 007337 1526 007342 1527 007343 1528 007350 1529 007352 1530 007353 1531 007356 1533 007357 1534 007362 1536 007366 1537 007371 1538 007373 1540 007374 1542 007405 1548 007406 1561 007410 1563 007412 1564 007421 1565 007423 1566 007435 1567 007437 1568 007444 1569 007447 1570 007451 1571 007453 1573 007454 ----------------------------------------------------------- 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