COMPILATION LISTING OF SEGMENT edm Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/09/85 1147.9 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 edm: proc; 12 13 /* recoded to take advantage of eis and to be less memory intensive: RMullen 1/74 */ 14 /* move request added: RMullen Autumn '75 */ 15 /* Sept 1983 C Spitzer: bug fixes applied. 16* phx2205: terminate segs when cleaning up. 17* phx3368, phx13842: use terminate_file_ to zero chars in last word 18* phx6041: use check_entryname_ on requested path on command line. 19* phx6407: move data then truncate so don't get rqo in ring 0. 20**/ 21 1 1 /* BEGIN INCLUDE FILE ... set_wakeup_table_info.incl.pl1 */ 1 2 1 3 /* Created 3/1/79 by J. Stern */ 1 4 1 5 1 6 dcl swt_infop ptr; 1 7 dcl swt_info_version_1 fixed bin static options (constant) init (1); 1 8 1 9 dcl 1 swt_info aligned based (swt_infop), /* info structure for set_wakeup_table control order */ 1 10 2 version fixed bin, /* version number of this structure */ 1 11 2 new_table like wakeup_table, /* wakeup table to set */ 1 12 2 old_table like wakeup_table; /* previous wakeup table */ 1 13 1 14 dcl wakeup_tablep ptr; 1 15 1 16 dcl 1 wakeup_table aligned based (wakeup_tablep), 1 17 2 wake_map (0:127) bit (1) unal, /* bit i ON if ith char is wakeup char */ 1 18 2 mbz bit (16) unal; 1 19 1 20 1 21 /* END INCLUDE FILE ... set_wakeup_table_info.incl.pl1 */ 22 2 1 /* BEGIN INCLUDE FILE ... access_mode_values.incl.pl1 2 2* 2 3* Values for the "access mode" argument so often used in hardcore 2 4* James R. Davis 26 Jan 81 MCR 4844 2 5* Added constants for SM access 4/28/82 Jay Pattin 2 6* Added text strings 03/19/85 Chris Jones 2 7**/ 2 8 2 9 2 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ 2 11 dcl ( 2 12 N_ACCESS init ("000"b), 2 13 R_ACCESS init ("100"b), 2 14 E_ACCESS init ("010"b), 2 15 W_ACCESS init ("001"b), 2 16 RE_ACCESS init ("110"b), 2 17 REW_ACCESS init ("111"b), 2 18 RW_ACCESS init ("101"b), 2 19 S_ACCESS init ("100"b), 2 20 M_ACCESS init ("010"b), 2 21 A_ACCESS init ("001"b), 2 22 SA_ACCESS init ("101"b), 2 23 SM_ACCESS init ("110"b), 2 24 SMA_ACCESS init ("111"b) 2 25 ) bit (3) internal static options (constant); 2 26 2 27 /* The following arrays are meant to be accessed by doing either 1) bin (bit_value) or 2 28* 2) divide (bin_value, 2) to come up with an index into the array. */ 2 29 2 30 dcl SEG_ACCESS_MODE_NAMES (0:7) init ("null", "W", "E", "EW", "R", "RW", "RE", "REW") char (4) internal 2 31 static options (constant); 2 32 2 33 dcl DIR_ACCESS_MODE_NAMES (0:7) init ("null", "A", "M", "MA", "S", "SA", "SM", "SMA") char (4) internal 2 34 static options (constant); 2 35 2 36 dcl ( 2 37 N_ACCESS_BIN init (00000b), 2 38 R_ACCESS_BIN init (01000b), 2 39 E_ACCESS_BIN init (00100b), 2 40 W_ACCESS_BIN init (00010b), 2 41 RW_ACCESS_BIN init (01010b), 2 42 RE_ACCESS_BIN init (01100b), 2 43 REW_ACCESS_BIN init (01110b), 2 44 S_ACCESS_BIN init (01000b), 2 45 M_ACCESS_BIN init (00010b), 2 46 A_ACCESS_BIN init (00001b), 2 47 SA_ACCESS_BIN init (01001b), 2 48 SM_ACCESS_BIN init (01010b), 2 49 SMA_ACCESS_BIN init (01011b) 2 50 ) fixed bin (5) internal static options (constant); 2 51 2 52 /* END INCLUDE FILE ... access_mode_values.incl.pl1 */ 23 3 1 /* BEGIN INCLUDE FILE ... terminate_file.incl.pl1 */ 3 2 /* format: style2,^inddcls,idind32 */ 3 3 3 4 declare 1 terminate_file_switches based, 3 5 2 truncate bit (1) unaligned, 3 6 2 set_bc bit (1) unaligned, 3 7 2 terminate bit (1) unaligned, 3 8 2 force_write bit (1) unaligned, 3 9 2 delete bit (1) unaligned; 3 10 3 11 declare TERM_FILE_TRUNC bit (1) internal static options (constant) initial ("1"b); 3 12 declare TERM_FILE_BC bit (2) internal static options (constant) initial ("01"b); 3 13 declare TERM_FILE_TRUNC_BC bit (2) internal static options (constant) initial ("11"b); 3 14 declare TERM_FILE_TERM bit (3) internal static options (constant) initial ("001"b); 3 15 declare TERM_FILE_TRUNC_BC_TERM bit (3) internal static options (constant) initial ("111"b); 3 16 declare TERM_FILE_FORCE_WRITE bit (4) internal static options (constant) initial ("0001"b); 3 17 declare TERM_FILE_DELETE bit (5) internal static options (constant) initial ("00001"b); 3 18 3 19 /* END INCLUDE FILE ... terminate_file.incl.pl1 */ 24 25 26 dcl 1 swt aligned static like swt_info; 27 dcl iox_$modes entry (ptr, char (*), char (*), fixed bin (35)); 28 dcl iox_$user_io ptr ext; 29 dcl error_table_$bad_mode fixed bin (35) ext; 30 dcl waketable_is_set bit (1) init (""b); 31 32 dcl readysw bit (1) aligned init ("0"b); 33 dcl cv_dec_check_ entry (char (*)aligned, fixed bin (35)) returns (fixed bin); 34 dcl (M, N) fixed bin (21); 35 dcl ready ext entry; 36 37 dcl 1 edata aligned, /* info about state of temp files */ 38 2 upper, /* these items sometimes saved seperately */ 39 3 fptr ptr, /* points to base of fromfile */ 40 3 indf fixed bin (21) init (0), /* current position in fromfile */ 41 3 iflag bit (1) aligned init ("1"b), /* "1" => nothing is in fromfile yet */ 42 3 csize1 fixed bin (24) init (0), /* offset of last char in fromfile */ 43 3 pad1 fixed bin, 44 2 tptr ptr, /* points to base of tofile */ 45 2 indt fixed bin (21) init (0), /* current position in tofile */ 46 2 eof_ bit (1) aligned init ("0"b), /* "1"b => at end of fromfile */ 47 2 changed bit (1) aligned init ("0"b), /* "1"b => text changed since last write */ 48 2 lngth fixed bin (17) init (0), /* length of current line in chars */ 49 2 curlino fixed bin (21) init (1), /* if not -1, is current line number */ 50 2 isok fixed bin (17) init (0); /* if not -1, is number of chars in tofile ident to fromfile */ 51 dcl line char (152) aligned; 52 53 dcl 1 Edata_pi like edata aligned; /* edata placed here, in case of pi */ 54 55 dcl pi_allowed bit (1) aligned init ("0"b); 56 57 dcl Line_pi char (152) aligned; 58 59 dcl 1 move_data aligned, /* info to undo move at pi-time */ 60 2 (x1, x2, xlen, y1, y2, ylen) fixed bin (21); 61 62 dcl did_move bit (1) aligned init ("0"b); 63 64 dcl buffer char (152) aligned; 65 dcl bufp ptr; 66 dcl sptr ptr init (null), 67 68 orig_ptr ptr; 69 70 dcl b168cu char (168) unal based; 71 dcl b32cu char (32) unal based; 72 73 dcl scanlen fixed bin (17); 74 75 dcl (g_lines, g_chars, mg_lines, mg_chars) fixed bin (21); 76 77 dcl (mc_skip, mc_chars) fixed bin (21); 78 dcl chunk fixed bin (21) init (512); /* try to deal with about this many chars */ 79 dcl (bkover, cgscanlen, xxxx, tnx) fixed bin (21); 80 81 dcl (bklen, nbk, nxlen) fixed bin (21); 82 83 dcl printing fixed bin; 84 dcl locating fixed bin; 85 86 dcl locstring char (152) aligned init (" 87 "); 88 dcl (loclen, locend) fixed bin; 89 dcl skipblank fixed bin; 90 dcl where_found fixed bin; 91 dcl locp pointer; 92 dcl trick_ptr ptr; 93 dcl me char (4) static aligned init ("edm "); 94 dcl active fixed bin static init (0); /* Are there active invocations of edm */ 95 96 dcl status bit (72) aligned, 97 (m, ij, ii) fixed bin (21), 98 error_message char (33) aligned init ("Line too long. Max length is 152.") static, 99 string char (262144) aligned based, 100 arg char (lname) based (np) unaligned, /* input argument */ 101 xarg char (lprinam) based (np) unal, /* pathname arg of merge, write, or split request */ 102 (error_table_$noentry, error_table_$noarg) fixed bin (35) ext, 103 error_table_$no_w_permission fixed bin(35) ext static, 104 (iox_$user_input, iox_$user_output) ptr ext, 105 code fixed bin (35), 106 type fixed bin (2), 107 (edct, num_err, cm1) fixed bin (17), 108 (i, j, k, n) fixed bin (21), 109 l fixed bin (17), 110 sw_pi bit (1) aligned init ("0"b), 111 gotlino fixed bin (21), 112 prc fixed bin (17), 113 count fixed bin (17), 114 (lname, lprinam) fixed bin (17), 115 located bit (1), 116 temp1 bit (1), 117 brief bit (1), 118 break char (1) aligned, 119 cwd char (1) aligned, 120 (rrs init (""), brs init (""), nl init (" 121 ")) char (1) aligned static, /* Color-shift, chars */ 122 saveflag fixed bin (17), 123 tlin char (152), 124 olin char (456) aligned, 125 /* TEDLIN char (152), */ 126 int_lab label init (pedit); /* non_local go to from program interrupt handler */ 127 dcl np ptr; 128 129 dcl (ptr1 init (null), 130 ptr2) int static ptr; 131 132 dcl 133 iox_$get_line entry (ptr, ptr, fixed bin (17), fixed bin (17), fixed bin (35)), 134 hcs_$truncate_seg entry (ptr, fixed bin (21), fixed bin (35)), 135 cu_$cp entry (ptr, fixed bin (17), fixed bin (35)), 136 hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)), 137 cu_$arg_ptr entry (fixed bin (17), ptr, fixed bin (17), fixed bin (35)), 138 (com_err_, command_query_) entry options (variable), 139 iox_$control entry (ptr, char (*) aligned, ptr, fixed bin (35)), 140 ioa_ entry options (variable), 141 initiate_file_ entry (char(*), char(*), bit(*), ptr, fixed bin(24), fixed bin(35)), 142 terminate_file_ entry (ptr, fixed bin(24), bit(*), fixed bin(35)), 143 expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35)), 144 check_entryname_ entry (char (*), fixed bin (35)), 145 hcs_$status_mins entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35)), 146 iox_$put_chars entry (ptr, ptr, fixed bin (17), fixed bin (35)); 147 148 dcl segsize fixed bin (21); 149 dcl merge_bc fixed bin (24); 150 151 dcl (cleanup, program_interrupt) condition; 152 153 dcl (addr, divide, fixed, index, min, mod, null, reverse, substr, unspec, verify) builtin; 154 155 dcl 1 query_info static aligned, 156 2 version fixed bin init (2), 157 2 yes_no bit (1) unal init ("1"b), 158 2 suppress_name bit (1) unal init ("0"b), 159 2 status fixed bin init (0), 160 2 query fixed bin init (0); 161 162 dcl answer char (4) varying; 163 164 dcl com_line char (cm1) aligned based (bufp); 165 dcl (dnp, enp) ptr; /* to point at dirname(o), ename(o) */ 166 167 dcl (ename, enameo) char (32), 168 (dirname, dirnameo) char (168); 169 170 dcl pad_count fixed bin; /* number of pad zeros that go in last word */ 171 172 /* */ 173 174 lname = 0; 175 brief = "0"b; 176 prc = 152; 177 178 bufp = addr (buffer); 179 180 /* Now get pointers to the buffers */ 181 182 Edata_pi.changed = "0"b; 183 184 if ptr1 = null then do; /* First time, get permanent pointers */ 185 call hcs_$make_seg ("", "temp1_", "", 1010b, ptr1, code); 186 call hcs_$make_seg ("", "temp2_", "", 1010b, ptr2, code); 187 end; 188 else if active ^= 0 then do; 189 call command_query_ (addr (query_info), answer, me, 190 "Pending work in previous invocation will be lost if you proceed;^/do you wish to proceed?"); 191 if answer ^= "yes" then go to return; 192 else go to truncate_temp; 193 end; 194 else do; 195 truncate_temp: call clean; 196 end; 197 198 active = active + 1; /* Set flag saying we're now working */ 199 200 /* Now establish a handler for cleanup condition */ 201 202 on cleanup call clean; 203 204 /* */ 205 /* Now check to see if an input argument was given */ 206 207 call cu_$arg_ptr (1, np, lname, code); 208 if code ^= 0 then if code = error_table_$noarg then go to finput; /* if no arguments, go to input mode */ 209 else do; 210 call com_err_ (code, me); 211 go to exit; 212 end; 213 214 if lname = 0 then go to finput; /* If none given, go to input mode */ 215 216 /* Now get a pointer to the segment to be edited */ 217 218 call expand_pathname_ (arg, dirnameo, enameo, code); 219 if code ^= 0 then do; 220 221 call com_err_ (code, me, "^a", arg); 222 go to exit; 223 end; 224 225 /* Is it a valid entry name? */ 226 227 call check_entryname_ (enameo, code); 228 if code ^= 0 then do; 229 call com_err_ (code, me, "^a", enameo); 230 goto exit; 231 end; 232 233 call initiate_file_ (dirnameo, enameo, RW_ACCESS, sptr, edata.csize1, code); /* Initiate the segment */ 234 235 /* Check to see that the segment is there */ 236 237 if sptr = null then do; 238 if code = error_table_$no_w_permission then do; 239 call initiate_file_ (dirnameo, enameo, R_ACCESS, sptr, edata.csize1, code); 240 if sptr ^= null then goto have_seg_ptr; 241 end; 242 if code = error_table_$noentry then do; 243 call ioa_ ("Segment not found."); 244 orig_ptr = null; 245 go to finput; 246 end; 247 else do; /* bad news indeed */ 248 dnp = addr (dirnameo); 249 enp = addr (enameo); 250 call COM_DE; 251 go to exit; 252 end; 253 end; 254 255 have_seg_ptr: 256 edata.csize1 = divide (edata.csize1, 9, 24, 0); /* change bit count to char count */ 257 if edata.csize1 ^= 0 then if substr (sptr -> string, edata.csize1, 1) ^= nl 258 then call com_err_ (0, me, "Warning --- ^a does not end in newline.", enameo); 259 260 /* */ 261 /* Dispatch on the command character */ 262 263 edata.fptr, orig_ptr = sptr; 264 edata.tptr = ptr1; 265 edata.iflag = "0"b; 266 on program_interrupt call interrupt; 267 sw_pi = "1"b; /* note pi_handler set up */ 268 269 pedit: /* here from input,comment,pi */ 270 call SAVE; /* save info about buffers */ 271 call ioa_ ("Edit."); 272 next: 273 274 275 /* DEBUGGING 276* if readysw then call ready (); 277* if cklinsw then call CKLINO; 278* if ckisoksw then call CKISOK; 279* if dumpsw then call EDUMP; /* END DEBUGGING */ 280 call iox_$get_line (iox_$user_input, bufp, prc, count, code); 281 cm1 = count - 1; 282 if cm1 = 0 then go to next; /* if null line then get another line, don't print error */ 283 /* pi can undo last request until SAVE */ 284 call SAVE; /* save info about buffers */ 285 if substr (buffer, 1, 1) = "E" then go to callms; 286 287 i = verify (substr (buffer, 2, count - 1), " "); /* find first nonblank char */ 288 if i = 0 then i = 152; /* SIMULATE old edm */ 289 290 if substr (buffer, 1, 1) = "w" then do; 291 edct = i; /* if w then all else is path */ 292 go to wsave; 293 end; 294 295 num_err = 0; /* Set flag saying number OK */ 296 297 if cm1 = 1 /* If single character line, numeric value is 1 */ 298 then go to got_num_1; /* End of line, no number, set it to 1 */ 299 300 n = 0; /* this section looks for and converts numbers after the */ 301 /* command letter. It leaves edct pointing to the first non- */ 302 /* blank, non-numeric character. First we initialize the value */ 303 304 num_err = num_err + 1; /* Increment it, will be cleared if # OK */ 305 /* now we do the numeric conversion */ 306 num_loop: j = fixed (unspec (substr (buffer, i + 1, 1)), 9) - 110000b /* ASCII value of "0" */; 307 if j<0 then go to got_num; /* if not "0-9" then end of numeric field */ 308 if j>9 then go to got_num; 309 n = 10 * n + j; /* add value found to 10*number so far */ 310 i = i + 1; 311 if i") */ 315 /* */ 316 edct = i - 1 + verify (substr (buffer, i+1, count - i), " "); /* find first nonblank after numbers */ 317 cwd = substr (buffer, 1, 1); /* cmd char in col 1 */ 318 319 if cwd = "i" then go to insert; 320 if cwd = "r" then go to retype; 321 if cwd = "l" then go to locate; /* */ 322 if cwd = "p" then go to print; /* */ 323 if cwd = "n" then go to nexlin; 324 if cwd = "-" then go to backup; 325 if cwd = "c" then go to change; 326 if cwd = "d" then go to dellin; /* */ 327 if cwd = "t" then go to top; 328 if cwd = "b" then go to bottom; 329 if cwd = "f" then go to find; /* */ 330 if cwd = "s" then go to change; 331 if cwd = "v" then go to veron; 332 333 /* DEBUGGING 334* if cwd = "o" then go to otize; /* DEBUGGING */ 335 if cwd = "k" then go to veroff; 336 if cwd = "." then do; 337 if cm1 = 1 then go to pinput; 338 go to request_err; 339 end; 340 if cwd = "=" then go to equals; /* */ 341 if cwd = "," then go to comment_init; 342 343 if count >= 3 344 then if substr (buffer, 1, 2) = "qf" 345 then go to q_force; 346 347 if cwd = "q" then go to quit; 348 349 if count >= 6 350 then if substr (buffer, 1, 5) = "merge" 351 then go to insert_file; 352 353 if count >= 5 then 354 if substr (buffer, 1, 4) = "move" then 355 go to move_; /* MOVE */ 356 357 if count >= 8 358 then if substr (buffer, 1, 7) = "upwrite" 359 then go to save_top; 360 361 if count >= 9 362 then if substr (buffer, 1, 8) = "updelete" 363 then go to delete_top_init; 364 365 call com_err_ (0, me, "Not a request: ^a", com_line); 366 reset_io: 367 call iox_$control (iox_$user_input, "resetread", null (), code); 368 go to next; 369 numeric_err: 370 call com_err_ (0, me, "Non-numeric characters in numeric argument: ^a", com_line); 371 go to reset_io; 372 request_err: 373 call com_err_ (0, me, "Text follows logical end of request, request ignored: ^a", com_line); 374 go to reset_io; 375 /* */ 376 377 /* ********* verify -- on and off ********* */ 378 379 veron: if cm1 ^= 1 then go to request_err; 380 else do; 381 brief = "0"b; 382 go to next; 383 end; 384 385 veroff: if cm1 ^= 1 then go to request_err; 386 else do; 387 brief = "1"b; 388 go to next; 389 end; 390 391 /* ********* input mode ********* */ 392 393 finput: edata.fptr = ptr1; edata.tptr = ptr2; 394 call SAVE; /* save info about buffers */ 395 if ^sw_pi then do; 396 on program_interrupt call interrupt; 397 sw_pi = "1"b; 398 end; 399 pinput: call ioa_ ("Input."); /* print word "Input" */ 400 call INPUT; 401 go to pedit; /* retn to editing */ 402 403 /* ********** comment ******************* */ 404 405 comment_init: 406 if cm1 ^= 1 then go to request_err; 407 408 comment: if edata.eof_ then go to eof; /* stop commenting at end of file */ 409 if edata.lngth = 1 then go to cnoline; /* don't print blank lines */ 410 if edata.lngth = 0 then go to cnoline; /* ignore no lines */ 411 call iox_$put_chars (iox_$user_output, addr (line), edata.lngth-1, code); /* write line minus NL */ 412 call iox_$get_line (iox_$user_input, bufp, prc, count, code); /* read addition to line */ 413 if count = 2 then /* check for mode change */ 414 if substr (buffer, 1, 1) = "." then go to pedit; 415 if count > 1 then do; 416 edata.changed = "1"b; 417 edata.isok = -1; 418 end; 419 substr (line, edata.lngth, count) = substr (buffer, 1, count); /* add new part to line */ 420 edata.lngth = edata.lngth + count - 1; /* update count */ 421 cnoline: call PUT; /* add to main file */ 422 call GET; /* get next line for commenting */ 423 go to comment; /* repeat */ 424 /* */ 425 426 /* ********** print line number ********* */ 427 428 equals: if cm1 ^= 1 then go to request_err; /* = alone on line */ 429 if edata.curlino = -1 then do; /* ! */ 430 call GET_LINO; /* ! */ 431 GET_LINO: proc; 432 if edata.isok ^= -1 then trick_ptr = edata.fptr; /* touch from file preferentially */ 433 else trick_ptr = edata.tptr; /* unless tofile is different from fromfile */ 434 i = 1; 435 k = edata.indt; 436 do gotlino = 1 by 1 while (k ^= 0); /* count number of nls */ 437 k = index (substr (trick_ptr -> string, i, edata.indt-i), nl); 438 i = i + k; 439 end; 440 if edata.indt = 0 then if edata.indf ^= 0 then gotlino = 1; /* begining of file */ 441 end GET_LINO; 442 edata.curlino = gotlino; /* ! */ 443 end; /* ! */ 444 else do; /* ! */ 445 gotlino = edata.curlino; /* ! */ 446 if gotlino = 0 then gotlino = 1; /* ! */ 447 end; /* ! */ 448 call ioa_ ("^d", gotlino); 449 go to next; /* ! */ 450 451 452 /* */ 453 /* ********* delete ********* */ 454 dellin: if num_err ^= 0 then go to numeric_err; /* use getlines, dont move to tofile */ 455 if edata.eof_ then go to eof; 456 if edata.lngth ^= 0 then do; 457 edata.changed = "1"b; 458 edata.isok = -1; 459 edata.lngth = 0; /* leave him at Noline. */ 460 end; 461 if n - 1 > 0 then do; /* if more than current line to delete */ 462 mg_lines = n-1; /* delete this many more */ 463 mg_chars = edata.csize1 - edata.indf; /* up to eof */ 464 call GET_LINES; /* setting g_chars, g_lines */ 465 if g_chars = 0 then g_chars = mg_chars; /* no newlines found */ 466 if g_chars ^= 0 then do; /* actually deleted something */ 467 edata.changed = "1"b; 468 edata.isok = -1; 469 end; 470 if g_lines ^= mg_lines then do; /* wanted more than got */ 471 edata.indf = edata.csize1; /* swallow rest of fromfile */ 472 edata.eof_ = "1"b; 473 go to eof; 474 end; 475 else edata.indf = edata.indf + g_chars; 476 end; 477 go to next; /* else keep quiet */ 478 479 /* ********* insert ********* */ 480 481 insert: call PUT; /* add current line to file */ 482 retype: /* doubles as retype com. without above */ 483 if substr (buffer, 2, 1) = " " then skipblank = 1;else skipblank = 0; 484 edata.lngth = count - skipblank - 1; 485 if edata.lngth ^= 0 then 486 substr (line, 1, edata.lngth) = substr (buffer, skipblank + 2, edata.lngth); /* add replaced (inserted) line */ 487 edata.changed = "1"b; /* text changed */ 488 edata.eof_ = "0"b; /* not EOF now */ 489 edata.isok = -1; 490 go to next; 491 492 /* */ 493 /* ********* next + print ********* */ 494 495 nexlin: printing = 0;go to NPSET; /* go to nth follwing line */ 496 print: printing = 1; /* print curline + n-1 following lines */ 497 /* There are two obvious strategies. */ 498 /* One is to move the lines to tofile as */ 499 /* they are counted. That way we never have */ 500 /* to double back and touch the same text twice. */ 501 /* The other way is to count ahead n lines, */ 502 /* and then move them all at once to the tofile. */ 503 /* That way the move part of the operation is faster. */ 504 /* On balance the first way is cheaper, at least for */ 505 /* large n. However it uses measurably more cpu */ 506 /* and so the following compromise was devised which */ 507 /* has the advantages of both, taking the */ 508 /* lesser working set of the first method */ 509 /* and the increased speed of the second. */ 510 /* This is basicaly the first method, taking */ 511 /* account of the fact that an "mlr" of one line */ 512 /* (say 8 words) is about half as efficent */ 513 /* as a long "mlr", by moving approx chunk chars */ 514 /* when possible. */ 515 NPSET: 516 if num_err ^= 0 then go to numeric_err; /* p, n take number only */ 517 if printing ^= 0 then do; 518 if n = 1 then go to NPFIN; /* just print current line */ 519 else do; 520 if edata.eof_ then go to eof; /* make wure not at eof already */ 521 n = n - 1; /* print 10 touches one less line than next 10 */ 522 call PRINT_CURLINE; /* because it prints and counts the curline */ 523 end; 524 end; 525 526 call PUT; /* put away curline */ 527 mg_lines = n - 1; 528 tnx = edata.csize1 - edata.indf; /* max num of chars to move */ 529 g_chars = 0; /* this many done so far */ 530 g_lines = 0; /* " */ 531 NPLOOP: 532 mg_lines = mg_lines - g_lines; /* find num of lines left to move */ 533 if mg_lines = 0 then go to NPGET; /* have done all lines requested, less one */ 534 mg_chars = min (chunk, tnx); /* max num to move at once is chunk */ 535 if mg_chars = 0 then go to NPGET; 536 537 call GET_LINES; /* get up to mg_lines, totaling <= mg_chars */ 538 if g_chars = 0 then g_chars = mg_chars; /* no more , take all */ 539 if printing ^= 0 then 540 call iox_$put_chars (iox_$user_output, addr (substr (edata.fptr -> string, edata.indf+1, 1)), (g_chars), code); 541 call MOVE_CHARS; /* moves these lines, step ptrs & curlino */ 542 tnx = tnx - g_chars; 543 go to NPLOOP; 544 545 NPGET: call GET; /* always get line, except for p1 */ 546 NPFIN: 547 if edata.eof_ then go to eof; 548 else if printing ^= 0 then call PRINT_CURLINE; /* print req, must print */ 549 else if ^brief then call PRINT_CURLINE; /* next req, maybe print */ 550 go to next; 551 552 /* */ 553 /* ********* locate & find ********* */ 554 555 find: locating = 0; go to FLSET; 556 locate: locating = 1; 557 /* locstring has last string specified for */ 558 /* find or locate, with a newline tacked on the */ 559 /* front of the string. If we are to do a */ 560 /* locate, we just set a pointer and a length */ 561 /* so as to not see that newline. */ 562 /* After we have tried to locate the string */ 563 /* the idea is to move as little text around */ 564 /* as possible. Clearly when the search fails */ 565 /* no text need be moved at all. */ 566 567 FLSET: 568 if count ^= 2 then do; /* new string given to be located */ 569 if substr (buffer, 2, 1) = " " then skipblank = 1; else skipblank = 0; 570 locend = count - 1 - skipblank; /* not counting cmd char, , or poss blank */ 571 /* but counting the canned newline */ 572 substr (locstring, 2, locend - 1) /* follow canned leading newline in locstring */ 573 = substr (buffer, 2 + skipblank, locend - 1); /* with string to be found */ 574 end; 575 else if locend = 1 then go to incmplt; /* has never been set evidently */ 576 577 locp = addr (substr (locstring, 1 + locating, 1)); /* no leading for locate */ 578 loclen = locend - locating; /* so string is one char shorter for now */ 579 580 call FIND_LOCATE; 581 if where_found = 0 then do; /* not found */ 582 call com_err_ (0, me, "Search failed."); 583 go to reset_io; 584 end; 585 586 if where_found = 1 then do; /* found in fromfile */ 587 call PUT; /* put away curline */ 588 if k ^= 0 then do; 589 g_chars = k; /* set arg for move */ 590 edata.curlino = -1; /* lose track of line num */ 591 call MOVE_CHARS; 592 end; 593 end; 594 else do; /* found in tofile */ 595 edata.curlino = -1; /* lose line num */ 596 if edata.isok ^= -1 then do; /* tofile identical to fromfile, dont move text */ 597 edata.indf, edata.indt = k; /* presto, changeo */ 598 go to FLFIN; /* where we pick up new curline */ 599 end; 600 bkover = edata.indt - k; /* compute amount to back up over */ 601 if edata.fptr ^= orig_ptr then /* not users file */ 602 if bkover + edata.lngth < edata.indf then /* and will fit in fromfile */ 603 if bkover < edata.csize1 - edata.indf + k /* and cheaper */ 604 then do; /* then take shortcut */ 605 call COPY_BACK; 606 go to FLFIN; 607 end; 608 call COPY; 609 call SWITCH; 610 g_chars = k; /* set arg for move */ 611 call MOVE_CHARS; 612 end; 613 FLFIN: 614 call GET; /* pick up new current line */ 615 if ^brief then call PRINT_CURLINE; 616 go to next; 617 618 /* */ 619 /* ********* change ********* */ 620 621 change: 622 located = "0"b; 623 if edct = cm1 624 then do; 625 incmplt: call com_err_ (0, me, "Incomplete request: ^a", com_line); 626 go to reset_io; 627 end; 628 break = substr (buffer, edct + 1, 1); 629 i = index (substr (buffer, edct+2, count-edct-2), break); 630 if i = 0 then go to incmplt; 631 j = index (substr (buffer, i+edct+2, count-edct-i-2), break); 632 if j = 0 then j = count-i-edct-1; /* Final break char not required */ 633 else if (edct + i + j + 2) ^= count 634 then go to request_err; 635 /* Extra stuff in request line */ 636 if edata.lngth = 0 then go to chnoline; /* no current line */ 637 ch1: temp1 = "0"b; /* to indicate if anything was c'd on line */ 638 m, ij, l = 1; /* indexes to strings */ 639 640 if i = 1 then do; /* add to begining of line */ 641 ij = j + edata.lngth -1; 642 if ij > 152 then do; 643 LONG_ERROR: 644 call com_err_ (0, me, "Change would result in too long a line. Max length is 152. Request ignored:^/ ^a", 645 com_line); 646 go to reset_io; 647 end; 648 temp1, located = "1"b; 649 if j ^= 1 then substr (tlin, 1, j-1) = substr (buffer, edct+i+2, j-1); /* copy part to be added */ 650 substr (tlin, j, edata.lngth) = substr (line, 1, edata.lngth); /* copy old line */ 651 if ^brief then do; 652 substr (olin, 1, 1) = rrs; /* shift to red for printed line */ 653 if j ^= 1 then substr (olin, 2, j-1) = substr (buffer, edct+i+2, j-1); /* copy */ 654 substr (olin, j+1, 1) = brs; /* black */ 655 substr (olin, j+2, edata.lngth) = substr (line, 1, edata.lngth); 656 l = j + edata.lngth +1; 657 end; 658 end; 659 else do; /* string to other string */ 660 ch2: if edata.lngth = m then k = 0; 661 else k = index (substr (line, m, edata.lngth-m), substr (buffer, edct+2, i-1)); /* locate what is to be changed */ 662 if k ^= 0 then do; 663 if (ij+k-2) > 152 then go to LONG_ERROR; 664 if k ^= 1 then substr (tlin, ij, k-1) = substr (line, m, k-1); /* copy line up to change */ 665 if j ^= 1 then substr (tlin, ij+k-1, j-1) = substr (buffer, edct+i+2, j-1); /* put in change */ 666 if ^brief then do; 667 if k ^= 1 then substr (olin, l, k-1) = substr (line, m, k-1); 668 substr (olin, l+k-1, 1) = rrs; /* red */ 669 if j ^= 1 then substr (olin, l+k, j-1) = substr (buffer, edct+i+2, j-1); 670 substr (olin, l+k+j-1, 1) = brs; /* black */ 671 l = l + k + j; 672 end; 673 m = m + k + i - 2; /* increment indexes */ 674 ij = ij + k + j - 2; 675 temp1, located = "1"b; /* indicate that you did someting */ 676 go to ch2; 677 end; 678 ii = ij + edata.lngth - m; 679 if ii > 152 then go to LONG_ERROR; 680 if temp1 then do; 681 if edata.lngth-m+1 ^= 0 then 682 substr (tlin, ij, edata.lngth-m+1) = substr (line, m, edata.lngth-m+1); /* copy rest of line */ 683 ij = ii; 684 if ^brief then do; 685 if edata.lngth-m+1 ^= 0 then 686 substr (olin, l, edata.lngth-m+1) = substr (line, m, edata.lngth-m+1); 687 l = l + edata.lngth - m; 688 end; 689 end; 690 end; 691 if temp1 then do; 692 substr (line, 1, ij) = substr (tlin, 1, ij); 693 edata.lngth = ij; 694 edata.changed = "1"b; /* the text has been changed */ 695 edata.isok = -1; /* tofile ^= fromfile anymore */ 696 if ^brief then call iox_$put_chars (iox_$user_output, addr (olin), l, code); 697 end; 698 chnoline: if n = 1 then do; /* finished */ 699 if ^located then do; 700 call com_err_ (0, me, "Substitution failed."); 701 go to reset_io; 702 end; 703 go to next; 704 end; 705 n = n-1; 706 call PUT; 707 /* NEW FAST CODE */ 708 if ^temp1 then do; /* Dual purpose test: always fails for s//string/ */ 709 /* and prevents bad performance in case where change */ 710 CGLOOP: /* will be made on more than half the lines of a group. */ 711 if n > 1 then /* If not line to be stopped on */ 712 if edata.csize1 - edata.indf > 0 then do; /* If not impending eof */ 713 cgscanlen = min (edata.csize1 - edata.indf, chunk); 714 xxxx = index (substr (edata.fptr -> string, edata.indf + 1, cgscanlen), substr (buffer, edct +2, i -1)); 715 if xxxx ^= 0 then mg_chars = xxxx; 716 else mg_chars = cgscanlen; 717 mg_lines = n - 1; 718 719 call GET_LINES; 720 if g_chars = 0 then /* if no between here and xxxx */ 721 if xxxx ^= 0 then /* and not just flushing along */ 722 go to CGGET; /* then better pick up line */ 723 call MOVE_CHARS; 724 725 n = n - g_lines; 726 if xxxx = 0 then go to CGLOOP; 727 end; 728 end; 729 CGGET: /* END NEW FAST CODE */ 730 call GET; 731 if edata.eof_ then go to eof; 732 go to ch1; 733 /* */ 734 735 /* ******** quit ********* */ 736 737 quit: 738 if cm1 ^= 1 then go to request_err; 739 /* if user has made changes ask */ 740 if edata.changed then do; /* if he really wants to quit */ 741 call command_query_ (addr (query_info), answer, me, 742 "Changes to text since last ""w"" request will be lost if you quit;^/do you wish to quit?"); 743 if answer ^= "yes" then go to pedit; 744 end; 745 746 q_force: if cm1 > 2 then go to request_err; 747 call clean; 748 exit: active = 0; /* Reset flag */ 749 go to return; 750 /* */ 751 752 /* ********* top ********* */ 753 754 top: 755 if cm1 ^= 1 then go to request_err; /* must be only a "t" */ 756 757 if edata.isok >= 0 then do; 758 edata.indt, edata.indf = 0; 759 go to TSET; 760 end; 761 if edata.indf >= edata.indt + edata.lngth /* poss to copy back */ 762 then if edata.indt < edata.csize1 - edata.indt /* worth copying back */ 763 then if edata.fptr ^= orig_ptr /* and not back to users file */ 764 then do; 765 bkover = edata.indt; /* backup over whole to file */ 766 call COPY_BACK; /* copy top of to to from */ 767 TSET: edata.lngth = 0; /* we're at Noline */ 768 edata.eof_ = "0"b; /* no way at eof */ 769 edata.curlino = 1; 770 go to next; 771 end; 772 773 call COPY; 774 call SWITCH; 775 edata.curlino = 1; 776 go to next; 777 778 /* ********* bottom ********* */ 779 780 bottom: 781 if cm1 ^= 1 then go to request_err; 782 edata.curlino = -1; 783 784 call COPY; 785 edata.lngth = 0; 786 go to pinput; 787 788 /* */ 789 790 /* ********* backup ********* */ 791 792 backup: /* backup n lines */ 793 if num_err ^= 0 then go to numeric_err; /* b takes a number only */ 794 795 edata.eof_ = "0"b; /* no way to remain at eof */ 796 scanlen = edata.indt - 1; /* nchars in tofile, less last nl */ 797 798 if edata.curlino ^= -1 then do; /* if we know current line num */ 799 if edata.curlino <= n then do; /* if we are sure to hit top-Noline */ 800 bklen = 0; 801 scanlen = -1; /* so new indt = 0, bkover = edata.indt */ 802 nbk = edata.curlino - 1; 803 go to BKDO; /* that was easy */ 804 end; 805 end; 806 807 if edata.isok ^= -1 /* if files the same */ 808 then trick_ptr = edata.fptr; /* then touch pages of fromfile */ 809 else trick_ptr = edata.tptr; /* else must touch tofile pages */ 810 811 do nbk = 0 to n - 1; /* see how far back to go */ 812 if scanlen <= 0 then do; /* at first line, its a newline only */ 813 bklen = scanlen + 1; 814 if bklen = 0 then go to BKDO; /* can't back up any further */ 815 end; 816 else do; /* there is more to scan back */ 817 bklen = index (reverse (substr 818 (trick_ptr -> string, 1, scanlen)), nl); /* if nl found, line is this long */ 819 if bklen = 0 then bklen = scanlen + 1; /* length is what we scanned plus one */ 820 end; 821 scanlen = scanlen - bklen; /* start next scan before it */ 822 end; /* unless we've backed up enough already */ 823 BKDO: /* note, line stopped on has length of bklen */ 824 g_chars = scanlen + 1; /* will be new indt */ 825 bkover = edata.indt - g_chars; /* chars between curlne and start of new curline */ 826 827 if edata.isok >= 0 then do; /* must be >= edata.indt ... */ 828 edata.indt, edata.indf = g_chars; /* no copying needed, top of tofile is identical to fromfile */ 829 go to BKFIN; /* go to load line */ 830 end; 831 832 if edata.fptr ^= orig_ptr /* if not copying back to users file */ 833 then if edata.indf >= bkover + edata.lngth /* if possible to copy back to fromfile */ 834 then if edata.csize1 - edata.indf + edata.indt - bkover > bkover /* and a shorter move */ 835 then do; /* then ok to take shortcut */ 836 call COPY_BACK; /* use bkover to modify edata, do job */ 837 go to BKFIN; 838 end; 839 /* must do it the hard way */ 840 call COPY; /* copy the rest of fromfile to tofile */ 841 call SWITCH; /* switch buffers */ 842 call MOVE_CHARS; /* load new tofile, mung line num */ 843 BKFIN: 844 if bklen = 0 then edata.lngth = 0; /* at top/Noline. */ 845 else call GET; /* go thr GET for new curline */ 846 if Edata_pi.curlino ^= -1 then do; /* update line number if possible */ 847 edata.curlino = Edata_pi.curlino - nbk; 848 end; 849 if ^brief then call PRINT_CURLINE; 850 go to next; 851 852 /* */ 853 854 /* ********** move ********** */ 855 856 move_: /* code to do "move M N */ 857 858 if count = 5 then go to incmplt; 859 /* set i to be chars gone by */ 860 i = 4; 861 call GET_NUM; /* pickup starting linno */ 862 M = N; /* subr sets N */ 863 864 i = i + j; 865 if i = count - 1 then N = 1; 866 else do; 867 call GET_NUM; 868 if j ^= count - i - 1 then go to request_err; 869 end; 870 871 872 /* Determine if move is legal */ 873 874 if edata.curlino = -1 then do; 875 call GET_LINO; 876 edata.curlino = gotlino; 877 end; 878 879 if M <= edata.curlino then 880 if M+N > edata.curlino then do; 881 call com_err_ (0b, me, "Text overlaps current line."); 882 go to reset_io; 883 end; 884 885 Edata_pi.isok = -1; /* soon buffers no longer match */ 886 call CHECK_ORIG; /* must not store into orig */ 887 888 if edata.curlino > M then do; 889 /* move from above */ 890 /* copy tail of fromfile to tofile */ 891 /* (will replace if pi taken) */ 892 /* switch buffers */ 893 /* set up the new tofile, rearranged */ 894 i = GET_BLOCK (edata.tptr, 0, edata.indt, M-1); 895 j = GET_BLOCK (edata.tptr, i, edata.indt - i, N); 896 k = edata.indt - i - j; 897 898 substr (edata.tptr -> string, edata.indt+edata.lngth+1, edata.csize1- edata.indf) 899 = substr (edata.fptr -> string, edata.indf+1, edata.csize1-edata.indf); 900 move_data.x1 = edata.indf; 901 move_data.x2 = edata.indt + edata.lngth; 902 move_data.xlen = edata.csize1 - edata.indf; 903 move_data.y1, move_data.y2, move_data.ylen = 0; /* nothing else to note */ 904 did_move = "1"b; 905 906 /* now can start clobbering fromfile */ 907 908 if edata.isok < 0 then /* else >indt so >i so no copy needed */ 909 substr (edata.fptr -> string, 1, i) = substr (edata.tptr -> string, 1, i); 910 substr (edata.fptr -> string, i+1, k) = substr (edata.tptr -> string, i+j+1, k); 911 substr (edata.fptr -> string, i+k+1, edata.lngth) = substr (line, 1, edata.lngth); 912 substr (edata.fptr -> string, edata.lngth+i+k+1, j) = substr (edata.tptr -> string, i+1, j); 913 914 edata.indt, edata.indf = i+j+k+edata.lngth; 915 edata.csize1 = edata.indf + move_data.xlen; 916 edata.fptr = Edata_pi.tptr; 917 edata.tptr = Edata_pi.fptr; 918 end; 919 else do; 920 /* move from below */ 921 /* let tofile have block A, line has L, from has XYZ */ 922 /* assume we want to move block of lines Y */ 923 /* to line from */ 924 /* current state is A L XYZ */ 925 /* change to ALY(X) - XYZ */ 926 /* change to ALY(X) - XZ */ 927 /* (use Y & X in tofile to restor fromfile if pi) */ 928 /* this has been optimized by nudging Z instead */ 929 /* of X when Z is much smaller. Since X has just been */ 930 /* referenced and since shortening fromfile */ 931 /* will tend to prevent COPY_BACK, moving X is */ 932 /* favored unless Z is half as large as X. */ 933 /* note that the existance of (X) is known only */ 934 /* by the pi-handler. note that we needed (X) */ 935 /* for the nudge of X anyway. */ 936 937 /* at noline => go further */ 938 i = GET_BLOCK (edata.fptr, edata.indf, edata.csize1-edata.indf, M-edata.curlino-min (1, edata.lngth)); 939 if i < 0 then do; 940 nonesuch: 941 call com_err_ (0, me, "Specified lines do not exist."); 942 go to reset_io; 943 end; 944 if edata.csize1 - edata.indf - i <= 0 then go to nonesuch; /* nothing left */ 945 j = GET_BLOCK (edata.fptr, edata.indf+i, edata.csize1-edata.indf-i, N); 946 if j < 0 then do; 947 j = edata.csize1 - edata.indf - i; /* take all for "move 75 9999" */ 948 edata.curlino = -1; /* dunno how many lines */ 949 end; 950 else edata.curlino = edata.curlino + N; /* N lines inserted above us */ 951 substr (edata.tptr -> string, edata.indt+1, edata.lngth) 952 = substr (line, 1, edata.lngth); 953 edata.indt = edata.indt + edata.lngth; 954 955 move_data.y1 = edata.indf + i; 956 move_data.y2 = edata.indt; 957 move_data.ylen = j; 958 959 move_data.x2 = edata.indt + j; 960 k = edata.csize1 - edata.indf - i - j; /* get len of Z block */ 961 if i < 2 * k then do; /* if clearly cheaper to nudge X .. */ 962 963 move_data.x1 = edata.indf; 964 move_data.xlen = i; 965 edata.indf = edata.indf + j; 966 i = 0; 967 end; 968 969 else do; 970 move_data.x1 = edata.indf + i + j; 971 move_data.xlen = k; 972 edata.csize1 = edata.csize1 - j; 973 end; 974 975 976 substr (edata.tptr -> string, move_data.x2 + 1, move_data.xlen) 977 = substr (edata.fptr -> string, move_data.x1 + 1, move_data.xlen); 978 substr (edata.tptr -> string, move_data.y2 + 1, move_data.ylen) 979 = substr (edata.fptr -> string, move_data.y1 + 1, move_data.ylen); 980 did_move = "1"b; 981 982 /* now can start clobbering fromfile */ 983 984 substr (edata.fptr -> string, edata.indf + i + 1, move_data.xlen) 985 = substr (edata.tptr -> string, move_data.x2 + 1, move_data.xlen); 986 987 edata.indt = move_data.y2 + move_data.ylen; 988 989 end; 990 991 /* now set items in control structure */ 992 993 if edata.curlino ^= -1 then 994 if edata.lngth ^= 0 then 995 edata.curlino = edata.curlino + 1; /* have PUT ^noline */ 996 edata.isok = -1; 997 edata.lngth = 0; /* leave him at noline */ 998 edata.changed = "1"b; /* remind him to write this opus */ 999 go to next; 1000 1001 /* */ 1002 1003 /* ********** write save ********** */ 1004 1005 wsave: 1006 saveflag = 0; 1007 go to scan_path; 1008 1009 /* ********** delete top ********** */ 1010 1011 delete_top_init: 1012 if cm1 ^= 8 1013 then go to request_err; 1014 1015 delete_top: 1016 edata.indt = 0; 1017 edata.changed = "1"b; /* text edata.changed */ 1018 edata.isok = -1; 1019 edata.curlino = 1; /* set line number */ 1020 go to next; 1021 1022 /* ********** save the top of the file ********** */ 1023 1024 save_top: 1025 saveflag = 2; 1026 edct = 7; /* Set scan pointer */ 1027 go to long_scan; 1028 1029 /* ********** insert a file after the current line ********** */ 1030 1031 insert_file: 1032 saveflag = 3; 1033 edct = 5; /* .. */ 1034 go to long_scan; 1035 1036 ret_insert: 1037 call initiate_file_ (dirname, ename, RW_ACCESS, sptr, merge_bc, code); 1038 if sptr = null 1039 then do; /* try for just r access */ 1040 call initiate_file_ (dirname, ename, R_ACCESS, sptr, merge_bc, code); 1041 if sptr = null then go to new_error; /* Now print message */ 1042 end; 1043 1044 ret_insert_default: 1045 segsize = divide (merge_bc+ 8, 9, 21, 0); 1046 call PUT; 1047 edata.lngth = 0; 1048 if segsize ^= 0 then do; 1049 substr (edata.tptr -> string, edata.indt + 1, segsize) 1050 = substr (sptr -> string, 1, segsize); 1051 edata.indt = edata.indt + segsize; 1052 edata.changed = "1"b; /* text edata.changed */ 1053 edata.isok = -1; 1054 edata.curlino = -1; 1055 end; 1056 go to next; 1057 1058 /* ********* save ********* */ 1059 1060 long_scan: 1061 edct = edct - 1 + verify (substr (buffer, edct + 1, count - edct), " "); 1062 1063 /* 1064* do edct = edct to cm1 while (ed.lin (edct) = " "); 1065* end; 1066* */ 1067 1068 scan_path: /* Code used to be here to guarantee no blanks in pathname */ 1069 lprinam = cm1 - edct; /* Derive length of rest of line (from first non-blank) */ 1070 1071 if (lname + lprinam) = 0 then do; /* no default name, no given name => lose */ 1072 call com_err_ (0, me, "No segment name given in ^a request.", com_line); 1073 go to reset_io; 1074 end; 1075 if lprinam ^= 0 then do; /* use name given in this request */ 1076 np = addr (substr (buffer, edct + 1, 1)); /* get ptr to segname */ 1077 call expand_pathname_ (substr (buffer, edct+1, lprinam), dirname, ename, code); 1078 if code ^= 0 then do; /* funny path => lose */ 1079 badname: call com_err_ (code, me, "^a", xarg); 1080 go to reset_io; 1081 end; 1082 call check_entryname_ (ename, code); /* Is good name? */ 1083 if code ^= 0 then go to badname; 1084 if saveflag = 3 then go to ret_insert; /* "merge" request, initiate it above */ 1085 else do; /* write or upwrite */ 1086 call hcs_$make_seg (dirname, ename, "", 01010b, sptr, code); /* create if not found */ 1087 if sptr = null then go to new_error; /* can't do it => lose */ 1088 end; 1089 end; 1090 else do; /* use default name */ 1091 sptr = orig_ptr; /* see about default pointer */ 1092 if sptr = null then do; /* not good */ 1093 if saveflag = 3 then do; /* merge */ 1094 call com_err_ (0, me, "No default segment for merge request."); /* nothing there */ 1095 go to reset_io; /* lose */ 1096 end; 1097 else do; /* write or upwrite */ 1098 call hcs_$make_seg (dirnameo, enameo, "", 01010b, sptr, code); /* create if not found */ 1099 if sptr = null then go to error; /* can't do it -> lose */ 1100 end; 1101 end; 1102 else if saveflag = 3 then do; /* merge, pointer good, check access */ 1103 call hcs_$status_mins (sptr, type, merge_bc, code); /* and get bit count */ 1104 if code ^= 0 then go to error; /* no bit count, no editing */ 1105 else go to ret_insert_default; /* good news */ 1106 end; 1107 end; 1108 1109 edata.curlino = -1; /* safety: assume line number is lost */ 1110 1111 if saveflag = 0 then do; 1112 i = edata.indt; /* remember where we were */ 1113 call COPY; /* "w" request, note syntax check before copy */ 1114 end; 1115 else do; /* saveflag = 2, "upwrite" case */ 1116 i = 0; /* forget where we were */ 1117 if sptr = edata.fptr then /* if about to write into fromfile */ 1118 call CHECK_ORIG; /* must not use orig as fromfile */ 1119 end; /* "w" always does COPY so check not needed */ 1120 1121 if edata.indt > i then substr (sptr -> string, i + 1, edata.indt - i) = /* first write block just COPY'd */ 1122 substr (edata.tptr -> string, i + 1, edata.indt - i); 1123 1124 if i > 0 then substr (sptr -> string, 1, i) = /* now write the head */ 1125 substr (edata.tptr -> string, 1, i); 1126 1127 call terminate_file_ (sptr, edata.indt*9, TERM_FILE_TRUNC_BC, code); 1128 if code ^= 0 then go to test_error; 1129 1130 if saveflag = 2 then go to delete_top; 1131 edata.changed = "0"b; /* no unsaved changes after "w" */ 1132 Edata_pi.changed = "0"b; /* if "w" completes then pi won't undo it */ 1133 if edata.isok >= 0 then edata.isok = edata.indt; /* now have two identical buffers, and a file */ 1134 /* which is also identical. This is only possible */ 1135 /* with a virtual memory */ 1136 go to next; 1137 1138 /* ********** call the command processor ********** */ 1139 1140 callms: 1141 substr (buffer, 1, 1) = " "; /* no E */ 1142 call cu_$cp (addr (buffer), count, code); 1143 if active = 0 /* Did it get reset while we were out */ 1144 then call com_err_ (0, me, "Working buffers have been destroyed."); 1145 active = active + 1; /* In any case, say we are still active */ 1146 go to pedit; 1147 1148 /* ********* eof ********* */ 1149 1150 eof: call ioa_ ("EOF"); 1151 go to next; 1152 1153 /* ********** FILE SYSTEM ERROR ********** */ 1154 1155 test_error: if lprinam = 0 then do; /* see which name got error */ 1156 error: dnp = addr (dirnameo); 1157 enp = addr (enameo); 1158 end; 1159 else do; 1160 new_error: dnp = addr (dirname); 1161 enp = addr (ename); 1162 end; 1163 call COM_DE; /* print the error message */ 1164 go to reset_io; 1165 1166 /* ********** return ********** */ 1167 1168 return: return; 1169 1170 /* 1171* ********* " I N T E R N A L P R O C E D U R E S " ********* */ 1172 1173 1174 1175 FIND_LOCATE: proc; /* locate string, wraparound if necess */ 1176 1177 dcl lptr ptr; 1178 dcl indl fixed bin (21); 1179 dcl lscan fixed bin (21); 1180 lptr = edata.fptr; /* search fromfile */ 1181 indl = edata.indf; 1182 lscan = edata.csize1 - edata.indf; 1183 where_found = 1; /* assume found in fromfile */ 1184 FLLOOP: /* try to find the string */ 1185 if locating = 0 then do; /* if finding */ 1186 if substr (lptr -> string, indl + 1, loclen - 1) /* then at top or next line */ 1187 = substr (locp -> string, 2, loclen - 1) then do; /* do not expect a prceeding newline */ 1188 i = 0; 1189 go to FLGOT; 1190 end; 1191 end; 1192 i = index (substr (lptr -> string, indl + 1, lscan), substr (locp -> string, 1, loclen)); 1193 if i = 0 then do; 1194 if where_found = 1 then do; 1195 where_found = -1; 1196 1197 if edata.isok ^= -1 /* if fromfile = tofile */ 1198 then lptr = edata.fptr; /* touch pages of fromfile */ 1199 else lptr = edata.tptr; /* must touch tofile */ 1200 1201 indl = 0; 1202 lscan = edata.indt; 1203 go to FLLOOP; 1204 end; 1205 else do; /* nowhere else to look */ 1206 where_found = 0; /* found nowhere */ 1207 return; 1208 end; 1209 end; 1210 FLGOT: 1211 if locating = 1 then do; /* if locating, we must get start of line */ 1212 k = index (reverse (substr (lptr -> string, indl + 1, i)), nl); 1213 if k ^= 0 then k = i - k + 1; /* chars to kopy */ 1214 end; 1215 else do; /* find */ 1216 k = i; /* kopy up to & inclding at start of found string */ 1217 end; 1218 1219 end FIND_LOCATE; 1220 1221 /* */ 1222 1223 CHECK_ORIG: proc; 1224 1225 if edata.fptr = orig_ptr /* if we are still using orig seg as fromfile */ 1226 then do; /* use a real fromfile in pdir */ 1227 edata.fptr = ptr2; /* note: at entry edata.tptr = ptr1, thus use other */ 1228 substr (edata.fptr -> string, 1, edata.csize1) /* now fill the new fromfile */ 1229 = substr (orig_ptr -> string, 1, edata.csize1); /* from his orig segment */ 1230 Edata_pi.fptr = ptr2; /* dont pi back to other */ 1231 end; 1232 1233 end CHECK_ORIG; 1234 1235 GET_BLOCK: proc (xp, xo, xc, xl) returns (fixed bin (21)); 1236 1237 dcl xp ptr; /* points to base of some seg */ 1238 dcl xo fixed bin (21); /* offset where we start looking */ 1239 dcl xc fixed bin (21); /* is max nchars to examine */ 1240 dcl xl fixed bin (21); /* is number of lines to scan past */ 1241 dcl xx fixed bin (21); /* returned: is number of chars in block */ 1242 1243 dcl (i, j, k) fixed bin (21); /* keep these real local */ 1244 1245 if xl = 0 then return (0); /* not want any */ 1246 1247 xx = 0; 1248 1249 i = 0; 1250 1251 do while (i < xl & xc-xx>0); 1252 j = index (substr (xp -> string, xo+xx+1, xc-xx), nl); 1253 1254 if j = 0 then xx = xc; /* take all the rest */ 1255 else xx = xx + j; 1256 i = i + 1; 1257 1258 end; 1259 1260 if i < xl then return (-1); 1261 else return (xx); 1262 1263 end GET_BLOCK; 1264 1265 GET_NUM: proc; /* called by move_ to get extents */ 1266 i = i + verify (substr (buffer, i + 1, count - i), " ") -1; 1267 j = index (substr (buffer, i+1, count-i), " ") -1; 1268 if j < 0 then j = count - i - 1; 1269 N = cv_dec_check_ (substr (buffer, i+1, j), code); 1270 if code ^= 0 then go to numeric_err; 1271 if N < 0 then go to numeric_err; 1272 if N = 0 then go to nonesuch; 1273 end GET_NUM; 1274 1275 /* */ 1276 1277 clean: proc; /* cleanup handler for edm */ 1278 /* invoked when quit is done in edm and not started */ 1279 1280 /* handler just truncates temporary segments */ 1281 /* in order to conserve pdir space */ 1282 /* and terminates input segment */ 1283 /* also used when exiting from edm */ 1284 1285 dcl code fixed bin (35); 1286 call hcs_$truncate_seg (ptr1, 0, code); 1287 call hcs_$truncate_seg (ptr2, 0, code); 1288 if sptr ^= null then call terminate_file_ (sptr, 0, TERM_FILE_TERM, code); 1289 active = 0; /* Clear flag */ 1290 1291 end clean; 1292 1293 1294 interrupt: proc; /* program interrupt handler */ 1295 1296 /* if ^pi_allowed then user quit while Edata_pi being filled in, */ 1297 /* so we cant use Edata_pi, so we leave at state defined by edata. Note we were */ 1298 /* in the process of making a pi impossible anyway (since we were */ 1299 /* filling Edata_pi from edata) so the user has only lost the ability */ 1300 /* to quit/pi during a few microsec interval when the results would have been */ 1301 /* indeterminate anyway. */ 1302 /* Otherwise we use the Edata_pi to undo the last edit request. */ 1303 /* If did_move is on, then the last request was a move and we must */ 1304 /* put some text back where we got it. did_move is */ 1305 /* turned on AFTER move_data is safe to use, but BEFORE move_data is */ 1306 /* necessary to use for recovery. Further note that the moves made here */ 1307 /* using move_data are to locations which do not overlap sending locations */ 1308 /* which means that quit/pi occuring in this procedure */ 1309 /* are as so many NOP's */ 1310 1311 if pi_allowed then do; 1312 edata = Edata_pi; 1313 if edata.lngth ^= 0 then 1314 substr (line, 1, edata.lngth) = substr (Line_pi, 1, edata.lngth); 1315 if did_move then do; /* restor buffs needed */ 1316 if move_data.xlen > 0 then 1317 substr (edata.fptr -> string, move_data.x1 +1, move_data.xlen) 1318 = substr (edata.tptr -> string, move_data.x2 +1, move_data.xlen); 1319 1320 if move_data.ylen > 0 then 1321 substr (edata.fptr -> string, move_data.y1 +1, move_data.ylen) 1322 = substr (edata.tptr -> string, move_data.y2 +1, move_data.ylen); 1323 did_move = ""b; 1324 end; 1325 end; 1326 1327 go to int_lab; /* go to pedit in initial invocation */ 1328 end interrupt; 1329 /* */ 1330 COM_DE: proc; /* errprint for truncate & bitcount errs */ 1331 1332 call com_err_ (code, me, "^a>^a", dnp -> b168cu, enp -> b32cu); 1333 1334 end COM_DE; 1335 1336 /* */ 1337 1338 /* FOLLOWING IP's are at end of pgm to be near pile of constants */ 1339 1340 COPY: proc; /* copy rest of from file into to file */ 1341 1342 call PUT; 1343 edata.lngth = 0; 1344 if ^edata.iflag then do; /* else new input, nothing to copy */ 1345 ij = edata.csize1 - edata.indf; 1346 if ij > 0 then do; 1347 if edata.isok >= 0 then do; 1348 mc_chars = edata.csize1 - edata.isok; 1349 edata.isok = edata.isok + mc_chars; 1350 end; 1351 else mc_chars = ij; 1352 mc_skip = ij - mc_chars; 1353 1354 if mc_chars > 0 then 1355 substr (edata.tptr -> string, edata.indt + mc_skip + 1, mc_chars) 1356 = substr (edata.fptr -> string, edata.indf + mc_skip + 1, mc_chars); 1357 1358 edata.indt = edata.indt + ij; 1359 edata.indf = edata.indf + ij; 1360 end; 1361 end; 1362 1363 end COPY; 1364 1365 COPY_BACK: proc; 1366 1367 if edata.lngth ^= 0 then do; 1368 edata.indf = edata.indf - edata.lngth; 1369 substr (edata.fptr -> string, edata.indf + 1, edata.lngth) 1370 = substr (line, 1, edata.lngth); /* put current line back in from */ 1371 end; 1372 1373 if bkover > 0 then do; /* move from tofile to fromfile */ 1374 edata.indf = edata.indf - bkover; /* set pointers */ 1375 edata.indt = edata.indt - bkover; 1376 substr (edata.fptr -> string, edata.indf + 1, bkover) 1377 = substr (edata.tptr -> string, edata.indt + 1, bkover); 1378 end; 1379 1380 end COPY_BACK; 1381 1382 /* */ 1383 SWITCH: proc; /* make from-file to-file, and v.v. */ 1384 if edata.tptr = ptr1 then 1385 do; 1386 edata.tptr = ptr2; 1387 edata.fptr = ptr1; 1388 end; else 1389 do; 1390 edata.tptr = ptr1; 1391 edata.fptr = ptr2; 1392 end; 1393 edata.csize1 = edata.indt; 1394 edata.isok, edata.lngth, edata.indt, edata.indf = 0; 1395 edata.iflag, edata.eof_ = "0"b; 1396 return; 1397 end SWITCH; 1398 1399 PRINT_CURLINE: proc; /* print the current line or "Noline." */ 1400 1401 if edata.lngth = 0 then call ioa_ ("No line."); 1402 else call iox_$put_chars (iox_$user_output, addr (line), edata.lngth, code); 1403 1404 end PRINT_CURLINE; 1405 1406 /* */ 1407 GET_LINES: proc; /* get not more than mg_lines totalling <= mg_chars */ 1408 g_chars = 0; 1409 g_lines = 0; 1410 GLOOP: 1411 nxlen = index (substr 1412 (edata.fptr -> string, edata.indf + 1 + g_chars, mg_chars - g_chars), nl); 1413 if nxlen ^= 0 then do; 1414 g_chars = g_chars + nxlen; 1415 g_lines = g_lines + 1; 1416 if g_lines < mg_lines then go to GLOOP; 1417 end; 1418 1419 end GET_LINES; 1420 1421 MOVE_CHARS: proc; /* move block of lines, keep linno if possible */ 1422 1423 if g_chars ^= 0 then do; 1424 if edata.isok >= 0 then do; /* if not -1 then >= edata.indt */ 1425 mc_chars = edata.indf + g_chars - edata.isok; 1426 if mc_chars < 0 then mc_chars = 0; 1427 else edata.isok = edata.isok + mc_chars; 1428 end; 1429 else mc_chars = g_chars; 1430 1431 mc_skip = g_chars - mc_chars; 1432 1433 if mc_chars >0 then 1434 substr (edata.tptr -> string, edata.indt + mc_skip + 1, mc_chars) 1435 = substr (edata.fptr -> string, edata.indf + mc_skip + 1, mc_chars); 1436 edata.indt = edata.indt + g_chars; 1437 edata.indf = edata.indf + g_chars; 1438 end; 1439 1440 if edata.curlino ^= -1 then do; 1441 edata.curlino = edata.curlino + g_lines; 1442 end; 1443 1444 end MOVE_CHARS; 1445 1446 INPUT: proc; /* IP for input mode, near PUT to save pageflts */ 1447 1448 if ^waketable_is_set then do; /* first time input */ 1449 unspec (swt) = ""b; 1450 swt.version = swt_info_version_1; 1451 swt.new_table.wake_map (46) = "1"b; /* octal 56 a period */ 1452 call iox_$control (iox_$user_io, "set_wakeup_table", addr (swt), code); 1453 waketable_is_set = "1"b; 1454 end; 1455 call iox_$modes (iox_$user_io, "wake_tbl", "", (0)); 1456 input: call iox_$get_line (iox_$user_input, bufp, prc, count, code); /* read a line */ 1457 if count = 2 then /* check for mode change */ 1458 if substr (buffer, 1, 1) = "." then do; /* ret to caller, thence editing */ 1459 call iox_$modes (iox_$user_io, "^wake_tbl", "", code); 1460 return; /* from internal proc */ 1461 end; 1462 call PUT; /* pseudo call */ 1463 edata.changed = "1"b; 1464 edata.isok = -1; 1465 edata.eof_ = "0"b; 1466 edata.lngth = count; 1467 substr (line, 1, edata.lngth) = substr (buffer, 1, edata.lngth); /* move line inputted into intermediate storage */ 1468 go to input; /* repeat 'til "." */ 1469 1470 end INPUT; 1471 1472 1473 PUT: proc; /* put current "line" into to-file */ 1474 1475 if edata.lngth ^= 0 then do; /* ignore Nolines. */ 1476 if edata.curlino ^= -1 then do; 1477 if index (substr (line, 1, edata.lngth), nl) ^= edata.lngth 1478 then edata.curlino = -1; /* we could try harder here */ 1479 else edata.curlino = edata.curlino + 1; 1480 end; 1481 if edata.indt >= edata.isok then do; 1482 substr (edata.tptr -> string, edata.indt+1, edata.lngth) 1483 = substr (line, 1, edata.lngth); 1484 end; 1485 edata.indt = edata.indt + edata.lngth; /* set counters */ 1486 if edata.isok >= 0 then 1487 if edata.isok < edata.indt then 1488 edata.isok = edata.indt; 1489 end; 1490 return; 1491 end PUT; 1492 1493 GET: proc; /* load next line from from-file into "line" */ 1494 1495 scanlen = edata.csize1 - edata.indf; 1496 if scanlen = 0 then do; 1497 edata.eof_ = "1"b; 1498 edata.lngth = 0; 1499 return; 1500 end; 1501 else if scanlen > 152 then scanlen = 152; 1502 1503 edata.eof_ = "0"b; 1504 1505 edata.lngth = index (substr (edata.fptr -> string, edata.indf + 1, scanlen), nl); 1506 1507 if edata.lngth = 0 then do; 1508 edata.lngth = min (151, scanlen); /* leave room to for user to add newline */ 1509 if scanlen = 152 then /* were >= 152 chars but no newline */ 1510 call com_err_ (0, me, error_message); /* complain */ 1511 end; 1512 1513 substr (line, 1, edata.lngth) = substr (edata.fptr -> string, edata.indf + 1, edata.lngth); 1514 edata.indf = edata.indf + edata.lngth; /* now set indf */ 1515 1516 end GET; 1517 1518 /* */ 1519 1520 1521 SAVE: proc; /* IP to make pi possible */ 1522 pi_allowed = ""b; /* dont allow while munging data */ 1523 1524 Edata_pi = edata; 1525 substr (Line_pi, 1, edata.lngth) = substr (line, 1, edata.lngth); 1526 did_move = ""b; /* edata, Edata_pi do not differ by a move to undo */ 1527 /* In fact they dont differ at all */ 1528 /* did_move ^= ""b when a move must */ 1529 /* be undone to make Edata_pi come true */ 1530 pi_allowed = "1"b; /* now pi is ok, a NOP until edata changes */ 1531 1532 end SAVE; 1533 1534 1535 /* */ 1536 1537 1538 1539 /* DEBUGGING CODE -- better to rob a pyramid than delete this code -- REM 1540* CKLINO: proc; 1541* call GET_LINO; 1542* if edata.curlino = -1 then do; 1543* edata.curlino = gotlino; 1544* end; 1545* else do; 1546* if edata.curlino ^= gotlino then do; 1547* call ioa_ ("curlino ^d should be ^d", edata.curlino, gotlino); 1548* edata.curlino = gotlino; 1549* end; 1550* 1551* end; 1552* 1553* end CKLINO; 1554* 1555* CKISOK: proc; 1556* 1557* if edata.isok < -1 then call ioa_ ("isok = ^d", edata.isok); 1558* else if edata.isok ^= -1 then do; 1559* 1560* if edata.indt + edata.lngth ^= edata.indf then call ioa_ 1561* ("indt = ^d, lngth = ^d, indf = ^d", 1562* edata.indt, edata.lngth, edata.indf); 1563* else do; 1564* if substr (edata.tptr -> string, 1, edata.indt) 1565* ^= substr (edata.fptr -> string, 1, edata.indt) 1566* then call ioa_ ("files differ, but isok = ^d", edata.isok); 1567* if substr (line, 1, edata.lngth) ^= 1568* substr (edata.fptr -> string, edata.indf + 1 - edata.lngth, edata.lngth) 1569* then call ioa_ ("line and fromfile differ, edata.isok = ^d", edata.isok); 1570* end; 1571* end; 1572* end CKISOK; 1573* 1574* EDUMP: proc; 1575* 1576* call ioa_ ( 1577* "fptr ^p, 1578* indf ^d, 1579* iflag ^w, 1580* csize1 ^d, 1581* tptr ^p, 1582* indt ^d, 1583* eof ^w, 1584* changed ^w, 1585* lngth ^d, 1586* curlino ^d, 1587* isok ^d", 1588* edata.fptr, edata.indf, edata.iflag, edata.csize1, edata.tptr, edata.indt, edata.eof_, edata.changed, edata.lngth, 1589* edata.curlino, edata.isok); 1590* end EDUMP; 1591* 1592* otize: if num_err ^= 0 then go to numeric_err; 1593* dcl (cklinsw, ckisoksw, dumpsw) bit (1) aligned init ("0"b); 1594* 1595* if n = 1 then do; readysw = "1"b; cklinsw = "0"b; ckisoksw = "0"b; dumpsw = "0"b;end; 1596* else if n = 2 then readysw = "0"b; 1597* else if n = 3 then do; cklinsw = "1"b; readysw = "0"b; end; 1598* else if n = 4 then cklinsw = "0"b; 1599* else if n = 5 then do; ckisoksw = "1"b; readysw = "0"b; end; 1600* else if n = 6 then ckisoksw = "0"b; 1601* 1602* else if n = 7 then do ; dumpsw = "1"b; readysw = "0"b; end; 1603* else if n = 8 then dumpsw = "0"b; 1604* else if n > 9 then do; 1605* if n < 64 then chunk = divide (chunk, 4, 17, 0); 1606* else chunk = n; 1607* call ioa_ ("^d word chunks", chunk); 1608* chunk = chunk * 4; 1609* end; 1610* 1611* go to next; 1612* /* END DEBUGGING CODE */ 1613 end edm; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/08/85 1129.1 edm.pl1 >spec>on>41-15>edm.pl1 22 1 04/27/79 1615.0 set_wakeup_table_info.incl.pl1 >ldd>include>set_wakeup_table_info.incl.pl1 23 2 04/09/85 1109.7 access_mode_values.incl.pl1 >spec>on>41-15>access_mode_values.incl.pl1 24 3 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. Edata_pi 000170 automatic structure level 1 dcl 53 set ref 1312 1524* Line_pi 000207 automatic char(152) dcl 57 set ref 1313 1525* M 000102 automatic fixed bin(21,0) dcl 34 set ref 862* 879 879 888 894 938 N 000103 automatic fixed bin(21,0) dcl 34 set ref 862 865* 879 895* 945* 950 1269* 1271 1272 RW_ACCESS 000002 constant bit(3) initial unaligned dcl 2-11 set ref 233* 1036* R_ACCESS 000031 constant bit(3) initial unaligned dcl 2-11 set ref 239* 1040* TERM_FILE_TERM 000000 constant bit(3) initial unaligned dcl 3-14 set ref 1288* TERM_FILE_TRUNC_BC 000001 constant bit(2) initial unaligned dcl 3-13 set ref 1127* active 000022 internal static fixed bin(17,0) initial dcl 94 set ref 188 198* 198 748* 1143 1145* 1145 1289* addr builtin function dcl 153 ref 178 189 189 248 249 411 411 539 539 577 696 696 741 741 1076 1142 1142 1156 1157 1160 1161 1402 1402 1452 1452 answer 000746 automatic varying char(4) dcl 162 set ref 189* 191 741* 743 arg based char unaligned dcl 96 set ref 218* 221* b168cu based char(168) unaligned dcl 70 set ref 1332* b32cu based char(32) unaligned dcl 71 set ref 1332* bklen 000354 automatic fixed bin(21,0) dcl 81 set ref 800* 813* 814 817* 819 819* 821 843 bkover 000350 automatic fixed bin(21,0) dcl 79 set ref 600* 601 601 765* 825* 832 832 832 1373 1374 1375 1376 1376 break 000466 automatic char(1) dcl 96 set ref 628* 629 631 brief 000465 automatic bit(1) unaligned dcl 96 set ref 175* 381* 387* 549 615 651 666 684 696 849 brs constant char(1) initial dcl 96 ref 654 670 buffer 000264 automatic char(152) dcl 64 set ref 178 285 287 290 306 316 317 343 349 353 357 361 413 419 482 485 569 572 628 629 631 649 653 661 665 669 714 1060 1076 1077 1077 1140* 1142 1142 1266 1267 1269 1269 1457 1467 bufp 000332 automatic pointer dcl 65 set ref 178* 272* 365 369 372 412* 625 643 1072 1456* cgscanlen 000351 automatic fixed bin(21,0) dcl 79 set ref 713* 714 716 changed 12 000170 automatic bit(1) initial level 2 in structure "Edata_pi" dcl 53 in procedure "edm" set ref 53* 182* 1132* changed 12 000104 automatic bit(1) initial level 2 in structure "edata" dcl 37 in procedure "edm" set ref 37* 416* 457* 467* 487* 694* 740 998* 1017* 1052* 1131* 1463* check_entryname_ 000114 constant entry external dcl 132 ref 227 1082 chunk 000347 automatic fixed bin(21,0) initial dcl 78 set ref 78* 534 713 cleanup 000732 stack reference condition dcl 151 ref 202 cm1 000447 automatic fixed bin(17,0) dcl 96 set ref 281* 282 297 337 365 365 369 369 372 372 379 385 405 428 623 625 625 643 643 737 746 754 780 1011 1068 1072 1072 code 000443 automatic fixed bin(35,0) dcl 96 in procedure "edm" set ref 185* 186* 207* 208 208 210* 218* 219 221* 227* 228 229* 233* 238 239* 242 272* 366* 411* 412* 539* 696* 1036* 1040* 1077* 1078 1079* 1082* 1083 1086* 1098* 1103* 1104 1127* 1128 1142* 1269* 1270 1332* 1402* 1452* 1456* 1459* code 000100 automatic fixed bin(35,0) dcl 1285 in procedure "clean" set ref 1286* 1287* 1288* com_err_ 000076 constant entry external dcl 132 ref 210 221 229 257 365 369 372 582 625 643 700 881 940 1072 1079 1094 1143 1332 1509 com_line based char dcl 164 set ref 365* 369* 372* 625* 643* 1072* command_query_ 000100 constant entry external dcl 132 ref 189 741 count 000460 automatic fixed bin(17,0) dcl 96 set ref 272* 281 287 311 316 343 349 353 357 361 412* 413 415 419 419 420 484 567 570 629 631 632 633 856 865 868 1060 1142* 1266 1267 1268 1456* 1457 1466 csize1 4 000104 automatic fixed bin(24,0) initial level 3 in structure "edata" dcl 37 in procedure "edm" set ref 37* 233* 239* 255* 255 257 257 463 471 528 601 710 713 761 832 898 898 902 915* 938 944 945 947 960 972* 972 1182 1228 1228 1345 1348 1393* 1495 csize1 4 000170 automatic fixed bin(24,0) initial level 3 in structure "Edata_pi" dcl 53 in procedure "edm" set ref 53* cu_$arg_ptr 000074 constant entry external dcl 132 ref 207 cu_$cp 000070 constant entry external dcl 132 ref 1142 curlino 14 000170 automatic fixed bin(21,0) initial level 2 in structure "Edata_pi" dcl 53 in procedure "edm" set ref 53* 846 847 curlino 14 000104 automatic fixed bin(21,0) initial level 2 in structure "edata" dcl 37 in procedure "edm" set ref 37* 429 442* 445 590* 595* 769* 775* 782* 798 799 802 847* 874 876* 879 879 888 938 948* 950* 950 993 993* 993 1019* 1054* 1109* 1440 1441* 1441 1476 1477* 1479* 1479 cv_dec_check_ 000050 constant entry external dcl 33 ref 1269 cwd 000467 automatic char(1) dcl 96 set ref 317* 319 320 321 322 323 324 325 326 327 328 329 330 331 335 336 340 341 347 did_move 000263 automatic bit(1) initial dcl 62 set ref 62* 904* 980* 1315 1323* 1526* dirname 000774 automatic char(168) unaligned dcl 167 set ref 1036* 1040* 1077* 1086* 1160 dirnameo 001046 automatic char(168) unaligned dcl 167 set ref 218* 233* 239* 248 1098* 1156 divide builtin function dcl 153 ref 255 1044 dnp 000750 automatic pointer dcl 165 set ref 248* 1156* 1160* 1332 edata 000104 automatic structure level 1 dcl 37 set ref 1312* 1524 edct 000445 automatic fixed bin(17,0) dcl 96 set ref 291* 316* 623 628 629 629 631 631 632 633 649 653 661 665 669 714 1026* 1033* 1060* 1060 1060 1060 1068 1076 1077 1077 ename 000754 automatic char(32) unaligned dcl 167 set ref 1036* 1040* 1077* 1082* 1086* 1161 enameo 000764 automatic char(32) unaligned dcl 167 set ref 218* 227* 229* 233* 239* 249 257* 1098* 1157 enp 000752 automatic pointer dcl 165 set ref 249* 1157* 1161* 1332 eof_ 11 000170 automatic bit(1) initial level 2 in structure "Edata_pi" dcl 53 in procedure "edm" set ref 53* eof_ 11 000104 automatic bit(1) initial level 2 in structure "edata" dcl 37 in procedure "edm" set ref 37* 408 455 472* 488* 520 546 731 768* 795* 1395* 1465* 1497* 1503* error_message 000023 internal static char(33) initial dcl 96 set ref 1509* error_table_$no_w_permission 000056 external static fixed bin(35,0) dcl 96 ref 238 error_table_$noarg 000054 external static fixed bin(35,0) dcl 96 ref 208 error_table_$noentry 000052 external static fixed bin(35,0) dcl 96 ref 242 expand_pathname_ 000112 constant entry external dcl 132 ref 218 1077 fixed builtin function dcl 153 ref 306 fptr 000170 automatic pointer level 3 in structure "Edata_pi" dcl 53 in procedure "edm" set ref 917 1230* fptr 000104 automatic pointer level 3 in structure "edata" dcl 37 in procedure "edm" set ref 263* 393* 432 539 539 601 714 761 807 832 898 908 910 911 912 916* 938* 945* 976 978 984 1117 1180 1197 1225 1227* 1228 1316 1320 1354 1369 1376 1387* 1391* 1410 1433 1505 1513 g_chars 000342 automatic fixed bin(21,0) dcl 75 set ref 465 465* 466 475 529* 538 538* 539 542 589* 610* 720 823* 825 828 1408* 1410 1410 1414* 1414 1423 1425 1429 1431 1436 1437 g_lines 000341 automatic fixed bin(21,0) dcl 75 set ref 470 530* 531 725 1409* 1415* 1415 1416 1441 gotlino 000456 automatic fixed bin(21,0) dcl 96 set ref 436* 440* 442 445* 446 446* 448* 876 hcs_$make_seg 000072 constant entry external dcl 132 ref 185 186 1086 1098 hcs_$status_mins 000116 constant entry external dcl 132 ref 1103 hcs_$truncate_seg 000066 constant entry external dcl 132 ref 1286 1287 i 001157 automatic fixed bin(21,0) dcl 1243 in procedure "GET_BLOCK" set ref 1249* 1251 1256* 1256 1260 i 000450 automatic fixed bin(21,0) dcl 96 in procedure "edm" set ref 287* 288 288* 291 306 310* 310 311 316 316 316 434* 437 437 438* 438 629* 630 631 631 632 633 640 649 653 661 665 669 673 714 860* 864* 864 865 868 894* 895* 895 896 908 908 910 910 911 912 912 914 938* 939 944 945 945 947 955 960 961 964 966* 970 984 1112* 1116* 1121 1121 1121 1121 1121 1124 1124 1124 1188* 1192* 1193 1212 1213 1216 1266* 1266 1266 1266 1267 1267 1268 1269 1269 iflag 3 000170 automatic bit(1) initial level 3 in structure "Edata_pi" dcl 53 in procedure "edm" set ref 53* iflag 3 000104 automatic bit(1) initial level 3 in structure "edata" dcl 37 in procedure "edm" set ref 37* 265* 1344 1395* ii 000442 automatic fixed bin(21,0) dcl 96 set ref 678* 679 683 ij 000441 automatic fixed bin(21,0) dcl 96 set ref 638* 641* 642 663 664 665 674* 674 678 681 683* 692 692 693 1345* 1346 1351 1352 1358 1359 index builtin function dcl 153 ref 437 629 631 661 714 817 1192 1212 1252 1267 1410 1477 1505 indf 2 000104 automatic fixed bin(21,0) initial level 3 in structure "edata" dcl 37 in procedure "edm" set ref 37* 440 463 471* 475* 475 528 539 539 597* 601 601 710 713 714 758* 761 828* 832 832 898 898 898 900 902 914* 915 938* 938 944 945 945 947 955 960 963 965* 965 970 984 1181 1182 1345 1354 1359* 1359 1368* 1368 1369 1374* 1374 1376 1394* 1410 1425 1433 1437* 1437 1495 1505 1513 1514* 1514 indf 2 000170 automatic fixed bin(21,0) initial level 3 in structure "Edata_pi" dcl 53 in procedure "edm" set ref 53* indl 001140 automatic fixed bin(21,0) dcl 1178 set ref 1181* 1186 1192 1201* 1212 indt 10 000104 automatic fixed bin(21,0) initial level 2 in structure "edata" dcl 37 in procedure "edm" set ref 37* 435 437 440 597* 600 758* 761 761 761 765 796 825 828* 832 894* 895 896 898 901 914* 951 953* 953 956 959 987* 1015* 1049 1051* 1051 1112 1121 1121 1121 1127 1133 1202 1354 1358* 1358 1375* 1375 1376 1393 1394* 1433 1436* 1436 1481 1482 1485* 1485 1486 1486 indt 10 000170 automatic fixed bin(21,0) initial level 2 in structure "Edata_pi" dcl 53 in procedure "edm" set ref 53* initiate_file_ 000106 constant entry external dcl 132 ref 233 239 1036 1040 int_lab 000722 automatic label variable initial dcl 96 set ref 96* 1327 ioa_ 000104 constant entry external dcl 132 ref 243 271 399 448 1150 1401 iox_$control 000102 constant entry external dcl 132 ref 366 1452 iox_$get_line 000064 constant entry external dcl 132 ref 272 412 1456 iox_$modes 000044 constant entry external dcl 27 ref 1455 1459 iox_$put_chars 000120 constant entry external dcl 132 ref 411 539 696 1402 iox_$user_input 000060 external static pointer dcl 96 set ref 272* 366* 412* 1456* iox_$user_io 000046 external static pointer dcl 28 set ref 1452* 1455* 1459* iox_$user_output 000062 external static pointer dcl 96 set ref 411* 539* 696* 1402* isok 15 000104 automatic fixed bin(17,0) initial level 2 in structure "edata" dcl 37 in procedure "edm" set ref 37* 417* 432 458* 468* 489* 596 695* 757 807 827 908 996* 1018* 1053* 1133 1133* 1197 1347 1348 1349* 1349 1394* 1424 1425 1427* 1427 1464* 1481 1486 1486 1486* isok 15 000170 automatic fixed bin(17,0) initial level 2 in structure "Edata_pi" dcl 53 in procedure "edm" set ref 53* 885* j 000451 automatic fixed bin(21,0) dcl 96 in procedure "edm" set ref 306* 307 308 309 631* 632 632* 633 641 649 649 649 650 653 653 653 654 655 656 665 665 665 669 669 669 670 671 674 864 868 895* 896 910 912 912 914 945* 946 947* 957 959 960 965 970 972 1267* 1268 1268* 1269 1269 j 001160 automatic fixed bin(21,0) dcl 1243 in procedure "GET_BLOCK" set ref 1252* 1254 1255 k 000452 automatic fixed bin(21,0) dcl 96 set ref 435* 436 437* 438 588 589 597 600 601 610 660* 661* 662 663 664 664 664 665 667 667 667 668 669 670 671 673 674 896* 910 910 911 912 914 960* 961 971 1212* 1213 1213* 1213 1216* l 000454 automatic fixed bin(17,0) dcl 96 set ref 638* 656* 667 668 669 670 671* 671 685 687* 687 696* line 000122 automatic char(152) dcl 51 set ref 411 411 419* 485* 650 655 661 664 667 681 685 692* 911 951 1313* 1369 1402 1402 1467* 1477 1482 1513* 1525 lname 000461 automatic fixed bin(17,0) dcl 96 set ref 174* 207* 214 218 218 221 221 1071 lngth 13 000104 automatic fixed bin(17,0) initial level 2 in structure "edata" dcl 37 in procedure "edm" set ref 37* 409 410 411 419 420* 420 456 459* 484* 485 485 485 601 636 641 650 650 655 655 656 660 661 678 681 681 681 685 685 685 687 693* 761 767* 785* 832 843* 898 901 911 911 912 914 938 951 951 953 993 997* 1047* 1313 1313 1313 1343* 1367 1368 1369 1369 1394* 1401 1402* 1466* 1467 1467 1475 1477 1477 1482 1482 1485 1498* 1505* 1507 1508* 1513 1513 1514 1525 1525 lngth 13 000170 automatic fixed bin(17,0) initial level 2 in structure "Edata_pi" dcl 53 in procedure "edm" set ref 53* located 000463 automatic bit(1) unaligned dcl 96 set ref 621* 648* 675* 699 locating 000360 automatic fixed bin(17,0) dcl 84 set ref 555* 556* 577 578 1184 1210 locend 000430 automatic fixed bin(17,0) dcl 88 set ref 570* 572 572 575 578 loclen 000427 automatic fixed bin(17,0) dcl 88 set ref 578* 1186 1186 1192 locp 000434 automatic pointer dcl 91 set ref 577* 1186 1192 locstring 000361 automatic char(152) initial dcl 86 set ref 86* 572* 577 lprinam 000462 automatic fixed bin(17,0) dcl 96 set ref 1068* 1071 1075 1077 1077 1079 1079 1155 lptr 001136 automatic pointer dcl 1177 set ref 1180* 1186 1192 1197* 1199* 1212 lscan 001141 automatic fixed bin(21,0) dcl 1179 set ref 1182* 1192 1202* m 000440 automatic fixed bin(21,0) dcl 96 set ref 638* 660 661 661 664 667 673* 673 678 681 681 681 681 685 685 685 685 687 mc_chars 000346 automatic fixed bin(21,0) dcl 77 set ref 1348* 1349 1351* 1352 1354 1354 1354 1425* 1426 1426* 1427 1429* 1431 1433 1433 1433 mc_skip 000345 automatic fixed bin(21,0) dcl 77 set ref 1352* 1354 1354 1431* 1433 1433 me 000021 internal static char(4) initial dcl 93 set ref 189* 210* 221* 229* 257* 365* 369* 372* 582* 625* 643* 700* 741* 881* 940* 1072* 1079* 1094* 1143* 1332* 1509* merge_bc 000731 automatic fixed bin(24,0) dcl 149 set ref 1036* 1040* 1044 1103* mg_chars 000344 automatic fixed bin(21,0) dcl 75 set ref 463* 465 534* 535 538 715* 716* 1410 mg_lines 000343 automatic fixed bin(21,0) dcl 75 set ref 462* 470 527* 531* 531 533 717* 1416 min builtin function dcl 153 ref 534 713 938 1508 move_data 000255 automatic structure level 1 dcl 59 n 000453 automatic fixed bin(21,0) dcl 96 set ref 300* 309* 309 313 313* 461 462 518 521* 521 527 698 705* 705 710 717 725* 725 799 811 nbk 000355 automatic fixed bin(21,0) dcl 81 set ref 802* 811* 847 new_table 1 000010 internal static structure level 2 dcl 26 nl 007130 constant char(1) initial dcl 96 ref 257 437 817 1212 1252 1410 1477 1505 np 000726 automatic pointer dcl 127 set ref 207* 218 221 1076* 1079 null builtin function dcl 153 ref 66 184 237 240 244 366 366 1038 1041 1087 1092 1099 1288 num_err 000446 automatic fixed bin(17,0) dcl 96 set ref 295* 304* 304 312* 454 515 792 nxlen 000356 automatic fixed bin(21,0) dcl 81 set ref 1410* 1413 1414 olin 000537 automatic char(456) dcl 96 set ref 652* 653* 654* 655* 667* 668* 669* 670* 685* 696 696 orig_ptr 000336 automatic pointer dcl 66 set ref 244* 263* 601 761 832 1091 1225 1228 pi_allowed 000206 automatic bit(1) initial dcl 55 set ref 55* 1311 1522* 1530* prc 000457 automatic fixed bin(17,0) dcl 96 set ref 176* 272* 412* 1456* printing 000357 automatic fixed bin(17,0) dcl 83 set ref 495* 496* 517 539 548 program_interrupt 000740 stack reference condition dcl 151 ref 266 396 ptr1 000034 internal static pointer initial dcl 129 set ref 184 185* 264 393 1286* 1384 1387 1390 ptr2 000036 internal static pointer dcl 129 set ref 186* 393 1227 1230 1287* 1386 1391 query_info 000040 internal static structure level 1 dcl 155 set ref 189 189 741 741 readysw 000101 automatic bit(1) initial dcl 32 set ref 32* reverse builtin function dcl 153 ref 817 1212 rrs constant char(1) initial dcl 96 ref 652 668 saveflag 000470 automatic fixed bin(17,0) dcl 96 set ref 1005* 1024* 1031* 1084 1093 1102 1111 1130 scanlen 000340 automatic fixed bin(17,0) dcl 73 set ref 796* 801* 812 813 817 819 821* 821 823 1495* 1496 1501 1501* 1505 1508 1509 segsize 000730 automatic fixed bin(21,0) dcl 148 set ref 1044* 1048 1049 1049 1051 skipblank 000431 automatic fixed bin(17,0) dcl 89 set ref 482* 483* 484 485 569* 569* 570 572 sptr 000334 automatic pointer initial dcl 66 set ref 66* 233* 237 239* 240 257 263 1036* 1038 1040* 1041 1049 1086* 1087 1091* 1092 1098* 1099 1103* 1117 1121 1124 1127* 1288 1288* string based char(262144) dcl 96 set ref 257 437 539 539 714 817 898* 898 908* 908 910* 910 911* 912* 912 951* 976* 976 978* 978 984* 984 1049* 1049 1121* 1121 1124* 1124 1186 1186 1192 1192 1212 1228* 1228 1252 1316* 1316 1320* 1320 1354* 1354 1369* 1376* 1376 1410 1433* 1433 1482* 1505 1513 substr builtin function dcl 153 set ref 257 285 287 290 306 316 317 343 349 353 357 361 413 419* 419 437 482 485* 485 539 539 569 572* 572 577 628 629 631 649* 649 650* 650 652* 653* 653 654* 655* 655 661 661 664* 664 665* 665 667* 667 668* 669* 669 670* 681* 681 685* 685 692* 692 714 714 817 898* 898 908* 908 910* 910 911* 911 912* 912 951* 951 976* 976 978* 978 984* 984 1049* 1049 1060 1076 1077 1077 1121* 1121 1124* 1124 1140* 1186 1186 1192 1192 1212 1228* 1228 1252 1266 1267 1269 1269 1313* 1313 1316* 1316 1320* 1320 1354* 1354 1369* 1369 1376* 1376 1410 1433* 1433 1457 1467* 1467 1477 1482* 1482 1505 1513* 1513 1525* 1525 sw_pi 000455 automatic bit(1) initial dcl 96 set ref 96* 267* 395 397* swt 000010 internal static structure level 1 dcl 26 set ref 1449* 1452 1452 swt_info based structure level 1 dcl 1-9 swt_info_version_1 constant fixed bin(17,0) initial dcl 1-7 ref 1450 temp1 000464 automatic bit(1) unaligned dcl 96 set ref 637* 648* 675* 680 691 708 terminate_file_ 000110 constant entry external dcl 132 ref 1127 1288 tlin 000471 automatic char(152) unaligned dcl 96 set ref 649* 650* 664* 665* 681* 692 tnx 000353 automatic fixed bin(21,0) dcl 79 set ref 528* 534 542* 542 tptr 6 000170 automatic pointer level 2 in structure "Edata_pi" dcl 53 in procedure "edm" set ref 916 tptr 6 000104 automatic pointer level 2 in structure "edata" dcl 37 in procedure "edm" set ref 264* 393* 433 809 894* 895* 898 908 910 912 917* 951 976 978 984 1049 1121 1124 1199 1316 1320 1354 1376 1384 1386* 1390* 1433 1482 trick_ptr 000436 automatic pointer dcl 92 set ref 432* 433* 437 807* 809* 817 type 000444 automatic fixed bin(2,0) dcl 96 set ref 1103* unspec builtin function dcl 153 set ref 306 1449* upper 000170 automatic structure level 2 in structure "Edata_pi" dcl 53 in procedure "edm" upper 000104 automatic structure level 2 in structure "edata" dcl 37 in procedure "edm" verify builtin function dcl 153 ref 287 316 1060 1266 version 000010 internal static fixed bin(17,0) level 2 dcl 26 set ref 1450* wake_map 1 000010 internal static bit(1) array level 3 packed unaligned dcl 26 set ref 1451* waketable_is_set 000100 automatic bit(1) initial unaligned dcl 30 set ref 30* 1448 1453* wakeup_table based structure level 1 dcl 1-16 where_found 000432 automatic fixed bin(17,0) dcl 90 set ref 581 586 1183* 1194 1195* 1206* x1 000255 automatic fixed bin(21,0) level 2 dcl 59 set ref 900* 963* 970* 976 1316 x2 1 000255 automatic fixed bin(21,0) level 2 dcl 59 set ref 901* 959* 976 984 1316 xarg based char unaligned dcl 96 set ref 1079* xc parameter fixed bin(21,0) dcl 1239 ref 1235 1251 1252 1254 xl parameter fixed bin(21,0) dcl 1240 ref 1235 1245 1251 1260 xlen 2 000255 automatic fixed bin(21,0) level 2 dcl 59 set ref 902* 915 964* 971* 976 976 984 984 1316 1316 1316 xo parameter fixed bin(21,0) dcl 1238 ref 1235 1252 xp parameter pointer dcl 1237 ref 1235 1252 xx 001156 automatic fixed bin(21,0) dcl 1241 set ref 1247* 1251 1252 1252 1254* 1255* 1255 1261 xxxx 000352 automatic fixed bin(21,0) dcl 79 set ref 714* 715 715 720 726 y1 3 000255 automatic fixed bin(21,0) level 2 dcl 59 set ref 903* 955* 978 1320 y2 4 000255 automatic fixed bin(21,0) level 2 dcl 59 set ref 903* 956* 978 987 1320 ylen 5 000255 automatic fixed bin(21,0) level 2 dcl 59 set ref 903* 957* 978 978 987 1320 1320 1320 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. A_ACCESS internal static bit(3) initial unaligned dcl 2-11 A_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 DIR_ACCESS_MODE_NAMES internal static char(4) initial array unaligned dcl 2-33 E_ACCESS internal static bit(3) initial unaligned dcl 2-11 E_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 M_ACCESS internal static bit(3) initial unaligned dcl 2-11 M_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 N_ACCESS internal static bit(3) initial unaligned dcl 2-11 N_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 REW_ACCESS internal static bit(3) initial unaligned dcl 2-11 REW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 RE_ACCESS internal static bit(3) initial unaligned dcl 2-11 RE_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 RW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 R_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 SA_ACCESS internal static bit(3) initial unaligned dcl 2-11 SA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 SEG_ACCESS_MODE_NAMES internal static char(4) initial array unaligned dcl 2-30 SMA_ACCESS internal static bit(3) initial unaligned dcl 2-11 SMA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 SM_ACCESS internal static bit(3) initial unaligned dcl 2-11 SM_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 S_ACCESS internal static bit(3) initial unaligned dcl 2-11 S_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 TERM_FILE_BC internal static bit(2) initial unaligned dcl 3-12 TERM_FILE_DELETE internal static bit(5) initial unaligned dcl 3-17 TERM_FILE_FORCE_WRITE internal static bit(4) initial unaligned dcl 3-16 TERM_FILE_TRUNC internal static bit(1) initial unaligned dcl 3-11 TERM_FILE_TRUNC_BC_TERM internal static bit(3) initial unaligned dcl 3-15 W_ACCESS internal static bit(3) initial unaligned dcl 2-11 W_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 error_table_$bad_mode external static fixed bin(35,0) dcl 29 k automatic fixed bin(21,0) dcl 1243 mod builtin function dcl 153 pad_count automatic fixed bin(17,0) dcl 170 ready 000000 constant entry external dcl 35 status automatic bit(72) dcl 96 swt_infop automatic pointer dcl 1-6 terminate_file_switches based structure level 1 packed unaligned dcl 3-4 wakeup_tablep automatic pointer dcl 1-14 NAMES DECLARED BY EXPLICIT CONTEXT. BKDO 003671 constant label dcl 823 ref 803 814 BKFIN 003730 constant label dcl 843 ref 829 837 CGGET 003445 constant label dcl 729 ref 720 CGLOOP 003372 constant label dcl 710 ref 726 CHECK_ORIG 005563 constant entry internal dcl 1223 ref 886 1117 COM_DE 006135 constant entry internal dcl 1330 ref 250 1163 COPY 006172 constant entry internal dcl 1340 ref 608 773 784 840 1113 COPY_BACK 006243 constant entry internal dcl 1365 ref 605 766 836 FIND_LOCATE 005447 constant entry internal dcl 1175 ref 580 FLFIN 002573 constant label dcl 613 ref 598 606 FLGOT 005533 constant label dcl 1210 ref 1189 FLLOOP 005461 constant label dcl 1184 ref 1203 FLSET 002427 constant label dcl 567 ref 555 GET 006735 constant entry internal dcl 1493 ref 422 545 613 729 845 GET_BLOCK 005604 constant entry internal dcl 1235 ref 894 895 938 945 GET_LINES 006366 constant entry internal dcl 1407 ref 464 537 719 GET_LINO 005377 constant entry internal dcl 431 ref 430 875 GET_NUM 005663 constant entry internal dcl 1265 ref 861 867 GLOOP 006371 constant label dcl 1410 ref 1416 INPUT 006475 constant entry internal dcl 1446 ref 400 LONG_ERROR 002745 constant label dcl 643 ref 663 679 MOVE_CHARS 006421 constant entry internal dcl 1421 ref 541 591 611 723 842 NPFIN 002411 constant label dcl 546 ref 518 NPGET 002410 constant label dcl 545 ref 533 535 NPLOOP 002337 constant label dcl 531 ref 543 NPSET 002312 constant label dcl 515 ref 495 PRINT_CURLINE 006327 constant entry internal dcl 1399 ref 522 548 549 615 849 PUT 006667 constant entry internal dcl 1473 ref 421 481 526 587 706 1046 1342 1462 SAVE 007032 constant entry internal dcl 1521 ref 269 284 394 SWITCH 006277 constant entry internal dcl 1383 ref 609 774 841 TSET 003556 constant label dcl 767 ref 759 backup 003600 constant label dcl 792 ref 324 badname 004722 constant label dcl 1079 ref 1083 bottom 003570 constant label dcl 780 ref 328 callms 005274 constant label dcl 1140 ref 285 ch1 002725 constant label dcl 637 ref 732 ch2 003054 constant label dcl 660 ref 676 change 002600 constant label dcl 621 ref 325 330 chnoline 003326 constant label dcl 698 ref 636 clean 005765 constant entry internal dcl 1277 ref 195 202 747 cnoline 002142 constant label dcl 421 ref 409 410 comment 002044 constant label dcl 408 ref 423 comment_init 002041 constant label dcl 405 ref 341 delete_top 004421 constant label dcl 1015 ref 1130 delete_top_init 004416 constant label dcl 1011 ref 361 dellin 002204 constant label dcl 454 ref 326 edm 000377 constant entry external dcl 11 eof 005345 constant label dcl 1150 ref 408 455 473 520 546 731 equals 002145 constant label dcl 428 ref 340 error 005363 constant label dcl 1156 ref 1099 1104 exit 003524 constant label dcl 748 ref 211 222 230 251 find 002423 constant label dcl 555 ref 329 finput 001770 constant label dcl 393 ref 208 214 245 got_num 001432 constant label dcl 313 ref 307 308 got_num_1 001434 constant label dcl 313 set ref 297 have_seg_ptr 001211 constant label dcl 255 ref 240 incmplt 002604 constant label dcl 625 ref 575 630 856 input 006573 constant label dcl 1456 ref 1468 insert 002255 constant label dcl 481 ref 319 insert_file 004436 constant label dcl 1031 ref 349 interrupt 006060 constant entry internal dcl 1294 ref 266 396 locate 002425 constant label dcl 556 ref 321 long_scan 004573 constant label dcl 1060 ref 1027 1034 move_ 003746 constant label dcl 856 ref 353 new_error 005370 constant label dcl 1160 ref 1041 1087 nexlin 002306 constant label dcl 495 ref 323 next 001322 constant label dcl 272 ref 282 368 382 388 449 477 490 550 616 703 770 776 850 999 1020 1056 1136 1151 nonesuch 004212 constant label dcl 940 ref 944 1272 num_loop 001404 constant label dcl 306 ref 311 numeric_err 001663 constant label dcl 369 set ref 454 515 792 1270 1271 pedit 001306 constant label dcl 269 ref 96 401 413 743 1146 pinput 002024 constant label dcl 399 ref 337 786 print 002310 constant label dcl 496 ref 322 q_force 003515 constant label dcl 746 ref 343 quit 003451 constant label dcl 737 ref 347 request_err 001720 constant label dcl 372 ref 338 379 385 405 428 633 737 746 754 780 868 1011 reset_io 001627 constant label dcl 366 set ref 371 374 583 626 646 701 882 942 1073 1080 1095 1164 ret_insert 004443 constant label dcl 1036 ref 1084 ret_insert_default 004545 constant label dcl 1044 ref 1105 return 005376 constant label dcl 1168 ref 191 749 retype 002256 constant label dcl 482 ref 320 save_top 004431 constant label dcl 1024 ref 357 scan_path 004614 constant label dcl 1068 ref 1007 test_error 005361 constant label dcl 1155 ref 1128 top 003527 constant label dcl 754 ref 327 truncate_temp 000623 constant label dcl 195 ref 192 veroff 001762 constant label dcl 385 ref 335 veron 001755 constant label dcl 379 ref 331 wsave 004414 constant label dcl 1005 ref 292 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 7442 7564 7132 7452 Length 10126 7132 122 325 307 34 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME edm 856 external procedure is an external procedure. on unit on line 202 64 on unit on unit on line 266 64 on unit on unit on line 396 64 on unit GET_LINO internal procedure shares stack frame of external procedure edm. FIND_LOCATE internal procedure shares stack frame of external procedure edm. CHECK_ORIG internal procedure shares stack frame of external procedure edm. GET_BLOCK internal procedure shares stack frame of external procedure edm. GET_NUM internal procedure shares stack frame of external procedure edm. clean 92 internal procedure is called by several nonquick procedures. interrupt 64 internal procedure is called by several nonquick procedures. COM_DE internal procedure shares stack frame of external procedure edm. COPY internal procedure shares stack frame of external procedure edm. COPY_BACK internal procedure shares stack frame of external procedure edm. SWITCH internal procedure shares stack frame of external procedure edm. PRINT_CURLINE internal procedure shares stack frame of external procedure edm. GET_LINES internal procedure shares stack frame of external procedure edm. MOVE_CHARS internal procedure shares stack frame of external procedure edm. INPUT internal procedure shares stack frame of external procedure edm. PUT internal procedure shares stack frame of external procedure edm. GET internal procedure shares stack frame of external procedure edm. SAVE internal procedure shares stack frame of external procedure edm. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 swt edm 000021 me edm 000022 active edm 000023 error_message edm 000034 ptr1 edm 000036 ptr2 edm 000040 query_info edm STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME clean 000100 code clean edm 000100 waketable_is_set edm 000101 readysw edm 000102 M edm 000103 N edm 000104 edata edm 000122 line edm 000170 Edata_pi edm 000206 pi_allowed edm 000207 Line_pi edm 000255 move_data edm 000263 did_move edm 000264 buffer edm 000332 bufp edm 000334 sptr edm 000336 orig_ptr edm 000340 scanlen edm 000341 g_lines edm 000342 g_chars edm 000343 mg_lines edm 000344 mg_chars edm 000345 mc_skip edm 000346 mc_chars edm 000347 chunk edm 000350 bkover edm 000351 cgscanlen edm 000352 xxxx edm 000353 tnx edm 000354 bklen edm 000355 nbk edm 000356 nxlen edm 000357 printing edm 000360 locating edm 000361 locstring edm 000427 loclen edm 000430 locend edm 000431 skipblank edm 000432 where_found edm 000434 locp edm 000436 trick_ptr edm 000440 m edm 000441 ij edm 000442 ii edm 000443 code edm 000444 type edm 000445 edct edm 000446 num_err edm 000447 cm1 edm 000450 i edm 000451 j edm 000452 k edm 000453 n edm 000454 l edm 000455 sw_pi edm 000456 gotlino edm 000457 prc edm 000460 count edm 000461 lname edm 000462 lprinam edm 000463 located edm 000464 temp1 edm 000465 brief edm 000466 break edm 000467 cwd edm 000470 saveflag edm 000471 tlin edm 000537 olin edm 000722 int_lab edm 000726 np edm 000730 segsize edm 000731 merge_bc edm 000746 answer edm 000750 dnp edm 000752 enp edm 000754 ename edm 000764 enameo edm 000774 dirname edm 001046 dirnameo edm 001136 lptr FIND_LOCATE 001140 indl FIND_LOCATE 001141 lscan FIND_LOCATE 001156 xx GET_BLOCK 001157 i GET_BLOCK 001160 j GET_BLOCK THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return tra_label_var enable shorten_stack ext_entry int_entry set_cs_eis index_cs_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. check_entryname_ com_err_ command_query_ cu_$arg_ptr cu_$cp cv_dec_check_ expand_pathname_ hcs_$make_seg hcs_$status_mins hcs_$truncate_seg initiate_file_ ioa_ iox_$control iox_$get_line iox_$modes iox_$put_chars terminate_file_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$no_w_permission error_table_$noarg error_table_$noentry iox_$user_input iox_$user_io iox_$user_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000376 30 000404 32 000405 37 000406 53 000421 55 000432 62 000433 66 000434 78 000436 86 000440 96 000443 174 000447 175 000450 176 000451 178 000453 182 000455 184 000456 185 000462 186 000521 187 000561 188 000562 189 000564 191 000615 192 000622 195 000623 198 000627 202 000631 207 000653 208 000672 210 000677 211 000713 214 000714 218 000716 219 000745 221 000747 222 001001 227 001002 228 001017 229 001021 230 001050 233 001051 237 001106 238 001112 239 001116 240 001152 242 001156 243 001162 244 001200 245 001202 248 001203 249 001205 250 001207 251 001210 255 001211 257 001214 263 001253 264 001256 265 001261 266 001262 267 001304 269 001306 271 001307 272 001322 281 001341 282 001344 284 001345 285 001346 287 001353 288 001367 290 001372 291 001374 292 001375 295 001376 297 001377 300 001402 304 001403 306 001404 307 001415 308 001416 309 001420 310 001424 311 001425 312 001431 313 001432 316 001436 317 001457 319 001462 320 001464 321 001466 322 001470 323 001472 324 001474 325 001476 326 001500 327 001502 328 001504 329 001506 330 001510 331 001512 335 001514 336 001516 337 001520 338 001523 340 001524 341 001526 343 001530 347 001537 349 001542 353 001551 357 001557 361 001565 365 001573 366 001627 368 001662 369 001663 371 001717 372 001720 374 001754 379 001755 381 001760 382 001761 385 001762 387 001765 388 001767 393 001770 393 001773 394 001775 395 001776 396 002000 397 002022 399 002024 400 002037 401 002040 405 002041 408 002044 409 002046 410 002051 411 002053 412 002074 413 002113 415 002122 416 002125 417 002127 419 002131 420 002136 421 002142 422 002143 423 002144 428 002145 429 002150 430 002153 442 002154 443 002156 445 002157 446 002160 448 002164 449 002203 454 002204 455 002206 456 002210 457 002212 458 002214 459 002216 461 002217 462 002222 463 002225 464 002230 465 002231 466 002235 467 002236 468 002240 470 002242 471 002245 472 002247 473 002251 475 002252 477 002254 481 002255 482 002256 483 002266 484 002267 485 002273 487 002300 488 002302 489 002303 490 002305 495 002306 495 002307 496 002310 515 002312 517 002314 518 002316 520 002321 521 002323 522 002325 526 002326 527 002327 528 002332 529 002335 530 002336 531 002337 533 002341 534 002343 535 002350 537 002352 538 002353 539 002357 541 002404 542 002405 543 002407 545 002410 546 002411 548 002413 549 002417 550 002422 555 002423 555 002424 556 002425 567 002427 569 002432 569 002442 570 002443 572 002447 574 002454 575 002455 577 002460 578 002464 580 002467 581 002470 582 002472 583 002520 586 002521 587 002523 588 002524 589 002526 590 002527 591 002531 593 002532 595 002533 596 002535 597 002540 598 002543 600 002544 601 002547 605 002564 606 002565 608 002566 609 002567 610 002570 611 002572 613 002573 615 002574 616 002577 621 002600 623 002601 625 002604 626 002643 628 002644 629 002650 630 002666 631 002667 632 002706 633 002715 636 002723 637 002725 638 002726 640 002733 641 002736 642 002743 643 002745 646 003001 648 003002 649 003005 650 003017 651 003024 652 003026 653 003030 654 003041 655 003045 656 003050 658 003053 660 003054 661 003061 662 003102 663 003104 664 003111 665 003123 666 003140 667 003142 668 003153 669 003160 670 003174 671 003201 673 003205 674 003212 675 003216 676 003221 678 003222 679 003226 680 003230 681 003232 683 003250 684 003252 685 003254 687 003266 691 003272 692 003274 693 003300 694 003301 695 003303 696 003305 698 003326 699 003331 700 003333 701 003363 703 003364 705 003365 706 003367 708 003370 710 003372 713 003400 714 003404 715 003423 716 003426 717 003430 719 003433 720 003434 723 003440 725 003441 726 003443 729 003445 731 003446 732 003450 737 003451 740 003454 741 003456 743 003510 746 003515 747 003520 748 003524 749 003526 754 003527 757 003532 758 003534 759 003536 761 003537 765 003553 766 003555 767 003556 768 003557 769 003560 770 003562 773 003563 774 003564 775 003565 776 003567 780 003570 782 003573 784 003575 785 003576 786 003577 792 003600 795 003602 796 003603 798 003606 799 003611 800 003613 801 003614 802 003616 803 003621 807 003622 809 003630 811 003632 812 003641 813 003643 814 003645 815 003646 817 003647 819 003661 821 003665 822 003667 823 003671 825 003674 827 003677 828 003701 829 003704 832 003705 836 003723 837 003724 840 003725 841 003726 842 003727 843 003730 845 003734 846 003735 847 003740 849 003742 850 003745 856 003746 860 003750 861 003752 862 003753 864 003755 865 003757 867 003766 868 003767 874 003774 875 003777 876 004000 879 004002 881 004010 882 004035 885 004036 886 004040 888 004041 894 004044 895 004052 896 004057 898 004063 900 004101 901 004103 902 004106 903 004111 904 004114 908 004116 910 004124 911 004135 912 004144 914 004156 915 004163 916 004165 917 004167 918 004171 938 004172 939 004210 940 004212 942 004237 944 004240 945 004245 946 004255 947 004257 948 004263 949 004265 950 004266 951 004270 953 004276 955 004300 956 004303 957 004305 959 004307 960 004311 961 004316 963 004321 964 004323 965 004325 966 004327 967 004330 970 004331 971 004335 972 004337 976 004341 978 004352 980 004362 984 004364 987 004375 993 004400 996 004406 997 004410 998 004411 999 004413 1005 004414 1007 004415 1011 004416 1015 004421 1017 004422 1018 004424 1019 004426 1020 004430 1024 004431 1026 004433 1027 004435 1031 004436 1033 004440 1034 004442 1036 004443 1038 004500 1040 004504 1041 004541 1044 004545 1046 004551 1047 004552 1048 004553 1049 004555 1051 004563 1052 004564 1053 004566 1054 004570 1056 004572 1060 004573 1068 004614 1071 004617 1072 004621 1073 004655 1075 004656 1076 004660 1077 004664 1078 004717 1079 004722 1080 004754 1082 004755 1083 004772 1084 004774 1086 004777 1087 005036 1089 005042 1091 005043 1092 005045 1093 005051 1094 005054 1095 005101 1098 005102 1099 005141 1101 005145 1102 005146 1103 005151 1104 005166 1105 005170 1109 005171 1111 005173 1112 005175 1113 005177 1114 005200 1116 005201 1117 005202 1121 005207 1124 005221 1127 005230 1128 005260 1130 005262 1131 005265 1132 005266 1133 005267 1136 005273 1140 005274 1142 005276 1143 005313 1145 005342 1146 005344 1150 005345 1151 005360 1155 005361 1156 005363 1157 005365 1158 005367 1160 005370 1161 005372 1163 005374 1164 005375 1168 005376 431 005377 432 005400 433 005406 434 005410 435 005412 436 005414 437 005420 438 005435 439 005436 440 005440 441 005446 1175 005447 1180 005450 1181 005452 1182 005454 1183 005457 1184 005461 1186 005463 1188 005474 1189 005475 1192 005476 1193 005507 1194 005510 1195 005513 1197 005515 1199 005523 1201 005525 1202 005526 1203 005530 1206 005531 1207 005532 1210 005533 1212 005536 1213 005552 1214 005557 1216 005560 1219 005562 1223 005563 1225 005564 1227 005570 1228 005573 1230 005601 1233 005603 1235 005604 1245 005606 1247 005612 1249 005613 1251 005614 1252 005625 1254 005643 1255 005647 1256 005650 1258 005651 1260 005652 1261 005660 1265 005663 1266 005664 1267 005703 1268 005716 1269 005723 1270 005755 1271 005760 1272 005762 1273 005763 1277 005764 1286 005772 1287 006005 1288 006021 1289 006054 1291 006056 1294 006057 1311 006065 1312 006070 1313 006073 1315 006100 1316 006102 1320 006116 1323 006132 1327 006133 1330 006135 1332 006136 1334 006171 1340 006172 1342 006173 1343 006174 1344 006175 1345 006177 1346 006202 1347 006203 1348 006205 1349 006210 1350 006211 1351 006212 1352 006214 1354 006217 1358 006237 1359 006241 1363 006242 1365 006243 1367 006244 1368 006246 1369 006250 1373 006256 1374 006260 1375 006262 1376 006264 1380 006276 1383 006277 1384 006300 1386 006305 1387 006307 1388 006311 1390 006312 1391 006314 1393 006316 1394 006320 1395 006324 1396 006326 1399 006327 1401 006330 1402 006346 1404 006365 1407 006366 1408 006367 1409 006370 1410 006371 1413 006412 1414 006413 1415 006414 1416 006415 1419 006420 1421 006421 1423 006422 1424 006424 1425 006426 1426 006432 1427 006435 1428 006436 1429 006437 1431 006441 1433 006444 1436 006464 1437 006466 1440 006467 1441 006472 1444 006474 1446 006475 1448 006476 1449 006500 1450 006504 1451 006506 1452 006510 1453 006541 1455 006543 1456 006573 1457 006612 1459 006621 1460 006652 1462 006653 1463 006654 1464 006656 1465 006660 1466 006661 1467 006663 1468 006666 1473 006667 1475 006670 1476 006672 1477 006675 1479 006713 1481 006714 1482 006717 1485 006724 1486 006726 1490 006734 1493 006735 1495 006736 1496 006741 1497 006742 1498 006744 1499 006745 1501 006746 1503 006752 1505 006753 1507 006766 1508 006767 1509 006774 1513 007021 1514 007027 1516 007031 1521 007032 1522 007033 1524 007034 1525 007037 1526 007043 1530 007044 1532 007046 ----------------------------------------------------------- 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