COMPILATION LISTING OF SEGMENT qedx_ Compiled by: Multics PL/I Compiler, Release 32f, of October 9, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 11/11/89 0955.2 mst Sat Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Bull Inc., 1987 * 6* * * 7* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 8* * * 9* * Copyright (c) 1972 by Massachusetts Institute of * 10* * Technology and Honeywell Information Systems, Inc. * 11* * * 12* *********************************************************** */ 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-02-02,Huen), approve(89-02-02,MCR8057), audit(89-05-24,RWaters), 17* install(89-05-31,MR12.3-1051): 18* Fix Bug 204 in qedx 19* editor - Ignore trailing whitespace after a quit request. 20* END HISTORY COMMENTS */ 21 22 /* format: off */ 23 24 /* Multics qedx Editor subroutine interface: the actual editor. */ 25 26 /* Created: August 1970 by R. C. Daley */ 27 /* Modified: August 1977 by R.J.C. Kissel to fix long entryname and garbage word bugs */ 28 /* Modified: 23 February 1979 by Steve Herbst to fix w and r error messages for MSFs */ 29 /* Modified: 4 September 1981 by E. N. Kittlitz to add -pathname, -no_rw_path, r request with no pathname, and to 30* eliminate b.default_len */ 31 /* Modified: 14 July 1980 by T. Oke for gapped buffer management */ 32 /* Modified: 3 March 1981 by S. G. Harris (UNCA) for read entry point */ 33 /* Modified: 3 March 1982 by S. Herbst to merge all of above changes */ 34 /* Modified: 16 April 1982 by S. Herbst to add quit query for modified buffers (subsequently removed, sigh) */ 35 /* Modified: 5 May 1982 by S. Herbst to check that it has not been recursively interrupted */ 36 /* Modified: 7 October 1982 by S. Herbst to fix "Substitution failed." bug inside recursed buffer */ 37 /* Modified: 3 November 1982 by S. Herbst to fix ".a" bug in empty buffer */ 38 /* Modified: January 1983 by G. Palter to make reentrant, convert into qedx_, re-enable quit query if requested by caller, 39* accept the archive component pathname convention on input, rename quit-force to "qf" from "Q", and add trusted 40* pathnames as in ted */ 41 /* Modified April 1983 by Keith Loepere to make work in Bootload Multics */ 42 /* Modified August 1983 by Keith Loepere for new bce switches */ 43 /* Modified March 1985 by Keith Loepere to run in bce and Multics. */ 44 /* Modified Jan 1989 by Huen (204) - Allow whitespace after a "q" request (such as q, Q, qf, etc) */ 45 46 /* format: on,style4,delnl,insnl,ifthenstmt,ifthen */ 47 48 qedx_: 49 procedure (P_qedx_info_ptr, P_code); 50 51 52 dcl P_qedx_info_ptr pointer parameter; /* -> caller's initial buffers, etc. */ 53 dcl P_code fixed binary (35) parameter; 54 55 dcl a_real_file bit (1) aligned; 56 dcl b0_bp ptr; 57 dcl b0_ifp ptr; 58 dcl buffer_idx fixed binary; 59 dcl callers_io_region_ptr pointer; 60 dcl ch char (1); 61 dcl cht char (1); 62 dcl code fixed bin (35); 63 dcl curbuf char (16) init ("0"); 64 dcl delim char (1); 65 dcl error_sw ptr; /* for "special" errors */ 66 dcl explicit_pathname bit (1) aligned; 67 dcl fe fixed bin (21); 68 dcl fle fixed bin (21); 69 dcl fli fixed bin (21); 70 dcl flsw bit (1); 71 dcl fp ptr; 72 dcl have_truncated_buffers bit (1) aligned; 73 dcl i fixed bin (21); 74 dcl ife fixed bin (21); /* index of last char in file */ 75 dcl ifp ptr; /* pointer to current file buffer */ 76 dcl ift fixed bin (21); 77 dcl ignore_result bit (1) aligned; 78 dcl il fixed bin (21); 79 dcl ilb fixed bin (21); 80 dcl iline char (512); 81 dcl intsw bit (1); 82 dcl j fixed bin (21); 83 dcl je fixed bin (21); 84 dcl k fixed bin (21); 85 dcl ka fixed bin (21); 86 dcl kx fixed bin (21); 87 dcl l fixed bin (21); 88 dcl le fixed bin (21); /* index of last char of current line */ 89 dcl li fixed bin (21); /* index of first char of current line */ 90 dcl lle fixed bin (21); /* index of last char of addressed line */ 91 dcl lli fixed bin (21); /* index of first char of addressed line */ 92 dcl llsw bit (1); 93 dcl 1 local_qbii aligned like qedx_buffer_io_info; 94 dcl 1 local_qid aligned like qid; /* describes this invocation */ 95 dcl me fixed bin (21); 96 dcl mi fixed bin (21); 97 dcl ml fixed bin (21); 98 dcl new_modes char (256); /* for call to iox_$modes */ 99 dcl old_modes char (256); 100 dcl output_routine entry (ptr, ptr, fixed bin (21), fixed bin (35)) variable; 101 dcl output_sw ptr; /* bce/iox_ switch for "special" output */ 102 dcl pfs fixed bin (35) init (0); 103 dcl pi_label label; 104 dcl pi_sw bit (1); 105 dcl process_type fixed bin; 106 dcl quit_force_sw bit (1); 107 dcl saved_current_buffer character (16); 108 dcl saved_ift fixed bin (21); /* copy of ift during call to "promote" */ 109 dcl sdsw bit (1); 110 dcl subsw bit (1); 111 dcl sub_comp_string character (3) aligned init (" "); 112 dcl tbp ptr; 113 dcl te fixed bin (21); /* index of last character in tw line */ 114 dcl 1 the_buffer aligned like qedx_info.buffers based (the_buffer_ptr); 115 dcl the_buffer_ptr pointer; 116 dcl the_pathname character (256); 117 dcl ti fixed bin (21); /* index of first unprocessed char in tw line */ 118 dcl tik fixed bin (21); 119 dcl tname char (16); 120 dcl tp ptr; /* pointer to current typewriter input request line */ 121 dcl twbuff char (512); 122 dcl was_empty bit (1) aligned; 123 dcl xsw bit (1); 124 dcl yes_sw bit (1); 125 126 /* ilb_offset is used for post-deletion of text during string substitution. 127* Post deletion is necessary so the the string search /^ // on line 1 will 128* not kill all spaces since first line anchoring tests for nothing before 129* and pre-deletion to next search will ensure a re-match for ^ . */ 130 131 dcl ilb_offset fixed bin (21); 132 133 dcl COMMANDS character (19) static options (constant) initial ("psaicdbmrwqg=xevn""Q"); 134 dcl command_index fixed binary; /* current command being executed */ 135 136 dcl QEDX_ character (32) static options (constant) initial ("qedx_"); 137 138 dcl QEDX_INFO_VERSION_0 character (8) static options (constant) initial ("qxi_0001"); 139 140 dcl MODIFIED_BUFFERS_EXPLANATION character (104) static options (constant) 141 initial ("If you quit now, your latest changes to the above buffers will not be 142 saved. Do you still wish to quit?"); 143 144 dcl TRUNCATED_BUFFERS_EXPLANATION character (100) static options (constant) 145 initial ("If you quit now, some of the contents of the above buffers will be 146 lost. Do you still wish to quit?"); 147 148 dcl TRUSTED_PATHNAMES_EXPLANATION character (198) static options (constant) 149 initial ("More than one pathname has been used with the read and write requests 150 in this buffer. Do you want to ^a this buffer using the pathname ^a 151 which I consider to be the correct default for this buffer?"); 152 153 dcl 1 t based (tp) aligned, /* structure to treat request line as character array */ 154 2 c (sys_info$max_seg_size * 4) char (1) unaligned; 155 156 dcl 1 f based aligned, /* structure to treat any file as character array */ 157 2 c (sys_info$max_seg_size * 4) char (1) unaligned; 158 159 dcl a_string char (sys_info$max_seg_size * 4) based aligned; 160 161 dcl CHASE fixed binary (1) static options (constant) initial (1); 162 163 dcl EC character (1) static options (constant) initial (""); 164 /* ancient conceal character = ASCII 031 */ 165 166 dcl NL character (1) static options (constant) initial (" 167 "); 168 169 /* format: off */ 170 dcl (error_table_$archive_component_modification, error_table_$archive_pathname, error_table_$bigarg, error_table_$dirseg, 171 error_table_$fatal_error, error_table_$inconsistent, error_table_$moderr, error_table_$no_r_permission, 172 error_table_$no_w_permission, error_table_$pathlong, error_table_$recoverable_error, 173 error_table_$unimplemented_version) 174 fixed binary (35) external; 175 /* format: on */ 176 dcl sys_info$max_seg_size fixed binary (19) external; 177 dcl sys_info$service_system bit (1) aligned external; 178 179 dcl (cleanup, program_interrupt, sub_request_abort_) condition; 180 181 dcl bce_data$console_put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)) external variable; 182 dcl bce_data$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)) external variable; 183 dcl iox_$user_output ptr ext; /* pointer to iocb for user_output */ 184 dcl iox_$user_io ptr ext; /* pointer to iocb for user_io */ 185 186 dcl bce_check_abort entry; 187 dcl bce_query$yes_no entry options (variable); 188 dcl bootload_fs_$flush_sys entry; 189 dcl bootload_fs_$get_ptr entry (char (*), ptr, fixed bin (21), fixed bin (35)); 190 dcl bootload_fs_$put_ptr entry (char (*), fixed bin (21), bit (1) aligned, ptr, fixed bin (35)); 191 dcl check_entryname_ entry (char (*), fixed bin (35)); 192 dcl com_err_ entry () options (variable); 193 dcl command_query_$yes_no entry options (variable); 194 dcl cu_$cp entry (ptr, fixed bin (21), fixed bin (35)); 195 dcl edx_util_$edx_cleanup entry (ptr); 196 dcl edx_util_$edx_init entry (ptr, ptr, ptr, ptr, fixed bin (35)); 197 dcl edx_util_$end_buffer entry (ptr, fixed bin (35)); 198 dcl edx_util_$get_buffer entry (ptr, ptr, fixed bin (21), fixed bin (21), char (16), ptr); 199 dcl edx_util_$list_buffers entry (ptr, char (16), ptr); 200 dcl edx_util_$list_modified_buffers entry (pointer, character (16), pointer); 201 dcl edx_util_$list_single_buffer entry (pointer, character (16), pointer, pointer); 202 dcl edx_util_$locate_buffer entry (ptr, char (16), ptr); 203 dcl edx_util_$modified_buffers entry (ptr) returns (bit (1)); 204 dcl edx_util_$prime entry (ptr, ptr, fixed bin (21)); 205 dcl edx_util_$read_ptr entry (ptr, ptr, fixed bin (21), fixed bin (21)); 206 dcl edx_util_$resetread entry (ptr); 207 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 208 dcl expand_pathname_$component entry (char (*), char (*), char (*), char (*), fixed bin (35)); 209 dcl get_addr_ 210 entry (ptr, ptr, fixed bin (21), fixed bin (21), ptr, fixed bin (21), fixed bin (21), fixed bin (21), 211 fixed bin (21), fixed bin (21), fixed bin (21), fixed bin (21), fixed bin (35)); 212 dcl get_system_free_area_ entry () returns (ptr); 213 dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); 214 dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); 215 dcl initiate_file_$component entry (char (*), char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35)); 216 dcl initiate_file_$create entry (char (*), char (*), bit (*), ptr, bit (1) aligned, fixed bin (24), fixed bin (35)); 217 dcl ioa_ entry () options (variable); 218 dcl ioa_$ioa_switch entry () options (variable); 219 dcl iox_$modes entry (ptr, char (*), char (*), fixed bin (35)); 220 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 221 dcl mrl_ entry (ptr, fixed bin (21), ptr, fixed bin (21)); 222 dcl pathname_ entry (char (*), char (*)) returns (char (168)); 223 dcl pathname_$component entry (char (*), char (*), char (*)) returns (char (194)); 224 dcl qx_search_file_ 225 entry (ptr, ptr, fixed bin (21), fixed bin (21), ptr, fixed bin (21), fixed bin (21), fixed bin (21), 226 fixed bin (21), fixed bin (21), fixed bin (21), fixed bin (35)); 227 dcl qx_search_file_$cleanup entry (ptr); 228 dcl qx_search_file_$init entry (ptr); 229 dcl release_temp_segment_ entry (char (*), ptr, fixed bin (35)); 230 dcl sub_err_ entry () options (variable); 231 dcl terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); 232 dcl user_info_$process_type entry (fixed bin); 233 234 dcl (addr, divide, index, min, null, search, substr, length, reverse, rtrim, string) builtin; 235 236 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 237 238 /* qedx_: procedure (P_qedx_info_ptr, P_code); */ 239 240 if sys_info$service_system then do; 241 output_routine = iox_$put_chars; 242 output_sw = iox_$user_output; 243 error_sw = iox_$user_io; 244 end; 245 else do; 246 output_routine = bce_data$put_chars; 247 error_sw = addr (bce_data$console_put_chars); 248 output_sw = addr (bce_data$put_chars); 249 end; 250 251 qedx_info_ptr = P_qedx_info_ptr; 252 253 if (qedx_info.version ^= QEDX_INFO_VERSION_0) & (qedx_info.version ^= QEDX_INFO_VERSION_1) then do; 254 P_code = error_table_$unimplemented_version; 255 return; 256 end; 257 258 259 /* Initialize per-invocation data */ 260 261 qid_ptr = addr (local_qid); /* use the one in automatic */ 262 263 qid.editor_name = qedx_info.editor_name; 264 qid.editor_area_ptr = get_system_free_area_ (); 265 qid.qedx_info_ptr = qedx_info_ptr; /* edx_util_, etc. may need it */ 266 267 qid.flags = qedx_info.header.flags, by name; /* all the same flags */ 268 269 qid.edx_util_data_ptr, /* for cleanup handler */ 270 qid.regexp_data_ptr, callers_io_region_ptr = null (); 271 272 on condition (cleanup) call cleanup_invocation_data (); 273 274 call edx_util_$edx_init (qid_ptr, addr (twbuff), b0_ifp, b0_bp, code); 275 if code ^= 0 then do; 276 call com_err_ (code, qid.editor_name, "Unable to initialize edx_util_."); 277 P_code = error_table_$fatal_error; 278 return; 279 end; 280 281 call get_buffer_state (b0_bp); /* let buffer "0" be current (for now) */ 282 283 call qx_search_file_$init (qid_ptr); 284 285 if qedx_info.caller_does_io then do; /* need an I/O buffer */ 286 call get_temp_segment_ (qid.editor_name, callers_io_region_ptr, code); 287 if code ^= 0 then do; 288 call com_err_ (code, qid.editor_name, "Obtaining I/O buffer."); 289 P_code = error_table_$fatal_error; 290 go to RETURN_FROM_QEDX_; 291 end; 292 end; 293 294 295 /* Initialize buffers to those supplied by the caller */ 296 297 do buffer_idx = 1 to qedx_info.n_buffers; 298 the_buffer_ptr = addr (qedx_info.buffers (buffer_idx)); 299 300 call edx_util_$locate_buffer (qid_ptr, the_buffer.buffer_name, bp); 301 if bp = null () then do; /* error already printed */ 302 P_code = error_table_$fatal_error; 303 go to RETURN_FROM_QEDX_; 304 end; 305 306 call get_buffer_state (bp); 307 b.callers_idx = buffer_idx; /* need to keep track of it */ 308 309 if the_buffer.read_write_region then do; /* read/write from caller's character string */ 310 if the_buffer.region_ptr = null () then do; 311 call sub_err_ (error_table_$inconsistent, QEDX_, ACTION_CANT_RESTART, null (), 0, 312 "Input/output area required for buffer ^a was not supplied.", the_buffer.buffer_name); 313 P_code = error_table_$fatal_error; 314 go to RETURN_FROM_QEDX_; 315 end; 316 else if qedx_info.caller_does_io then do; 317 call sub_err_ (error_table_$inconsistent, QEDX_, ACTION_CANT_RESTART, null (), 0, 318 "Input/output area can not be used for buffer ^a when caller performs I/O.", 319 the_buffer.buffer_name); 320 P_code = error_table_$fatal_error; /* ... caller I/O only works with pathnames */ 321 go to RETURN_FROM_QEDX_; 322 end; 323 else do; /* ... and it's actually there */ 324 a_real_file = "0"b; /* ... ...don't terminate it */ 325 the_pathname = the_buffer.buffer_pathname; 326 b.default_was_region = "1"b; 327 the_buffer.region_final_lth = the_buffer.region_initial_lth; 328 end; 329 end; 330 331 else do; /* read/write from the specified file */ 332 if the_buffer.buffer_pathname = "" then do; 333 call sub_err_ (error_table_$inconsistent, QEDX_, ACTION_CANT_RESTART, null (), 0, 334 "Default pathname not specified for buffer ^a.", the_buffer.buffer_name); 335 P_code = error_table_$fatal_error; 336 go to RETURN_FROM_QEDX_; 337 end; 338 else do; /* ... and there is a pathname given */ 339 a_real_file = "1"b; 340 the_pathname = the_buffer.buffer_pathname; 341 b.default_was_region = "0"b; 342 end; 343 end; 344 345 fle = ife; /* put it at the end (of the empty buffer) */ 346 if ^perform_read (a_real_file, the_pathname, "1"b) then do; 347 P_code = error_table_$fatal_error; /* ... didn't work (sigh) */ 348 go to RETURN_FROM_QEDX_; 349 end; 350 351 if qedx_info.version = QEDX_INFO_VERSION_1 then 352 b.default_locked = the_buffer.locked_pathname; 353 else b.default_locked = ^the_buffer.locked_pathname; 354 /* version 0 structure: this flag had the opposite meaning */ 355 356 call save_buffer_state (); /* save it */ 357 end; 358 359 360 /* Initialize everything else ... */ 361 362 pi_sw = "0"b; /* set switch to ignore program interrupts */ 363 364 if sys_info$service_system then on condition (program_interrupt) call interrupt (); 365 /* establish handler for program interrupt */ 366 else on condition (sub_request_abort_) call interrupt (); 367 /* establish handler for request abort */ 368 369 tp = addr (iline); /* initialize pointer to input line buffer */ 370 substr (iline, 1, 3) = "b0 "; /* move to buffer zero */ 371 te = 3; 372 373 do buffer_idx = 1 to qedx_info.n_buffers; /* insure we execute all request buffers */ 374 the_buffer_ptr = addr (qedx_info.buffers (buffer_idx)); 375 if the_buffer.execute_buffer then do; 376 if (te + length ("\b() ") + length (rtrim (the_buffer.buffer_name))) > length (iline) then do; 377 call com_err_ (error_table_$bigarg, qid.editor_name, "Preparing to execute buffer ^a.", 378 the_buffer.buffer_name); 379 P_code = error_table_$fatal_error; 380 go to RETURN_FROM_QEDX_; 381 end; 382 substr (iline, (te + 1), (length ("\b() ") + length (rtrim (the_buffer.buffer_name)))) = 383 "\b(" || rtrim (the_buffer.buffer_name) || ") "; 384 te = te + length ("\b() ") + length (rtrim (the_buffer.buffer_name)); 385 end; 386 end; 387 388 substr (iline, te, 1) = NL; /* makes sure initial requests are executed properly */ 389 390 call edx_util_$prime (qid_ptr, tp, te); /* prime input stream to read in and execute macro */ 391 392 /* **** Start of working Code **** 393* 394* 395* qedx returns here to process each new command line, from either the 396* macro file, or the terminal, if qedx is executing multiple commands from 397* a single line, re-entry is made to the label next:, rather than nx_line:. 398* 399* At this point the basic command is cracked and addressing is determined. */ 400 401 402 nx_line: 403 ti = 1; /* read next request line from input stream */ 404 call edx_util_$read_ptr (qid_ptr, tp, length (iline), te); 405 406 next: 407 if ^sys_info$service_system then do; 408 intsw = "0"b; 409 call bce_check_abort; 410 if intsw = "1"b then go to RETURN_FROM_QEDX_; 411 end; 412 call save_buffer_state (); /* save current buffer state */ 413 if ti >= te then go to nx_line; /* check after each request if request line exhausted */ 414 intsw = "0"b; /* reset previous program_interrupt (if any) */ 415 416 call get_addr_ (qid_ptr, tp, ti, te, ifp, ilb, ift, ife, li, le, fli, fle, code); 417 /* find first address if any */ 418 if code = 0 then flsw, llsw = "0"b; /* code = 0, no address found (use default) */ 419 else if code = 1 then do; /* code = 1, */ 420 flsw = "1"b; /* single address found, */ 421 llsw = "0"b; /* use default for second address if needed */ 422 end; 423 else if code < 4 then do; /* code 2 or 3, */ 424 flsw, llsw = "1"b; /* both addresses found */ 425 if code = 2 then 426 call get_addr_ (qid_ptr, tp, ti, te, ifp, ilb, ift, ife, li, le, lli, lle, code); 427 /* code 2 = "," */ 428 else call get_addr_ (qid_ptr, tp, ti, te, ifp, ilb, ift, ife, fli, fle, lli, lle, code); 429 /* code 3 = ";" */ 430 if code = 4 then go to reg_err; /* check for failure to match on regular expression */ 431 if code > 4 then go to rq_err; /* check for other error */ 432 end; 433 else if code = 4 then do; /* code = 4, */ 434 reg_err: 435 call edx_util_$end_buffer (qid_ptr, code); /* failure to match reg. expression, pop buffer stack */ 436 if code ^= 0 then do; /* if already at highest buffer level (0) */ 437 call ioa_ ("Search failed."); /* print error message */ 438 go to rq_err; /* treat as normal error */ 439 end; 440 else go to nx_line; /* resume input from next higher level */ 441 end; 442 else if code > 4 then do; /* code > 4, error detected in get_addr_ */ 443 rq_err: 444 call edx_util_$resetread (qid_ptr); /* reset buffer push down stack and tw input buffer */ 445 go to nx_line; /* read next line from console typewriter (level=0) */ 446 end; 447 448 ch = t.c (ti); /* pick up first character after address */ 449 ti = ti + 1; /* bump request line character index */ 450 if ch = NL then /* check for new-line character */ 451 if flsw then 452 go to print1; /* print line pointed to by "." if address found */ 453 else go to nx_line; /* otherwise, ignore NL and read next request line */ 454 command_index = index (COMMANDS, ch); /* which command given */ 455 pi_label = ACTION (0); /* assume we will be an error */ 456 go to ACTION (command_index); /* go do it */ 457 458 ACTION (0): /* here if unrecognized */ 459 call ioa_ ("^a: ^a not recognized as a request.", qid.editor_name, ch); 460 /* here if request not understood */ 461 go to rq_err; /* treat as any other error */ 462 463 /* **** read request **** 464* 465* Read in specified file after addressed line in current buffer file. 466* 467* Current line is left at the end of the readin section. 468* 469* Operation is performed by splitting the buffer under where the readin should 470* occur and reading appending to the bottom of the top section. 471* This leaves the gap below the readin section, which is where it will tend to 472* speed initial editing commands on the readin section. 473**/ 474 475 ACTION (9): 476 read: 477 call determine_file ("0"b, a_real_file, the_pathname, explicit_pathname); 478 479 if ^flsw then fle = ife; /* no address: append to end of file */ 480 481 if perform_read (a_real_file, the_pathname, explicit_pathname) then 482 go to nx_line; /* successfull read */ 483 else go to rq_err; 484 485 /* **** write request **** 486* 487* Write out the specified contents of the current buffer into the spec file. 488* 489* This operation is done without gap movement by calculating if the data is 490* split across the gap, or entirely contained within either the top or bottom 491* sections of the buffer. If the data is contiguous, then a single substr is 492* used, otherwise the section within the bottom, and the section within the 493* top are separately written, with the top write appended on the bottom. 494* 495* The current line position is not altered by writing. 496**/ 497 498 ACTION (10): 499 write: 500 call defaults (1, ife); /* supply default addresses (1,$) if necessary */ 501 pi_label = wr_quit; /* in case of quit */ 502 pi_sw = "1"b; /* activate quit handler and label */ 503 504 call determine_file ("1"b, a_real_file, the_pathname, explicit_pathname); 505 /* firgure out where it goes */ 506 507 if ^perform_write (a_real_file, the_pathname, explicit_pathname, "1"b) then go to rq_err; 508 /* didn't work */ 509 510 wr_quit: 511 pi_sw = "0"b; /* turn of pi handler */ 512 go to nx_line; /* go pick up next qedx request line */ 513 514 /* * * * * quit request .......... clean up and exit from qedx editor (i.e., return to caller) * * * * * * * * */ 515 516 ACTION (19): /* Q request: don't worry about modified buffers */ 517 quit_force_sw = "1"b; 518 go to DO_QUIT_REQUEST; 519 520 ACTION (11): /* q/qf request */ 521 if t.c (ti) = "f" then do; /* ... it's qf: don't worry about modified buffers */ 522 quit_force_sw = "1"b; 523 ti = ti + 1; 524 end; 525 else quit_force_sw = "0"b; /* ... it's q: may query if modified buffers exist */ 526 527 DO_QUIT_REQUEST: 528 if (flsw) then do; /* special syntax check for quit request */ 529 call ioa_ ("Syntax error in quit request."); 530 go to rq_err; 531 end; 532 /* Bug_204 : Ignore trailing whitespace after a quit request */ 533 if (t.c (ti) ^= NL) then do; 534 ti = ti + verify (substr (iline, ti), " ") - 1; 535 if (t.c (ti) ^= NL) then do; 536 call ioa_ ("Syntax error in quit request."); 537 go to rq_err; 538 end; 539 end; 540 541 542 /* Check for modified buffers if caller so desires */ 543 544 if qid.query_if_modified & ^quit_force_sw then /* ... but only if user doesn't want out */ 545 if edx_util_$modified_buffers (qid_ptr) then do; 546 547 if sys_info$service_system then 548 call user_info_$process_type (process_type); 549 else process_type = 1; 550 if process_type = 1 then do; /* ... and only if interactive */ 551 call ioa_$ioa_switch (error_sw, "Modified buffers exist:"); 552 call edx_util_$list_modified_buffers (qid_ptr, (b.name), error_sw); 553 554 if sys_info$service_system then 555 call command_query_$yes_no (yes_sw, 0, qid.editor_name, MODIFIED_BUFFERS_EXPLANATION, 556 "Do you still wish to quit and lose these changes?"); 557 else call bce_query$yes_no (yes_sw, MODIFIED_BUFFERS_EXPLANATION); 558 if yes_sw then /* ... is equivalent to using Q */ 559 quit_force_sw = "1"b; 560 else go to rq_err; /* ... no: back to request loop */ 561 end; 562 end; 563 564 if quit_force_sw then go to SET_OUTPUT_VALUES; /* quit force: don't update anything requesting auto_write */ 565 566 567 /* Update any buffers with auto-write and query if there are truncated buffers */ 568 569 saved_current_buffer = b.name; /* in case user doesn't want to quit */ 570 call save_buffer_state (); 571 572 have_truncated_buffers = "0"b; /* need this locally */ 573 574 do buffer_idx = 1 to qedx_info.n_buffers; 575 the_buffer_ptr = addr (qedx_info.buffers (buffer_idx)); 576 call edx_util_$locate_buffer (qid_ptr, the_buffer.buffer_name, bp); 577 call get_buffer_state (bp); /* switch buffers */ 578 579 if the_buffer.read_write_region then do; /* check this buffer and/or write it */ 580 581 if the_buffer.auto_write then do; /* ... write it */ 582 fli = 1; /* ... ... setup to write entire buffer */ 583 lle = ife; 584 ignore_result = perform_write ("0"b, "", "0"b, "0"b); 585 end; /* put it back without error messages */ 586 587 if the_buffer.region_final_lth > the_buffer.region_max_lth then do; 588 if ^have_truncated_buffers then do;/* ... first truncated buffer */ 589 call ioa_$ioa_switch (error_sw, "Buffers which will be truncated:"); 590 have_truncated_buffers = "1"b; 591 end; 592 call edx_util_$list_single_buffer (qid_ptr, saved_current_buffer, output_sw, bp); 593 end; 594 end; 595 end; 596 597 if have_truncated_buffers then do; /* need permission for this ... */ 598 if sys_info$service_system then 599 call command_query_$yes_no (yes_sw, 0, qid.editor_name, TRUNCATED_BUFFERS_EXPLANATION, 600 "Do you still wish to quit?"); 601 else call bce_query$yes_no (yes_sw, TRUNCATED_BUFFERS_EXPLANATION); 602 if ^yes_sw then do; /* ... user got scared */ 603 call edx_util_$locate_buffer (qid_ptr, saved_current_buffer, bp); 604 call get_buffer_state (bp); /* ... back to where user thinks he is */ 605 go to rq_err; 606 end; 607 end; 608 609 610 /* Set output parameters in query_info structure and P_code */ 611 612 SET_OUTPUT_VALUES: 613 qedx_info.quit_forced = quit_force_sw; /* let caller know */ 614 qedx_info.buffers_truncated = "0"b; /* until following check proves otherwise */ 615 616 do buffer_idx = 1 to qedx_info.n_buffers; 617 the_buffer_ptr = addr (qedx_info.buffers (buffer_idx)); 618 if the_buffer.read_write_region then /* ... only check those not using a file */ 619 if the_buffer.region_final_lth > the_buffer.region_max_lth then 620 qedx_info.buffers_truncated, the_buffer.truncated = "1"b; 621 end; 622 623 if qedx_info.quit_forced | qedx_info.buffers_truncated then 624 P_code = error_table_$recoverable_error; /* caller beware */ 625 else P_code = 0; 626 627 628 /* Control arrives here when it is time to exit qedx (with P_code already set) */ 629 630 RETURN_FROM_QEDX_: 631 call cleanup_invocation_data (); 632 633 return; 634 635 /* **** Print value of current addressed line **** 636* 637* This entry is used to print a line from a single address, such as dot, relative 638* or absolute. The line addressed by lli,lle is printed. New input line is 639* forced by mating ti and te. */ 640 641 print1: 642 ti = te; /* force nx_line call through next label */ 643 644 /* **** print request print out specified portion of current buffer **** 645* 646* This code is directly the same as used in write, with the character stream 647* going to the terminal, rather than the output file. */ 648 649 ACTION (1): 650 print: 651 call defaults (li, le); /* supply default addresses (.,.) if necessary */ 652 pi_label = end_pr; /* allow printing to be aborted */ 653 pi_sw = "1"b; /* by means of a program interrupt */ 654 if lle <= ilb | fli >= ift then do; /* portion addressed is purely in bottom or top */ 655 i = lle - fli + 1; 656 call output_routine (output_sw, addr (ifp -> f.c (fli)), i, code); 657 end; /* print specified portion of buffer on user's console */ 658 else if fli <= ilb then do; /* top in top, bottom in bottom */ 659 i = lle - ift + 1 + ilb - fli; 660 call output_routine (output_sw, addr (ifp -> f.c (fli)), ilb - fli + 1, code); 661 /* print specified portion of buffer on user's console */ 662 call output_routine (output_sw, addr (ifp -> f.c (ift)), lle - ift + 1, code); 663 /* print specified portion of buffer on user's console */ 664 end; 665 pi_sw = "0"b; /* turn off program interrupt handling */ 666 end_pr: 667 call last_line (lle); /* set current line to last line printed */ 668 go to next; /* go pick up next qedx request */ 669 670 /* **** delete request delete specified lines from current buffer *** */ 671 672 ACTION (6): 673 delete: 674 call defaults (li, le); /* supply default addresses (.,.) if necessary */ 675 call delete_text (); /* flush the text */ 676 call next_line (ift); /* reposition at line after last line deleted (if any) */ 677 b.modified = "1"b; /* deletion is a modification */ 678 go to next; /* get next qedx request */ 679 680 681 682 /* Actually deletes text (used also by the change request) */ 683 684 delete_text: 685 procedure (); 686 687 /* deletion is done to make gap movement minimized. Three situations are 688* considered. 689* 1. Bottom of range is above gap. Then only undeleted chars are moved and 690* ift is moved to delete. 691* 2. Top of range is below gap. Then only undeleted chars are moved and 692* ilb is moved down to delete. 693* 3. Range spans gap. The ift and ilb are updated and fli -> ift. 694**/ 695 696 if lle <= ilb then do; /* move chars up til end of range */ 697 call open_gap (lle); 698 ilb = fli - 1; /* set lower bound of delete */ 699 end; 700 else if fli >= ift then do; /* move chars down from bottom of range */ 701 call open_gap ((fli - 1)); /* open gap in front of section to delete */ 702 ift = lle + 1; /* set upper bound of delete */ 703 end; 704 else do; /* range spans gap */ 705 ilb = fli - 1; /* delete lower end */ 706 ift = lle + 1; /* delete upper end */ 707 fli = ift; /* clear range */ 708 end; 709 710 return; 711 712 end delete_text; 713 714 /* **** append, insert or change request, append after, insert before or replace addressed text. **** 715* 716* All actions are performed by calculating a split point for the buffer and 717* then opening the gap at that point. For change, one also moves the 718* lower section top pointer to delete text before reading in the new 719* text. 720* 721* Space allocation for reading of new text is done by input calling 722* for possible buffer promotion prior to each line of input being moved from 723* the working line buffer, to the temporary file buffer. 724* 725* The current line position is left at the last line input. 726**/ 727 728 ACTION (3): /* append text after addressed line */ 729 append: 730 if ^flsw | /* if no address given or */ 731 fle > ife then /* addres is "." and buffer empty then */ 732 fle = le; /* append after current line */ 733 call open_gap ((fle)); /* open gap after current line */ 734 go to in_mode; /* join common console input code */ 735 736 ACTION (4): /* insert text before addressed line */ 737 insert: 738 if ^flsw then fli = li; /* insert before current line if no address given */ 739 fle = fli - 1; /* back up one line (.-1) */ 740 call open_gap ((fle)); /* open the gap before the current line */ 741 go to in_mode; /* join common console input code */ 742 743 ACTION (5): /* replace addressed lines with input from console */ 744 change: 745 call defaults (li, le); 746 call delete_text (); /* get rid of the old text */ 747 b.modified = "1"b; /* buffer is modified even if nothing is input here */ 748 749 750 in_mode: /* attempt to enter cheap input mode */ 751 if sys_info$service_system then do; 752 new_modes = "wake_tbl"; 753 call iox_$modes (iox_$user_io, new_modes, old_modes, code); 754 end; 755 756 was_empty = (ilb < 1) & (ift > ife); /* remember whether buffer was empty or not */ 757 758 pi_label = in_mode; /* setup recovery info for promote */ 759 call input (ifp, ilb); /* input from console, append to input buffer file */ 760 pi_label = nx_line; /* kill input flag to promote */ 761 762 /* If we have added a line which does not end in a newline then the gap spans 763* within a line and violates standards. Compact the line by finding the start 764* and end of the last line entered and opening the gap before it. 765**/ 766 767 call last_line (ilb); /* position at last line input from console */ 768 call open_gap ((li - 1)); /* compact the possible split line */ 769 call next_line (li); /* find end of current line (may be across gap) */ 770 771 if sys_info$service_system then do; 772 new_modes = "^wake_tbl"; /* turn off cheap input */ 773 call iox_$modes (iox_$user_io, new_modes, old_modes, code); 774 end; 775 776 if was_empty then /* if buffer was empty, can no longer trust default path */ 777 b.default_untrusted = ^b.default_locked & (b.default_path ^= ""); 778 779 go to next; /* get next qedx request */ 780 781 /* **** substitute request s/string1/string2/ replaces all occurrences of string1 with string2 **** 782* 783* This operation is done through constant and non-standard buffer gap moves. 784* This is the only operation in which the buffer gap would not be at a line 785* boundary. Moves are done as the scan through the line is done, with 786* processed characters left in the bottom section and unprocessed 787* characters in the top. As processing continues characters move down to 788* the bottom section. This permits all additions to the buffer to be done 789* by appending to the lower section, and deletions to be done by 790* moving the top pointer of the bottom section, with the one exception 791* being if the last substitution has been done such that fli>lle, then 792* the lower pointer of the upper section is moved. This is due to the 793* action of the sdsw increment of fli to bypass the NL, and the requirement 794* to delete immediately, since post deletion is not possible. 795* 796* Post deletion of text is used where the replacing string is null, or 797* contains &'s. In the case of null replacement the construct s/^.// would 798* replace the entire line with null, unless post deletion was done. 799* In the case of & replacement, we have to retain the original source matched 800* by the & to replace, therefore post deletion is necessary. 801* Otherwise immediate deletion is done to retain the ability to edit an 802* entire segment. 803* 804* Post deletion of text is accomplished by setting up an ilb correction factor 805* to be applied after the next qx_search_file_. This is to prevent /^.// from 806* matching all characters, since deletion immediately would result in the 807* end of line moving up and being found again. This post deletion requires 808* substitute to always pass through a final qx_search_file_ which doesn't find 809* the string. When this occurs the correction is already done. The exception 810* is already noted above, and only occurs if fli is incremented when the 811* string ended in *$. 812**/ 813 814 ACTION (2): 815 pi_label = sub_done; /* say we are a substitute */ 816 substitute: 817 call defaults (li, le); /* provide default addresses in needed */ 818 delim = t.c (ti); /* pick up string delimiter */ 819 intsw = "0"b; /* trap interrupts in long substitutes */ 820 subsw = "0"b; /* set switch for first string */ 821 sdsw = "0"b; /* initiate star-dollar match switch */ 822 823 ilb_offset = 0; /* no post-deletion needed */ 824 825 tik = ti + 1; /* set index to first char of string1 */ 826 i = tik; /* and hold it. */ 827 sub_comp_string = delim || EC || "\"; /* set compare for delim conceal two char conceal */ 828 829 sub_search: 830 k = search (substr (tp -> a_string, tik, te - tik + 1), sub_comp_string); 831 /* search for delim or conceal char */ 832 833 if k = 0 then do; /* syntax error -- no delimiter */ 834 sub_err: 835 call ioa_ ("Syntax error in substitute request."); 836 go to rq_err; 837 end; 838 839 kx = index (sub_comp_string, t.c (tik + k - 1)); /* which character was found? */ 840 go to sub_case (kx); /* process case found */ 841 842 sub_case (1): 843 if ^subsw then do; /* working on first string */ 844 j = tik + k; /* set index, first char string2 */ 845 il = j - 1 - i; /* save length of string1 */ 846 if substr (tp -> a_string, j - 3, 2) = "*$" /* check last chars of string1 for star dollar */ 847 then 848 if substr (tp -> a_string, j - 4, 1) ^= EC 849 /* check for conceal character */ 850 then 851 if (substr (tp -> a_string, j - 5, 2)) ^= "\c" then 852 if (substr (tp -> a_string, j - 5, 2)) ^= "\C" then sdsw = "1"b; 853 /* found star dollar */ 854 tik = j; 855 subsw = "1"b; /* working on second string, string2 */ 856 go to sub_search; 857 end; 858 else go to sub2; /* found end of string2 */ 859 860 sub_case (2): 861 if (ti + k) < te then do; /* is there a char after the concealed char? */ 862 tik = (tik + k) + 1; /* skip concealed char */ 863 go to sub_search; /* and continue scan */ 864 end; 865 else go to sub_err; /* no delimiter found */ 866 867 sub_case (3): 868 if (tik + k) > te then go to sub_err; /* there is no char after the escape, 134 */ 869 if (t.c (tik + k) = "C") | (t.c (tik + k) = "c") /* is this conceal symbol */ 870 then 871 if (tik + k) + 1 < te /* is more after concealed char */ 872 then do; 873 tik = tik + k + 2; /* start at next char */ 874 go to sub_search; 875 end; 876 else go to sub_err; /* no delimiter */ 877 else do; /* this was not a conceal symbol */ 878 tik = tik + k; /* search continues at next char */ 879 go to sub_search; 880 end; 881 882 sub2: 883 ti = tik + k; /* set index to next character after substitue request */ 884 je = tik + k - 2; /* get index of last character in strin2 */ 885 call open_gap ((fli - 1)); /* setup buffer for substitution */ 886 887 subsw = "0"b; /* initialize switch to indicate nothing found yet */ 888 sub_loop: 889 call qx_search_file_ (qid_ptr, tp, i, il, ifp, fli, lle, mi, me, ilb, ift, code); 890 /* try to match on string1 */ 891 ilb = ilb - ilb_offset; /* post-delete previous stuff */ 892 ilb_offset = 0; /* and don't delete more til we are ready */ 893 if ^sys_info$service_system then call bce_check_abort; 894 if intsw then do; /* interrupt in substitution */ 895 call ioa_ ("^a: Interrupt during substitute, remainder unprocessed.", qid.editor_name); 896 intsw = "0"b; 897 goto sub_done; 898 end; 899 900 if code ^= 0 then goto sub_done; /* if nothing found, all done */ 901 ml = me - mi + 1; /* otherwise, get length of string found */ 902 subsw = "1"b; /* indicate something found */ 903 il = 0; /* use canned regular expression next time thru */ 904 l = mi - fli; /* copy buffer up to char(mi) */ 905 if l > 0 then /* .. (if anything to copy) */ 906 fli = fli + l; /* set point of copy */ 907 908 /* **** This is the only point at which the gap is part way through a line **** */ 909 call open_gap ((fli - 1)); 910 911 l = j; /* set index to beginning of input string */ 912 sub_string_search: /* search input string for special symbols */ 913 k = search (substr (tp -> a_string, l, je - l + 1), "&\"); 914 /* search for special symbol &, conceal = 031, "\" */ 915 if k = 0 then do; /* no special symbols */ 916 if je >= j then /* only process if sub string not null */ 917 if ml ^= 0 then do; 918 call promote ((je - l + 1 - ml)); /* make sure space exists */ 919 /* Check here to prevent inadvertant deletion of matched string */ 920 ift = ift + ml; /* immediate delete since no & present */ 921 ml = -1; /* indicate already deleted */ 922 end; 923 924 saved_ift = ift; 925 call promote ((je - l + 1)); /* make sure space exists */ 926 927 substr (ifp -> a_string, ilb + 1, (je - l + 1)) = substr (tp -> a_string, l, (je - l + 1)); 928 /* insert string */ 929 ilb = ilb + je - l + 1; /* update output buffer length */ 930 b.modified = "1"b; /* substitute is a modify */ 931 go to sub_next; /* see if more substitution */ 932 end; 933 934 kx = index ("&\", t.c (l + k - 1)); /* which one found/ */ 935 go to do_sub (kx); /* go process it */ 936 937 do_sub (1): /* found &, insert matched string here */ 938 if k > 1 then do; /* input non special chars before special */ 939 call promote ((k - 1)); /* ensure space exists */ 940 substr (ifp -> a_string, ilb + 1, k - 1) = substr (tp -> a_string, l, k - 1); 941 /* copy nonspecial chars */ 942 ilb = ilb + k - 1; /* update output coount */ 943 b.modified = "1"b; /* substitute is a modify */ 944 end; 945 946 /* Insertion of the original matched text is done by copying from the top 947* to the bottom sections. This permits multiple inclusions of text. This 948* operation is safe since data is moved from the top to the 949* bottom, and buffer promotion ensures that the gap is big enough to 950* prevent overlap. */ 951 if ml > 0 then do; /* length of matched string */ 952 call promote ((ml)); /* ensure space exists */ 953 substr (ifp -> a_string, ilb + 1, ml) = substr (ifp -> a_string, mi, ml); 954 /* copy section */ 955 ilb = ilb + ml; /* update end of bottom */ 956 b.modified = "1"b; /* substitute is a modify */ 957 end; 958 959 l = l + k; /* update index into input string */ 960 961 go to sub_string_search; /* and continue search */ 962 963 do_sub (2): /* found conceal character 031 */ 964 ka = 0; /* single character conceal symbol */ 965 do_sub_conceal: /* append string to here plus concealed character */ 966 call promote ((k)); /* ensure space exists */ 967 substr (ifp -> a_string, ilb + 1, k) = substr (tp -> a_string, l, k - 1) || t.c (l + k + ka); 968 ilb = ilb + k; /* update output string index */ 969 b.modified = "1"b; /* substitute is a modify */ 970 l = l + k + ka + 1; /* update input string index */ 971 go to sub_string_search; /* and continue search */ 972 973 do_sub (3): /* found "\" so check for following "c" */ 974 if (t.c (k + l) = "C") | (t.c (k + l) = "c") then do; 975 /* if two character conceal symbol */ 976 ka = 1; /* then set special character counter */ 977 go to do_sub_conceal; /* found two character conceal symbol */ 978 end; 979 else do; /* some other character */ 980 call promote ((k)); /* ensure space exists */ 981 substr (ifp -> a_string, ilb + 1, k) = substr (tp -> a_string, l, k); 982 /* copy up to and including "\" */ 983 ilb = ilb + k; /* update output buffer index */ 984 b.modified = "1"b; /* substitute is a modify */ 985 l = l + k; /* set input index */ 986 go to sub_string_search; /* and continue search */ 987 end; 988 989 sub_next: 990 if ml = 0 then /* if matched string was null */ 991 fli = fli + 1; /* ensure we find a different null string next time */ 992 else do; /* if matched string not null, resume search */ 993 fli = me + 1; /* set index after last matched character */ 994 if sdsw /* for star dollar match, step over new line. */ 995 then 996 fli = fli + 1; /* update search index */ 997 if ml < 0 then ilb_offset = 0; 998 else if fli > lle then ift = ift + ml; /* delete text if we will quit */ 999 else ilb_offset = ml; /* post-delete matched section from buffer */ 1000 end; 1001 1002 /* This gap opening is necessary due to post-deletion. If we opened the 1003* gap purely at fli-1 then .*$ would cause us to post-delete the 'NL'. 1004* By opening the gap at the end of the matched string everything 1005* is okay. */ 1006 1007 if sdsw then /* Check if fli is overstepped */ 1008 call open_gap ((fli - 2)); 1009 else call open_gap ((fli - 1)); 1010 if fli <= lle then go to sub_loop; /* until end of addressed portion of buffer reached */ 1011 sub_done: 1012 call last_line (min (fli, lle)); /* find start of this line */ 1013 call open_gap ((li - 1)); /* fixup gap to line boundary */ 1014 call next_line (lle); /* set current line to end of range */ 1015 1016 /* The following call to last_line is necessary to find the true beginning 1017* of the current line, since last_line and next_line both set the other end 1018* of the line, one must have at least one of them supplied with a true end. 1019* The above next_line truely sets up the end of the line, the following 1020* last_line truely sets up the beginning. */ 1021 1022 call last_line (le); 1023 1024 /* **** After this point buffer is again following line gap standards **** */ 1025 1026 if ^subsw then do; /* error if nothing found */ 1027 call edx_util_$end_buffer (qid_ptr, code); /* attempt to pop buffer recursion stack */ 1028 if code = 0 then go to nx_line; /* and continue execution in calling buffer */ 1029 1030 call ioa_ ("Substitution failed."); /* print error message if at recursion level 0 */ 1031 go to rq_err; /* and treat as normal error */ 1032 end; 1033 else go to next; /* go pick up next request */ 1034 1035 /* * * * * execute request ... pass remainder of line to command processor (i.e. escape to command system) * */ 1036 1037 ACTION (15): 1038 execute: 1039 substr (tp -> a_string, 1, (ti - 1)) = " "; /* blank out preceding portion of request line */ 1040 pi_label = nx_line; /* allow command to be aborted */ 1041 if sys_info$service_system then do; 1042 pi_sw = "1"b; /* by means of a program interrupt */ 1043 call cu_$cp (tp, te, code); /* pass request line to command processor */ 1044 pi_sw = "0"b; /* disable program interrupt upon return */ 1045 end; 1046 else call ioa_ ("^a: Escape to command level not allowed.", qid.editor_name); 1047 go to nx_line; /* get fresh request line from input stream */ 1048 1049 1050 1051 /* * * * * buffer request ..... change working buffer after saving status of current buffer * * * * * * * * * */ 1052 1053 ACTION (7): 1054 buffer: 1055 call save_buffer_state (); /* save previous buffer's state */ 1056 call edx_util_$get_buffer (qid_ptr, tp, ti, te, tname, tbp); 1057 /* pick up pointer to control block of new buffer */ 1058 if tbp = null then go to rq_err; 1059 call get_buffer_state (tbp); /* instantiate new one */ 1060 go to next; 1061 1062 /* **** move request move addressed lines from current buffer into auxilliary buffer **** 1063* 1064* This move is directly borrowed from write, and print. It does not alter the 1065* current line, or move the gap. */ 1066 1067 ACTION (8): 1068 move: 1069 call defaults (li, le); /* provide default addresses in needed */ 1070 call edx_util_$get_buffer (qid_ptr, tp, ti, te, tname, tbp); 1071 /* get pointer to control block of specified buffer */ 1072 if tbp = null then go to rq_err; 1073 fp = tbp -> b.dp; /* get pointer to buffer file */ 1074 if lle <= ilb | fli >= ift then do; /* portion addressed is purely in bottom or top */ 1075 fe = lle - fli + 1; 1076 if fe > sys_info$max_seg_size * 4 then do; 1077 move_overflow: 1078 call ioa_ ("^a: Buffer full!! Move not performed.", qid.editor_name); 1079 goto rq_err; 1080 end; 1081 substr (fp -> a_string, 1, fe) = substr (ifp -> a_string, fli, fe); 1082 /* copy specified portion of buffer into new buffer */ 1083 end; 1084 else if fli <= ilb then do; /* top in top, bottom in bottom */ 1085 fe = lle - ift + 1 + ilb - fli + 1; 1086 if fe > sys_info$max_seg_size * 4 then goto move_overflow; 1087 substr (fp -> a_string, 1, ilb - fli + 1) = substr (ifp -> a_string, fli, ilb - fli + 1); 1088 substr (fp -> a_string, ilb - fli + 2, lle - ift + 1) = substr (ifp -> a_string, ift, lle - ift + 1); 1089 end; 1090 if fe < 4 * 4 * 1024 then i = 4 * 4 * 1024; 1091 else if fe < 16 * 4 * 1024 then i = 16 * 4 * 1024; 1092 else if fe < 64 * 4 * 1024 then i = 64 * 4 * 1024; 1093 else i = 255 * 4 * 1024; 1094 i = min (i, sys_info$max_seg_size * 4); 1095 1096 tbp -> b.lb = fe; 1097 tbp -> b.de = i; /* update buffer status */ 1098 tbp -> b.ft = i + 1; /* upper buffer is empty */ 1099 tbp -> b.li = 1; /* .. */ 1100 tbp -> b.le = index (substr (fp -> a_string, 1, fe), NL); 1101 if tbp -> b.le = 0 then tbp -> b.le = fe; /* set to last line */ 1102 if tbp -> b.le = 0 then tbp -> b.le = ilb; /* if no new line then set to end of buffer */ 1103 tbp -> b.modified = "1"b; /* target buffer is now modified */ 1104 tbp -> b.default_untrusted = ^tbp -> b.default_locked & (tbp -> b.default_path ^= ""); 1105 /* target's pathname is no longer trusted */ 1106 go to delete; /* now delete addressed lines from current buffer */ 1107 1108 /* * * * * status ("x") request ..... list status of all buffers (current and auxiliary) * * * * * * * * * * * */ 1109 1110 ACTION (14): 1111 status: 1112 call save_buffer_state (); 1113 call edx_util_$list_buffers (qid_ptr, curbuf, output_sw); 1114 go to next; /* and go pick up next qedx request */ 1115 1116 /* **** print current line number ("=") request prints out line number of current line in buffer **** 1117* 1118* This is one of the grottier pieces of code, not due to poor coding, but due 1119* to poor design for a paging system. = must read the entire temp file, and 1120* count line feeds until the current character index of the current line is 1121* reached. The modifications done here are entirely to account for the gap in 1122* the middle of the buffer. */ 1123 1124 ACTION (13): 1125 cur_line: 1126 call defaults (li, le); /* provide default addresses if necessary */ 1127 call last_line (lle); /* set current line to addressed line */ 1128 if ifp -> f.c (lle) = NL then 1129 j = 0; /* watch out for last line with no new-line character */ 1130 else j = 1; /* .. */ 1131 i = 1; /* start with first character */ 1132 do while (i <= lle); /* up to last character of current line */ 1133 if i > ilb & i < ift then i = ift; /* fixup gap entry */ 1134 retry_top: 1135 if i >= ift then 1136 k = index (substr (ifp -> a_string, i, lle - i + 1), NL); 1137 /* find a new line */ 1138 else do; 1139 k = index (substr (ifp -> a_string, i, ilb - i + 1), NL); 1140 /* find a new line */ 1141 if k = 0 & ift <= ife then do; /* move to upper and continue line */ 1142 i = ift; 1143 goto retry_top; 1144 end; 1145 end; 1146 if k = 0 then 1147 i = lle + 1; /* done */ 1148 else j = j + 1; /* add to count of new lines */ 1149 i = i + k; /* start with next character */ 1150 end; 1151 call ioa_ ("^d", j); /* print out line number */ 1152 go to next; /* get next qedx request */ 1153 1154 /* **** global/exclude request repeat given request for lines containing (or not containing) reg. exp **** 1155* 1156* This command may move the gap, for deletion, if it finds a line which must 1157* be deleted. At this point the gap will be opened below the next 1158* line to be processed. This means all operations will execute on a 1159* contiguous buffer. Deletion is done simply by moving the ift pointer up to 1160* indicate that the line no longer exists in the buffer. */ 1161 1162 ACTION (16): 1163 exclude: 1164 xsw = "1"b; /* exclude request */ 1165 go to gb1; /* set switch and join common code */ 1166 1167 ACTION (12): 1168 global: 1169 xsw = "0"b; /* global request */ 1170 gb1: 1171 call defaults (1, ife); /* provide default addresses (1,$) if necessary */ 1172 if ti > te then go to gb_err; /* error if nothing follows g or v request */ 1173 ch = t.c (ti); /* get request following global request */ 1174 if ch ^= "p" then 1175 if ch ^= "d" then 1176 if ch ^= "=" then do; /* check for valid global request */ 1177 gb_err: 1178 call ioa_ ("Syntax error in global request."); 1179 go to rq_err; 1180 end; 1181 delim = t.c (ti + 1); /* pick up regular expression delimiter */ 1182 i = ti + 2; /* get index of first character of regular expression */ 1183 do ti = i to te; /* find end of regular expression */ 1184 cht = t.c (ti); /* pickup one character */ 1185 if cht = delim then go to gb2; /* found end of string */ 1186 else if cht = EC then ti = ti + 1; /* escape in one character */ 1187 else if cht = "\" then 1188 if ti < te then 1189 if (t.c (ti + 1) = "C") | (t.c (ti + 1) = "c") then ti = ti + 2; 1190 /* ... */ 1191 end; 1192 go to gb_err; /* error if end cannot be found */ 1193 1194 gb2: 1195 il = ti - i; /* get length of regular expression */ 1196 ti = ti + 1; /* leave request line index pointing to next character */ 1197 l = 0; /* initialize line counter */ 1198 if ch ^= "=" then go to gb_loop; /* count lines only for "=" request */ 1199 do j = 1 to (fli - 1); /* for "=" request up to starting line number */ 1200 if j > ilb & j < ift then j = ift; /* move across gap */ 1201 if j <= fli - 1 then 1202 if ifp -> f.c (j) = NL then l = l + 1; /* .. */ 1203 end; 1204 gb_loop: 1205 l = l + 1; /* increment line counter */ 1206 if fli > ilb & fli < ift then fli = ift; /* move across gap */ 1207 if fli > lle then goto gb_quit; 1208 le = index (substr (ifp -> a_string, fli, (lle - fli + 1)), NL); 1209 /* find end of next line */ 1210 if le = 0 then 1211 le = lle; /* worry about no new-line at end of buffer */ 1212 else le = fli + le - 1; /* get index of end of line (NL character) */ 1213 call qx_search_file_ (qid_ptr, tp, i, il, ifp, fli, le, mi, me, ilb, ift, code); 1214 /* search line for regular expression */ 1215 if code > 1 then go to gb_quit; /* bad regular expression */ 1216 il = 0; /* null regular expression to form // */ 1217 if xsw then 1218 if code ^= 0 then go to gb_test; /* check for match on exclude request */ 1219 if ^xsw then 1220 if code = 0 then go to gb_test; /* check for match on global request */ 1221 fli = le + 1; /* no match (global or exclude) skip to next line */ 1222 go to gb_end; /* .. */ 1223 1224 gb_test: 1225 if ch = "p" then do; /* match found, check for global print (p) request */ 1226 j = le - fli + 1; /* compute number of characters in line to print */ 1227 pi_label = gb_quit; /* in case of a quit */ 1228 pi_sw = "1"b; /* activate the label */ 1229 call output_routine (output_sw, addr (ifp -> f.c (fli)), j, code); 1230 /* print line */ 1231 pi_sw = "0"b; /* disable the label */ 1232 fli = le + 1; /* move to next line */ 1233 if ^sys_info$service_system then call bce_check_abort; 1234 if intsw then go to gb_quit; /* abort request if program interrupt has occurred */ 1235 end; 1236 else if ch = "d" then do; /* check for global delete (d) request */ 1237 call open_gap ((fli - 1)); /* open gap below delete point */ 1238 ift = le + 1; /* start of good text */ 1239 fli = ift; /* move up index */ 1240 b.modified = "1"b; /* deletion is a modification */ 1241 if ^sys_info$service_system then call bce_check_abort; 1242 if intsw then go to gb_quit; /* abort request if program interrupt has occurred */ 1243 end; 1244 else if ch = "=" then do; /* check for global "=" request (print line number) */ 1245 call ioa_ ("^d", l); /* print line number */ 1246 fli = le + 1; /* move to next line */ 1247 if ^sys_info$service_system then call bce_check_abort; 1248 if intsw then go to gb_quit; /* abort request if program interrupt has occurred */ 1249 end; 1250 gb_end: 1251 if fli <= lle then go to gb_loop; /* check for last line processed */ 1252 gb_quit: 1253 if ch = "p" then call ioa_ (""); 1254 call last_line (lle); /* when done, leave current line at last line processed */ 1255 go to next; /* and pick up next qedx request */ 1256 1257 /* * * * * null request .......... change value of "." and get next request from input line */ 1258 1259 ACTION (17): 1260 nullrq: 1261 if ^flsw then go to next; /* ignore request if no address given */ 1262 call defaults (li, le); /* provide default addresses if necessary */ 1263 call last_line (lle); /* change "." to last line addressed */ 1264 go to next; 1265 1266 1267 /* * * * * comment delimiter (") found ..... change value of "." to last line addressed and ignore rest of line */ 1268 1269 ACTION (18): 1270 comment: 1271 if ^flsw then go to nx_line; /* ignore completely if no address given */ 1272 call defaults (li, le); /* provide default addresses if necessary */ 1273 call last_line (lle); /* change "." to last line addressed */ 1274 go to nx_line; /* ignore remainder of this request line */ 1275 1276 /* * * * * * * * * * * * * * * * * * * * INTERNAL PROCEDURES * * * * * * * * * * * * * * * * * * * */ 1277 1278 /* Cleans up the data structures used by this invocation of qedx_ */ 1279 1280 cleanup_invocation_data: 1281 procedure (); 1282 1283 if callers_io_region_ptr ^= null () then do; 1284 call release_temp_segment_ (qid.editor_name, callers_io_region_ptr, (0)); 1285 callers_io_region_ptr = null (); 1286 end; 1287 1288 call edx_util_$edx_cleanup (qid_ptr); 1289 1290 call qx_search_file_$cleanup (qid_ptr); 1291 1292 return; 1293 1294 end cleanup_invocation_data; 1295 1296 /* Saves the current buffer's state variables */ 1297 1298 save_buffer_state: 1299 procedure (); 1300 1301 b.dp = ifp; 1302 b.de = ife; 1303 b.lb = ilb; 1304 b.ft = ift; 1305 b.li = li; 1306 b.le = le; 1307 1308 return; 1309 1310 end save_buffer_state; 1311 1312 1313 /* Restores the state of the specifier buffer causing it to be current */ 1314 1315 get_buffer_state: 1316 procedure (p_bp); 1317 1318 dcl p_bp pointer parameter; 1319 1320 bp = p_bp; /* switch to new buffer */ 1321 curbuf = b.name; /* ... */ 1322 1323 ifp = b.dp; /* pointer to buffer file */ 1324 ife = b.de; /* index of last character in buffer */ 1325 ilb = b.lb; 1326 ift = b.ft; 1327 li = b.li; /* index of first character of current line */ 1328 le = b.le; /* index of last character of current line */ 1329 1330 return; 1331 1332 end get_buffer_state; 1333 1334 /* Determine the "file" to be read/written: only used by actual read/write requests */ 1335 1336 determine_file: 1337 procedure (write_request, a_real_file, the_pathname, explicit_pathname); 1338 1339 dcl write_request bit (1) aligned parameter; /* an output operation */ 1340 dcl a_real_file bit (1) aligned parameter; /* set ON => using a "file" rather than caller's buffer */ 1341 dcl the_pathname character (256) parameter; /* set to the name of the "file" */ 1342 dcl explicit_pathname bit (1) aligned parameter; /* set ON => user supplied a pathname to the request */ 1343 dcl l fixed binary (21); 1344 1345 if b.callers_idx = 0 then /* not a buffer known to our caller */ 1346 the_buffer_ptr = null (); 1347 else the_buffer_ptr = addr (qedx_info.buffers (b.callers_idx)); 1348 1349 do ti = ti to te while (t.c (ti) = " "); /* skip leading blanks in path name */ 1350 end; 1351 l = te - ti; /* compute length of path name */ 1352 1353 if l > 0 then do; /* have a pathname ... */ 1354 explicit_pathname = "1"b; 1355 if qid.no_rw_path then do; /* user specified path but is not allowed to do so */ 1356 call ioa_ ("A pathname cannot be specified with the ^[w^;r^] request", write_request); 1357 go to rq_err; 1358 end; 1359 if l > length (the_pathname) then do; 1360 call com_err_ (error_table_$pathlong, qid.editor_name, "^a", substr (tp -> a_string, ti, l)); 1361 b.default_untrusted = ^b.default_locked & (b.default_path ^= ""); 1362 go to rq_err; 1363 end; 1364 a_real_file = "1"b; /* will be reading from a segment all right */ 1365 the_pathname = substr (tp -> a_string, ti, l); 1366 end; /* save the input pathname */ 1367 1368 else do; /* determine source/destination */ 1369 explicit_pathname = "0"b; 1370 a_real_file = ^b.default_is_region; /* ... check if reading/writing a file */ 1371 1372 if the_buffer_ptr ^= null () then /* ... check that user may use default "pathname" */ 1373 if the_buffer.read_write_region & b.default_is_region then 1374 if (write_request & ^the_buffer.default_write_ok) 1375 | (^write_request & ^the_buffer.default_read_ok) then do; 1376 call ioa_ ("No pathname given."); 1377 go to rq_err; 1378 end; 1379 1380 if ^write_request & b.default_is_region then /* can only read back original if buffer's empty */ 1381 if ^((ift > ife) & (ilb < 1)) then do; 1382 call ioa_ ("Cannot restore original text unless buffer is empty."); 1383 go to rq_err; 1384 end; 1385 1386 if a_real_file then /* verify that we have a pathname ... */ 1387 if b.default_path ^= "" then 1388 the_pathname = b.default_path; 1389 else do; 1390 call ioa_ ("No pathname given."); 1391 go to rq_err; 1392 end; 1393 end; 1394 1395 return; 1396 1397 end determine_file; 1398 1399 /* Read the "file" into the buffer: returns "1"b if successfull */ 1400 1401 perform_read: 1402 procedure (a_real_file, the_pathname, explicit_pathname) returns (bit (1) aligned); 1403 1404 dcl a_real_file bit (1) aligned parameter; /* ON => reading from a real "file" vs. caller's buffer */ 1405 dcl the_pathname character (256) parameter; /* the file to be read */ 1406 dcl explicit_pathname bit (1) aligned; /* ON => above pathname given by the user */ 1407 1408 dcl file_ptr pointer; 1409 dcl dirname character (168); 1410 dcl (ename, component) character (32); 1411 dcl (was_empty, read_ok) bit (1) aligned; 1412 dcl trust_the_pathname bit (1); 1413 dcl (code, status_code) fixed binary (35); 1414 dcl file_bc fixed binary (24); 1415 dcl file_lth fixed binary (21); 1416 1417 1418 /* Establish pointer/length of the "file" */ 1419 1420 if b.callers_idx = 0 then /* our caller doesn't care about this buffer */ 1421 the_buffer_ptr = null (); 1422 else the_buffer_ptr = addr (qedx_info.buffers (b.callers_idx)); 1423 1424 if qedx_info.caller_does_io then do; /* let the caller get the file for us */ 1425 local_qbii.version = QEDX_BUFFER_IO_INFO_VERSION_1; 1426 local_qbii.editor_name = qid.editor_name; 1427 local_qbii.pathname = the_pathname; 1428 local_qbii.buffer_ptr = callers_io_region_ptr; 1429 local_qbii.buffer_max_lth = 4 * sys_info$max_seg_size; 1430 local_qbii.direction = QEDX_READ_FILE; 1431 string (local_qbii.flags) = ""b; 1432 local_qbii.default_pathname = ^explicit_pathname; 1433 call qedx_info.buffer_io (addr (local_qbii), read_ok); 1434 if ^read_ok then do; /* caller will print any error messages */ 1435 if explicit_pathname then b.default_untrusted = ^b.default_locked & (b.default_path ^= ""); 1436 return ("0"b); 1437 end; 1438 file_ptr = callers_io_region_ptr; 1439 file_lth = local_qbii.buffer_lth; 1440 end; 1441 1442 else if a_real_file then do; /* get it from an honest to God file */ 1443 if sys_info$service_system then do; 1444 call expand_pathname_$component (the_pathname, dirname, ename, component, code); 1445 if code ^= 0 then do; 1446 call com_err_ (code, qid.editor_name, "^a", the_pathname); 1447 if explicit_pathname then b.default_untrusted = ^b.default_locked & (b.default_path ^= ""); 1448 return ("0"b); 1449 end; 1450 call initiate_file_$component (dirname, ename, component, R_ACCESS, file_ptr, file_bc, code); 1451 if code ^= 0 then do; /* can't get it */ 1452 if code = error_table_$dirseg then do; 1453 call hcs_$status_minf (dirname, ename, CHASE, 0, file_bc, status_code); 1454 if (status_code = 0) & (file_bc ^= 0) then 1455 call com_err_ (0, qid.editor_name, "This operation is not allowed for an MSF. ^a", 1456 pathname_$component (dirname, ename, component)); 1457 else call com_err_ (code, qid.editor_name, "^a", 1458 pathname_$component (dirname, ename, component)); 1459 end; 1460 else call com_err_ (code, qid.editor_name, "^a", pathname_$component (dirname, ename, component)) 1461 ; 1462 if explicit_pathname & (code ^= error_table_$moderr) & (code ^= error_table_$no_r_permission) 1463 then 1464 b.default_untrusted = ^b.default_locked & (b.default_path ^= ""); 1465 return ("0"b); 1466 end; 1467 file_lth = divide ((file_bc + 8), 9, 21, 0); 1468 end; 1469 else do; 1470 call bootload_fs_$get_ptr (the_pathname, file_ptr, file_lth, code); 1471 if code ^= 0 then do; 1472 call com_err_ (code, qid.editor_name, "^a", the_pathname); 1473 if explicit_pathname then b.default_untrusted = ^b.default_locked & (b.default_path ^= ""); 1474 return ("0"b); 1475 end; 1476 end; 1477 end; 1478 1479 else do; /* read from the caller's buffer */ 1480 file_ptr = the_buffer.region_ptr; 1481 file_lth = min (the_buffer.region_final_lth, the_buffer.region_max_lth); 1482 end; 1483 1484 1485 /* Check if reading with an untrustworthy default pathname and ask for permission if so */ 1486 1487 if b.default_untrusted & ^explicit_pathname then do; 1488 if sys_info$service_system then 1489 call command_query_$yes_no (trust_the_pathname, 0, qid.editor_name, TRUSTED_PATHNAMES_EXPLANATION, 1490 "Do you wish to ^a with the untrustworthy default pathname ^a?", "read", the_pathname); 1491 else call bce_query$yes_no (trust_the_pathname, TRUSTED_PATHNAMES_EXPLANATION); 1492 if trust_the_pathname then 1493 ; /* user says it's OK ... */ 1494 else go to rq_err; /* ... punt */ 1495 end; 1496 1497 else trust_the_pathname = "0"b; /* be sure it's initialized */ 1498 1499 1500 /* Move the data into the buffer */ 1501 1502 was_empty = (ilb < 1) & (ift > ife); /* remember whether buffer was empty or not */ 1503 1504 call open_gap ((fle)); /* open a gap to add after */ 1505 call promote (file_lth); /* ensure space exists */ 1506 1507 le = ift - 1; /* mark end of buffer */ 1508 ift = ift - file_lth; /* setup location where we will read */ 1509 1510 substr (ifp -> a_string, ift, file_lth) = substr (file_ptr -> a_string, 1, file_lth); 1511 /* copy file */ 1512 1513 file_lth = le; /* remember position of end of last line */ 1514 call next_line (ift); /* get end of first line of new data */ 1515 call last_line (le); /* get start of first line of data (and maybe more) */ 1516 call open_gap ((li - 1)); /* open gap at start of line (which might be in lower) */ 1517 call last_line (file_lth); /* end of buffer has last line */ 1518 call next_line (li); /* ensure a whole line */ 1519 1520 1521 /* Set default pathname if necessary and cleanup */ 1522 1523 if b.default_locked then do; /* pathname is locked */ 1524 b.default_untrusted = "0"b; 1525 b.modified = ^was_empty | explicit_pathname; /* ... make sure 1,$dr works right */ 1526 end; 1527 1528 else if was_empty then do; /* empty and not locked: set new default pathname */ 1529 if sys_info$service_system then 1530 if a_real_file & ^qedx_info.caller_does_io then 1531 b.default_path = pathname_$component (dirname, ename, component); 1532 else b.default_path = the_pathname; /* ... if not from a file it wasn't expanded */ 1533 else b.default_path = the_pathname; 1534 b.default_is_region = ^a_real_file; /* ... might have been caller's buffer */ 1535 b.default_untrusted = "0"b; /* ... we trust the pathname again */ 1536 b.modified = "0"b; /* ... and this buffer is no longer modified */ 1537 end; 1538 1539 else do; /* buffer wasn't empty */ 1540 b.default_untrusted = (b.default_path ^= "");/* ... we can't trust the default anymore (if there is one) */ 1541 b.modified = "1"b; /* ... and the buffer is modified */ 1542 end; 1543 1544 if sys_info$service_system then 1545 if a_real_file & ^qedx_info.caller_does_io then 1546 /* terminate it when done */ 1547 call terminate_file_ (file_ptr, 0, TERM_FILE_TERM, (0)); 1548 1549 return ("1"b); /* success */ 1550 1551 end perform_read; 1552 1553 /* Write the specified portion of the buffer into the "file": returns "1"b if successful */ 1554 1555 perform_write: 1556 procedure (a_real_file, the_pathname, explicit_pathname, issue_truncation_warning) returns (bit (1) aligned); 1557 1558 dcl a_real_file bit (1) aligned parameter; /* ON => writing to a file vs. caller's buffer */ 1559 dcl the_pathname character (256) parameter; /* the name of the file */ 1560 dcl explicit_pathname bit (1) aligned parameter; /* ON => user specified a pathname to the write request */ 1561 dcl issue_truncation_warning bit (1) aligned parameter; /* ON => if it won't fit in caller's buffer: tell the user */ 1562 1563 dcl file_ptr pointer; 1564 dcl dirname character (168); 1565 dcl ename character (32); 1566 dcl (split_data, write_ok, created_file, wrote_whole_buffer) bit (1) aligned; 1567 dcl trust_the_pathname bit (1); 1568 dcl (code, status_code) fixed binary (35); 1569 dcl file_bc fixed binary (24); 1570 dcl file_lth fixed binary (21); 1571 1572 1573 if b.callers_idx = 0 then /* caller doesn't care about this buffer */ 1574 the_buffer_ptr = null (); 1575 else the_buffer_ptr = addr (qedx_info.buffers (b.callers_idx)); 1576 1577 if (lle <= ilb) | (fli >= ift) then do; /* all data is in one half of the buffer */ 1578 split_data = "0"b; 1579 file_lth = lle - fli + 1; 1580 end; 1581 else do; /* data spans the gap */ 1582 split_data = "1"b; 1583 file_lth = (ilb - fli + 1) + (lle - ift + 1); 1584 end; 1585 1586 1587 /* Check if writing with an untrustworthy default pathname and ask for permission if so */ 1588 1589 if b.default_untrusted & ^explicit_pathname then do; 1590 if sys_info$service_system then 1591 call command_query_$yes_no (trust_the_pathname, 0, qid.editor_name, TRUSTED_PATHNAMES_EXPLANATION, 1592 "Do you wish to ^a with the untrustworthy default pathname ^a?", "write", the_pathname); 1593 else call bce_query$yes_no (trust_the_pathname, TRUSTED_PATHNAMES_EXPLANATION); 1594 if trust_the_pathname then /* user says it's OK ... */ 1595 b.default_untrusted = "0"b; 1596 else go to rq_err; /* ... punt */ 1597 end; 1598 1599 else trust_the_pathname = "0"b; /* be sure this is properly initialized */ 1600 1601 1602 if qedx_info.caller_does_io then do; 1603 1604 /* Caller does actual I/O: put the portion of the buffer being written into out buffer and have the caller write it */ 1605 1606 call put_data (callers_io_region_ptr); 1607 1608 local_qbii.version = QEDX_BUFFER_IO_INFO_VERSION_1; 1609 local_qbii.editor_name = qid.editor_name; 1610 local_qbii.pathname = the_pathname; 1611 local_qbii.buffer_ptr = callers_io_region_ptr; 1612 local_qbii.buffer_lth = file_lth; 1613 local_qbii.direction = QEDX_WRITE_FILE; 1614 string (local_qbii.flags) = ""b; 1615 local_qbii.default_pathname = ^explicit_pathname; 1616 1617 call qedx_info.buffer_io (addr (local_qbii), write_ok); 1618 if ^write_ok then do; /* failed: caller has already printed reason */ 1619 if explicit_pathname then b.default_untrusted = ^b.default_locked & (b.default_path ^= ""); 1620 return ("0"b); 1621 end; 1622 end; 1623 1624 1625 else if a_real_file then do; 1626 if sys_info$service_system then do; 1627 1628 /* A real file: initiate/create the file and then put the data into it (do not accept archive component pathnames) */ 1629 1630 call expand_pathname_ (the_pathname, dirname, ename, code); 1631 if code ^= 0 then do; 1632 if code = error_table_$archive_pathname then code = error_table_$archive_component_modification; 1633 call com_err_ (code, qid.editor_name, "^a", the_pathname); 1634 if explicit_pathname & (code ^= error_table_$archive_component_modification) then 1635 b.default_untrusted = ^b.default_locked & (b.default_path ^= ""); 1636 return ("0"b); 1637 end; 1638 1639 call initiate_file_$create (dirname, ename, RW_ACCESS, file_ptr, created_file, (0), code); 1640 if created_file then do; /* insure that the file just created has an acceptable name */ 1641 call check_entryname_ (ename, code); 1642 if code ^= 0 then do; /* ... sorry: be sure to delete the unwanted file */ 1643 call terminate_file_ (file_ptr, 0, TERM_FILE_DELETE, (0)); 1644 call com_err_ (code, qid.editor_name, "^a", pathname_ (dirname, ename)); 1645 if explicit_pathname then b.default_untrusted = ^b.default_locked & (b.default_path ^= ""); 1646 return ("0"b); 1647 end; 1648 end; 1649 1650 if code ^= 0 then do; /* unable to initiate/create it */ 1651 if code = error_table_$dirseg then do; 1652 call hcs_$status_minf (dirname, ename, CHASE, 0, file_bc, status_code); 1653 if (status_code = 0) & (file_bc ^= 0) then 1654 call com_err_ (0, qid.editor_name, "This operation is not allowed for an MSF. ^a", 1655 pathname_ (dirname, ename)); 1656 else call com_err_ (code, qid.editor_name, "^a", pathname_ (dirname, ename)); 1657 end; 1658 else call com_err_ (code, qid.editor_name, "^a", pathname_ (dirname, ename)); 1659 if explicit_pathname & (code ^= error_table_$moderr) & (code ^= error_table_$no_r_permission) 1660 & (code ^= error_table_$no_w_permission) then 1661 b.default_untrusted = ^b.default_locked & (b.default_path ^= ""); 1662 return ("0"b); 1663 end; 1664 end; 1665 else do; 1666 call bootload_fs_$put_ptr (the_pathname, file_lth, "0"b, file_ptr, code); 1667 if code ^= 0 then do; 1668 call com_err_ (code, qid.editor_name, "^a", the_pathname); 1669 if explicit_pathname then b.default_untrusted = ^b.default_locked & (b.default_path ^= ""); 1670 return ("0"b); 1671 end; 1672 end; 1673 1674 call put_data (file_ptr); /* do it */ 1675 1676 if sys_info$service_system then do; 1677 call terminate_file_ (file_ptr, (9 * file_lth), TERM_FILE_TRUNC_BC_TERM, code); 1678 if code ^= 0 then do; /* couldn't cleanup */ 1679 call com_err_ (code, qid.editor_name, "^a", pathname_ (dirname, ename)); 1680 if explicit_pathname then b.default_untrusted = ^b.default_locked & (b.default_path ^= ""); 1681 return ("0"b); 1682 end; 1683 end; 1684 else call bootload_fs_$flush_sys; /* force write */ 1685 end; 1686 1687 1688 else do; 1689 1690 /* Using the caller's input/output area: put the data out and issue truncation warning if necessary */ 1691 1692 the_buffer.region_final_lth = file_lth; 1693 file_lth = min (file_lth, the_buffer.region_max_lth); 1694 1695 call put_data (the_buffer.region_ptr); /* stuff it */ 1696 1697 if issue_truncation_warning & (the_buffer.region_final_lth > the_buffer.region_max_lth) then 1698 call com_err_ (0, qid.editor_name, "Warning: Buffer ^a will be truncated on exit from the editor.", 1699 b.name); 1700 end; 1701 1702 1703 /* Set default pathname and reset modified flag as appropriate */ 1704 1705 /* format: off */ 1706 wrote_whole_buffer = ((1 > ilb) & ((fli = ift) & (lle = ife))) | 1707 ((ift > ife) & ((fli = 1) & (lle = ilb))) | 1708 (((1 <= ilb) & (ift <= ife)) & ((fli = 1) & (lle = ife))); 1709 /* format: on */ 1710 1711 if b.default_locked then do; /* pathname is locked */ 1712 b.default_untrusted = "0"b; /* ... stays modified unless the entire buffer was ... */ 1713 b.modified = b.modified & (^wrote_whole_buffer | explicit_pathname); 1714 end; /* ... ... written to the default pathname */ 1715 1716 else if wrote_whole_buffer then do; /* wrote it all and not locked: set new default pathname */ 1717 if sys_info$service_system then 1718 if a_real_file & ^qedx_info.caller_does_io then 1719 b.default_path = pathname_ (dirname, ename); 1720 else b.default_path = the_pathname; /* ... not a real file: pathname isn't expanded */ 1721 else b.default_path = the_pathname; 1722 b.default_is_region = ^a_real_file; /* ... might have been caller's buffer */ 1723 b.modified = "0"b; /* ... it's now safe */ 1724 b.default_untrusted = "0"b; /* ... and we trust this pathname */ 1725 end; 1726 1727 else b.default_untrusted = (b.default_path ^= "");/* didn't write everything */ 1728 1729 return ("1"b); /* success */ 1730 1731 1732 1733 /* Internal to perform_write: actually moves the data from our buffer into the output area */ 1734 1735 put_data: 1736 procedure (p_file_ptr); 1737 1738 dcl p_file_ptr pointer parameter; 1739 dcl (part1_lth, part2_lth) fixed binary (21); 1740 1741 if split_data then do; /* data spans the gap ... */ 1742 part1_lth = min ((ilb - fli + 1), file_lth); 1743 part2_lth = min ((lle - ift + 1), (file_lth - part1_lth)); 1744 substr (p_file_ptr -> a_string, 1, part1_lth) = substr (ifp -> a_string, fli, part1_lth); 1745 if part2_lth > 0 then /* it all really fits */ 1746 substr (p_file_ptr -> a_string, (part1_lth + 1), part2_lth) = 1747 substr (ifp -> a_string, ift, part2_lth); 1748 end; 1749 1750 else substr (p_file_ptr -> a_string, 1, file_lth) = substr (ifp -> a_string, fli, file_lth); 1751 1752 return; 1753 1754 end put_data; 1755 1756 end perform_write; 1757 1758 /* Locate line ending with specified character (ale) */ 1759 1760 last_line: 1761 procedure (ale); 1762 1763 dcl ale fixed bin (21); /* index of last character of line to be isolated */ 1764 1765 dcl i fixed bin (21); /* position returned from index */ 1766 1767 if ale < ift & ale > ilb then /* never - never land in the gap */ 1768 le = ilb; 1769 else le = ale; /* position at last character of line */ 1770 /* Modified last_line search to use index function across gapped buffer. */ 1771 1772 li = le - 1; /* miss current NL */ 1773 1774 retry: 1775 if li >= ift then do; 1776 i = index (reverse (substr (ifp -> a_string, ift, li - ift + 1)), NL); 1777 /* search upper */ 1778 if i = 0 then 1779 if ilb > 0 then do; /* move across gap to lower and re-try search */ 1780 li = ilb; 1781 goto retry; 1782 end; 1783 else do; /* this must be the first line */ 1784 li = ift; 1785 return; 1786 end; 1787 end; 1788 else do; /* search lower section */ 1789 if li < 1 then do; 1790 li = 1; /* force to bottom */ 1791 return; 1792 end; 1793 if li > ilb then li = ilb; /* force across gap */ 1794 i = index (reverse (substr (ifp -> a_string, 1, li)), NL); 1795 if i = 0 then do; /* not found - force to 1st character */ 1796 li = 1; 1797 return; 1798 end; 1799 end; 1800 li = li - i + 1; /* setup start index */ 1801 1802 /* correct for overstep */ 1803 1804 if li = ilb then 1805 li = ift; /* force up */ 1806 else li = li + 1; /* correct for pointing at NL */ 1807 return; /* and return */ 1808 1809 end last_line; 1810 1811 /* Locate line beginning with specified character (ali) */ 1812 1813 next_line: 1814 procedure (ali); 1815 1816 dcl ali fixed bin (21); /* index of first character of line */ 1817 1818 if ali <= ife then do; /* if line address within the buffer file */ 1819 if ali < ift & ali > ilb then /* never - never land in the gap */ 1820 li = ift; 1821 else li = ali; /* isolate line within file */ 1822 retry_top: 1823 if li <= ilb then do; 1824 le = index (substr (ifp -> a_string, li, (ilb - li + 1)), NL); 1825 /* attempt to find NL char at end of this line */ 1826 if le = 0 & ift <= ife then do; 1827 li = ift; 1828 goto retry_top; 1829 end; 1830 end; 1831 else le = index (substr (ifp -> a_string, li, (ife - li + 1)), NL); 1832 /* attempt to find NL char at end of this line */ 1833 if le = 0 then 1834 le = ife; /* if no NL found, set line end to end of file */ 1835 else le = (li - 1) + le; /* otherwise, compute index of NL within entire file */ 1836 end; 1837 else do; /* if line address is outside of buffer file */ 1838 li = ife + 1; /* set line beginning to next char to be added to file */ 1839 le = ife; /* indicate address points outside of buffer */ 1840 end; 1841 return; 1842 1843 end next_line; 1844 1845 /* Compute default addresses if necessary */ 1846 1847 defaults: 1848 procedure (afli, alle); 1849 1850 dcl afli fixed bin (21), /* default first index for first address */ 1851 alle fixed bin (21); /* default last index for last address */ 1852 1853 dcl (qfli, qlle) fixed bin (21); 1854 1855 if afli > ilb & afli < ift then 1856 qfli = ift; /* fixup default in gap */ 1857 else qfli = afli; 1858 1859 if alle > ilb & alle < ift then 1860 qlle = ift; 1861 else qlle = alle; 1862 1863 1864 if ^flsw then do; /* if no addresses provided */ 1865 fli, lli = qfli; /* fill in addresses with given defaults */ 1866 fle, lle = qlle; /* .. */ 1867 end; 1868 else if ^llsw then do; /* if only one addr, make second addr same as first */ 1869 if fli > ilb & fli < ift then 1870 lli = ift; 1871 else lli = fli; /* .. */ 1872 if fle > ilb & fle < ift then 1873 lle = ift; 1874 else lle = fle; /* .. */ 1875 end; 1876 if (ift > ife) & (ilb < 1) then do; /* check for empty buffer */ 1877 call ioa_ ("Buffer empty."); 1878 go to rq_err; 1879 end; 1880 if (fli = 0) | (lle = 0) | (fli > ife) then do; /* check for address outside of buffer */ 1881 call ioa_ ("Address out of buffer."); 1882 go to rq_err; 1883 end; 1884 if fli > lle then do; /* check for address wrap-around */ 1885 call ioa_ ("Address wrap-around."); 1886 go to rq_err; 1887 end; 1888 if fli > ife then fli = ilb; /* over-range */ 1889 if lli > ife then lli = ilb; 1890 if fle > ife then fle = ilb; 1891 if lle > ife then lle = ilb; 1892 return; 1893 1894 end defaults; 1895 1896 /* **** input data from input stream, append to text **** 1897* 1898* This command auxilliary for i,a, and c, calls promote to increase the size 1899* of the working text file, prior to moving data from the working line buffer. 1900* Promote will move the working file to the next aste pool boundary if space 1901* is available and is needed, and may abort the input command if no space is 1902* available in a 255K segment. */ 1903 1904 1905 input: 1906 procedure (afp, afe); /* procedure to append data from console to either file */ 1907 1908 dcl afp ptr, /* pointer to file to which data is to be appended */ 1909 afe fixed bin (21); /* index of (current) last character in file */ 1910 1911 1912 if t.c (ti) = NL then go to rd_line; /* check for NL immediately following input request */ 1913 if t.c (ti) = " " then ti = ti + 1; /* skip space following input request */ 1914 if ti <= te then go to inp_search; /* pick up any remaining characters from current line */ 1915 rd_line: 1916 call edx_util_$read_ptr (qid_ptr, tp, length (iline), te); 1917 /* read a line (or portion of line) from input stream */ 1918 ti = 1; /* initialize character index */ 1919 1920 inp_search: 1921 k = search (substr (tp -> a_string, ti, te - ti + 1), "\"); 1922 /* search for end input (034), conceal (031) or escape ("\") */ 1923 1924 if k = 0 then do; /* no special symbol found */ 1925 k = te - ti + 2; /* set up string length */ 1926 inp_move_string: 1927 call promote (k - 1); /* ensure space exists */ 1928 substr (afp -> a_string, afe + 1, (k - 1)) = substr (tp -> a_string, ti, (k - 1)); 1929 afe = afe + (k - 1); /* update output string index */ 1930 if (k - 1) > 0 then b.modified = "1"b; 1931 go to rd_line; /* get the next line */ 1932 end; 1933 1934 kx = index ("\", t.c (ti + (k - 1))); /* which symbol was found? */ 1935 go to inp_case (kx); /* handle it */ 1936 1937 inp_case (1): 1938 ka = 0; /* found single character terminate symbol */ 1939 inp_act (1): 1940 inp_act (2): 1941 inp_final: 1942 call promote (k - 1); /* ensure space exists */ 1943 substr (afp -> a_string, afe + 1, (k - 1)) = substr (tp -> a_string, ti, (k - 1)); 1944 /* move last of input */ 1945 afe = afe + (k - 1); /* update output string index */ 1946 if (k - 1) > 0 then b.modified = "1"b; 1947 ti = ti + k + ka; /* update input string index */ 1948 return; /* done with input */ 1949 1950 inp_case (2): 1951 ka = 0; /* found single character conceal */ 1952 inp_act (3): 1953 inp_act (4): 1954 inp_conceal: 1955 if (ti + k + ka) > te then go to inp_move_string; /* check length for character to conceal */ 1956 call promote (k); /* ensure space xists */ 1957 substr (afp -> a_string, afe + 1, k) = substr (tp -> a_string, ti, (k - 1)) || t.c (ti + k + ka); 1958 /* move string and concealed character */ 1959 afe = afe + k; /* update output string */ 1960 if k > 0 then b.modified = "1"b; 1961 ti = (ti + k + ka) + 1; /* update input string */ 1962 if ti > te then 1963 go to rd_line; /* get the next input line */ 1964 else go to inp_search; /* continue the search */ 1965 1966 inp_case (3): 1967 ka = 1; /* escape character found */ 1968 1969 kx = index ("fFcC", t.c (ti + k)); /* is this end input or conceal */ 1970 1971 if kx = 0 /* it is neither */ 1972 then do; 1973 call promote (k); /* ensure space exists */ 1974 substr (afp -> a_string, afe + 1, k) = substr (tp -> a_string, ti, k); 1975 /* copy everything */ 1976 afe = afe + k; /* update output string */ 1977 if k > 0 then b.modified = "1"b; 1978 ti = ti + k; /* update input string */ 1979 if ti > te then 1980 go to rd_line; 1981 else go to inp_search; 1982 end; 1983 1984 go to inp_act (kx); /* otherwise end input or conceal */ 1985 1986 1987 end input; 1988 1989 /* **** interrupt handling **** 1990* 1991* Interrupt handling is done in one of two modes, either we want to be interrupted 1992* and the current operation suspended, or we don't. This interrupt processing 1993* includes some verbosity to indicate what has happened. 1994**/ 1995 1996 1997 interrupt: 1998 procedure (); /* procedure to handle program interrupts */ 1999 2000 if pi_sw then do; /* are we currently accepting program interrupts */ 2001 pi_sw = "0"b; /* if so, reset enable switch */ 2002 go to pi_label; /* and do a non-local go to specified location */ 2003 end; 2004 else do; /* if no label assigned to handle interrupt */ 2005 intsw = "1"b; /* set switch to indicate interrupt occurred */ 2006 return; /* and otherwise ignore the program interrupt */ 2007 end; 2008 2009 end interrupt; 2010 2011 /* **** Promote **** 2012* 2013* This is an auxilliary routine called each time data is added to the working 2014* text buffer. It will check to ensure that the gap is big enough to contain 2015* the data. Otherwise it will grow the working file to a size great enough 2016* to contain the data. This is done by determining which aste pool size will 2017* be needed, and then moving the top section of the working buffer to the top 2018* of the new aste size. Pointers are then cleaned up and editing can continue. 2019* 2020* If there cannot be enough space left in a max len segment, then promote will 2021* dump an error message to the terminal, and will abort the current operation. 2022* 2023* This will mean that the current line will be lost for terminal input, and 2024* that the entire read will not be done for reading. */ 2025 2026 promote: 2027 procedure (string_length); 2028 2029 dcl string_length fixed bin (21); 2030 2031 dcl (new_fe, new_ft) fixed bin (21); 2032 2033 dcl offset_action fixed bin (21); 2034 2035 if (ife - ift + 1) + (ilb) + string_length > ife then do; 2036 /* determine end of next pool */ 2037 new_fe = ife; 2038 do while ((ife - ift + 1) + ilb + string_length > new_fe); 2039 if new_fe >= sys_info$max_seg_size * 4 then do; 2040 /* error on size */ 2041 if pi_label = sub_done then do; 2042 call ioa_ ("^a: Segment full!! Skipping remaining substitutions.", qid.editor_name); 2043 goto sub_done; 2044 end; 2045 2046 if pi_label = in_mode then 2047 call ioa_ ("^a: Segment full!! Last line of input lost - back to command mode.", 2048 qid.editor_name); 2049 else call ioa_ ("^a: Read will not fit in buffer - read not performed.", qid.editor_name); 2050 if pi_label = in_mode then call last_line (ilb); 2051 /* fixup last line input for input cleanup */ 2052 goto rq_err; 2053 end; 2054 else new_fe = min (new_fe * 4, sys_info$max_seg_size * 4); 2055 end; 2056 new_ft = ift - ife + new_fe; 2057 2058 if ife - ift >= 0 then do; /* top exists and must be moved */ 2059 call mrl_ (addr (substr (ifp -> a_string, ift)), (ife - ift + 1), 2060 addr (substr (ifp -> a_string, new_ft)), (ife - ift + 1)); 2061 end; 2062 2063 /* update current line pointers if they fall within the upper part. */ 2064 2065 offset_action = new_ft - ift; 2066 if lle >= ift then lle = lle + offset_action; 2067 if lli >= ift then lli = lli + offset_action; 2068 if le >= ift then le = le + offset_action; 2069 if li >= ift then li = li + offset_action; 2070 2071 if mi >= ift then mi = mi + offset_action; 2072 if me >= ift then me = me + offset_action; 2073 if fli >= ift then fli = fli + offset_action; 2074 2075 if b.ti >= ift then do; 2076 b.ti = b.ti + offset_action; 2077 b.te = b.te + offset_action; 2078 end; 2079 2080 ife = new_fe; 2081 ift = new_ft; 2082 end; 2083 2084 end promote; 2085 2086 /* Open_gap is used to open a processing gap in the text buffer at the 2087* point of the current line. This may require text to be moved up or down at 2088* the current gap. When data has been moved appropriate pointers are cleaned 2089* up and moved if they were in the section of text which was moved. */ 2090 2091 open_gap: 2092 procedure (gap_index); 2093 2094 /* gap is opened after the specified index */ 2095 2096 dcl gap_index fixed bin (21); 2097 2098 dcl offset_action fixed bin (21); 2099 2100 dcl gap fixed bin (21); 2101 2102 if ilb ^= gap_index & ift - 1 ^= gap_index then do; 2103 /* gap not at current index */ 2104 if gap_index <= ilb then do; /* index in bottom, move upper bottom up */ 2105 gap = ilb - gap_index; 2106 call mrl_ (addr (substr (ifp -> a_string, gap_index + 1)), gap, 2107 addr (substr (ifp -> a_string, ift - gap)), gap); 2108 offset_action = -gap_index + ift - gap - 1; 2109 /* form offset for index movement */ 2110 if li <= ilb & li > gap_index then li = li + offset_action; 2111 if le <= ilb & le > gap_index then le = le + offset_action; 2112 if lli <= ilb & lli > gap_index then lli = lli + offset_action; 2113 if lle <= ilb & lle > gap_index then lle = lle + offset_action; 2114 if fli <= ilb & fli > gap_index then fli = fli + offset_action; 2115 if fle <= ilb & fle > gap_index then fle = fle + offset_action; 2116 2117 if b.ti <= ilb & b.ti > gap_index then b.ti = b.ti + offset_action; 2118 2119 ift = ift - gap; 2120 ilb = ilb - gap; 2121 2122 if b.ti <= ilb then 2123 b.te = ilb; 2124 else b.te = ife; 2125 end; 2126 else do; 2127 gap = gap_index - ift + 1; 2128 substr (ifp -> a_string, ilb + 1, gap) = substr (ifp -> a_string, ift, gap); 2129 offset_action = -ift + ilb + 1; /* offset for index move */ 2130 if li >= ift & li <= gap_index then li = li + offset_action; 2131 if le >= ift & le <= gap_index then le = le + offset_action; 2132 if lli >= ift & lli <= gap_index then lli = lli + offset_action; 2133 if lle >= ift & lle <= gap_index then lle = lle + offset_action; 2134 2135 if b.ti >= ift & b.ti <= gap_index then b.ti = b.ti + offset_action; 2136 2137 if fli >= ift & fli <= gap_index then fli = fli + offset_action; 2138 if fle >= ift & fle <= gap_index then fle = fle + offset_action; 2139 ilb = ilb + gap; 2140 ift = ift + gap; 2141 if b.ti <= ilb then 2142 b.te = ilb; 2143 else b.te = ife; 2144 2145 end; 2146 end; 2147 2148 end open_gap; 2149 1 1 /* BEGIN INCLUDE FILE ... qedx_internal_data.incl.pl1 */ 1 2 /* Created: January 1983 by G. Palter */ 1 3 1 4 /* Data used by a single invocation of qedx or qedx_ */ 1 5 1 6 dcl 1 qid aligned based (qid_ptr), 1 7 2 editor_name character (72) unaligned, /* name of the editor (eg: "send_mail (qedx)") */ 1 8 2 editor_area_ptr pointer, /* -> area used to allocate data */ 1 9 2 qedx_info_ptr pointer, /* -> caller's definition of this qedx invocation */ 1 10 2 edx_util_data_ptr pointer, /* -> data used by edx_util_ */ 1 11 2 regexp_data_ptr pointer, /* -> data used by qx_search_file_ */ 1 12 2 flags, 1 13 3 no_rw_path bit (1) unaligned, 1 14 3 query_if_modified bit (1) unaligned, 1 15 3 pad bit (34) unaligned, 1 16 2 b0 like b, /* buffer 0 */ 1 17 2 tw like b; /* typewriter buffer */ 1 18 1 19 dcl qid_ptr pointer; 1 20 1 21 dcl editor_area area based (qid.editor_area_ptr); 1 22 1 23 1 24 /* Description of an element of the buffer recursion stack */ 1 25 1 26 dcl 1 sv based aligned, 1 27 2 prev pointer, /* pointer to previous element in stack */ 1 28 2 bp pointer, /* pointer to control block for this element */ 1 29 2 (ti, te) fixed binary (21); /* saved copies of buffer read indexes */ 1 30 1 31 /* Description of a single qedx buffer: Buffers are managed in two sections, a top and a bottom. The gap between the 1 32* sections is the end of the current line, and permits easy insertion and deletion of text, without extraineous data 1 33* movement. 1 34* 1 35* An empty section is indicated when the pointers are out-of-sequence. For example for the bottom section if lb 1 36* (last_bottom) is < 1 then the bottom is empty. If ft (first_top) is > (file_end) then the top is empty. 1 37* 1 38* In addition only one temporary file is needed to support operations on the buffers 1 39* 1 40* Line and range pointers: 1 41* li - Start index of current line. 1 42* le - End index of current line. Points to NL. 1 43* 1 44* lli - Start index of last line of range. 1 45* lle - End index of last line of range. Points to NL. 1 46* 1 47* fli - Start index of first line of range. 1 48* fle - End index of first line of range. 1 49* 1 50* Gapped buffer standards: 1 51* 1 - Start index of buffer. 1 52* ilb - End index of first part of buffer. Should point to NL. 1 53* ift - Start index of second part of buffer. 1 54* ife - End index of buffer. Should be one of: 1024*4*4, 1024*4*16, 1024*4*64, or 1024*4*255; 1 55* 1 56* Gapped standards permit the range to split across the gap, but a line of text cannot split across the gap. Therefore 1 57* when the gap is moved one should also move li and le if they are in the moved section of buffer. 1 58* 1 59* The gap, when processing insert, delete, change, substitute, is either immediately before, or immediately after the 1 60* range specified. This is dependant upon the type of operation. I/O such as writing and printing of buffer contents, 1 61* or searching and line indexing is done without moving the gap, and is done in sections as appropriate for the current 1 62* operational positioning and the current gap position */ 1 63 1 64 dcl 1 b based (bp) aligned, 1 65 2 name character (16), /* buffer name */ 1 66 2 next pointer, /* pointer to next buffer control block (if any) */ 1 67 2 dp pointer, /* pointer to beginning of buffer data */ 1 68 2 default_path character (256), /* default output pathname for this buffer */ 1 69 2 lb fixed binary (21), /* index of last character of bottom section */ 1 70 2 ft fixed binary (21), /* index of first character of top section */ 1 71 2 de fixed binary (21), /* index of last character in buffer */ 1 72 2 li fixed binary (21), /* index of first character of current line */ 1 73 2 le fixed binary (21), /* index of last character of current line */ 1 74 2 ti fixed binary (21), /* index of next char. to be read from buffer */ 1 75 2 te fixed binary (21), /* index of last char. of line being read from buffer */ 1 76 2 tw_sw bit (1), /* typewriter buffer switch (OFF for normal buffers) */ 1 77 2 callers_idx fixed binary, /* index in caller's qedx_info.buffers of this buffer */ 1 78 2 flags, 1 79 3 modified bit (1) unaligned, /* buffer has been modified since last write */ 1 80 3 default_was_region bit (1) unaligned, /* default pathname was originally caller's region */ 1 81 3 default_is_region bit (1) unaligned, /* default pathname is currently caller's region */ 1 82 3 default_locked bit (1) unaligned, /* default pathname can not be changed by r/w requests */ 1 83 3 default_untrusted bit (1) unaligned, /* buffer pathname is not trustworthy */ 1 84 3 pad bit (31) unaligned; 1 85 1 86 dcl bp pointer; 1 87 1 88 /* END INCLUDE FILE ... qedx_internal_data.incl.pl1 */ 2150 2151 2 1 /* BEGIN INCLUDE FILE ... qedx_info.incl.pl1 */ 2 2 /* Created: January 1983 by G. Palter */ 2 3 2 4 /* Data structure which supplies input/output arguments to qedx_ subroutine */ 2 5 2 6 dcl 1 qedx_info aligned based (qedx_info_ptr), 2 7 2 header, /* allows use of like to build automatic version */ 2 8 3 version character (8), 2 9 3 editor_name character (72) unaligned, 2 10 3 buffer_io entry (pointer, bit (1) aligned), /* procedure invoked to read/write an editor buffer */ 2 11 3 flags, 2 12 4 no_rw_path bit (1) unaligned, /* ON => no r/w may use a pathname and R/W are illegal */ 2 13 4 query_if_modified bit (1) unaligned, /* ON => query on exit if modified buffers exist */ 2 14 4 caller_does_io bit (1) unaligned, /* ON => caller does actual work of read/write requests */ 2 15 4 quit_forced bit (1) unaligned, /* set ON => user used Q or asked to punt modified buffers */ 2 16 4 buffers_truncated bit (1) unaligned, /* set ON => some editing lost when written */ 2 17 4 pad bit (29) unaligned, 2 18 3 n_buffers fixed binary, /* # of buffers supplied by caller */ 2 19 2 buffers (qedx_info_n_buffers refer (qedx_info.n_buffers)), 2 20 3 buffer_name character (16) unaligned, /* name of the buffer */ 2 21 3 buffer_pathname character (256) unaligned, /* initial default pathname of buffer */ 2 22 3 region_ptr pointer, /* -> caller's optional region */ 2 23 3 region_max_lth fixed binary (21), /* # of characters which will fit in caller's region */ 2 24 3 region_initial_lth fixed binary (21), /* # of characters in caller's region for initial read */ 2 25 3 region_final_lth fixed binary (21), /* set to # of characters placed in caller's region on exit */ 2 26 3 flags, 2 27 4 read_write_region bit (1) unaligned, /* ON => use caller's region as default for read/write; 2 28* OFF => use file specified by pathname as default */ 2 29 4 locked_pathname bit (1) unaligned, /* ON => read/write will never change default pathname or 2 30* prevent qedx from trusting the default path; 2 31* OFF => read with pathname sets ^trusted and write with 2 32* pathname changes the default */ 2 33 4 execute_buffer bit (1) unaligned, /* ON => execute it's contents before reading from terminal */ 2 34 /*** following switches apply only when read_write_region is ON ... */ 2 35 4 default_read_ok bit (1) unaligned, /* ON => r without explicit pathname is OK */ 2 36 4 default_write_ok bit (1) unaligned, /* ON => w without explicit pathname is OK */ 2 37 4 auto_write bit (1) unaligned, /* ON => automatically write buffer contents on "q" */ 2 38 4 truncated bit (1) unaligned, /* set ON => edited version is too long for caller's region */ 2 39 4 pad bit (29) unaligned; 2 40 2 41 dcl qedx_info_ptr pointer; 2 42 dcl qedx_info_n_buffers fixed binary; /* needed to allocate above structure */ 2 43 2 44 dcl QEDX_INFO_VERSION_1 character (8) static options (constant) initial ("qxi_01.1"); 2 45 2 46 /* END INCLUDE FILE ... qedx_info.incl.pl1 */ 2152 2153 3 1 /* BEGIN INCLUDE FILE ... qedx_buffer_io_info.incl.pl1 */ 3 2 /* Created: January 1983 by G. Palter */ 3 3 3 4 /* Data structure used by qedx_ to invoke the caller's buffer_io procedure to read/write all or part of an editor buffer 3 5* to the specified "file" */ 3 6 3 7 dcl 1 qedx_buffer_io_info aligned based (qbii_ptr), 3 8 2 version character (8), 3 9 2 editor_name character (72), /* for error messages */ 3 10 2 pathname character (256) unaligned, /* pathname of "file" to be read/written */ 3 11 2 buffer_ptr pointer, /* -> the buffer to write/read */ 3 12 2 buffer_max_lth fixed binary (21), /* read: maximum size of above buffer; write: ignored */ 3 13 2 buffer_lth fixed binary (21), /* read: amount of data read into buffer from the "file"; 3 14* write: amount of data to write into the "file" */ 3 15 2 direction fixed binary, /* whether to read/write */ 3 16 2 flags, 3 17 3 default_pathname bit (1) unaligned, /* ON => pathname above is the default for this buffer */ 3 18 3 pad bit (35) unaligned; 3 19 3 20 dcl qbii_ptr pointer; 3 21 3 22 dcl QEDX_BUFFER_IO_INFO_VERSION_1 character (8) static options (constant) initial ("qbii_001"); 3 23 3 24 dcl (QEDX_READ_FILE initial (1), /* read data from the "file" */ 3 25 QEDX_WRITE_FILE initial (2)) /* write data into the "file" */ 3 26 fixed binary static options (constant); 3 27 3 28 /* END INCLUDE FILE ... qedx_buffer_io_info.incl.pl1 */ 2154 2155 4 1 /* BEGIN INCLUDE FILE ... access_mode_values.incl.pl1 4 2* 4 3* Values for the "access mode" argument so often used in hardcore 4 4* James R. Davis 26 Jan 81 MCR 4844 4 5* Added constants for SM access 4/28/82 Jay Pattin 4 6* Added text strings 03/19/85 Chris Jones 4 7**/ 4 8 4 9 4 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ 4 11 dcl ( 4 12 N_ACCESS init ("000"b), 4 13 R_ACCESS init ("100"b), 4 14 E_ACCESS init ("010"b), 4 15 W_ACCESS init ("001"b), 4 16 RE_ACCESS init ("110"b), 4 17 REW_ACCESS init ("111"b), 4 18 RW_ACCESS init ("101"b), 4 19 S_ACCESS init ("100"b), 4 20 M_ACCESS init ("010"b), 4 21 A_ACCESS init ("001"b), 4 22 SA_ACCESS init ("101"b), 4 23 SM_ACCESS init ("110"b), 4 24 SMA_ACCESS init ("111"b) 4 25 ) bit (3) internal static options (constant); 4 26 4 27 /* The following arrays are meant to be accessed by doing either 1) bin (bit_value) or 4 28* 2) divide (bin_value, 2) to come up with an index into the array. */ 4 29 4 30 dcl SEG_ACCESS_MODE_NAMES (0:7) init ("null", "W", "E", "EW", "R", "RW", "RE", "REW") char (4) internal 4 31 static options (constant); 4 32 4 33 dcl DIR_ACCESS_MODE_NAMES (0:7) init ("null", "A", "M", "MA", "S", "SA", "SM", "SMA") char (4) internal 4 34 static options (constant); 4 35 4 36 dcl ( 4 37 N_ACCESS_BIN init (00000b), 4 38 R_ACCESS_BIN init (01000b), 4 39 E_ACCESS_BIN init (00100b), 4 40 W_ACCESS_BIN init (00010b), 4 41 RW_ACCESS_BIN init (01010b), 4 42 RE_ACCESS_BIN init (01100b), 4 43 REW_ACCESS_BIN init (01110b), 4 44 S_ACCESS_BIN init (01000b), 4 45 M_ACCESS_BIN init (00010b), 4 46 A_ACCESS_BIN init (00001b), 4 47 SA_ACCESS_BIN init (01001b), 4 48 SM_ACCESS_BIN init (01010b), 4 49 SMA_ACCESS_BIN init (01011b) 4 50 ) fixed bin (5) internal static options (constant); 4 51 4 52 /* END INCLUDE FILE ... access_mode_values.incl.pl1 */ 2156 2157 5 1 /* BEGIN INCLUDE FILE sub_err_flags.incl.pl1 BIM 11/81 */ 5 2 /* format: style3 */ 5 3 5 4 /* These constants are to be used for the flags argument of sub_err_ */ 5 5 /* They are just "string (condition_info_header.action_flags)" */ 5 6 5 7 declare ( 5 8 ACTION_CAN_RESTART init (""b), 5 9 ACTION_CANT_RESTART init ("1"b), 5 10 ACTION_DEFAULT_RESTART 5 11 init ("01"b), 5 12 ACTION_QUIET_RESTART 5 13 init ("001"b), 5 14 ACTION_SUPPORT_SIGNAL 5 15 init ("0001"b) 5 16 ) bit (36) aligned internal static options (constant); 5 17 5 18 /* End include file */ 2158 2159 6 1 /* BEGIN INCLUDE FILE ... terminate_file.incl.pl1 */ 6 2 /* format: style2,^inddcls,idind32 */ 6 3 6 4 declare 1 terminate_file_switches based, 6 5 2 truncate bit (1) unaligned, 6 6 2 set_bc bit (1) unaligned, 6 7 2 terminate bit (1) unaligned, 6 8 2 force_write bit (1) unaligned, 6 9 2 delete bit (1) unaligned; 6 10 6 11 declare TERM_FILE_TRUNC bit (1) internal static options (constant) initial ("1"b); 6 12 declare TERM_FILE_BC bit (2) internal static options (constant) initial ("01"b); 6 13 declare TERM_FILE_TRUNC_BC bit (2) internal static options (constant) initial ("11"b); 6 14 declare TERM_FILE_TERM bit (3) internal static options (constant) initial ("001"b); 6 15 declare TERM_FILE_TRUNC_BC_TERM bit (3) internal static options (constant) initial ("111"b); 6 16 declare TERM_FILE_FORCE_WRITE bit (4) internal static options (constant) initial ("0001"b); 6 17 declare TERM_FILE_DELETE bit (5) internal static options (constant) initial ("00001"b); 6 18 6 19 /* END INCLUDE FILE ... terminate_file.incl.pl1 */ 2160 2161 2162 end qedx_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0803.9 qedx_.pl1 >spec>install>1111>qedx_.pl1 2150 1 05/04/83 1117.9 qedx_internal_data.incl.pl1 >ldd>include>qedx_internal_data.incl.pl1 2152 2 05/04/83 1118.0 qedx_info.incl.pl1 >ldd>include>qedx_info.incl.pl1 2154 3 05/04/83 1118.0 qedx_buffer_io_info.incl.pl1 >ldd>include>qedx_buffer_io_info.incl.pl1 2156 4 04/11/85 1452.6 access_mode_values.incl.pl1 >ldd>include>access_mode_values.incl.pl1 2158 5 04/16/82 0958.1 sub_err_flags.incl.pl1 >ldd>include>sub_err_flags.incl.pl1 2160 6 04/06/83 1239.4 terminate_file.incl.pl1 >ldd>include>terminate_file.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. ACTION_CANT_RESTART 000316 constant bit(36) initial dcl 5-7 set ref 311* 317* 333* CHASE 000335 constant fixed bin(1,0) initial dcl 161 set ref 1453* 1652* COMMANDS 000232 constant char(19) initial packed unaligned dcl 133 ref 454 EC 014765 constant char(1) initial packed unaligned dcl 163 ref 827 846 1186 MODIFIED_BUFFERS_EXPLANATION 000165 constant char(104) initial packed unaligned dcl 140 set ref 554* 557* NL 014764 constant char(1) initial packed unaligned dcl 166 ref 388 450 533 535 1100 1128 1134 1139 1201 1208 1776 1794 1824 1831 1912 P_code parameter fixed bin(35,0) dcl 53 set ref 48 254* 277* 289* 302* 313* 320* 335* 347* 379* 623* 625* P_qedx_info_ptr parameter pointer dcl 52 ref 48 251 QEDX_ 000222 constant char(32) initial packed unaligned dcl 136 set ref 311* 317* 333* QEDX_BUFFER_IO_INFO_VERSION_1 000046 constant char(8) initial packed unaligned dcl 3-22 ref 1425 1608 QEDX_INFO_VERSION_0 000220 constant char(8) initial packed unaligned dcl 138 ref 253 QEDX_INFO_VERSION_1 000050 constant char(8) initial packed unaligned dcl 2-44 ref 253 351 QEDX_READ_FILE constant fixed bin(17,0) initial dcl 3-24 ref 1430 QEDX_WRITE_FILE constant fixed bin(17,0) initial dcl 3-24 ref 1613 RW_ACCESS 000044 constant bit(3) initial packed unaligned dcl 4-11 set ref 1639* R_ACCESS 000316 constant bit(3) initial packed unaligned dcl 4-11 set ref 1450* TERM_FILE_DELETE 000041 constant bit(5) initial packed unaligned dcl 6-17 set ref 1643* TERM_FILE_TERM 000043 constant bit(3) initial packed unaligned dcl 6-14 set ref 1544* TERM_FILE_TRUNC_BC_TERM 000042 constant bit(3) initial packed unaligned dcl 6-15 set ref 1677* TRUNCATED_BUFFERS_EXPLANATION 000134 constant char(100) initial packed unaligned dcl 144 set ref 598* 601* TRUSTED_PATHNAMES_EXPLANATION 000052 constant char(198) initial packed unaligned dcl 148 set ref 1488* 1491* 1590* 1593* a_real_file parameter bit(1) dcl 1558 in procedure "perform_write" ref 1555 1625 1717 1722 a_real_file parameter bit(1) dcl 1404 in procedure "perform_read" ref 1401 1442 1529 1534 1544 a_real_file parameter bit(1) dcl 1340 in procedure "determine_file" set ref 1336 1364* 1370* 1386 a_real_file 000100 automatic bit(1) dcl 55 in procedure "qedx_" set ref 324* 339* 346* 475* 481* 504* 507* a_string based char dcl 159 set ref 829 846 846 846 846 912 927* 927 940* 940 953* 953 967* 967 981* 981 1037* 1081* 1081 1087* 1087 1088* 1088 1100 1134 1139 1208 1360 1360 1365 1510* 1510 1744* 1744 1745* 1745 1750* 1750 1776 1794 1824 1831 1920 1928* 1928 1943* 1943 1957* 1957 1974* 1974 2059 2059 2059 2059 2106 2106 2106 2106 2128* 2128 addr builtin function dcl 234 ref 247 248 261 274 274 298 369 374 575 617 656 656 660 660 662 662 1229 1229 1347 1422 1433 1433 1575 1617 1617 2059 2059 2059 2059 2106 2106 2106 2106 afe parameter fixed bin(21,0) dcl 1908 set ref 1905 1928 1929* 1929 1943 1945* 1945 1957 1959* 1959 1974 1976* 1976 afli parameter fixed bin(21,0) dcl 1850 ref 1847 1855 1855 1857 afp parameter pointer dcl 1908 ref 1905 1928 1943 1957 1974 ale parameter fixed bin(21,0) dcl 1763 ref 1760 1767 1767 1769 ali parameter fixed bin(21,0) dcl 1816 ref 1813 1818 1819 1819 1821 alle parameter fixed bin(21,0) dcl 1850 ref 1847 1859 1859 1861 auto_write 111(05) based bit(1) level 3 packed packed unaligned dcl 114 ref 581 b based structure level 1 dcl 1-64 b0_bp 000102 automatic pointer dcl 56 set ref 274* 281* b0_ifp 000104 automatic pointer dcl 57 set ref 274* bce_check_abort 000054 constant entry external dcl 186 ref 409 893 1233 1241 1247 bce_data$console_put_chars 000044 external static entry variable dcl 181 set ref 247 bce_data$put_chars 000046 external static entry variable dcl 182 set ref 246 248 bce_query$yes_no 000056 constant entry external dcl 187 ref 557 601 1491 1593 bootload_fs_$flush_sys 000060 constant entry external dcl 188 ref 1684 bootload_fs_$get_ptr 000062 constant entry external dcl 189 ref 1470 bootload_fs_$put_ptr 000064 constant entry external dcl 190 ref 1666 bp 001620 automatic pointer dcl 1-86 set ref 300* 301 306* 307 326 341 351 353 552 569 576* 577* 592* 603* 604* 677 747 776 776 776 930 943 956 969 984 1240 1301 1302 1303 1304 1305 1306 1320* 1321 1323 1324 1325 1326 1327 1328 1345 1347 1361 1361 1361 1370 1372 1380 1386 1386 1420 1422 1435 1435 1435 1447 1447 1447 1462 1462 1462 1473 1473 1473 1487 1523 1524 1525 1529 1532 1533 1534 1535 1536 1540 1540 1541 1573 1575 1589 1594 1619 1619 1619 1634 1634 1634 1645 1645 1645 1659 1659 1659 1669 1669 1669 1680 1680 1680 1697 1711 1712 1713 1713 1717 1720 1721 1722 1723 1724 1727 1727 1930 1946 1960 1977 2075 2076 2076 2077 2077 2117 2117 2117 2117 2122 2122 2124 2135 2135 2135 2135 2141 2141 2143 buffer_idx 000106 automatic fixed bin(17,0) dcl 58 set ref 297* 298 307* 373* 374* 574* 575* 616* 617* buffer_io 24 based entry variable level 3 dcl 2-6 ref 1433 1617 buffer_lth 127 000362 automatic fixed bin(21,0) level 2 dcl 93 set ref 1439 1612* buffer_max_lth 126 000362 automatic fixed bin(21,0) level 2 dcl 93 set ref 1429* buffer_name based char(16) level 2 packed packed unaligned dcl 114 set ref 300* 311* 317* 333* 376 377* 382 382 384 576* buffer_pathname 4 based char(256) level 2 packed packed unaligned dcl 114 ref 325 332 340 buffer_ptr 124 000362 automatic pointer level 2 dcl 93 set ref 1428* 1611* buffers 32 based structure array level 2 dcl 2-6 set ref 298 374 575 617 1347 1422 1575 buffers_truncated 30(04) based bit(1) level 4 packed packed unaligned dcl 2-6 set ref 614* 618* 623 c based char(1) array level 2 in structure "f" packed packed unaligned dcl 156 in procedure "qedx_" set ref 656 656 660 660 662 662 1128 1201 1229 1229 c based char(1) array level 2 in structure "t" packed packed unaligned dcl 153 in procedure "qedx_" ref 448 520 533 535 818 839 869 869 934 967 973 973 1173 1181 1184 1187 1187 1349 1912 1913 1934 1957 1969 caller_does_io 30(02) based bit(1) level 4 packed packed unaligned dcl 2-6 ref 285 316 1424 1529 1544 1602 1717 callers_idx 120 based fixed bin(17,0) level 2 dcl 1-64 set ref 307* 1345 1347 1420 1422 1573 1575 callers_io_region_ptr 000110 automatic pointer dcl 59 set ref 269* 286* 1283 1284* 1285* 1428 1438 1606* 1611 ch 000112 automatic char(1) packed unaligned dcl 60 set ref 448* 450 454 458* 1173* 1174 1174 1174 1198 1224 1236 1244 1252 check_entryname_ 000066 constant entry external dcl 191 ref 1641 cht 000113 automatic char(1) packed unaligned dcl 61 set ref 1184* 1185 1186 1187 cleanup 001574 stack reference condition dcl 179 ref 272 code 000114 automatic fixed bin(35,0) dcl 62 in procedure "qedx_" set ref 274* 275 276* 286* 287 288* 416* 418 419 423 425 425* 428* 430 431 433 434* 436 442 656* 660* 662* 753* 773* 888* 900 1027* 1028 1043* 1213* 1215 1217 1219 1229* code 002075 automatic fixed bin(35,0) dcl 1568 in procedure "perform_write" set ref 1630* 1631 1632 1632* 1633* 1634 1639* 1641* 1642 1644* 1650 1651 1656* 1658* 1659 1659 1659 1666* 1667 1668* 1677* 1678 1679* code 001771 automatic fixed bin(35,0) dcl 1413 in procedure "perform_read" set ref 1444* 1445 1446* 1450* 1451 1452 1457* 1460* 1462 1462 1470* 1471 1472* com_err_ 000070 constant entry external dcl 192 ref 276 288 377 1360 1446 1454 1457 1460 1472 1633 1644 1653 1656 1658 1668 1679 1697 command_index 001572 automatic fixed bin(17,0) dcl 134 set ref 454* 456 command_query_$yes_no 000072 constant entry external dcl 193 ref 554 598 1488 1590 component 001756 automatic char(32) packed unaligned dcl 1410 set ref 1444* 1450* 1454* 1454* 1457* 1457* 1460* 1460* 1529* created_file 002072 automatic bit(1) dcl 1566 set ref 1639* 1640 cu_$cp 000074 constant entry external dcl 194 ref 1043 curbuf 000115 automatic char(16) initial packed unaligned dcl 63 set ref 63* 1113* 1321* de 112 based fixed bin(21,0) level 2 dcl 1-64 set ref 1097* 1302* 1324 default_is_region 121(02) based bit(1) level 3 packed packed unaligned dcl 1-64 set ref 1370 1372 1380 1534* 1722* default_locked 121(03) based bit(1) level 3 packed packed unaligned dcl 1-64 set ref 351* 353* 776 1104 1361 1435 1447 1462 1473 1523 1619 1634 1645 1659 1669 1680 1711 default_path 10 based char(256) level 2 dcl 1-64 set ref 776 1104 1361 1386 1386 1435 1447 1462 1473 1529* 1532* 1533* 1540 1619 1634 1645 1659 1669 1680 1717* 1720* 1721* 1727 default_pathname 131 000362 automatic bit(1) level 3 packed packed unaligned dcl 93 set ref 1432* 1615* default_read_ok 111(03) based bit(1) level 3 packed packed unaligned dcl 114 ref 1372 default_untrusted 121(04) based bit(1) level 3 packed packed unaligned dcl 1-64 set ref 776* 1104* 1361* 1435* 1447* 1462* 1473* 1487 1524* 1535* 1540* 1589 1594* 1619* 1634* 1645* 1659* 1669* 1680* 1712* 1724* 1727* default_was_region 121(01) based bit(1) level 3 packed packed unaligned dcl 1-64 set ref 326* 341* default_write_ok 111(04) based bit(1) level 3 packed packed unaligned dcl 114 ref 1372 delim 000121 automatic char(1) packed unaligned dcl 64 set ref 818* 827 1181* 1185 direction 130 000362 automatic fixed bin(17,0) level 2 dcl 93 set ref 1430* 1613* dirname 001674 automatic char(168) packed unaligned dcl 1409 in procedure "perform_read" set ref 1444* 1450* 1453* 1454* 1454* 1457* 1457* 1460* 1460* 1529* dirname 002006 automatic char(168) packed unaligned dcl 1564 in procedure "perform_write" set ref 1630* 1639* 1644* 1644* 1652* 1653* 1653* 1656* 1656* 1658* 1658* 1679* 1679* 1717* divide builtin function dcl 234 ref 1467 dp 6 based pointer level 2 dcl 1-64 set ref 1073 1301* 1323 editor_area_ptr 22 based pointer level 2 dcl 1-6 set ref 264* editor_name 2 000362 automatic char(72) level 2 in structure "local_qbii" dcl 93 in procedure "qedx_" set ref 1426* 1609* editor_name based char(72) level 2 in structure "qid" packed packed unaligned dcl 1-6 in procedure "qedx_" set ref 263* 276* 286* 288* 377* 458* 554* 598* 895* 1046* 1077* 1284* 1360* 1426 1446* 1454* 1457* 1460* 1472* 1488* 1590* 1609 1633* 1644* 1653* 1656* 1658* 1668* 1679* 1697* 2042* 2046* 2049* editor_name 2 based char(72) level 3 in structure "qedx_info" packed packed unaligned dcl 2-6 in procedure "qedx_" ref 263 edx_util_$edx_cleanup 000076 constant entry external dcl 195 ref 1288 edx_util_$edx_init 000100 constant entry external dcl 196 ref 274 edx_util_$end_buffer 000102 constant entry external dcl 197 ref 434 1027 edx_util_$get_buffer 000104 constant entry external dcl 198 ref 1056 1070 edx_util_$list_buffers 000106 constant entry external dcl 199 ref 1113 edx_util_$list_modified_buffers 000110 constant entry external dcl 200 ref 552 edx_util_$list_single_buffer 000112 constant entry external dcl 201 ref 592 edx_util_$locate_buffer 000114 constant entry external dcl 202 ref 300 576 603 edx_util_$modified_buffers 000116 constant entry external dcl 203 ref 544 edx_util_$prime 000120 constant entry external dcl 204 ref 390 edx_util_$read_ptr 000122 constant entry external dcl 205 ref 404 1915 edx_util_$resetread 000124 constant entry external dcl 206 ref 443 edx_util_data_ptr 26 based pointer level 2 dcl 1-6 set ref 269* ename 002060 automatic char(32) packed unaligned dcl 1565 in procedure "perform_write" set ref 1630* 1639* 1641* 1644* 1644* 1652* 1653* 1653* 1656* 1656* 1658* 1658* 1679* 1679* 1717* ename 001746 automatic char(32) packed unaligned dcl 1410 in procedure "perform_read" set ref 1444* 1450* 1453* 1454* 1454* 1457* 1457* 1460* 1460* 1529* error_sw 000122 automatic pointer dcl 65 set ref 243* 247* 551* 552* 589* error_table_$archive_component_modification 000010 external static fixed bin(35,0) dcl 170 ref 1632 1634 error_table_$archive_pathname 000012 external static fixed bin(35,0) dcl 170 ref 1632 error_table_$bigarg 000014 external static fixed bin(35,0) dcl 170 set ref 377* error_table_$dirseg 000016 external static fixed bin(35,0) dcl 170 ref 1452 1651 error_table_$fatal_error 000020 external static fixed bin(35,0) dcl 170 ref 277 289 302 313 320 335 347 379 error_table_$inconsistent 000022 external static fixed bin(35,0) dcl 170 set ref 311* 317* 333* error_table_$moderr 000024 external static fixed bin(35,0) dcl 170 ref 1462 1659 error_table_$no_r_permission 000026 external static fixed bin(35,0) dcl 170 ref 1462 1659 error_table_$no_w_permission 000030 external static fixed bin(35,0) dcl 170 ref 1659 error_table_$pathlong 000032 external static fixed bin(35,0) dcl 170 set ref 1360* error_table_$recoverable_error 000034 external static fixed bin(35,0) dcl 170 ref 623 error_table_$unimplemented_version 000036 external static fixed bin(35,0) dcl 170 ref 254 execute_buffer 111(02) based bit(1) level 3 packed packed unaligned dcl 114 ref 375 expand_pathname_ 000126 constant entry external dcl 207 ref 1630 expand_pathname_$component 000130 constant entry external dcl 208 ref 1444 explicit_pathname parameter bit(1) dcl 1342 in procedure "determine_file" set ref 1336 1354* 1369* explicit_pathname parameter bit(1) dcl 1560 in procedure "perform_write" ref 1555 1589 1615 1619 1634 1645 1659 1669 1680 1713 explicit_pathname 000124 automatic bit(1) dcl 66 in procedure "qedx_" set ref 475* 481* 504* 507* explicit_pathname parameter bit(1) dcl 1406 in procedure "perform_read" ref 1401 1432 1435 1447 1462 1473 1487 1525 f based structure level 1 dcl 156 fe 000125 automatic fixed bin(21,0) dcl 67 set ref 1075* 1076 1081 1081 1085* 1086 1090 1091 1092 1096 1100 1101 file_bc 001773 automatic fixed bin(24,0) dcl 1414 in procedure "perform_read" set ref 1450* 1453* 1454 1467 file_bc 002077 automatic fixed bin(24,0) dcl 1569 in procedure "perform_write" set ref 1652* 1653 file_lth 002100 automatic fixed bin(21,0) dcl 1570 in procedure "perform_write" set ref 1579* 1583* 1612 1666* 1677 1692 1693* 1693 1742 1743 1750 1750 file_lth 001774 automatic fixed bin(21,0) dcl 1415 in procedure "perform_read" set ref 1439* 1467* 1470* 1481* 1505* 1508 1510 1510 1513* 1517* file_ptr 002004 automatic pointer dcl 1563 in procedure "perform_write" set ref 1639* 1643* 1666* 1674* 1677* file_ptr 001672 automatic pointer dcl 1408 in procedure "perform_read" set ref 1438* 1450* 1470* 1480* 1510 1544* flags 32 based structure level 2 in structure "qid" dcl 1-6 in procedure "qedx_" set ref 267* flags 111 based structure level 2 in structure "the_buffer" dcl 114 in procedure "qedx_" flags 131 000362 automatic structure level 2 in structure "local_qbii" dcl 93 in procedure "qedx_" set ref 1431* 1614* flags 30 based structure level 3 in structure "qedx_info" dcl 2-6 in procedure "qedx_" set ref 267 flags 121 based structure level 2 in structure "b" dcl 1-64 in procedure "qedx_" fle 000126 automatic fixed bin(21,0) dcl 68 set ref 345* 416* 428* 479* 728 728* 733 739* 740 1504 1866* 1872 1872 1874 1890 1890* 2115 2115 2115* 2115 2138 2138 2138* 2138 fli 000127 automatic fixed bin(21,0) dcl 69 set ref 416* 428* 582* 654 655 656 656 658 659 660 660 660 698 700 701 705 707* 736* 739 885 888* 904 905* 905 909 989* 989 993* 994* 994 998 1007 1009 1010 1011 1011 1074 1075 1081 1084 1085 1087 1087 1087 1088 1199 1201 1206 1206 1206* 1207 1208 1208 1212 1213* 1221* 1226 1229 1229 1232* 1237 1239* 1246* 1250 1577 1579 1583 1706 1706 1706 1742 1744 1750 1865* 1869 1869 1871 1880 1880 1884 1888 1888* 2073 2073* 2073 2114 2114 2114* 2114 2137 2137 2137* 2137 flsw 000130 automatic bit(1) packed unaligned dcl 70 set ref 418* 420* 424* 450 479 527 728 736 1259 1269 1864 fp 000132 automatic pointer dcl 71 set ref 1073* 1081 1087 1088 1100 ft 111 based fixed bin(21,0) level 2 dcl 1-64 set ref 1098* 1304* 1326 gap 002167 automatic fixed bin(21,0) dcl 2100 set ref 2105* 2106* 2106 2106 2106* 2108 2119 2120 2127* 2128 2128 2139 2140 gap_index parameter fixed bin(21,0) dcl 2096 ref 2091 2102 2102 2104 2105 2106 2106 2108 2110 2111 2112 2113 2114 2115 2117 2127 2130 2131 2132 2133 2135 2137 2138 get_addr_ 000132 constant entry external dcl 209 ref 416 425 428 get_system_free_area_ 000134 constant entry external dcl 212 ref 264 get_temp_segment_ 000136 constant entry external dcl 213 ref 286 have_truncated_buffers 000134 automatic bit(1) dcl 72 set ref 572* 588 590* 597 hcs_$status_minf 000140 constant entry external dcl 214 ref 1453 1652 header based structure level 2 dcl 2-6 i 000135 automatic fixed bin(21,0) dcl 73 in procedure "qedx_" set ref 655* 656* 659* 826* 845 888* 1090* 1091* 1092* 1093* 1094* 1094 1097 1098 1131* 1132 1133 1133 1133* 1134 1134 1134 1139 1139 1142* 1146* 1149* 1149 1182* 1183 1194 1213* i 002120 automatic fixed bin(21,0) dcl 1765 in procedure "last_line" set ref 1776* 1778 1794* 1795 1800 ife 000136 automatic fixed bin(21,0) dcl 74 set ref 345 416* 425* 428* 479 498* 583 728 756 1141 1170* 1302 1324* 1380 1502 1706 1706 1706 1706 1818 1826 1831 1833 1838 1839 1876 1880 1888 1889 1890 1891 2035 2035 2037 2038 2056 2058 2059 2059 2080* 2124 2143 ifp 000140 automatic pointer dcl 75 set ref 416* 425* 428* 656 656 660 660 662 662 759* 888* 927 940 953 953 967 981 1081 1087 1088 1128 1134 1139 1201 1208 1213* 1229 1229 1301 1323* 1510 1744 1745 1750 1776 1794 1824 1831 2059 2059 2059 2059 2106 2106 2106 2106 2128 2128 ift 000142 automatic fixed bin(21,0) dcl 76 set ref 416* 425* 428* 654 659 662 662 662 676* 700 702* 706* 707 756 888* 920* 920 924 998* 998 1074 1085 1088 1088 1088 1133 1133 1134 1141 1142 1200 1200 1206 1206 1213* 1238* 1239 1304 1326* 1380 1502 1507 1508* 1508 1510 1514* 1577 1583 1706 1706 1706 1743 1745 1767 1774 1776 1776 1784 1804 1819 1819 1826 1827 1855 1855 1859 1859 1869 1869 1872 1872 1876 2035 2038 2056 2058 2059 2059 2059 2059 2065 2066 2067 2068 2069 2071 2072 2073 2075 2081* 2102 2106 2106 2108 2119* 2119 2127 2128 2129 2130 2131 2132 2133 2135 2137 2138 2140* 2140 ignore_result 000143 automatic bit(1) dcl 77 set ref 584* il 000144 automatic fixed bin(21,0) dcl 78 set ref 845* 888* 903* 1194* 1213* 1216* ilb 000145 automatic fixed bin(21,0) dcl 79 set ref 416* 425* 428* 654 658 659 660 696 698* 705* 756 759* 767* 888* 891* 891 927 929* 929 940 942* 942 953 955* 955 967 968* 968 981 983* 983 1074 1084 1085 1087 1087 1088 1102 1133 1139 1200 1206 1213* 1303 1325* 1380 1502 1577 1583 1706 1706 1706 1742 1767 1767 1778 1780 1793 1793 1804 1819 1822 1824 1855 1859 1869 1872 1876 1888 1889 1890 1891 2035 2038 2050* 2102 2104 2105 2110 2111 2112 2113 2114 2115 2117 2120* 2120 2122 2122 2128 2129 2139* 2139 2141 2141 ilb_offset 001571 automatic fixed bin(21,0) dcl 131 set ref 823* 891 892* 997* 999* iline 000146 automatic char(512) packed unaligned dcl 80 set ref 369 370* 376 382* 388* 404 404 534 1915 1915 index builtin function dcl 234 ref 454 839 934 1100 1134 1139 1208 1776 1794 1824 1831 1934 1969 initiate_file_$component 000142 constant entry external dcl 215 ref 1450 initiate_file_$create 000144 constant entry external dcl 216 ref 1639 intsw 000346 automatic bit(1) packed unaligned dcl 81 set ref 408* 410 414* 819* 894 896* 1234 1242 1248 2005* ioa_ 000146 constant entry external dcl 217 ref 437 458 529 536 834 895 1030 1046 1077 1151 1177 1245 1252 1356 1376 1382 1390 1877 1881 1885 2042 2046 2049 ioa_$ioa_switch 000150 constant entry external dcl 218 ref 551 589 iox_$modes 000152 constant entry external dcl 219 ref 753 773 iox_$put_chars 000154 constant entry external dcl 220 ref 241 iox_$user_io 000052 external static pointer dcl 184 set ref 243 753* 773* iox_$user_output 000050 external static pointer dcl 183 ref 242 issue_truncation_warning parameter bit(1) dcl 1561 ref 1555 1697 j 000347 automatic fixed bin(21,0) dcl 82 set ref 844* 845 846 846 846 846 854 911 916 1128* 1130* 1148* 1148 1151* 1199* 1200 1200 1200* 1201 1201* 1226* 1229* je 000350 automatic fixed bin(21,0) dcl 83 set ref 884* 912 916 918 925 927 927 929 k 000351 automatic fixed bin(21,0) dcl 84 set ref 829* 833 839 844 860 862 867 869 869 869 873 878 882 884 912* 915 934 937 939 940 940 942 959 965 967 967 967 968 970 973 973 980 981 981 983 985 1134* 1139* 1141 1146 1149 1920* 1924 1925* 1926 1928 1928 1929 1930 1934 1939 1943 1943 1945 1946 1947 1952 1956* 1957 1957 1957 1959 1960 1961 1969 1973* 1974 1974 1976 1977 1978 ka 000352 automatic fixed bin(21,0) dcl 85 set ref 963* 967 970 976* 1937* 1947 1950* 1952 1957 1961 1966* kx 000353 automatic fixed bin(21,0) dcl 86 set ref 839* 840 934* 935 1934* 1935 1969* 1971 1984 l 001662 automatic fixed bin(21,0) dcl 1343 in procedure "determine_file" set ref 1351* 1353 1359 1360 1360 1365 l 000354 automatic fixed bin(21,0) dcl 87 in procedure "qedx_" set ref 904* 905 905 911* 912 912 918 925 927 927 927 929 934 940 959* 959 967 967 970* 970 973 973 981 985* 985 1197* 1201* 1201 1204* 1204 1245* lb 110 based fixed bin(21,0) level 2 dcl 1-64 set ref 1096* 1303* 1325 le 114 based fixed bin(21,0) level 2 in structure "b" dcl 1-64 in procedure "qedx_" set ref 1100* 1101 1101* 1102 1102* 1306* 1328 le 000355 automatic fixed bin(21,0) dcl 88 in procedure "qedx_" set ref 416* 425* 649* 672* 728 743* 816* 1022* 1067* 1124* 1208* 1210 1210* 1212* 1212 1213* 1221 1226 1232 1238 1246 1262* 1272* 1306 1328* 1507* 1513 1515* 1767* 1769* 1772 1824* 1826 1831* 1833 1833* 1835* 1835 1839* 2068 2068* 2068 2111 2111 2111* 2111 2131 2131 2131* 2131 length builtin function dcl 234 ref 376 376 376 382 382 384 384 404 404 1359 1915 1915 li 000356 automatic fixed bin(21,0) dcl 89 in procedure "qedx_" set ref 416* 425* 649* 672* 736 743* 768 769* 816* 1013 1067* 1124* 1262* 1272* 1305 1327* 1516 1518* 1772* 1774 1776 1780* 1784* 1789 1790* 1793 1793* 1794 1796* 1800* 1800 1804 1804* 1806* 1806 1819* 1821* 1822 1824 1824 1827* 1831 1831 1835 1838* 2069 2069* 2069 2110 2110 2110* 2110 2130 2130 2130* 2130 li 113 based fixed bin(21,0) level 2 in structure "b" dcl 1-64 in procedure "qedx_" set ref 1099* 1305* 1327 lle 000357 automatic fixed bin(21,0) dcl 90 set ref 425* 428* 583* 654 655 659 662 666* 696 697* 702 706 888* 998 1010 1011 1011 1014* 1074 1075 1085 1088 1088 1127* 1128 1132 1134 1146 1207 1208 1210 1250 1254* 1263* 1273* 1577 1579 1583 1706 1706 1706 1743 1866* 1872* 1874* 1880 1884 1891 1891* 2066 2066* 2066 2113 2113 2113* 2113 2133 2133 2133* 2133 lli 000360 automatic fixed bin(21,0) dcl 91 set ref 425* 428* 1865* 1869* 1871* 1889 1889* 2067 2067* 2067 2112 2112 2112* 2112 2132 2132 2132* 2132 llsw 000361 automatic bit(1) packed unaligned dcl 92 set ref 418* 421* 424* 1868 local_qbii 000362 automatic structure level 1 dcl 93 set ref 1433 1433 1617 1617 local_qid 000514 automatic structure level 1 dcl 94 set ref 261 locked_pathname 111(01) based bit(1) level 3 packed packed unaligned dcl 114 ref 351 353 me 001014 automatic fixed bin(21,0) dcl 95 set ref 888* 901 993 1213* 2072 2072* 2072 mi 001015 automatic fixed bin(21,0) dcl 96 set ref 888* 901 904 953 1213* 2071 2071* 2071 min builtin function dcl 234 ref 1011 1011 1094 1481 1693 1742 1743 2054 ml 001016 automatic fixed bin(21,0) dcl 97 set ref 901* 916 918 920 921* 951 952 953 953 955 989 997 998 999 modified 121 based bit(1) level 3 packed packed unaligned dcl 1-64 set ref 677* 747* 930* 943* 956* 969* 984* 1103* 1240* 1525* 1536* 1541* 1713* 1713 1723* 1930* 1946* 1960* 1977* mrl_ 000156 constant entry external dcl 221 ref 2059 2106 n_buffers 31 based fixed bin(17,0) level 3 dcl 2-6 ref 297 373 574 616 name based char(16) level 2 dcl 1-64 set ref 552 569 1321 1697* new_fe 002154 automatic fixed bin(21,0) dcl 2031 set ref 2037* 2038 2039 2054* 2054 2056 2080 new_ft 002155 automatic fixed bin(21,0) dcl 2031 set ref 2056* 2059 2059 2065 2081 new_modes 001017 automatic char(256) packed unaligned dcl 98 set ref 752* 753* 772* 773* no_rw_path 32 based bit(1) level 3 packed packed unaligned dcl 1-6 set ref 1355 null builtin function dcl 234 ref 269 301 310 311 311 317 317 333 333 1058 1072 1283 1285 1345 1372 1420 1573 offset_action 002166 automatic fixed bin(21,0) dcl 2098 in procedure "open_gap" set ref 2108* 2110 2111 2112 2113 2114 2115 2117 2129* 2130 2131 2132 2133 2135 2137 2138 offset_action 002156 automatic fixed bin(21,0) dcl 2033 in procedure "promote" set ref 2065* 2066 2067 2068 2069 2071 2072 2073 2076 2077 old_modes 001117 automatic char(256) packed unaligned dcl 99 set ref 753* 773* output_routine 001220 automatic entry variable dcl 100 set ref 241* 246* 656 660 662 1229 output_sw 001224 automatic pointer dcl 101 set ref 242* 248* 592* 656* 660* 662* 1113* 1229* p_bp parameter pointer dcl 1318 ref 1315 1320 p_file_ptr parameter pointer dcl 1738 ref 1735 1744 1745 1750 part1_lth 002110 automatic fixed bin(21,0) dcl 1739 set ref 1742* 1743 1744 1744 1745 part2_lth 002111 automatic fixed bin(21,0) dcl 1739 set ref 1743* 1745 1745 1745 pathname 24 000362 automatic char(256) level 2 packed packed unaligned dcl 93 set ref 1427* 1610* pathname_ 000160 constant entry external dcl 222 ref 1644 1644 1653 1653 1656 1656 1658 1658 1679 1679 1717 pathname_$component 000162 constant entry external dcl 223 ref 1454 1454 1457 1457 1460 1460 1529 pfs 001226 automatic fixed bin(35,0) initial dcl 102 set ref 102* pi_label 001230 automatic label variable dcl 103 set ref 455* 501* 652* 758* 760* 814* 1040* 1227* 2002 2041 2046 2050 pi_sw 001234 automatic bit(1) packed unaligned dcl 104 set ref 362* 502* 510* 653* 665* 1042* 1044* 1228* 1231* 2000 2001* process_type 001235 automatic fixed bin(17,0) dcl 105 set ref 547* 549* 550 program_interrupt 001602 stack reference condition dcl 179 ref 364 qedx_buffer_io_info based structure level 1 dcl 3-7 qedx_info based structure level 1 dcl 2-6 qedx_info_ptr 24 based pointer level 2 in structure "qid" dcl 1-6 in procedure "qedx_" set ref 265* qedx_info_ptr 001622 automatic pointer dcl 2-41 in procedure "qedx_" set ref 251* 253 253 263 265 267 285 297 298 316 351 373 374 574 575 612 614 616 617 618 623 623 1347 1422 1424 1433 1529 1544 1575 1602 1617 1717 qfli 002136 automatic fixed bin(21,0) dcl 1853 set ref 1855* 1857* 1865 qid based structure level 1 dcl 1-6 qid_ptr 001616 automatic pointer dcl 1-19 set ref 261* 263 264 265 267 269 269 274* 276 283* 286 288 300* 377 390* 404* 416* 425* 428* 434* 443* 458 544 544* 552* 554 576* 592* 598 603* 888* 895 1027* 1046 1056* 1070* 1077 1113* 1213* 1284 1288* 1290* 1355 1360 1426 1446 1454 1457 1460 1472 1488 1590 1609 1633 1644 1653 1656 1658 1668 1679 1697 1915* 2042 2046 2049 qlle 002137 automatic fixed bin(21,0) dcl 1853 set ref 1859* 1861* 1866 query_if_modified 32(01) based bit(1) level 3 packed packed unaligned dcl 1-6 set ref 544 quit_force_sw 001236 automatic bit(1) packed unaligned dcl 106 set ref 516* 522* 525* 544 558* 564 612 quit_forced 30(03) based bit(1) level 4 packed packed unaligned dcl 2-6 set ref 612* 623 qx_search_file_ 000164 constant entry external dcl 224 ref 888 1213 qx_search_file_$cleanup 000166 constant entry external dcl 227 ref 1290 qx_search_file_$init 000170 constant entry external dcl 228 ref 283 read_ok 001767 automatic bit(1) dcl 1411 set ref 1433* 1434 read_write_region 111 based bit(1) level 3 packed packed unaligned dcl 114 ref 309 579 618 1372 regexp_data_ptr 30 based pointer level 2 dcl 1-6 set ref 269* region_final_lth 110 based fixed bin(21,0) level 2 dcl 114 set ref 327* 587 618 1481 1692* 1697 region_initial_lth 107 based fixed bin(21,0) level 2 dcl 114 ref 327 region_max_lth 106 based fixed bin(21,0) level 2 dcl 114 ref 587 618 1481 1693 1697 region_ptr 104 based pointer level 2 dcl 114 set ref 310 1480 1695* release_temp_segment_ 000172 constant entry external dcl 229 ref 1284 reverse builtin function dcl 234 ref 1776 1794 rtrim builtin function dcl 234 ref 376 382 382 384 saved_current_buffer 001237 automatic char(16) packed unaligned dcl 107 set ref 569* 592* 603* saved_ift 001243 automatic fixed bin(21,0) dcl 108 set ref 924* sdsw 001244 automatic bit(1) packed unaligned dcl 109 set ref 821* 846* 994 1007 search builtin function dcl 234 ref 829 912 1920 split_data 002070 automatic bit(1) dcl 1566 set ref 1578* 1582* 1741 status_code 001772 automatic fixed bin(35,0) dcl 1413 in procedure "perform_read" set ref 1453* 1454 status_code 002076 automatic fixed bin(35,0) dcl 1568 in procedure "perform_write" set ref 1652* 1653 string builtin function dcl 234 set ref 1431* 1614* string_length parameter fixed bin(21,0) dcl 2029 ref 2026 2035 2038 sub_comp_string 001246 automatic char(3) initial dcl 111 set ref 111* 827* 829 839 sub_err_ 000174 constant entry external dcl 230 ref 311 317 333 sub_request_abort_ 001610 stack reference condition dcl 179 ref 366 substr builtin function dcl 234 set ref 370* 382* 388* 534 829 846 846 846 846 912 927* 927 940* 940 953* 953 967* 967 981* 981 1037* 1081* 1081 1087* 1087 1088* 1088 1100 1134 1139 1208 1360 1360 1365 1510* 1510 1744* 1744 1745* 1745 1750* 1750 1776 1794 1824 1831 1920 1928* 1928 1943* 1943 1957* 1957 1974* 1974 2059 2059 2059 2059 2106 2106 2106 2106 2128* 2128 subsw 001245 automatic bit(1) packed unaligned dcl 110 set ref 820* 842 855* 887* 902* 1026 sys_info$max_seg_size 000040 external static fixed bin(19,0) dcl 176 ref 829 846 846 846 846 912 927 927 940 940 953 953 967 967 981 981 1037 1076 1081 1081 1086 1087 1087 1088 1088 1094 1100 1134 1139 1208 1360 1360 1365 1429 1510 1510 1744 1744 1745 1745 1750 1750 1776 1794 1824 1831 1920 1928 1928 1943 1943 1957 1957 1974 1974 2039 2054 2059 2059 2059 2059 2106 2106 2106 2106 2128 2128 sys_info$service_system 000042 external static bit(1) dcl 177 ref 240 364 406 547 554 598 750 771 893 1041 1233 1241 1247 1443 1488 1529 1544 1590 1626 1676 1717 t based structure level 1 dcl 153 tbp 001250 automatic pointer dcl 112 set ref 1056* 1058 1059* 1070* 1072 1073 1096 1097 1098 1099 1100 1101 1101 1102 1102 1103 1104 1104 1104 te 001252 automatic fixed bin(21,0) dcl 113 in procedure "qedx_" set ref 371* 376 382 384* 384 388 390* 404* 413 416* 425* 428* 641 829 860 867 869 1043* 1056* 1070* 1172 1183 1187 1349 1351 1914 1915* 1920 1925 1952 1962 1979 te 116 based fixed bin(21,0) level 2 in structure "b" dcl 1-64 in procedure "qedx_" set ref 2077* 2077 2122* 2124* 2141* 2143* terminate_file_ 000176 constant entry external dcl 231 ref 1544 1643 1677 the_buffer based structure level 1 dcl 114 the_buffer_ptr 001254 automatic pointer dcl 115 set ref 298* 300 309 310 311 317 325 327 327 332 333 340 351 353 374* 375 376 377 382 382 384 575* 576 579 581 587 587 617* 618 618 618 618 1345* 1347* 1372 1372 1372 1372 1420* 1422* 1480 1481 1481 1573* 1575* 1692 1693 1695 1697 1697 the_pathname parameter char(256) packed unaligned dcl 1559 in procedure "perform_write" set ref 1555 1590* 1610 1630* 1633* 1666* 1668* 1720 1721 the_pathname parameter char(256) packed unaligned dcl 1405 in procedure "perform_read" set ref 1401 1427 1444* 1446* 1470* 1472* 1488* 1532 1533 the_pathname 001256 automatic char(256) packed unaligned dcl 116 in procedure "qedx_" set ref 325* 340* 346* 475* 481* 504* 507* the_pathname parameter char(256) packed unaligned dcl 1341 in procedure "determine_file" set ref 1336 1359 1365* 1386* ti 115 based fixed bin(21,0) level 2 in structure "b" dcl 1-64 in procedure "qedx_" set ref 2075 2076* 2076 2117 2117 2117* 2117 2122 2135 2135 2135* 2135 2141 ti 001356 automatic fixed bin(21,0) dcl 117 in procedure "qedx_" set ref 402* 413 416* 425* 428* 448 449* 449 520 523* 523 533 534* 534 534 535 641* 818 825 860 882* 1037 1056* 1070* 1172 1173 1181 1182 1183* 1184 1186* 1186 1187 1187 1187 1187* 1187* 1194 1196* 1196 1349* 1349 1349* 1351 1360 1360 1365 1912 1913 1913* 1913 1914 1918* 1920 1920 1925 1928 1934 1943 1947* 1947 1952 1957 1957 1961* 1961 1962 1969 1974 1978* 1978 1979 tik 001357 automatic fixed bin(21,0) dcl 118 set ref 825* 826 829 829 839 844 854* 862* 862 867 869 869 869 873* 873 878* 878 882 884 tname 001360 automatic char(16) packed unaligned dcl 119 set ref 1056* 1070* tp 001364 automatic pointer dcl 120 set ref 369* 390* 404* 416* 425* 428* 448 520 533 535 818 829 839 846 846 846 846 869 869 888* 912 927 934 940 967 967 973 973 981 1037 1043* 1056* 1070* 1173 1181 1184 1187 1187 1213* 1349 1360 1360 1365 1912 1913 1915* 1920 1928 1934 1943 1957 1957 1969 1974 truncated 111(06) based bit(1) level 3 packed packed unaligned dcl 114 set ref 618* trust_the_pathname 001770 automatic bit(1) packed unaligned dcl 1412 in procedure "perform_read" set ref 1488* 1491* 1492 1497* trust_the_pathname 002074 automatic bit(1) packed unaligned dcl 1567 in procedure "perform_write" set ref 1590* 1593* 1594 1599* twbuff 001366 automatic char(512) packed unaligned dcl 121 set ref 274 274 user_info_$process_type 000200 constant entry external dcl 232 ref 547 version 000362 automatic char(8) level 2 in structure "local_qbii" dcl 93 in procedure "qedx_" set ref 1425* 1608* version based char(8) level 3 in structure "qedx_info" dcl 2-6 in procedure "qedx_" ref 253 253 351 was_empty 001766 automatic bit(1) dcl 1411 in procedure "perform_read" set ref 1502* 1525 1528 was_empty 001566 automatic bit(1) dcl 122 in procedure "qedx_" set ref 756* 776 write_ok 002071 automatic bit(1) dcl 1566 set ref 1617* 1618 write_request parameter bit(1) dcl 1339 set ref 1336 1356* 1372 1372 1380 wrote_whole_buffer 002073 automatic bit(1) dcl 1566 set ref 1706* 1713 1716 xsw 001567 automatic bit(1) packed unaligned dcl 123 set ref 1162* 1167* 1217 1219 yes_sw 001570 automatic bit(1) packed unaligned dcl 124 set ref 554* 557* 558 598* 601* 602 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ACTION_CAN_RESTART internal static bit(36) initial dcl 5-7 ACTION_DEFAULT_RESTART internal static bit(36) initial dcl 5-7 ACTION_QUIET_RESTART internal static bit(36) initial dcl 5-7 ACTION_SUPPORT_SIGNAL internal static bit(36) initial dcl 5-7 A_ACCESS internal static bit(3) initial packed unaligned dcl 4-11 A_ACCESS_BIN internal static fixed bin(5,0) initial dcl 4-36 DIR_ACCESS_MODE_NAMES internal static char(4) initial array packed unaligned dcl 4-33 E_ACCESS internal static bit(3) initial packed unaligned dcl 4-11 E_ACCESS_BIN internal static fixed bin(5,0) initial dcl 4-36 M_ACCESS internal static bit(3) initial packed unaligned dcl 4-11 M_ACCESS_BIN internal static fixed bin(5,0) initial dcl 4-36 N_ACCESS internal static bit(3) initial packed unaligned dcl 4-11 N_ACCESS_BIN internal static fixed bin(5,0) initial dcl 4-36 REW_ACCESS internal static bit(3) initial packed unaligned dcl 4-11 REW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 4-36 RE_ACCESS internal static bit(3) initial packed unaligned dcl 4-11 RE_ACCESS_BIN internal static fixed bin(5,0) initial dcl 4-36 RW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 4-36 R_ACCESS_BIN internal static fixed bin(5,0) initial dcl 4-36 SA_ACCESS internal static bit(3) initial packed unaligned dcl 4-11 SA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 4-36 SEG_ACCESS_MODE_NAMES internal static char(4) initial array packed unaligned dcl 4-30 SMA_ACCESS internal static bit(3) initial packed unaligned dcl 4-11 SMA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 4-36 SM_ACCESS internal static bit(3) initial packed unaligned dcl 4-11 SM_ACCESS_BIN internal static fixed bin(5,0) initial dcl 4-36 S_ACCESS internal static bit(3) initial packed unaligned dcl 4-11 S_ACCESS_BIN internal static fixed bin(5,0) initial dcl 4-36 TERM_FILE_BC internal static bit(2) initial packed unaligned dcl 6-12 TERM_FILE_FORCE_WRITE internal static bit(4) initial packed unaligned dcl 6-16 TERM_FILE_TRUNC internal static bit(1) initial packed unaligned dcl 6-11 TERM_FILE_TRUNC_BC internal static bit(2) initial packed unaligned dcl 6-13 W_ACCESS internal static bit(3) initial packed unaligned dcl 4-11 W_ACCESS_BIN internal static fixed bin(5,0) initial dcl 4-36 editor_area based area(1024) dcl 1-21 qbii_ptr automatic pointer dcl 3-20 qedx_info_n_buffers automatic fixed bin(17,0) dcl 2-42 sv based structure level 1 dcl 1-26 terminate_file_switches based structure level 1 packed packed unaligned dcl 6-4 NAMES DECLARED BY EXPLICIT CONTEXT. ACTION 000000 constant label array(0:19) dcl 458 set ref 455 456 DO_QUIT_REQUEST 002653 constant label dcl 527 ref 518 RETURN_FROM_QEDX_ 003437 constant label dcl 630 ref 290 303 314 321 336 348 380 410 SET_OUTPUT_VALUES 003364 constant label dcl 612 ref 564 append 003613 constant label dcl 728 buffer 005037 constant label dcl 1053 change 003641 constant label dcl 743 cleanup_invocation_data 006244 constant entry internal dcl 1280 ref 272 630 comment 006200 constant label dcl 1269 cur_line 005353 constant label dcl 1124 defaults 012341 constant entry internal dcl 1847 ref 498 649 672 743 816 1067 1124 1170 1262 1272 delete 003602 constant label dcl 672 ref 1106 delete_text 006207 constant entry internal dcl 684 ref 675 746 determine_file 006370 constant entry internal dcl 1336 ref 475 504 do_sub 000027 constant label array(3) dcl 937 ref 935 do_sub_conceal 004531 constant label dcl 965 ref 977 end_pr 003577 constant label dcl 666 ref 652 exclude 005505 constant label dcl 1162 execute 004766 constant label dcl 1037 gb1 005511 constant label dcl 1170 ref 1165 gb2 005624 constant label dcl 1194 ref 1185 gb_end 006146 constant label dcl 1250 ref 1222 gb_err 005534 constant label dcl 1177 ref 1172 1192 gb_loop 005670 constant label dcl 1204 ref 1198 1250 gb_quit 006151 constant label dcl 1252 ref 1207 1215 1227 1234 1242 1248 gb_test 006004 constant label dcl 1224 ref 1217 1219 get_buffer_state 006342 constant entry internal dcl 1315 ref 281 306 577 604 1059 global 005510 constant label dcl 1167 in_mode 003647 constant label dcl 750 ref 734 741 758 2046 2050 inp_act 000035 constant label array(4) dcl 1939 ref 1984 inp_case 000032 constant label array(3) dcl 1937 ref 1935 inp_conceal 012743 constant label dcl 1952 inp_final 012701 constant label dcl 1939 inp_move_string 012627 constant label dcl 1926 ref 1952 inp_search 012603 constant label dcl 1920 ref 1914 1964 1981 input 012542 constant entry internal dcl 1905 ref 759 insert 003626 constant label dcl 736 interrupt 013102 constant entry internal dcl 1997 ref 364 366 last_line 012126 constant entry internal dcl 1760 ref 666 767 1011 1022 1127 1254 1263 1273 1515 1517 2050 move 005070 constant label dcl 1067 move_overflow 005141 constant label dcl 1077 ref 1086 next 002241 constant label dcl 406 ref 668 678 779 1026 1060 1114 1152 1255 1259 1264 next_line 012237 constant entry internal dcl 1813 ref 676 769 1014 1514 1518 nullrq 006171 constant label dcl 1259 nx_line 002220 constant label dcl 402 ref 413 436 445 453 481 512 760 1028 1040 1047 1269 1274 open_gap 013432 constant entry internal dcl 2091 ref 697 701 733 740 768 885 909 1007 1009 1013 1237 1504 1516 perform_read 006716 constant entry internal dcl 1401 ref 346 481 perform_write 010213 constant entry internal dcl 1555 ref 507 584 print 003446 constant label dcl 649 print1 003444 constant label dcl 641 ref 450 promote 013120 constant entry internal dcl 2026 ref 918 925 939 952 965 980 1505 1926 1939 1956 1973 put_data 012044 constant entry internal dcl 1735 ref 1606 1674 1695 qedx_ 001064 constant entry external dcl 48 rd_line 012562 constant label dcl 1915 ref 1912 1931 1962 1979 read 002573 constant label dcl 475 reg_err 002447 constant label dcl 434 ref 430 retry 012143 constant label dcl 1774 ref 1781 retry_top 012254 constant label dcl 1822 in procedure "next_line" ref 1828 retry_top 005405 constant label dcl 1134 in procedure "qedx_" ref 1143 rq_err 002503 constant label dcl 443 ref 431 438 461 483 507 530 537 558 605 836 1031 1058 1072 1079 1179 1357 1362 1377 1383 1391 1492 1594 1878 1882 1886 2052 save_buffer_state 006322 constant entry internal dcl 1298 ref 356 412 570 1053 1110 status 005336 constant label dcl 1110 sub2 004201 constant label dcl 882 ref 842 sub_case 000024 constant label array(3) dcl 842 ref 840 sub_done 004714 constant label dcl 1011 ref 814 897 900 2041 2043 sub_err 004053 constant label dcl 834 ref 860 867 869 sub_loop 004216 constant label dcl 888 ref 1010 sub_next 004646 constant label dcl 989 ref 931 sub_search 004036 constant label dcl 829 ref 856 863 874 879 sub_string_search 004336 constant label dcl 912 ref 961 971 986 substitute 004010 constant label dcl 816 wr_quit 002634 constant label dcl 510 ref 501 write 002611 constant label dcl 498 NAME DECLARED BY CONTEXT OR IMPLICATION. verify builtin function ref 534 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 15726 16130 14773 15736 Length 16650 14773 202 504 733 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME qedx_ 1672 external procedure is an external procedure. on unit on line 272 64 on unit on unit on line 364 64 on unit on unit on line 366 64 on unit delete_text internal procedure shares stack frame of external procedure qedx_. cleanup_invocation_data 80 internal procedure is called by several nonquick procedures. save_buffer_state internal procedure shares stack frame of external procedure qedx_. get_buffer_state internal procedure shares stack frame of external procedure qedx_. determine_file internal procedure shares stack frame of external procedure qedx_. perform_read internal procedure shares stack frame of external procedure qedx_. perform_write internal procedure shares stack frame of external procedure qedx_. put_data internal procedure shares stack frame of external procedure qedx_. last_line internal procedure shares stack frame of external procedure qedx_. next_line internal procedure shares stack frame of external procedure qedx_. defaults internal procedure shares stack frame of external procedure qedx_. input internal procedure shares stack frame of external procedure qedx_. interrupt 64 internal procedure is called by several nonquick procedures. promote internal procedure shares stack frame of external procedure qedx_. open_gap internal procedure shares stack frame of external procedure qedx_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME qedx_ 000100 a_real_file qedx_ 000102 b0_bp qedx_ 000104 b0_ifp qedx_ 000106 buffer_idx qedx_ 000110 callers_io_region_ptr qedx_ 000112 ch qedx_ 000113 cht qedx_ 000114 code qedx_ 000115 curbuf qedx_ 000121 delim qedx_ 000122 error_sw qedx_ 000124 explicit_pathname qedx_ 000125 fe qedx_ 000126 fle qedx_ 000127 fli qedx_ 000130 flsw qedx_ 000132 fp qedx_ 000134 have_truncated_buffers qedx_ 000135 i qedx_ 000136 ife qedx_ 000140 ifp qedx_ 000142 ift qedx_ 000143 ignore_result qedx_ 000144 il qedx_ 000145 ilb qedx_ 000146 iline qedx_ 000346 intsw qedx_ 000347 j qedx_ 000350 je qedx_ 000351 k qedx_ 000352 ka qedx_ 000353 kx qedx_ 000354 l qedx_ 000355 le qedx_ 000356 li qedx_ 000357 lle qedx_ 000360 lli qedx_ 000361 llsw qedx_ 000362 local_qbii qedx_ 000514 local_qid qedx_ 001014 me qedx_ 001015 mi qedx_ 001016 ml qedx_ 001017 new_modes qedx_ 001117 old_modes qedx_ 001220 output_routine qedx_ 001224 output_sw qedx_ 001226 pfs qedx_ 001230 pi_label qedx_ 001234 pi_sw qedx_ 001235 process_type qedx_ 001236 quit_force_sw qedx_ 001237 saved_current_buffer qedx_ 001243 saved_ift qedx_ 001244 sdsw qedx_ 001245 subsw qedx_ 001246 sub_comp_string qedx_ 001250 tbp qedx_ 001252 te qedx_ 001254 the_buffer_ptr qedx_ 001256 the_pathname qedx_ 001356 ti qedx_ 001357 tik qedx_ 001360 tname qedx_ 001364 tp qedx_ 001366 twbuff qedx_ 001566 was_empty qedx_ 001567 xsw qedx_ 001570 yes_sw qedx_ 001571 ilb_offset qedx_ 001572 command_index qedx_ 001616 qid_ptr qedx_ 001620 bp qedx_ 001622 qedx_info_ptr qedx_ 001662 l determine_file 001672 file_ptr perform_read 001674 dirname perform_read 001746 ename perform_read 001756 component perform_read 001766 was_empty perform_read 001767 read_ok perform_read 001770 trust_the_pathname perform_read 001771 code perform_read 001772 status_code perform_read 001773 file_bc perform_read 001774 file_lth perform_read 002004 file_ptr perform_write 002006 dirname perform_write 002060 ename perform_write 002070 split_data perform_write 002071 write_ok perform_write 002072 created_file perform_write 002073 wrote_whole_buffer perform_write 002074 trust_the_pathname perform_write 002075 code perform_write 002076 status_code perform_write 002077 file_bc perform_write 002100 file_lth perform_write 002110 part1_lth put_data 002111 part2_lth put_data 002120 i last_line 002136 qfli defaults 002137 qlle defaults 002154 new_fe promote 002155 new_ft promote 002156 offset_action promote 002166 offset_action open_gap 002167 gap open_gap THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_l_a r_g_a r_e_as r_ne_as r_le_a alloc_char_temp cat_realloc_chars call_ent_var call_ext_out_desc call_ext_out call_int_this call_int_other return_mac tra_ext_2 enable_op shorten_stack ext_entry int_entry search_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. bce_check_abort bce_query$yes_no bootload_fs_$flush_sys bootload_fs_$get_ptr bootload_fs_$put_ptr check_entryname_ com_err_ command_query_$yes_no cu_$cp edx_util_$edx_cleanup edx_util_$edx_init edx_util_$end_buffer edx_util_$get_buffer edx_util_$list_buffers edx_util_$list_modified_buffers edx_util_$list_single_buffer edx_util_$locate_buffer edx_util_$modified_buffers edx_util_$prime edx_util_$read_ptr edx_util_$resetread expand_pathname_ expand_pathname_$component get_addr_ get_system_free_area_ get_temp_segment_ hcs_$status_minf initiate_file_$component initiate_file_$create ioa_ ioa_$ioa_switch iox_$modes iox_$put_chars mrl_ pathname_ pathname_$component qx_search_file_ qx_search_file_$cleanup qx_search_file_$init release_temp_segment_ sub_err_ terminate_file_ user_info_$process_type THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. bce_data$console_put_chars bce_data$put_chars error_table_$archive_component_modification error_table_$archive_pathname error_table_$bigarg error_table_$dirseg error_table_$fatal_error error_table_$inconsistent error_table_$moderr error_table_$no_r_permission error_table_$no_w_permission error_table_$pathlong error_table_$recoverable_error error_table_$unimplemented_version iox_$user_io iox_$user_output sys_info$max_seg_size sys_info$service_system LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 48 001060 63 001071 102 001074 111 001075 240 001077 241 001101 242 001105 243 001110 244 001113 246 001114 247 001121 248 001123 251 001125 253 001131 254 001137 255 001141 261 001142 263 001144 264 001147 265 001155 267 001160 269 001176 272 001202 274 001224 275 001245 276 001247 277 001273 278 001277 281 001300 283 001302 285 001311 286 001315 287 001336 288 001340 289 001367 290 001373 297 001374 298 001405 300 001411 301 001424 302 001430 303 001434 306 001435 307 001437 309 001442 310 001446 311 001452 313 001521 314 001525 316 001526 317 001532 320 001601 321 001605 324 001606 325 001607 326 001612 327 001614 329 001616 332 001617 333 001623 335 001672 336 001676 339 001677 340 001701 341 001704 345 001706 346 001710 347 001717 348 001723 351 001724 353 001741 356 001753 357 001754 362 001756 364 001757 366 002005 369 002027 370 002031 371 002033 373 002035 374 002045 375 002051 376 002054 377 002074 379 002124 380 002130 382 002131 384 002163 386 002177 388 002201 390 002205 402 002220 404 002222 406 002241 408 002244 409 002245 410 002251 412 002254 413 002255 414 002260 416 002261 418 002320 419 002325 420 002327 421 002331 422 002332 423 002333 424 002335 425 002340 428 002402 430 002441 431 002444 432 002445 433 002446 434 002447 436 002460 437 002462 438 002501 442 002502 443 002503 445 002512 448 002513 449 002521 450 002522 453 002530 454 002531 455 002542 456 002545 458 002546 461 002572 475 002573 479 002577 481 002603 483 002610 498 002611 501 002615 502 002620 504 002622 507 002625 510 002634 512 002635 516 002636 518 002640 520 002641 522 002646 523 002650 524 002651 525 002652 527 002653 529 002655 530 002671 533 002672 534 002677 535 002720 536 002724 537 002740 544 002741 547 002763 549 002775 550 002777 551 003002 552 003025 554 003047 557 003107 558 003123 564 003130 569 003132 570 003136 572 003137 574 003140 575 003151 576 003155 577 003170 579 003172 581 003176 582 003201 583 003203 584 003205 587 003216 588 003222 589 003224 590 003244 592 003246 595 003263 597 003265 598 003267 601 003327 602 003343 603 003346 604 003361 605 003363 612 003364 614 003372 616 003374 617 003403 618 003407 621 003422 623 003424 625 003435 630 003437 633 003443 641 003444 649 003446 652 003450 653 003453 654 003455 655 003463 656 003467 657 003511 658 003512 659 003514 660 003522 662 003550 665 003576 666 003577 668 003601 672 003602 675 003604 676 003605 677 003607 678 003612 728 003613 733 003622 734 003625 736 003626 739 003632 740 003635 741 003640 743 003641 746 003643 747 003644 750 003647 752 003652 753 003655 756 003700 758 003711 759 003714 760 003716 767 003721 768 003723 769 003730 771 003732 772 003735 773 003740 776 003763 779 004004 814 004005 816 004010 818 004012 819 004020 820 004021 821 004022 823 004023 825 004024 826 004027 827 004030 829 004036 833 004052 834 004053 836 004067 839 004070 840 004103 842 004104 844 004106 845 004111 846 004114 854 004137 855 004141 856 004143 860 004144 862 004150 863 004153 867 004154 869 004157 873 004172 874 004175 878 004176 879 004200 882 004201 884 004204 885 004210 887 004215 888 004216 891 004253 892 004255 893 004256 894 004265 895 004267 896 004307 897 004310 900 004311 901 004313 902 004317 903 004321 904 004322 905 004325 909 004327 911 004334 912 004336 915 004356 916 004357 918 004364 920 004371 921 004373 924 004375 925 004377 927 004405 929 004423 930 004430 931 004433 934 004434 935 004446 937 004447 939 004452 940 004456 942 004473 943 004477 951 004502 952 004504 953 004507 955 004520 956 004522 959 004525 961 004527 963 004530 965 004531 967 004535 968 004572 969 004575 970 004600 971 004603 973 004604 976 004616 977 004620 980 004621 981 004625 983 004637 984 004641 985 004644 986 004645 989 004646 993 004652 994 004655 997 004660 998 004664 999 004672 1007 004674 1009 004704 1010 004711 1011 004714 1013 004723 1014 004730 1022 004732 1026 004734 1027 004736 1028 004747 1030 004751 1031 004765 1037 004766 1040 004773 1041 004776 1042 005001 1043 005003 1044 005015 1045 005016 1046 005017 1047 005036 1053 005037 1056 005040 1058 005061 1059 005065 1060 005067 1067 005070 1070 005072 1072 005113 1073 005117 1074 005122 1075 005130 1076 005134 1077 005141 1079 005161 1081 005162 1083 005170 1084 005171 1085 005173 1086 005203 1087 005210 1088 005221 1090 005232 1091 005240 1092 005245 1093 005252 1094 005254 1096 005263 1097 005266 1098 005270 1099 005272 1100 005274 1101 005306 1102 005311 1103 005315 1104 005317 1106 005335 1110 005336 1113 005337 1114 005352 1124 005353 1127 005355 1128 005357 1130 005367 1131 005371 1132 005373 1133 005377 1134 005405 1139 005427 1141 005445 1142 005451 1143 005452 1146 005453 1148 005461 1149 005462 1150 005464 1151 005465 1152 005504 1162 005505 1165 005507 1167 005510 1170 005511 1172 005515 1173 005520 1174 005524 1177 005534 1179 005550 1181 005551 1182 005556 1183 005560 1184 005567 1185 005574 1186 005577 1187 005603 1191 005621 1192 005623 1194 005624 1196 005626 1197 005627 1198 005630 1199 005634 1200 005645 1201 005653 1203 005666 1204 005670 1206 005671 1207 005700 1208 005702 1210 005720 1212 005724 1213 005727 1215 005764 1216 005767 1217 005770 1219 005774 1221 006000 1222 006003 1224 006004 1226 006010 1227 006014 1228 006017 1229 006021 1231 006043 1232 006044 1233 006047 1234 006056 1235 006060 1236 006061 1237 006063 1238 006070 1239 006073 1240 006074 1241 006077 1242 006106 1243 006110 1244 006111 1245 006113 1246 006132 1247 006135 1248 006144 1250 006146 1252 006151 1254 006166 1255 006170 1259 006171 1262 006173 1263 006175 1264 006177 1269 006200 1272 006202 1273 006204 1274 006206 684 006207 696 006210 697 006213 698 006215 699 006220 700 006221 701 006224 702 006230 703 006233 705 006234 706 006236 707 006241 710 006242 1280 006243 1283 006251 1284 006256 1285 006277 1288 006302 1290 006311 1292 006321 1298 006322 1301 006323 1302 006326 1303 006331 1304 006333 1305 006335 1306 006337 1308 006341 1315 006342 1320 006344 1321 006347 1323 006352 1324 006354 1325 006357 1326 006361 1327 006363 1328 006365 1330 006367 1336 006370 1345 006372 1347 006400 1349 006404 1350 006420 1351 006422 1353 006425 1354 006426 1355 006431 1356 006435 1357 006455 1359 006456 1360 006460 1361 006517 1362 006537 1364 006540 1365 006542 1366 006551 1369 006552 1370 006554 1372 006563 1376 006611 1377 006630 1380 006631 1382 006644 1383 006660 1386 006661 1390 006675 1391 006714 1395 006715 1401 006716 1420 006720 1422 006726 1424 006732 1425 006736 1426 006740 1427 006744 1428 006750 1429 006752 1430 006756 1431 006760 1432 006761 1433 006767 1434 007001 1435 007004 1436 007027 1438 007031 1439 007033 1440 007035 1442 007036 1443 007041 1444 007044 1445 007073 1446 007075 1447 007125 1448 007150 1450 007152 1451 007212 1452 007214 1453 007217 1454 007254 1457 007336 1459 007411 1460 007412 1462 007464 1465 007515 1467 007517 1468 007523 1470 007524 1471 007550 1472 007552 1473 007602 1474 007625 1477 007627 1480 007630 1481 007633 1487 007641 1488 007651 1491 007723 1492 007737 1495 007742 1497 007743 1502 007745 1504 007756 1505 007762 1507 007764 1508 007767 1510 007771 1513 010000 1514 010002 1515 010004 1516 010006 1517 010013 1518 010015 1523 010017 1524 010023 1525 010025 1526 010037 1528 010040 1529 010042 1532 010105 1533 010112 1534 010117 1535 010127 1536 010131 1537 010133 1540 010134 1541 010144 1544 010146 1549 010207 1555 010213 1573 010215 1575 010223 1577 010227 1578 010235 1579 010236 1580 010242 1582 010243 1583 010245 1589 010256 1590 010264 1593 010337 1594 010353 1597 010361 1599 010362 1602 010364 1606 010370 1608 010372 1609 010374 1610 010400 1611 010405 1612 010407 1613 010411 1614 010413 1615 010414 1617 010422 1618 010435 1619 010440 1620 010463 1622 010465 1625 010466 1626 010472 1630 010475 1631 010521 1632 010523 1633 010530 1634 010557 1636 010606 1639 010610 1640 010652 1641 010655 1642 010672 1643 010674 1644 010723 1645 010772 1646 011015 1650 011017 1651 011021 1652 011024 1653 011061 1656 011137 1657 011206 1658 011207 1659 011255 1662 011310 1664 011312 1666 011313 1667 011345 1668 011347 1669 011377 1670 011422 1674 011424 1676 011426 1677 011431 1678 011460 1679 011462 1680 011531 1681 011554 1683 011556 1684 011557 1685 011563 1692 011564 1693 011567 1695 011573 1697 011601 1706 011642 1711 011713 1712 011717 1713 011721 1714 011737 1716 011740 1717 011742 1720 012001 1721 012006 1722 012013 1723 012023 1724 012025 1725 012027 1727 012030 1729 012040 1735 012044 1741 012046 1742 012050 1743 012057 1744 012071 1745 012101 1748 012114 1750 012115 1752 012125 1760 012126 1767 012130 1769 012140 1772 012141 1774 012143 1776 012146 1778 012164 1780 012167 1781 012170 1784 012171 1785 012173 1787 012174 1789 012175 1790 012177 1791 012201 1793 012202 1794 012206 1795 012220 1796 012221 1797 012223 1800 012224 1804 012230 1806 012235 1807 012236 1813 012237 1818 012241 1819 012244 1821 012253 1822 012254 1824 012257 1826 012275 1827 012301 1828 012302 1830 012303 1831 012304 1833 012322 1835 012327 1836 012332 1838 012333 1839 012336 1841 012340 1847 012341 1855 012343 1857 012353 1859 012354 1861 012364 1864 012365 1865 012367 1866 012372 1867 012375 1868 012376 1869 012400 1871 012410 1872 012411 1874 012421 1876 012422 1877 012430 1878 012447 1880 012450 1881 012457 1882 012476 1884 012477 1885 012501 1886 012515 1888 012516 1889 012522 1890 012527 1891 012534 1892 012541 1905 012542 1912 012544 1913 012552 1914 012557 1915 012562 1918 012601 1920 012603 1924 012622 1925 012623 1926 012627 1928 012634 1929 012653 1930 012655 1931 012663 1934 012664 1935 012677 1937 012700 1939 012701 1943 012706 1945 012725 1946 012727 1947 012735 1948 012741 1950 012742 1952 012743 1956 012750 1957 012752 1959 013011 1960 013014 1961 013021 1962 013025 1964 013027 1966 013030 1969 013032 1971 013045 1973 013046 1974 013050 1976 013064 1977 013066 1978 013073 1979 013074 1981 013077 1984 013100 1997 013101 2000 013107 2001 013112 2002 013113 2005 013115 2006 013117 2026 013120 2035 013122 2037 013131 2038 013133 2039 013145 2041 013153 2042 013166 2043 013205 2046 013206 2049 013241 2050 013260 2052 013275 2054 013276 2055 013304 2056 013305 2058 013311 2059 013313 2065 013350 2066 013353 2067 013360 2068 013365 2069 013372 2071 013377 2072 013404 2073 013411 2075 013416 2076 013422 2077 013424 2080 013425 2081 013427 2084 013431 2091 013432 2102 013434 2104 013443 2105 013446 2106 013451 2108 013502 2110 013510 2111 013517 2112 013526 2113 013535 2114 013544 2115 013553 2117 013562 2119 013572 2120 013574 2122 013576 2124 013604 2125 013606 2127 013607 2128 013612 2129 013623 2130 013627 2131 013636 2132 013645 2133 013654 2135 013663 2137 013673 2138 013702 2139 013711 2140 013713 2141 013714 2143 013722 2148 013724 ----------------------------------------------------------- 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