COMPILATION LISTING OF SEGMENT tedmgr_ Compiled by: Multics PL/I Compiler, Release 30, of February 16, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 10/07/88 1309.4 mst Fri Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* *********************************************************** */ 8 9 10 /****^ HISTORY COMMENTS: 11* 1) change(88-08-03,RWaters), approve(88-08-03,MCR7950), audit(88-09-29,Huen), 12* install(88-10-07,MR12.2-1146): 13* Bug fixes for MR12.2. 14* END HISTORY COMMENTS */ 15 16 17 /**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16 */ 18 /**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo */ 19 /**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend */ 20 /**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt */ 21 22 /* */ 23 /* _|_ | */ 24 /* | _ _ | _ _ */ 25 /* | / \ / \| |/|/| / \| |/ \ */ 26 /* | (__/ ( | | | | ( | | */ 27 /* \_ \_/ \_/| | | | \_/| | */ 28 /* | ----- */ 29 /* \__/ */ 30 31 /* UPDATE HISTORY (finally) */ 32 /* EL# date TR comments */ 33 /* 139 84-10-09 phx17096 "q" complains about buffer even though its deleted */ 34 /* 140 84-10-09 phx17209 "x" on windowed buffer not show windowed size */ 35 /* 158 84-10-10 phx17290 "ted -restart" with 1 active environment will get */ 36 /* the user into a confusing dialogue. */ 37 /* 152 84-10-11 phx17594 OOB fault on empty buffer (after [buffer X]) */ 38 /* 163 88-07-08 changed pic6 to be picture 7 to avoid size condition in */ 39 /* buffers that exceed 99999 lines. */ 40 /* 201 88-07-08 phx20688 fix message about archive component. */ 41 /* NNN 88-19-07 flag the buffer as modified when ted_buffer get called as */ 42 /* an active function */ 43 44 tedmgr_: /* dump current database */ 45 proc; 46 47 dbase_p = envir.bwd; /* pick up latest environment */ 48 call ioa_$ioa_switch (db_output, 49 "ptr(^d)=^p ""^a""", env_ct, dbase_p, 50 dbase.dir_db); 51 if (dbase_p = null ()) 52 then return; 53 call tedshow_ (dbase_p, "base"); 54 return; 55 56 list: /* list all active pointers */ 57 entry; 58 dcl ptr_2 (2) ptr based; 59 tp = envir.bwd; 60 do while (tp ^= null ()); 61 call ioa_$ioa_switch (db_output, 62 " @^p^-`^a'^( ^p^)", tp, tp -> dbase.recurs, 63 tp -> dbase.bwd, addr (tp -> dbase.reset) -> ptr_2); 64 tp = tp -> dbase.bwd; 65 end; 66 call ioa_$ioa_switch (db_output, " EOL"); 67 return; 68 dcl 1 DATABASE based (dbase_p), 69 2 zzzzzz like dbase, 70 2 cb (0:DATABASE.bufnum) like b; 71 72 dcl 1 entries (e_c) aligned based (e_p), 73 2 type bit (2) unal, 74 2 nnames fixed bin (15) unal, 75 2 nindex fixed bin (17) unal; 76 dcl names (3) char (32) based (n_p); 77 78 dcl NL char (1) int static options (constant) init (" 79 "); 80 dcl area_p ptr; 81 dcl arg char (arg_l) based (arg_p); 82 dcl arg_bufs fixed bin; 83 dcl arg_l fixed bin (21); 84 dcl arg_p ptr; 85 dcl cleanup condition; 86 dcl code fixed bin (35); 87 dcl db_dir char (168) var; 88 dcl DD pic "99"; 89 dcl ( 90 error_table_$action_not_performed, 91 error_table_$dirseg, 92 error_table_$invalid_lock_reset, 93 error_table_$locked_by_this_process, 94 error_table_$namedup, 95 error_table_$noentry, 96 error_table_$no_component, 97 error_table_$unimplemented_version, 98 error_table_$zero_length_seg 99 ) fixed bin (35) ext static; 100 dcl e_c fixed bin; 101 dcl e_ca fixed bin; 102 dcl e_p ptr; 103 dcl func fixed bin; 104 dcl i fixed bin (21); 105 dcl ii fixed bin (21); 106 dcl j fixed bin (21); 107 dcl lockid bit (36) int static init ("0"b); 108 dcl n_p ptr; 109 dcl pdir char (32)int static init (""); 110 dcl pic3 pic "999"; 111 dcl reply char (32); 112 dcl rqid char (19); 113 dcl startup fixed bin (71); 114 dcl status_only bit (1); 115 dcl the_name char (32); 116 dcl tp ptr; 117 dcl used fixed bin (21); 118 119 /* ------------------------- EXTERNAL PROCEDURES --------------------------- */ 120 121 dcl com_err_ entry options (variable); 122 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); 123 dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); 124 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 125 dcl delete_$ptr entry (ptr, bit (6), char (*), fixed bin (35)); 126 dcl delete_$path entry (char (*), char (*), bit (6), char (*), 127 fixed bin (35)); 128 dcl get_default_wdir_ entry returns (char (168)); 129 dcl get_lock_id_ entry returns (bit (36)); 130 dcl get_system_free_area_ entry returns (ptr); 131 dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); 132 dcl hcs_$append_link entry (char (*), char (*), char (*), fixed bin (35)); 133 dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin (21), char (*), 134 fixed bin (35)); 135 dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), 136 fixed bin (2), ptr, fixed bin (35)); 137 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, 138 fixed bin (35)); 139 dcl hcs_$set_bc_seg entry (ptr, fixed bin (21), fixed bin (35)); 140 dcl hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, 141 ptr, ptr, fixed bin (35)); 142 dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); 143 dcl hcs_$truncate_seg entry (ptr, fixed bin (18), fixed bin (35)); 144 dcl get_pdir_ entry () returns (char (168)); 145 dcl ioa_ entry options (variable); 146 dcl ioa_$nnl entry () options (variable); 147 dcl ioa_$ioa_switch entry () options (variable); 148 dcl iox_$error_output ptr ext static; 149 dcl iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), 150 fixed bin (35)); 151 dcl iox_$user_input ptr ext static; 152 dcl release_temp_segment_ entry (char (*), ptr, fixed bin (35)); 153 dcl set_lock_$lock entry (bit (36), fixed bin, fixed bin (35)); 154 dcl request_id_ entry (fixed bin (71)) returns (char (19)); 155 dcl user_info_ entry options (variable); 156 157 dcl env_ct fixed bin int static init (0); 158 dcl 1 envir int static, 159 2 (fwd, bwd) ptr init (null ()); 160 161 dcl ( 162 clock, convert, ltrim, low, max, ptr, rel, 163 rtrim, string, unspec 164 ) builtin; 165 166 /**** <<<<----- dcl_tedinit_.incl.pl1 tedinit_ */ 167 tedinit_: /* create a ted environment */ 168 entry (ted_data_p, adb_p, acode); 169 dcl ( 170 ted_data_p ptr, /* -> ted_ input structure */ 171 adb_p ptr, /* -> dbase (OUT) */ 172 acode fixed bin (35) /* status code */ 173 ) parm; /* ----->>>> */ 174 175 if (pdir = "") 176 then pdir = get_pdir_(); 177 if ted_data.version = 1000 /* handle old version */ 178 then do; 179 if (ted_data.ted_mode = RESTART) | (ted_data.ted_mode = SAFE) 180 then db_dir = rtrim (get_default_wdir_ ()); 181 else db_dir = ""; 182 end; 183 else db_dir = rtrim (ted_data.temp_dir); 184 status_only = "0"b; 185 the_name = ted_data.tedname; 186 goto somehow; 187 188 /**** <<<<----- dcl_tedstatus_.incl.pl1 tedstatus_ */ 189 tedstatus_: /* display saved environments */ 190 entry (tempdir, acode); 191 dcl ( 192 tempdir char (*) /* name of temp dir */ 193 /****acode fixed bin (35) /* status code */ 194 ) parm; /* ----->>>> */ 195 196 dcl i21 fixed bin (21); 197 198 db_dir = tempdir; 199 status_only = "1"b; 200 the_name = "ted"; 201 goto status_1; 202 203 nil_action: 204 acode = error_table_$action_not_performed; 205 abort_print: 206 call com_err_ (acode, the_name, "^a^/^-abort[^a]", msg, 207 convert (DD, env_ct)); 208 abort_no_print: 209 goto get_out; 210 somehow: 211 acode = 1; 212 213 if (env_ct >= 14) then do; 214 msg = "Recursion exceeds depth of 14"; 215 goto nil_action; 216 end; 217 218 startup = clock (); 219 if (lockid = "0"b) 220 then lockid = get_lock_id_ (); 221 e_p, n_p, dbase_p = null; 222 e_c = 0; 223 on condition (cleanup) begin; 224 if (dbase_p ^= null ()) 225 then call tedcleanup_ (dbase_p); 226 end; 227 if (ted_data.ted_mode = RESTART) 228 then do; 229 status_1: 230 area_p = get_system_free_area_ (); 231 call hcs_$star_ ((db_dir), db_select, 3, area_p, e_c, e_p, n_p, 232 acode); 233 if (e_c = 0) 234 then do; 235 no_envir: 236 msg = "No environment exists"; 237 if status_only 238 then do; 239 call ioa_ (msg); 240 return; 241 end; 242 goto nil_action; 243 end; 244 begin; 245 dcl ps (e_c) ptr; 246 e_ca = e_c; 247 do i = 1 to e_c; 248 call hcs_$initiate ((db_dir), names (entries (i).nindex), 249 "", 0, 1, ps (i), acode); 250 if (ps (i) = null ()) 251 then do; 252 e_ca = e_ca - 1; 253 if (acode = error_table_$dirseg) 254 then do; 255 end; 256 else if (acode = error_table_$noentry) 257 then do; 258 /**** The only way I know that this can happen is when a -temp_dir was */ 259 /**** specified (thus a link was created) and now the destination of that */ 260 /**** link does not exist. */ 261 call delete_$path ((db_dir), names (entries (i).nindex), 262 "100010"b, the_name, (code)); 263 /* try to unlink */ 264 265 end; 266 else call com_err_ (acode, the_name, "^a>^a", db_dir, 267 names (entries (i).nindex)); 268 end; 269 else do; 270 if (ps (i) -> dbase.version ^= dbase_vers_3) 271 then do; 272 call com_err_ (error_table_$unimplemented_version, 273 the_name, "^a>^a", db_dir, 274 names (entries (i).nindex)); 275 call term; 276 end; 277 else if (e_c > 1) | status_only 278 then do; 279 end; 280 end; 281 end; 282 if (e_ca < 1) 283 then goto no_envir; 284 if (e_ca > 1) & ^status_only 285 then call ioa_ ("More than 1 environment exists."); 286 force = ""b; /* #158*/ 287 displ_1: 288 if (e_ca > 1) | status_only 289 | force /* #158*/ 290 then call ioa_ (" # Started, by whom, as what"); 291 dcl (shown, activ) fixed bin; 292 dcl mylock fixed bin; /* #158*/ 293 dcl force bit (1); /* #158*/ 294 dcl b1 bit (1); 295 296 shown = 0; 297 displ: 298 activ = 0; 299 mylock = 0; 300 do i = 1 to e_c while ((e_ca > 1) | status_only | force); /* #158*/ 301 if ps (i) ^= null () 302 then do; 303 dbase_p = ps (i); 304 if db_util 305 then call ioa_$ioa_switch (db_output, 306 "B ^p -> ^w [^i]", ps (i), 307 dbase.lock, dbase.recurs); 308 if (dbase.recurs = 0) 309 then dbase.lock = "0"b; 310 else if (dbase.lock = "0"b) 311 then dbase.recurs = 0; 312 else do; 313 call set_lock_$lock (dbase.lock, 314 0, acode); 315 if db_util 316 then call ioa_$ioa_switch (db_output, 317 "A ^p -> ^w [^i]", ps (i), 318 dbase.lock, dbase.recurs); 319 if (acode = error_table_$invalid_lock_reset) 320 then do; 321 dbase.lock = "0"b; 322 dbase.recurs = 0; 323 end; 324 if (acode = error_table_$locked_by_this_process) 325 then mylock = mylock + 1; /* #158*/ 326 end; 327 b1 = (dbase.recurs ^= 0); 328 if b1 329 then activ = activ + 1; 330 shown = shown + 1; 331 call ioa_ ( 332 "^2i^[*^; ^] ^a ^a.^a (^a[^i])", 333 i, b1, date_time_$format ("date_time", dbase.time,"",""), 334 dbase.person, dbase.project, 335 dbase.tedname, dbase.recurs); 336 if dbase.remote_sw 337 then call ioa_ (" @ ^a", dbase.dir_db); 338 if (length (dbase.comment) > 0) 339 then call ioa_ ("^-comment=^a", 340 dbase.comment); 341 end; 342 end; 343 if (activ > 0) 344 then call ioa_ ("(*=now active)"); 345 if status_only 346 then goto freum2; 347 if (shown = 0) & ^force /* BEGIN #158*/ 348 then do; 349 force = "1"b; 350 shown = 0; 351 goto displ_1; 352 end; 353 if (activ = shown) 354 then do; 355 if (shown > 1) 356 then do; 357 call ioa_ (" 358 All saved ted environments found are active."); 359 if (mylock > 0) 360 then call ioa_ ( 361 " Use ""pi"" or ""ted -reset"" to return to the latest one you have active."); 362 if (mylock > 1) 363 then call ioa_ ( 364 " Use ""ted -reset 1"" to return to the first one you have active, 365 discarding environment^[ 2^;s 2 thru ^i.^]", 366 (mylock=2), mylock); 367 end; 368 else call ioa_ (" 369 The only saved ted environment found is active.^[ 370 Use ""pi"" or ""ted -reset"" to return to it.^]", 371 (mylock>0)); /* END #158*/ 372 goto freum; 373 end; 374 if (e_ca = 1) & (activ <= shown) 375 then i = 1; 376 else do; 377 i = 0; 378 call ioa_ ("Type the number of the one you want or ""?""."); 379 end; 380 do while (i = 0); 381 getline: 382 call iox_$get_line (iox_$user_input, addr (reply), 383 length (reply), i21, acode); 384 if (substr (reply, 1, 1) = "q") 385 then goto freum; 386 if (substr (reply, 1, 1) = "l") 387 then goto displ; 388 if (substr (reply, 1, 2) = "??") 389 then call ioa_ (" sN^-dump of environment N"); 390 if (substr (reply, 1, 1) = "?") 391 then do; 392 call ioa_ (" dN^-delete environment N"); 393 call ioa_ (" xN^-list buffers in environment N"); 394 call ioa_ (" l^-list available environments"); 395 call ioa_ (" q^-quit"); 396 goto getline; 397 end; 398 if (substr (reply, 1, 1) = "x") 399 then do; 400 ii = 2; 401 func = 1; 402 end; 403 else if (substr (reply, 1, 1) = "d") 404 then do; 405 ii = 2; 406 func = 2; 407 end; 408 else if (substr (reply, 1, 1) = "s") 409 then do; 410 ii = 2; 411 func = 3; 412 end; 413 else do; 414 ii = 1; 415 func = 4; 416 end; 417 i = cv_dec_check_ (substr (reply, ii, i21 - ii), acode); 418 if (acode ^= 0) 419 | (i < 1) 420 | (i > e_c) 421 then do; 422 call ioa_ ("Please give a number in range 1-^i.", 423 e_c); 424 i = 0; 425 goto getline; 426 end; 427 if (ps (i) = null ()) 428 then do; 429 call ioa_ ("Environment ^i is not available.", i); 430 i = 0; 431 goto getline; 432 end; 433 goto rsfunc (func); 434 rsfunc (1): /* function "x" */ 435 call tedlist_buffers_ (ps (i), "", "0"b, "0"b); 436 goto getline; 437 rsfunc (2): /* function "d" */ 438 if (ps (i) -> dbase.lock ^= "0"b) 439 then do; 440 call ioa_ (" 441 Environment ^i is currently active, delete not done.", i); 442 goto getline; 443 end; 444 /*-*/ 445 call tedcleanup_ (ps (i)); 446 ps (i) = null (); 447 e_ca = e_ca - 1; 448 if (e_ca < 1) 449 then goto no_envir; 450 goto getline; 451 rsfunc (3): /* function "s" */ 452 dbase_p = ps (i); 453 call tedshow_ (dbase_p, "base"); 454 goto getline; 455 term: proc; 456 call hcs_$terminate_noname (ps (i), 0); 457 ps (i) = null (); 458 e_ca = e_ca - 1; 459 end; 460 rsfunc (4): /* try starting up again */ 461 if (ps (i) -> dbase.lock ^= "0"b) 462 then do; 463 call ioa_ ( 464 "Environment ^i is currently active, restart not done.", i); 465 goto getline; 466 end; 467 end; 468 dbase_p = ps (i); 469 call set_lock_$lock (dbase.lock, 0, acode); 470 if (acode = error_table_$invalid_lock_reset) 471 then acode = 0; 472 if (acode ^= 0) 473 then do; 474 call ioa_ ("The selected ted environment is already active."); 475 goto getline; 476 end; 477 ps (i) = null (); 478 if ""b 479 then do; 480 freum: 481 acode = error_table_$action_not_performed; 482 status_only = "1"b; 483 end; 484 freum2: 485 free entries; 486 free names; 487 do i = 1 to e_c; 488 if (ps (i) ^= null ()) 489 then call term; 490 end; 491 end; 492 493 if status_only 494 then return; 495 call ioa_ ("Restarting session of ^a.", 496 date_time_$format ("date_time", dbase.time,"","")); 497 call restart; 498 end; 499 else do; /* starting from scratch */ 500 if (db_dir ^= "") 501 then do; 502 call hcs_$star_ ((db_dir), db_select, 3, null (), e_c, e_p, 503 n_p, code); 504 if (e_c > 0) 505 then call ioa_ ("^a: ^i environment^[s^] already saved.", 506 the_name, e_c, (e_c > 1)); 507 end; 508 rqid = request_id_ (startup); 509 dbase_p = null (); 510 call get_base (adb_p, 0, "base ", acode); 511 dbase_p = adb_p; 512 call start; 513 end; 514 env_ct = env_ct + 1; 515 dbase.recurs = env_ct; 516 dbase.lock = lockid; /* show user is active */ 517 dbase.bwd = envir.bwd; /* link new one in to list */ 518 envir.bwd = dbase_p; 519 acode = 0; /* successful initialization */ 520 adb_p = dbase_p; 521 get_out: 522 if db_util then call ioa_$ioa_switch (db_output, 523 "dbase_p=^p[^i]", envir.bwd, env_ct); 524 return; 525 dcl db_select char (26) int static options (constant) init ( 526 "ted_.????????????.??????.X"); 527 /**** "ted_.820827000117.6795936.X" */ 528 529 tedhold_: /* exit ted, keeping environment */ 530 entry (adb_p); 531 dbase_p = adb_p; 532 cleaning = "0"b; 533 goto hold_clean; 534 535 dcl cleaning bit (1); 536 tedcleanup_: /* exit ted, destroying environment */ 537 entry (adb_p); 538 dbase_p = adb_p; 539 if db_util then do; 540 call ioa_$ioa_switch (db_output, "CLEANUP ^p", dbase_p); 541 call tedshow_ (dbase_p, "base"); 542 end; 543 cleaning = "1"b; 544 hold_clean: 545 if (dbase.recurs ^= 0) 546 then do; 547 if dbase_p ^= envir.bwd 548 then signal condition (base_ne_envir); dcl base_ne_envir condition; 549 envir.bwd = dbase.bwd; 550 dbase.bwd = null; 551 env_ct = env_ct - 1; 552 end; 553 the_name = dbase.tedname; 554 dbase_lock = dbase.lock; 555 dbase.lock = "0"b; /* show not in service */ 556 dcl dbase_lock bit (36); 557 dcl segid char (32); 558 559 if ^cleaning 560 then do; 561 do bp = addr (cb (0)), addr (cb (1)); 562 b.b_.l.re = b.b_.l.le - 1; /* empty out b((request line)) */ 563 b.b_.r.le = b.b_.r.re + 1; /* and b((ted)) */ 564 b_s = low (b.maxl); 565 end; 566 if (dbase.seg_p (3) ^= null()) /* empty out call stack if there */ 567 then call hcs_$truncate_seg (dbase.seg_p (3), 0, 0); 568 569 do i = 0 to dbase.bufnum; 570 bp = addr (cb (i)); 571 if (b.cur.sn > 0) /* is there buffer space? */ 572 & (i ^= 2) /* and it's not the eval segment */ 573 & ^b.pseudo /* and its for real */ 574 then do; /* zero out the empty part */ 575 substr (b_s, b.b_.l.re + 1,b.b_.r.le - b.b_.l.re - 1) 576 = low (b.b_.r.le - b.b_.l.re - 1); 577 end; 578 end; 579 end; 580 call delete_$path (pdir, "ted_." || dbase.rq_id, "100100"b, 581 the_name, 0); /* cleanup possible fileout segment */ 582 segid = "ted_.yymmddHHMMSS.UUUUUU.000"; 583 substr (segid, 6, 19) = dbase.rq_id; 584 do i = dbase.seg_ct to 1 by -1; 585 if (dbase.seg_p (i) ^= null ()) 586 then do; 587 call wipeout (i); 588 end; 589 end; 590 call wipeout (0); 591 if db_util 592 then call ioa_$ioa_switch (db_output, 593 "^2d ^p", env_ct, envir.bwd); 594 return; 595 wipeout: proc (ndx); 596 597 dcl ndx fixed bin (21); 598 599 dcl tp ptr; 600 601 tp = dbase.seg_p (i); 602 if db_util 603 then call ioa_$ioa_switch (db_output, 604 "wipe: ^p^[ cleaning^]^[ active^]^[ base^]", 605 tp, cleaning, (dbase_lock^="0"b), (ndx=0)); 606 607 /**** This statement is OK because the only way you will be cleaning up an */ 608 /**** environment of temp segs is when the environment is active. */ 609 if (dbase.dir_db = "") 610 then call release_temp_segment_ (the_name, tp, code); 611 else do; 612 /**** If we're not cleaning out, then just tuck 'em in bed. */ 613 if ^cleaning 614 then call hcs_$terminate_noname (tp, code); 615 else do; 616 /**** OK! We're throwing the stuff away. */ 617 if (ndx = 0) 618 then substr (segid, 26) = "X "; 619 else substr (segid, 26) = convert (pic3, i); 620 /**** If the environment is active, get rid of them by pointer, otherwise we */ 621 /**** must do it by pathname. */ 622 if (dbase_lock ^= "0"b) 623 then call delete_$ptr (tp, "100100"b, the_name, code); 624 else call delete_$path (dbase.dir_db, segid, 625 "100100"b, the_name, code); 626 /**** If -temp_dir was specified, a link was placed in the home dir so we */ 627 /**** can find the database. When we clean up everything, this link is a */ 628 /**** part of everything. We don't know or care if it is there... */ 629 if (ndx = 0) 630 then call delete_$path (get_default_wdir_ (), segid, "100010"b, 631 the_name, (code)); /* ...just get rid of it! */ 632 end; 633 if (code ^= 0) 634 then call com_err_ (code, the_name); 635 end; 636 end wipeout; 637 dcl date_time_$format entry (char(*), fixed bin(71), char(*), char(*)) 638 returns(char(250) var); 639 buffer: /* return name of buffer segment */ 640 entry; 641 buf_comm: 642 if (env_ct = 0) 643 then do; 644 call ioa_ ("Not in ted"); 645 return; 646 end; 647 call cu_$arg_ptr (1, arg_p, arg_l, code); 648 if (code ^= 0) | (arg_l = 0) 649 then do; 650 call com_err_ (code, "ted_buffer", "Buffer name"); 651 return; 652 end; 653 654 dbase_p = envir.bwd; 655 do j = 3 to dbase.bufnum; 656 bp = addr (cb (j)); 657 if (b.name = arg) 658 then do; 659 if db_util 660 then call tedshow_(bp,"bcb"); 661 if (b.cur.sn = -1) /* is this a ^read file */ 662 then do; 663 if b.ck_ptr_sw 664 then do; 665 if db_util then call ioa_$ioa_switch (db_output, 666 "ck_ptr"); 667 call tedck_ptr_ (bp); 668 end; 669 dbase.not_read_ct = max (0, dbase.not_read_ct - 1); 670 end; 671 call tedcloseup_ (bp); /* put into own segment */ 672 if db_util 673 then call tedshow_ (bp, "bcb"); 674 call hcs_$set_bc_seg (b.cur.sp, b.b_.l.re * 9, code); 675 call hcs_$truncate_seg (b.cur.sp, 676 divide (b.b_.l.re + 3, 4, 21, 0), code); 677 if (dbase.dir_db = "") 678 then do; 679 call hcs_$fs_get_path_name (b.cur.sp, d_name, dl, e_name, 0); 680 msg = substr (d_name, 1, dl); 681 msg = msg || ">"; 682 msg = msg || rtrim (e_name); 683 end; 684 else do; 685 msg = rtrim (dbase.dir_db); 686 msg = msg || ">ted_."; 687 msg = msg || dbase.rq_id; 688 msg = msg || "."; 689 msg = msg || convert (pic3, b.cur.sn); 690 end; 691 if db_util 692 then call ioa_$ioa_switch (db_output, 693 "val=`^va'", length (msg), msg); 694 call cu_$af_arg_count (j, code); 695 if (code ^= 0) 696 then call ioa_ ("^a", msg); 697 else do; 698 b.get_bit_count = "1"b; 699 /* RW 88 */ 700 /* e emacs [ted_buffer 0] should set the buffer as modified 701* * possibly, it should also decriment the sequence number?? 702* * b.cur.sn--; 703* */ 704 b.mod_sw = "1"b; /* #NNN*/ 705 call cu_$af_return_arg (j + 1, af_ptr, af_len, code); 706 af_val = msg; 707 end; 708 return; 709 end; 710 end; 711 call com_err_ (0, "ted_buffer", "b(^a) not found.", arg); 712 return; 713 dcl d_name char (168); 714 dcl e_name char (32); 715 dcl dl fixed bin (21); 716 dcl cu_$af_arg_count entry (fixed bin (21), fixed bin (35)); 717 dcl cu_$af_return_arg entry (fixed bin (21), ptr, fixed bin (21), 718 fixed bin (35)); 719 dcl af_val char (af_len) var based (af_ptr); 720 dcl af_ptr ptr; 721 dcl af_len fixed bin (21); 722 tedreset_: /* re-enter ted, simulating an error */ 723 entry; 724 725 if (env_ct = 0) 726 then do; 727 call ioa_ ("Not in ted"); 728 return; 729 end; 730 call cu_$arg_ptr (1, arg_p, arg_l, code); 731 if (code = 0) 732 then do; 733 if (verify (arg, "0123456789") = 0) 734 then do; 735 i = fixed (arg); 736 if (i > env_ct) 737 then do; 738 call ioa_ ("ted[^a] not active", arg); 739 return; 740 end; 741 end; 742 else do; 743 call ioa_ ("ted -reset: invalid argument"); 744 return; 745 end; 746 end; 747 else i = env_ct; 748 dbase_p = envir.bwd; 749 j = env_ct; 750 if db_util 751 then call tedmgr_$list; 752 do while (j > i); 753 if db_util 754 then call ioa_$nnl (" [^i] ^p ->", j, dbase_p); 755 dbase_p = dbase.bwd; 756 j = j - 1; 757 end; 758 if db_util 759 then call ioa_$ioa_switch (db_output, 760 " [^i] ^p", j, dbase_p); 761 call ioa_$ioa_switch (iox_$error_output, "^a: reset[^i]", 762 dbase.tedname, dbase.recurs); 763 goto dbase.reset; 764 tedbreak_: /* set break mode and continue */ 765 entry; 766 if (env_ct = 0) 767 then do; 768 call ioa_ ("Not in ted"); 769 return; 770 end; 771 envir.bwd -> dbase.at_break = 1; 772 call start$start; 773 dcl start$start entry; 774 return; 775 /**** <<<<----- dcl_tedget_buffer_.incl.pl1 tedget_existing_buffer_ */ 776 tedget_existing_buffer_: /* find a named buffer */ 777 entry (adb_p, ain_p, ain_l, abp, a_msg); 778 /****dcl ( 779*/****adb_p ptr, /* -> database */ 780 /****ain_p ptr, /* -> string containing buffer name */ 781 /****ain_l fixed bin (21), /* length of string [IN] */ 782 /* how much was used [OUT] */ 783 /****abp ptr /* buffer control block (OUT) */ 784 /****a_msg char (168)var /* error message text */ 785 /****) parm; /* ----->>>> */ 786 787 create = "0"b; 788 goto common_get; 789 790 /**** <<<<----- dcl_tedget_buffer_.incl.pl1 tedget_buffer_ */ 791 tedget_buffer_: /* find (or create) a buffer */ 792 entry (adb_p, ain_p, ain_l, abp, a_msg); 793 dcl ( 794 /****adb_p ptr, /* -> database */ 795 ain_p ptr, /* -> string containing buffer name */ 796 ain_l fixed bin (21), /* length of string [IN] */ 797 /* how much was used [OUT] */ 798 abp ptr /* buffer control block (OUT) */ 799 /****a_msg char (168)var /* error message text */ 800 ) parm; /* ----->>>> */ 801 802 dcl create bit (1); 803 804 create = "1"b; 805 common_get: 806 dbase_p = adb_p; 807 if (dbase_p = null ()) 808 then dbase_p = envir.bwd; 809 if (dbase_p = null ()) 810 then do; 811 abp = null (); 812 /* @@ */ 813 return; 814 end; 815 816 dcl hcs_$status_mins entry (ptr, fixed bin (2), fixed bin (21), 817 fixed bin (35)); 818 find_buffer: begin; 819 /* extract buffer name and find */ 820 /* (or create) buffer */ 821 822 dcl next_in fixed bin; /* where at in address data */ 823 dcl in_p ptr; /* -> address data */ 824 dcl in_l fixed bin (21); /* length of it */ 825 dcl in_s char (in_l) based (in_p); /* data as a string */ 826 dcl in_c (in_l) char (1) based (in_p); /* data as an array */ 827 828 dcl i fixed bin (21); 829 dcl j fixed bin (21); 830 dcl l fixed bin (21); 831 dcl tch char (1); 832 dcl tnl fixed bin (21); 833 dcl tname char (32); 834 dcl MTi fixed bin (21); 835 dcl inext_in fixed bin (21); 836 /* dcl acode fixed bin (35); */ 837 838 make_buf: proc; 839 840 if (MTi ^= 0) 841 then do; 842 bp = addr (cb (MTi)); 843 call re_alloc (bp, tname); 844 end; 845 else do; 846 call allocate_cb (bp, tname); 847 end; 848 end make_buf; 849 850 bp = null; /* null ptr => error occurred */ 851 in_p = ain_p; 852 in_l = ain_l; 853 next_in = verify (in_s, " "); 854 inext_in = next_in; 855 tch = in_c (next_in); 856 if tch ^= "(" /* one char buffer name given */ 857 then do; 858 tname = tch; /* pick up single character name */ 859 if (index ("(),;", tch) ^= 0) 860 then do; 861 msg = "Bbc) Invalid buffer name."; 862 goto add_str; 863 end; 864 tnl = 1; 865 if (tch = NL) 866 then goto Bnn; 867 next_in = next_in + 1; /* skip index over buffer name */ 868 tch = ")"; 869 end; 870 else do; /* if multiple characters in name */ 871 if (substr (in_s, next_in + 1, 1) = "@") 872 then do; /* this is a "current buffer" ref */ 873 next_in = next_in + 3; 874 tch = in_c (next_in - 1); 875 bp = ptr (dbase_p, dbase.cb_c_r); 876 tname = b.name; 877 goto addr_check; 878 end; 879 if (substr (in_s, next_in, 6) = "((g*))") 880 then do; 881 tnl = 4; 882 tname = "(g*)"; 883 next_in = next_in + 6; 884 end; 885 else do; 886 l = in_l - next_in; /* find end of buffer name */ 887 if l < 2 888 then goto Bmd; 889 i = next_in + 1; /* skip over the "(" */ 890 j = search (substr (in_s, i, l), "),"); 891 if (j < 2) 892 then do; 893 if (j = 0) 894 then goto Bmd; 895 Bnn: 896 msg = "Bnn) Null buffer name."; 897 goto add_str; 898 end; 899 tnl = j - 1; 900 if (tnl > length (b.name)) 901 then do; 902 msg = "Bln) Name > "; 903 msg = msg || ltrim (char (length (b.name))); 904 msg = msg || " char."; 905 goto add_str; 906 end; 907 next_in = i + j; /* set line index after char found */ 908 tname = substr (in_s, i, tnl); /* pick up buffer name */ 909 end; 910 tch = in_c (next_in - 1); /* pick up stopper character */ 911 end; 912 ain_l = next_in - 1; /* tell how much string used up */ 913 MTi = 0; 914 do i = 3 to dbase.bufnum; 915 if (cb (i).name = "") 916 then MTi = i; 917 else do; 918 if (cb (i).name = tname) 919 then do; 920 bp = addr (cb (i)); 921 b.noref = "0"b; 922 call check_bc; /* #152*/ 923 goto addr_check; 924 end; 925 end; 926 end; 927 if create 928 then do; 929 call make_buf; 930 addr_check: 931 if (tch = ",") 932 then do; 933 if (in_c (next_in) = "@") 934 then do; 935 msg = "@ not allowed in this context"; 936 goto add_str; 937 end; 938 /**** b.temp = b.a_; */ 939 /**** b.newb = b.b_; */ 940 /**** if (rel (bp) ^= dbase.cb_c_r) /* not current buffer? */ 941 /**** then do; */ 942 /**** b.newb.l.le = 1; /* 4/12/82 cant remember why this */ 943 /**** b.newb.r.re = b.maxl; */ 944 /**** end; */ 945 used = in_l - next_in + 1; 946 call tedaddr_ (dbase_p, addr (in_c (next_in)), used, bp, 947 msg, code); 948 next_in = next_in + used + 1; 949 ain_l = next_in - 1; /* tell how much string used up */ 950 if (code > 1) 951 then do; 952 add_str: 953 msg = msg || " """; 954 msg = msg || substr (in_s, inext_in, next_in - inext_in + 1); 955 msg = msg || """."; 956 goto err_out; 957 end; 958 tch = in_c (next_in - 1); 959 if ^b.present (1) 960 then b.a_ (1), b.a_ (2) = b.a_ (0); 961 else do; 962 if ^b.present (2) 963 then b.a_ (2) = b.a_ (1); 964 /* b.newb.l.ln, b.newb.r.ln = -1; */ 965 end; 966 end; 967 else do; 968 b.a_.l.ln (1) = 1; 969 b.a_.r.ln (2) = b.b_.r.ln; 970 b.a_.l (1) = b.b_.l; 971 b.a_.l.re (1) = b.a_.l.le (1); 972 b.a_.r (2) = b.b_.r; 973 b.a_.r.le (2) = b.a_.r.re (2); 974 b.present (1), b.present (2) = "0"b; 975 end; 976 if (tch ^= ")") 977 then do; 978 Bmd: 979 msg = "Bmd) Missing )."; 980 goto add_str; 981 end; 982 end; 983 else do; /* not found, take error return */ 984 msg = "Bnf) b("; /* ***) not found. */ /* ERROR */ 985 msg = msg || substr (tname, 1, tnl); 986 msg = msg || ") not found."; 987 err_out: 988 bp = null (); 989 a_msg = msg; 990 end; 991 end find_buffer; /* #152*/ 992 out: 993 abp = bp; /* give him what we got */ 994 out_only: 995 return; 996 check_bc: proc; /* #152*/ 997 998 if b.ck_ptr_sw & b.terminate 999 then call tedck_ptr_ (bp); 1000 if b.get_bit_count 1001 then do; 1002 b.get_bit_count = "0"b; 1003 call hcs_$status_mins (b.cur.sp, 0, arg_l, code); 1004 if (code ^= 0) 1005 then do; 1006 msg = b.name; 1007 call tederror_rc_ (dbase_p, msg, code); 1008 goto out_only; 1009 end; 1010 arg_l = divide (arg_l, 9, 24, 0); 1011 if (arg_l ^= b.b_.l.re) 1012 then do; 1013 b.b_.l.re = arg_l; /* set changed buffer length */ 1014 b.a_.l.le (0), b.a_.r.le (0) = 1; /* "." undefined */ 1015 b.a_.l.re (0), b.a_.r.re (0) = -1; 1016 b.maxln, /* line counts unknown */ 1017 b.a_.r.ln (0), b.a_.l.ln (0) = -1; 1018 end; 1019 end; /* #152*/ 1020 end check_bc; /* #152*/ 1021 1022 tedcheck_buffer_state_: entry (adb_p, abp, a_msg); /* #152*/ 1023 1024 dbase_p = adb_p; /* #152*/ 1025 bp = abp; /* #152*/ 1026 call check_bc; /* #152*/ 1027 return; /* #152*/ 1028 1029 /**** <<<<----- dcl_tedget_segment_.incl.pl1 tedget_segment_ */ 1030 tedget_segment_: /* get a segment to work in */ 1031 entry (adb_p, asp, asn); 1032 dcl ( 1033 /****adb_p ptr, /* -> database */ 1034 asp ptr, /* -> gotten segment [OUT] */ 1035 asn fixed bin /* sequence # of it [IN/OUT] */ 1036 /* if >0 upon entry, it will then */ 1037 /* fill that entry in seg_p array */ 1038 /* otherwise it will take any one */ 1039 ) parm; /* ----->>>> */ 1040 1041 dbase_p = adb_p; 1042 if (asn = 0) 1043 then call get_seg (asp, asn, "getseg ", code); 1044 else if (asn = 2) 1045 then call get_seg_n (asp, asn, "16Kpool ", code); 1046 else if (asn = 3) 1047 then call get_seg_n (asp, asn, "stk ", code); 1048 else call get_seg_n (asp, asn, "getsegn ", code); 1049 1050 return; 1051 /**** <<<<----- dcl_tedfree_segment_.incl.pl1 tedfree_segment_ */ 1052 tedfree_segment_: /* give back a work segment */ 1053 entry (adb_p, asn); 1054 /****dcl ( 1055*/****adb_p ptr, /* -> database */ 1056 /****asn fixed bin /* sequence # of segment to free */ 1057 /****) parm; /* ----->>>> */ 1058 1059 dbase_p = adb_p; 1060 call hcs_$truncate_seg (dbase.seg_p (asn), 0, 0); 1061 substr (dbase.inuse_seg, asn, 1) = "0"b; 1062 return; 1063 tederror_rc_: /* add return code data to message */ 1064 entry (adb_p, a_msg, rc); 1065 dcl ( 1066 /****adb_p ptr, /* -> dabatase */ 1067 a_msg char (168) var, /* error message */ 1068 rc fixed bin (35) /* code to include with message */ 1069 ) parm; 1070 1071 dcl shortinfo char (8); 1072 dcl longinfo char (100); 1073 dcl convert_status_code_ entry (fixed bin (35), char (8), char (100)); 1074 1075 call convert_status_code_ (rc, shortinfo, longinfo); 1076 /* RW 88 */ 1077 if (rc = error_table_$noentry) 1078 then msg = "Cnf) "; 1079 else if (rc = error_table_$no_component) /*#201*/ 1080 then msg = "Cnf) "; 1081 else if (rc = error_table_$zero_length_seg) 1082 then msg = "Czl) "; 1083 else msg = "Cxx) "; 1084 msg = msg || rtrim (longinfo); 1085 msg = msg || " "; 1086 msg = msg || a_msg; 1087 call tederror_ (adb_p, msg); 1088 return; 1089 /**** <<<<----- dcl_tedlist_buffers_.incl.pl1 tedlist_buffers_ */ 1090 tedlist_buffers_: /* show the status of buffers */ 1091 entry (adb_p, select, atest, ln_sw); 1092 dcl ( 1093 /****adb_p ptr, /* -> database */ 1094 select char (16), /* name of buffer to show */ 1095 atest bit (1), /* 0- listing inactive environment */ 1096 /* 1- listing active one */ 1097 ln_sw bit (1) /* 1- validate b.maxln */ 1098 ) parm; /* ----->>>> */ 1099 1100 dcl buf_ct fixed bin (21); 1101 dcl line_counts char (24)var; 1102 dcl Window char (24)var; /* #140*/ 1103 1104 dbase_p = adb_p; 1105 buf_ct = 0; 1106 arg_bufs = dbase.argct; 1107 if (arg_bufs > 0) 1108 then arg_bufs = arg_bufs + 1; 1109 do ii = 1110 3 + arg_bufs to dbase.bufnum, 1111 3 to 2 + arg_bufs; 1112 bp = addr (cb (ii)); 1113 if (b.name ^= "") & ^b.noref 1114 then do; 1115 if atest 1116 then call check_bc; /* #152*/ 1117 if (select = " ") | (select = b.name) 1118 then do; 1119 buf_ct = buf_ct + 1; 1120 call fix_buffer_data (atest, ln_sw); 1121 call ioa_ ( 1122 "^a ^[->^; ^] ^[mod^; ^] (^a)^a^[ [^^trust]^]" 1123 || "^[ [^^pasted]^] ^a^[>^a^[:^]^a^a^[ *^]^]", 1124 line_counts, (rel (bp) = dbase.cb_c_r), 1125 b.mod_sw, b.name, Window, ^b.trust_sw, b.not_pasted, 1126 b.dname, b.file_sw, b.ename, (b.kind = ":"), 1127 b.kind, b.cname, (b.cur.sn = -1)); /* #140*/ 1128 /* print buffer status line */ 1129 end; 1130 end; 1131 end; 1132 if (buf_ct = 0) 1133 then do; 1134 msg = "X: b("; 1135 msg = msg || select; 1136 msg = msg || ") not found"; 1137 call tederror_ (adb_p, msg); 1138 end; 1139 return; 1140 dcl in_window bit (1); 1141 fix_buffer_data: proc (flag, ln_sw); 1142 1143 dcl flag bit (1), 1144 ln_sw bit (1); 1145 1146 /* RW 88 */ 1147 dcl pic7 pic "------9"; /*#163*/ 1148 dcl hold_maxln fixed bin (21); 1149 1150 if (b.cur.sn = 0) /* buffer empty? */ 1151 | (b.b_.l.le > b.b_.l.re) & (b.b_.r.le > b.b_.r.re) /* #152*/ 1152 then do; 1153 b.mod_sw, b.not_pasted = "0"b; 1154 b.maxln = 0; 1155 end; 1156 else if ^(b.file_sw | (b.name = "0")) 1157 then b.mod_sw = "0"b; 1158 if ^b.file_sw 1159 then b.trust_sw = "1"b; 1160 else b.not_pasted = "0"b; 1161 hold_maxln = b.maxln; 1162 if ln_sw & atest 1163 then b.maxln = -1; 1164 if (b.b_.l.le = 1) & (b.b_.r.re = b.maxl) 1165 then do; /* #140*/ 1166 in_window = ""b; /* #140*/ 1167 Window = ""; /* #140*/ 1168 end; /* #140*/ 1169 else do; /* #140*/ 1170 in_window = "1"b; /* #140*/ 1171 Window = " windowed("; /* #140*/ 1172 b.maxln = -1; /* force linecounting #140*/ 1173 end; /* #140*/ 1174 /* RW 88 */ 1175 if (b.maxln < 0) 1176 then string (pic7) = " ??"; /* #140,163*/ 1177 else pic7 = b.maxln; /* #140*/ 1178 if flag & (b.maxln < 0) 1179 then do; 1180 call tedcount_lines_ (bp, b.b_.l.le, b.b_.r.re, b.maxln); /* #140*/ 1181 if ^in_window /* #140*/ 1182 then b.b_.r.ln = b.maxln; 1183 pic7 = b.maxln; /* #140*/ 1184 end; 1185 if in_window 1186 then do; /* #140*/ 1187 line_counts = " ??"; /* #140,163*/ 1188 Window = Window || pic7; /* #140*/ 1189 Window = Window || ")"; /* #140*/ 1190 b.maxln = -1; /* #140*/ 1191 end; /* #140*/ 1192 else line_counts = pic7; /* #140*/ 1193 if ln_sw & atest 1194 then do; 1195 pic7 = hold_maxln; 1196 line_counts = line_counts || " <<"; 1197 line_counts = line_counts || pic7; 1198 end; 1199 1200 end fix_buffer_data; 1201 /**** <<<<----- dcl_tedcheck_buffers_.incl.pl1 tedcheck_buffers_ */ 1202 tedcheck_buffers_: /* check for modified buffers */ 1203 entry (adb_p, check_code); 1204 dcl ( 1205 /****adb_p ptr, /* -> database */ 1206 check_code fixed bin /* number of modified buffers found */ 1207 ) parm; /* ----->>>> */ 1208 1209 dbase_p = adb_p; 1210 check_code = 0; 1211 do i = 3 to dbase.bufnum; 1212 bp = addr (cb (i)); 1213 if b.ck_ptr_sw & b.terminate 1214 then call tedck_ptr_ (bp); 1215 call fix_buffer_data (""b, ""b); 1216 if (b.name ^= "") then /* #139*/ 1217 if b.mod_sw | b.not_pasted 1218 then do; 1219 if (check_code = 0) 1220 then call ioa_ ("Modified buffers exist:"); 1221 check_code = 1; 1222 call ioa_ ("^[->^; ^](^a) ^a^[>^a^[:^]^a^a^]", 1223 (rel (bp) = dbase.cb_c_r), 1224 b.name, b.dname, b.file_sw, b.ename, 1225 (b.kind = ":"), b.kind, b.cname); 1226 end; 1227 end; 1228 return; 1229 tedset_ck_ptr_: /* set "check" flag on ^read buffers */ 1230 entry (adb_p); 1231 1232 dbase_p = adb_p; 1233 do ii = 3 to dbase.bufnum; 1234 bp = addr (cb (ii)); 1235 if (b.cur.sn = -1) & b.terminate 1236 then b.ck_ptr_sw = "1"b; 1237 end; 1238 return; 1239 /* ------------------------- INTERNAL PROCEDURES --------------------------- */ 1240 allocate_cb: proc (cb_ptr, cb_name); 1241 1242 dcl cb_ptr ptr, /* points to new control block [OUT] */ 1243 cb_name char (32); /* name of new block */ 1244 1245 1246 dcl ii fixed bin; 1247 dcl new bit (1); 1248 1249 dbase.bufnum = dbase.bufnum + 1; 1250 cb_ptr = addr (cb (dbase.bufnum)); 1251 new = "1"b; 1252 if ""b 1253 then do; 1254 1255 re_alloc: entry (cb_ptr, cb_name); 1256 new = ""b; 1257 end; 1258 unspec (cb_ptr -> b) = "0"b; /* clean everything out */ 1259 do ii = 1 to all_des; 1260 cb_ptr -> buf_des (ii) = tedcommon_$no_data; 1261 end; 1262 cb_ptr -> b.cur = tedcommon_$no_seg; 1263 cb_ptr -> b.ex = tedcommon_$no_data; 1264 cb_ptr -> b.ex.l.le = cb_ptr -> b.ex.l.re + 1; 1265 cb_ptr -> b.name = cb_name; 1266 cb_ptr -> b.dname = ""; 1267 cb_ptr -> b.ename = ""; 1268 cb_ptr -> b.cname = ""; 1269 cb_ptr -> b.kind = ""; 1270 cb_ptr -> b.trust_sw = "1"b; 1271 if db_util 1272 then call ioa_$ioa_switch (db_output, 1273 "^[new^;old^]-cb ^d.^d b(^a)", new, env_ct, 1274 dbase.bufnum, cb_name); 1275 if db_util 1276 then call tedshow_ (cb_ptr, ".", ltrim(char(dbase.bufnum)), "bcb"); 1277 1278 end allocate_cb; 1279 get_seg: proc (seg_dp, seg_id_no, seg_use, a_code); 1280 1281 seg_id_no = 0; /* set seq # unspecified */ 1282 1283 get_seg_n: entry (seg_dp, seg_id_no, seg_use, a_code); 1284 1285 dcl ( 1286 seg_dp ptr, /* ptr to gotten segment [OUT] */ 1287 seg_id_no fixed bin, /* sequence # of segment [IN/OUT] */ 1288 seg_use char (8), /* use of the segment (db info) */ 1289 a_code fixed bin (35) 1290 ) parm; 1291 1292 if (seg_id_no = 0) /* if no slot specified, look.. */ 1293 then /* ..for an unused one */ 1294 seg_id_no = index (substr (dbase.inuse_seg, 4), "0"b) + 3; 1295 if (seg_id_no > dbase.seg_ct) /* there wasn't one so we're using.. */ 1296 then dbase.seg_ct = seg_id_no; /* ..a new one */ 1297 /* (Really should check for 72 seg */ 1298 /* ..limit being exceeded.) */ 1299 seg_dp = dbase.seg_p (seg_id_no); /* get contents of this slot */ 1300 if (seg_dp ^= null ()) /* is there something there? */ 1301 then do; /* YES */ 1302 substr (dbase.inuse_seg, seg_id_no, 1) = "1"b; 1303 goto exit; 1304 end; 1305 1306 dcl dirname char (168); 1307 dcl myname char (32) var; 1308 dcl ename char (32); 1309 dcl i fixed bin; 1310 1311 get_base: entry (seg_dp, seg_id_no, seg_use, a_code); 1312 1313 a_code = 0; 1314 ename = "ted_.yymmddHHMMSS.UUUUUU.000"; 1315 if (dbase_p = null ()) /* getting the database segment */ 1316 then do; 1317 substr (ename, 6, 19) = rqid; 1318 substr (ename, 26) = "X"; 1319 dirname = db_dir; 1320 if db_util 1321 then call ioa_$ioa_switch (db_output, 1322 " ^[[pd]^s^;^a^] > ^a", (dirname = ""), dirname, ename); 1323 myname = ted_data.tedname; 1324 end; 1325 else do; /* getting an auxiliary segment */ 1326 /**** This routine enters new entries into dbase.seg_p. demote handles the */ 1327 /**** freeing of them during execution. (cleanup, of course, cleans them */ 1328 /**** all out at termination time.) */ 1329 substr (dbase.inuse_seg, seg_id_no, 1) = "1"b; 1330 substr (ename, 6, 19) = dbase.rq_id; 1331 substr (ename, 26) = convert (pic3, seg_id_no); 1332 dirname = dbase.dir_db; 1333 myname = dbase.tedname; 1334 end; 1335 seg_dp = null (); 1336 if (dirname ^= "") /* -safe/-temp_dir environment */ 1337 then do; 1338 call hcs_$make_seg (dirname, ename, "", 01011b, seg_dp, a_code); 1339 if (seg_dp = null ()) 1340 then do; 1341 call com_err_ (a_code, myname, "get_seg(^a>^a)", 1342 dirname, ename); 1343 goto abort_no_print; 1344 end; 1345 a_code = 0; 1346 end; 1347 else do; /* environment is in [pd] */ 1348 call get_temp_segment_ ((myname), seg_dp, a_code); 1349 if (a_code ^= 0) 1350 then do; 1351 msg = "Getting temp segment"; 1352 goto abort_print; 1353 end; 1354 end; 1355 if (dbase_p ^= null ()) 1356 then dbase.seg_p (seg_id_no) = seg_dp; 1357 else do; 1358 do i = -1 to 72; /* initialize the ptr array */ 1359 seg_dp -> dbase.seg_p (i) = null (); 1360 end; 1361 seg_dp -> dbase.seg_p (0) = seg_dp; /* just for completeness */ 1362 seg_dp -> dbase.seg_ct = 2; /* reserve 1 and 2 */ 1363 string (seg_dp -> dbase.sws) = "0"b; 1364 if (db_dir ^= "") /* The temp_dir given may not be the */ 1365 then do; /* home_dir. Try to link to the */ 1366 /* segment we just created */ 1367 call hcs_$append_link (get_default_wdir_ (), ename, 1368 rtrim (dirname) || ">" || ename, a_code); 1369 /* If a name duplication then */ 1370 /* temp_dir IS home_dir, no sweat */ 1371 if (a_code ^= 0) 1372 then do; 1373 if (a_code ^= error_table_$namedup) 1374 then call com_err_ (a_code, ted_data.tedname, 1375 "Trying to link to remote dbase ^a>^a.", 1376 rtrim (dirname), ename); 1377 end; 1378 else seg_dp -> dbase.remote_sw = "1"b; 1379 1380 end; 1381 end; 1382 exit: 1383 if db_util 1384 then call ioa_$ioa_switch (db_output, 1385 "get_seg ^3d ^p ^a", seg_id_no, seg_dp, seg_use); 1386 1387 end get_seg; 1388 1389 start: proc; 1390 1391 /**** This is a clean segment, so all fields which need to be initialized to */ 1392 /**** zero are left alone. */ 1393 1394 if db_util then call ioa_$ioa_switch (db_output, 1395 "begin start"); 1396 dbase.tedname = ted_data.tedname; /* these 3 values */ 1397 dbase.dir_db = db_dir; /* ..must be set */ 1398 dbase.rq_id = rqid; /* ..before calling get_seg */ 1399 dbase.cba_p = addr (cb (1)); 1400 dbase.eval_p = null (); 1401 dbase.version = dbase_vers_3; 1402 /*** dbase.seg_p(*) is initialized by get_base */ 1403 1404 dbase.time = startup; 1405 dbase.argct = ted_data.arg_list_n - max (1, ted_data.arg_list_1) + 1; 1406 call user_info_ (dbase.person, dbase.project); 1407 dbase.nulreq = "p"; 1408 dbase.err_go = ""; 1409 dbase.recurs = env_ct + 1; 1410 1411 /**** init call stack data */ 1412 dbase.stk_info.top = null (); 1413 dbase.stk_info.curp = addr (cb (1)); 1414 dbase.stk_info.level = 0; 1415 dbase.stk_info.next = 1; 1416 1417 /**** request buffer space */ 1418 bp = addr (cb (0)); 1419 call re_alloc (bp, "(request line)"); 1420 call tedpromote_ (bp, 4096); /* get some buffer space */ 1421 dbase.rl.part1 = b.cur; 1422 dbase.rl.part2 = b.b_; 1423 1424 /**** allocate the console cb */ 1425 call allocate_cb (bp, "(ted)"); /* ted_ will allocate the space */ 1426 call tedpromote_ (bp, 4096); /* get some buffer space */ 1427 b.tw_sw = "1"b; /* ..where data will be read */ 1428 b.terminate = "0"b; 1429 1430 /**** allocate val cb */ 1431 1432 call allocate_cb (bp, "(val)"); 1433 dbase.eval_p = bp; /* a "buffer" segment will be gotten */ 1434 /* if evaluation is ever used. */ 1435 1436 /**** process arg buffers */ 1437 1438 if (dbase.argct > 0) 1439 then do; 1440 call allocate_cb (bp, "args"); 1441 b.noref = "1"b; 1442 dcl arg_no fixed bin; 1443 dcl tbp ptr; 1444 i = 0; /* first find out how many chars */ 1445 do arg_no = ted_data.arg_list_1 to ted_data.arg_list_n; 1446 call cu_$arg_ptr_rel (arg_no, arg_p, arg_l, code, 1447 ted_data.arg_list_p); 1448 i = i + arg_l + 1; 1449 end; 1450 call tedpromote_ (bp, i); /* get enough room for args */ 1451 b.a_.r.le (0), b.a_.r.re (0) = -1; 1452 b.maxln = dbase.argct; 1453 b.pseudo = "1"b; 1454 b.cur.ast = 0; /* (make promotion work) */ 1455 i = 1; 1456 do arg_no = ted_data.arg_list_1 to ted_data.arg_list_n; 1457 call cu_$arg_ptr_rel (arg_no, arg_p, arg_l, code, 1458 ted_data.arg_list_p); 1459 substr (b_s, b.b_.l.re + 1, arg_l) = arg; 1460 call allocate_cb (tbp, "arg" || ltrim (char (i))); 1461 i = i + 1; 1462 /**** Leave buffer empty if no data to put there. */ 1463 if (arg_l > 0) 1464 then call tedpseudo_ (tbp, b.cur.sn, addr (b_c (b.b_.l.re + 1)), arg_l); 1465 tbp -> b.a_.r.le (0), tbp -> b.a_.r.re (0) = -1; 1466 tbp -> b.maxln = fixed (arg_l > 0); 1467 tbp -> b.noref = "1"b; 1468 b.b_.l.re = b.b_.l.re + arg_l + 1; 1469 b_c (b.b_.l.re) = NL; 1470 end; 1471 end; 1472 1473 /* allocate b(0) cb */ 1474 1475 call allocate_cb (bp, "0"); 1476 dbase.cb_c_r = rel (bp); 1477 1478 if db_util then call ioa_$ioa_switch (db_output, 1479 "end start"); 1480 1481 end; 1482 restart: proc; 1483 1484 1485 if (dbase.version ^= dbase_vers_3) 1486 then do; 1487 call com_err_ (0, dbase.tedname, 1488 "Old version of ted dbase, cannot restart."); 1489 goto abort_no_print; 1490 end; 1491 if db_util then call tedshow_ (dbase_p, "> restart base"); 1492 1493 dbase.seg_p (0) = dbase_p; 1494 do i = 1 to dbase.seg_ct; 1495 if (dbase.seg_p (i) ^= null ()) 1496 then do; 1497 dbase.seg_p (i) = null (); 1498 call get_seg_n (dbase.seg_p (i), (i), "reget_n ", code); 1499 if (code ^= 0) 1500 then goto abort_print; 1501 end; 1502 end; 1503 dbase.eval_p = addr (cb (2)); 1504 dbase.cba_p = addr (cb (1)); 1505 do i = 0 to dbase.bufnum; 1506 bp = addr (cb (i)); 1507 if (b.cur.sn = -1) 1508 then do; 1509 if cb (i).terminate | cb (i).initiate 1510 then do; 1511 addr (cb (i).cur.sp) -> its.segno = "77777"b3; 1512 call tedck_ptr_ (addr (cb (i))); 1513 end; 1514 end; 1515 if (b.cur.sn > 0) /* was this an active pointer? */ 1516 then addr (b.cur.sp) -> its.segno 1517 = addr (dbase.seg_p (b.cur.sn)) -> its.segno; 1518 if (b.pend.sn > 0) /* was this an active pointer? */ 1519 then addr (b.pend.sp) -> its.segno 1520 = addr (dbase.seg_p (b.pend.sn)) -> its.segno; 1521 end; 1522 dbase.rl.part1 = cb (0).cur; 1523 dbase.recurs = env_ct + 1; 1524 dbase.stk_info.top = null (); 1525 dbase.stk_info.curp = addr (cb (1)); 1526 dbase.stk_info.level = 0; 1527 1528 if db_util then call tedshow_ (dbase_p, "< restart base"); 1529 return; 1530 1531 1532 end restart; 1533 dcl (addr, char, divide, fixed, index, length, null, search, substr, 1534 verify) builtin; 1535 1 1 /**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16 */ 1 2 /**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo */ 1 3 /**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend */ 1 4 /**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt */ 1 5 /* BEGIN INCLUDE FILE ..... ted_.incl.pl1 ..... 12/08/77 J Falksen */ 1 6 /* 08/11/81 jaf Added version number in place of implied pad field */ 1 7 1 8 dcl ted_ entry (ptr, fixed bin (35)) options(variable); 1 9 1 10 /* call ted_ (ted_data_p,code); */ 1 11 dcl ted_data_version_1 fixed bin int static options (constant) init (1001); 1 12 1 13 dcl 1 ted_data based (ted_data_p), 1 14 2 tedname char (32) var, /* name which should appear in error */ 1 15 /* messages */ 1 16 2 version fixed bin (35), 1 17 2 ted_com_p ptr, /* string to be initially executed */ 1 18 2 ted_com_l fixed bin (21), /* length thereof */ 1 19 2 ted_mode fixed bin, /* ted operating mode */ 1 20 /* 0 - NORMAL */ 1 21 /* 1 - SAFE */ 1 22 /* 2 - COM */ 1 23 /* 3 - RESTART */ 1 24 1 25 2 arg_list_p ptr, /* pointer to the argument list */ 1 26 2 arg_list_1 fixed bin, /* first argument to be used */ 1 27 2 arg_list_n fixed bin, /* last argument to be used */ 1 28 1 29 /* To avoid forcing the caller to always manufacture an argument list for */ 1 30 /* arg_list_p to point to, ted_ will accept additional arguments (3...n). */ 1 31 /* If more than 2 are present, ted_'s argument pointer will be placed in */ 1 32 /* arg_list_p, 3 into arg_list_1 and the number of args into arg_list_n. */ 1 33 1 34 2 return_string_p ptr, /* active function return string */ 1 35 2 return_string_l fixed bin (21), /* length thereof */ 1 36 /* b(argn) is copied into this */ 1 37 /* string if it exists */ 1 38 2 input_p ptr, /* pointer to data to be edited */ 1 39 2 input_l fixed bin (21), /* length of data to be edited */ 1 40 /* if this exists, the the data is */ 1 41 /* copied into b0 */ 1 42 2 output_p ptr, /* pointer to output segment */ 1 43 2 output_l fixed bin (21), /* length of output data (output) */ 1 44 /* if output_p = null the data is */ 1 45 /* put back into input area */ 1 46 2 temp_dir char (168); /* directory to hold work segments */ 1 47 1 48 dcl tederror_table_$ted_com_abort fixed bin(35) ext static; 1 49 1 50 1 51 /* END INCLUDE FILE ..... ted_.incl.pl1 ..... */ 1536 2 1 /* BEGIN INCLUDE FILE ..... tedbase.incl.pl1 ..... 02/09/82 J Falksen */ 2 2 2 3 dcl NORMAL fixed bin (24) int static init (0), 2 4 SAFE fixed bin (24) int static init (1), 2 5 COM fixed bin (24) int static init (2), 2 6 RESTART fixed bin (24) int static init (3); 2 7 2 8 dcl rc_close fixed bin (24) int static init (100); 2 9 dcl rc_fail fixed bin (24) int static init (10); 2 10 dcl rc_nop fixed bin (24) int static init (2); 2 11 dcl rc_keyerr fixed bin (24) int static init (1); 2 12 2 13 /*** the request line as both string and character */ 2 14 dcl rl_b fixed bin (21); /* where current req begins */ 2 15 dcl rl_i fixed bin (21) defined (dbase.rl.l.le); 2 16 dcl rl_l fixed bin (21) defined (dbase.rl.l.re); 2 17 dcl rl_c (rl_l) char (1) based (dbase.rl.sp); 2 18 dcl rl_s char (rl_l) based (dbase.rl.sp); 2 19 2 20 dcl 1 seg_des based, /* segment descriptor */ 2 21 2 sp ptr, /* -> segment */ 2 22 2 sn fixed bin, /* sequence # in dbase */ 2 23 2 pn fixed bin, /* part #, if in pool */ 2 24 2 ast fixed bin, /* size of aste */ 2 25 2 mbz fixed bin; /* --reserved */ 2 26 2 27 2 28 2 29 dcl dbase_p ptr; 2 30 dcl dbase_vers_3 fixed bin int static init (3); 2 31 dcl 1 dbase based (dbase_p), 2 32 2 version fixed bin, 2 33 2 recurs fixed bin, /* recursion level at which active */ 2 34 2 bwd ptr, /* links active db's together */ 2 35 2 cba_p ptr, /* contains addr (cb (1)) */ 2 36 2 eval_p ptr, /* contains cb (2).sp */ 2 37 2 rl, /* describes the request buffer */ 2 38 3 part1 like seg_des, /* ..its segment */ 2 39 3 part2 like buf_des, /* ..its limits */ 2 40 2 seg_p (-1:72) ptr, /* list of segment pointers */ 2 41 /* seg_p(-1)is a temp for restart */ 2 42 /* seg_p(0) is the database */ 2 43 /* seg_p(1) is the 1K/4K pool */ 2 44 /* seg_p(2) is reserved for 16K pool */ 2 45 /* seg_p(3) is reserved for call_stk */ 2 46 2 inuse_seg bit (72) aligned, /* which segments (1:72) are in use */ 2 47 /* seg_p(0) is ALWAYS in use */ 2 48 2 inuse_1K bit (16) aligned, /* which 1K buffers are in use */ 2 49 2 inuse_4K bit (12) aligned, /* which 4K buffers are in use */ 2 50 2 inuse_16K bit (4) aligned, /* which 16K buffers are in use */ 2 51 2 reset label, /* where to go on a reset condition */ 2 52 2 time fixed bin (71), /* time request id is based on */ 2 53 2 seg_ct fixed bin, /* how many segments in use */ 2 54 /* seg_p (0)--database */ 2 55 /* seg_p (1)--4K pool (64K total) */ 2 56 /* seg_p (2)--16K pool (64K total) */ 2 57 2 argct fixed bin, /* how many args to ted */ 2 58 2 S_count fixed bin, /* # matches on last substitute */ 2 59 2 not_read_ct fixed bin, /* how many "not-read" files */ 2 60 2 at_break fixed bin, /* 1-break pending, 2-break entered */ 2 61 2 bufnum fixed bin, /* how many buffer control blocks */ 2 62 2 lock bit (36), /* to find if active (set LAST!) */ 2 63 2 cb_c_r bit (18) aligned, /* offset of current buffer */ 2 64 2 cb_w_r bit (18) aligned, /* offset of buffer being worked on */ 2 65 2 sws, 2 66 3 flow_sw bit (1) unal, /* -label specified */ 2 67 3 break_sw bit (1) unal, /* -break specified */ 2 68 3 edit_sw bit (1) unal, /* -trace_edit specified */ 2 69 3 input_sw bit (1) unal, /* -trace_input */ 2 70 3 old_style bit (1) unal, /* 1-old-style escapes allowed */ 2 71 3 remote_sw bit (1) unal, /* 1-not in home_dir */ 2 72 3 read_sw bit (1) unal, /* 1-always read files */ 2 73 3 lit_sw bit (1) unal, /* 1-expressions are literal */ 2 74 3 fill bit (28) unal, 2 75 2 tedname char (32) var, /* name under which ted_ was called */ 2 76 2 comment char (256)var, /* user ident of environment */ 2 77 2 err_msg char (168)var, 2 78 2 regexp char (500), /* holds the remembered regular expr */ 2 79 /* is placed here to get word */ 2 80 /* alignment */ 2 81 2 dir_db char (168), /* where work segments live */ 2 82 2 person char (22), /* who started */ 2 83 2 project char (9), /* ...this environment */ 2 84 2 nulreq char (2), /* what is null request (p|P|!p) */ 2 85 2 err_go char (16), /* label to go to on error */ 2 86 2 rq_id char (19), /* request id for this */ 2 87 2 stk_info, 2 88 3 curp ptr, /* pointer to current buffer */ 2 89 3 top ptr, /* pointer to top of stack */ 2 90 3 level fixed bin (21), /* recursion depth */ 2 91 3 next fixed bin (21); 2 92 /* next space available in stack */ 2 93 2 94 2 95 /* END INCLUDE FILE ..... tedbase.incl.pl1 ..... */ 1537 3 1 /* BEGIN INCLUDE FILE ..... tedbcb.incl.pl1 ..... 01/29/82 J Falksen */ 3 2 3 3 /* UPDATE HISTORY (finally) */ 3 4 /* EL# date TR comments */ 3 5 /* --- 84-10-19 -------- add sws.INPUT */ 3 6 /* --- 84-10-29 -------- add sws.invoking */ 3 7 3 8 /* if the structure of buf_des changes, tedcommon_.alm and */ 3 9 /* tedcommon.incl.pl1 must be appropriately changed */ 3 10 3 11 dcl 1 buf_des (all_des) based (bp), /* buffer part descriptor */ 3 12 2 l, /* left end (LHE) data (see Note 1) */ 3 13 3 ln fixed bin (21), /* line number */ 3 14 3 le fixed bin (21), /* left end (LE) offset */ 3 15 3 re fixed bin (21), /* right end (RE) offset */ 3 16 2 r like buf_des.l; /* right end (RHE) data */ 3 17 3 18 /* Note1: buf_des describes 2 slightly different things, buffer parts and */ 3 19 /* addresses. These are the circumstances: */ 3 20 /* */ 3 21 /* */ 3 22 /* |.........................................| */ 3 23 /* b.cur.sp| |.....................| | */ 3 24 /* Buffer: xxxxxxxxxxwwwwwwwwwwwww......wwwwwwxxxxxxxxxx */ 3 25 /* | | | | | */ 3 26 /* b.b_.l.le| b.b_.l.re| b.b_.r.le| | maxl| */ 3 27 /* b.b_.l.ln| b.b_.r.le| maxln| */ 3 28 /* b.b_.r.ln| */ 3 29 /* b.b_.l.ln (if known) tells the # of lines in left part of window */ 3 30 /* b.b_.r.ln (if known) tells the # of lines the whole window */ 3 31 /* b.maxln (if known) tells the # of lines in the whole buffer */ 3 32 /* Either left or right part may be null. A ^read file */ 3 33 /* is in the right part. A file is always read at the */ 3 34 /* upper end of the hole. This will usually minimize the */ 3 35 /* amount of data movement during subsequent editing */ 3 36 /* operations. */ 3 37 /* */ 3 38 /* Data movement which occurs within a request, for example substitute, can */ 3 39 /* cause an offset to temporarily point into the hole. This will clear up */ 3 40 /* before the operation is complete. */ 3 41 3 42 /* N */ 3 43 /* Address: ....xxxxxxxxxxsssss -- sssssssxxxxxxxxxxL.... */ 3 44 /* | | | | */ 3 45 /* l.le| l.re| r.le| r.re| */ 3 46 /* l.ln| r.ln| */ 3 47 /* l.re is the beginning of the string addressed. */ 3 48 /* l.le is the beginning of line containing location l.re */ 3 49 /* Thus l.ln is related to both l.re and l.le */ 3 50 /* r.re is the end of the string addressed. */ 3 51 /* r.le is the end of line containing location r.re */ 3 52 /* Thus r.ln is related to both r.re and r.le */ 3 53 /* (l.le and r.le relate to the same line when 1 line is addressed) */ 3 54 /* In line mode each request starts with l.re=l.le & r.re=r.le */ 3 55 /* In string mode a global request forces these conditions. */ 3 56 3 57 /*** b_c/b_s reference the string which represents the buffer data. */ 3 58 dcl b_c (b.maxl) char (1) based (b.cur.sp); 3 59 dcl b_s char (b.maxl) based (b.cur.sp); 3 60 3 61 dcl (live_des init (8), 3 62 all_des init (13), 3 63 reloc_first init (2), /* where to begin minus 1 */ 3 64 reloc_last init (8) /* where to stop */ 3 65 ) fixed bin int static options (constant); 3 66 dcl bp ptr; 3 67 dcl 1 b based (bp), /* ted buffer control block */ 3 68 2 b_ like buf_des, /* defines buffer limits */ 3 69 2 newb like buf_des, /* pending buffer values */ 3 70 2 ex like buf_des, /* execution limits */ 3 71 2 a_ (0:2) like buf_des, /* address data */ 3 72 /* (0) "cur location" */ 3 73 /* (1) 1st addr result */ 3 74 /* (2) 2nd addr result */ 3 75 2 cd like buf_des, /* copy destination */ 3 76 2 gb like buf_des, /* info for global processing */ 3 77 2 newa like buf_des, /* pending address values */ 3 78 /* ----limit of relocation---- */ 3 79 /* these are not relocated because they define the relocation data */ 3 80 2 rel_temp like buf_des, /* hold during relocation */ 3 81 2 temp (0:2) like buf_des, /* hold during [.]addr processing */ 3 82 2 old, /* where string used to be */ 3 83 3 (le,re) fixed bin (21), /* ends of range */ 3 84 2 new like b.old, /* where string has gone to */ 3 85 2 test like b.old, /* allowable relocatable range */ 3 86 /* (may be 1 or 2 larger than b.old) */ 3 87 2 cur like seg_des, /* CURRENT buffer area info */ 3 88 /* (see note 2) */ 3 89 2 pend like seg_des, /* PENDING buffer area info */ 3 90 2 file_d, /* file related data */ 3 91 3 dtcm bit(36), /* when read seg was modified */ 3 92 3 uid bit(36), /* unique ID of segment */ 3 93 3 dname char(168), /* directory of file */ 3 94 3 ename char(32), /* entry of file */ 3 95 3 cname char(32), /* component of file */ 3 96 3 kind char(1)unal, /* kind of component */ 3 97 /* " "-none, ":"-archive */ 3 98 /* "|"-superfile */ 3 99 3 sws unal, 3 100 4 file_sw bit(1), /* 1-file associated */ 3 101 4 trust_sw bit(1), /* 1-file name trustable */ 3 102 4 mod_sw bit(1), /* 1-buffer has been modified */ 3 103 4 terminate bit(1), /* 1-dp points to file, terminate */ 3 104 4 get_bit_count bit(1), /* 1-get_bit_count before using this */ 3 105 /* buffer, it may have been modified by */ 3 106 /* externally via [ted$buffer xx] usage */ 3 107 4 force_name bit(1), /* 1-name has been forced */ 3 108 4 no_io bit(1), /* 1-no r w ^b allowed */ 3 109 /* (external string edit) */ 3 110 4 not_pasted bit(1), /* 1-data was moved into buffer but */ 3 111 /* has not been read anywhere */ 3 112 4 initiate bit(1), /* 1-must initiate on restart */ 3 113 /* (b% and b!) */ 3 114 4 ck_ptr_sw bit(1), /* 1-if segment is external, must */ 3 115 /* check pointer before ref */ 3 116 4 pseudo bit (1), /* 1-^read or read-only buffer */ 3 117 4 INPUT bit (1), /* 1-active INPUT mode on buffer */ 3 118 4 invoking bit (1), /* 1-buffer being invoked */ 3 119 4 fill bit (14), 3 120 2 name char(16), /* buffer name */ 3 121 2 fill char(27), 3 122 2 stackl bit (18)aligned, /* offset of list of stacked data */ 3 123 2 stack_o bit (18)aligned, /* offset of data being relocated */ 3 124 2 present (0:2) bit(1), /* 1 if addr present */ 3 125 2 tw_sw bit(1), /* 1-typewriter buffer */ 3 126 2 bs, /* Old-style escapes in this buffer */ 3 127 3 (c,b,r,f) bit(1), /* 1-\031,\030,\036,\034 found */ 3 128 2 noref bit(1), /* 1-not ref'ed, don't list */ 3 129 2 maxl fixed bin(21), /* max buffer length in this AST */ 3 130 2 maxln fixed bin(21), /* number of lines in buffer */ 3 131 2 state_r fixed bin(21), /* what state is request in */ 3 132 2 (N1,N2,N3) fixed bin(21), /* values kept for -safe_ty */ 3 133 2 state_b fixed bin(21); /* what state is buffer change in */ 3 134 3 135 /* Note2: sn=0 means empty because the database segment will never */ 3 136 /* contain a buffer holder */ 3 137 /* sn=-1 (&^b.terminate) means read-only data, if modification is */ 3 138 /* done, a copy will be made. */ 3 139 /* sn=-1 (& b.terminate) means ^read file, if modification is done */ 3 140 /* the file is read first */ 3 141 /* sn>0 means a buffer holder segment */ 3 142 3 143 /* END INCLUDE FILE ..... tedbcb.incl.pl1 ..... */ 1538 4 1 /* BEGIN INCLUDE FILE ..... tedstk.incl.pl1 ..... 04/16/76 J Falksen */ 4 2 4 3 dcl sv_p ptr; 4 4 dcl 1 sv based (sv_p), 4 5 2 prev ptr, /* ->previous frame */ 4 6 2 bp ptr, /* ->buffer control block last used */ 4 7 2 ex like b.ex, /* execution limits in buffer */ 4 8 2 a0 like b.a_, /* "." in buffer */ 4 9 2 stackl bit (18)aligned, /* linked list of occurances of same */ 4 10 /* buffer in the stack */ 4 11 2 fill bit (36)aligned, 4 12 2 this fixed bin (21), /* space index before this frame was */ 4 13 /* allocated */ 4 14 2 pn fixed bin (21), /* parameter number */ 4 15 2 pv (0:sv.pn), 4 16 3 pp ptr, /* pointer to parameter */ 4 17 3 pl fixed bin (21); /* length of parameter */ 4 18 4 19 dcl pstr based char (256); 4 20 4 21 dcl 1 call_stk based (dbase.seg_p (3)), 4 22 2 space (2000) ptr; /* place to put stack frames */ 4 23 4 24 /* END INCLUDE FILE ..... tedstk.incl.pl1 ..... */ 1539 5 1 /* BEGIN INCLUDE FILE ..... tederror_.incl.pl1 ..... 09/02/76 J Falksen */ 5 2 5 3 dcl tederror_ entry(ptr, char(168)var); 5 4 dcl tederror_rc_ entry(ptr, char(168)var,fixed bin(35)); 5 5 5 6 dcl msg char(168)var; 5 7 dcl msg_ptr ptr; 5 8 5 9 /* END INCLUDE FILE ..... tederror_.incl.pl1 ..... */ 1540 6 1 /* BEGIN INCLUDE FILE ..... tedcommon_.incl.pl1 ..... 02/15/82 J Falksen */ 6 2 6 3 /* ted common data area */ 6 4 6 5 dcl 1 tedcommon_$id ext static, 6 6 2 ted_vers char(12)var; /* version.revision */ 6 7 6 8 dcl 1 tedcommon_$no_data like buf_des ext static; 6 9 dcl 1 tedcommon_$no_seg like seg_des ext static; 6 10 6 11 dcl 1 tedcommon_$etc ext static, 6 12 2 com_blank bit(1)aligned, 6 13 2 com1_blank bit(1)aligned, 6 14 2 caps bit(1)aligned, 6 15 2 reset_read bit(1)aligned, 6 16 2 sws, 6 17 3 (db_ted, lg_ted) bit(1)aligned, 6 18 3 (db_addr, lg_addr) bit(1)aligned, 6 19 3 (db_eval, lg_eval) bit(1)aligned, 6 20 3 (db_sort, lg_sort) bit(1)aligned, 6 21 3 (db_gv, lg_gv) bit(1)aligned, 6 22 3 (db_util, lg_util) bit(1)aligned, 6 23 3 (db_srch, lg_srch) bit(1)aligned, 6 24 3 (db_glob, lg_glob) bit(1)aligned, 6 25 3 (db_trac, lg_sp4) bit(1)aligned, 6 26 3 (db_Ed, lg_sp3) bit(1)aligned, 6 27 3 (db_sp2, lg_sp2) bit(1)aligned, 6 28 3 (db_sp1, lg_sp1) bit(1)aligned, 6 29 3 (db_catch, lg_catch)bit(1)aligned, 6 30 2 db_output ptr; 6 31 6 32 /* END INCLUDE FILE ..... tedcommon_.incl.pl1 ..... */ 1541 1542 dcl tedmgr_$list entry; 1543 dcl tedaddr_ entry ( /* process request addresses */ 1544 ptr, /* -> database */ 1545 ptr, /* -> string containing address */ 1546 fixed bin (21), /* length of it [IN] */ 1547 /* If <0 then recursive call */ 1548 /* how much was used up [OUT] */ 1549 ptr, /* -> buffer control block [IN/OUT] */ 1550 char (168) var, /* place to hold err message if any */ 1551 fixed bin (35), /* status code */ 1552 /* 0- null address */ 1553 /* 1- address found */ 1554 /* 8- error, msg tells what */ 1555 ); 1556 1557 1558 dcl tedck_ptr_ entry (ptr); 1559 dcl tedcount_lines_ entry ( /* return # lines in string */ 1560 ptr, /* -> buffer in which to count */ 1561 fixed bin (21), /* where string begins in segment */ 1562 fixed bin (21), /* where string ends in segment */ 1563 fixed bin (21) /* # lines [OUT] */ 1564 ); 1565 1566 1567 dcl tedcloseup_ entry ( /* move all buffer data to lower */ 1568 ptr /* -> to buffer to convert */ 1569 ); 1570 1571 1572 dcl tedpromote_ entry ( /* get a larger data buffer */ 1573 ptr, /* -> buffer to promote */ 1574 fixed bin (21) /* amount not fitting */ 1575 ); 1576 1577 1578 dcl tedpseudo_ entry ( /* make a pseudo (read-only) buffer */ 1579 ptr, /* -> to buffer to convert */ 1580 fixed bin, /* segno of data (-1 if ^read) */ 1581 ptr, /* -> the data */ 1582 fixed bin (21) /* the length of it */ 1583 ); 1584 1585 1586 dcl tedshow_ entry options (variable); 7 1 /* BEGIN INCLUDE FILE its.incl.pl1 7 2* modified 27 July 79 by JRDavis to add its_unsigned 7 3* Internal format of ITS pointer, including ring-number field for follow-on processor */ 7 4 7 5 dcl 1 its based aligned, /* declaration for ITS type pointer */ 7 6 2 pad1 bit (3) unaligned, 7 7 2 segno bit (15) unaligned, /* segment number within the pointer */ 7 8 2 ringno bit (3) unaligned, /* ring number within the pointer */ 7 9 2 pad2 bit (9) unaligned, 7 10 2 its_mod bit (6) unaligned, /* should be 43(8) */ 7 11 7 12 2 offset bit (18) unaligned, /* word offset within the addressed segment */ 7 13 2 pad3 bit (3) unaligned, 7 14 2 bit_offset bit (6) unaligned, /* bit offset within the word */ 7 15 2 pad4 bit (3) unaligned, 7 16 2 mod bit (6) unaligned; /* further modification */ 7 17 7 18 dcl 1 itp based aligned, /* declaration for ITP type pointer */ 7 19 2 pr_no bit (3) unaligned, /* number of pointer register to use */ 7 20 2 pad1 bit (27) unaligned, 7 21 2 itp_mod bit (6) unaligned, /* should be 41(8) */ 7 22 7 23 2 offset bit (18) unaligned, /* word offset from pointer register word offset */ 7 24 2 pad2 bit (3) unaligned, 7 25 2 bit_offset bit (6) unaligned, /* bit offset relative to new word offset */ 7 26 2 pad3 bit (3) unaligned, 7 27 2 mod bit (6) unaligned; /* further modification */ 7 28 7 29 7 30 dcl 1 its_unsigned based aligned, /* just like its, but with unsigned binary */ 7 31 2 pad1 bit (3) unaligned, 7 32 2 segno fixed bin (15) unsigned unaligned, 7 33 2 ringno fixed bin (3) unsigned unaligned, 7 34 2 pad2 bit (9) unaligned, 7 35 2 its_mod bit (6) unaligned, 7 36 7 37 2 offset fixed bin (18) unsigned unaligned, 7 38 2 pad3 bit (3) unaligned, 7 39 2 bit_offset fixed bin (6) unsigned unaligned, 7 40 2 pad4 bit (3) unaligned, 7 41 2 mod bit (6) unaligned; 7 42 7 43 dcl 1 itp_unsigned based aligned, /* just like itp, but with unsigned binary where appropriate */ 7 44 2 pr_no fixed bin (3) unsigned unaligned, 7 45 2 pad1 bit (27) unaligned, 7 46 2 itp_mod bit (6) unaligned, 7 47 7 48 2 offset fixed bin (18) unsigned unaligned, 7 49 2 pad2 bit (3) unaligned, 7 50 2 bit_offset fixed bin (6) unsigned unaligned, 7 51 2 pad3 bit (3) unaligned, 7 52 2 mod bit (6) unaligned; 7 53 7 54 7 55 dcl ITS_MODIFIER bit (6) unaligned internal static options (constant) init ("43"b3); 7 56 dcl ITP_MODIFIER bit (6) unaligned internal static options (constant) init ("41"b3); 7 57 7 58 /* END INCLUDE FILE its.incl.pl1 */ 1587 1588 end tedmgr_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/07/88 1308.4 tedmgr_.pl1 >spec>install>1146>tedmgr_.pl1 1536 1 11/23/82 1324.6 ted_.incl.pl1 >ldd>include>ted_.incl.pl1 1537 2 11/23/82 1324.7 tedbase.incl.pl1 >ldd>include>tedbase.incl.pl1 1538 3 12/18/84 0954.3 tedbcb.incl.pl1 >ldd>include>tedbcb.incl.pl1 1539 4 11/23/82 1324.7 tedstk.incl.pl1 >ldd>include>tedstk.incl.pl1 1540 5 11/23/82 1324.7 tederror_.incl.pl1 >ldd>include>tederror_.incl.pl1 1541 6 12/18/84 0954.3 tedcommon_.incl.pl1 >ldd>include>tedcommon_.incl.pl1 1587 7 11/26/79 1320.6 its.incl.pl1 >ldd>include>its.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. DATABASE based structure level 1 unaligned dcl 68 DD automatic picture(2) packed unaligned dcl 88 ref 205 205 MTi 000562 automatic fixed bin(21,0) dcl 834 set ref 840 842 913* 915* NL constant char(1) initial packed unaligned dcl 78 ref 865 1469 RESTART constant fixed bin(24,0) initial dcl 2-3 ref 179 227 SAFE constant fixed bin(24,0) initial dcl 2-3 ref 179 Window 000413 automatic varying char(24) dcl 1102 set ref 1121* 1167* 1171* 1188* 1188 1189* 1189 a_ 22 based structure array level 2 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" set ref 959 959* 959* 962* 962 a_ 1004 based structure array level 3 in structure "DATABASE" unaligned dcl 68 in procedure "tedmgr_" a_code parameter fixed bin(35,0) dcl 1285 set ref 1279 1283 1311 1313* 1338* 1341* 1345* 1348* 1349 1367* 1371 1373 1373* a_msg parameter varying char(168) dcl 1065 set ref 776 791 989* 1022 1063 1086 abp parameter pointer dcl 793 set ref 776 791 811* 992* 1022 1025 acode parameter fixed bin(35,0) dcl 169 set ref 167 189 203* 205* 210* 231* 248* 253 256 266* 313* 319 324 381* 417* 418 469* 470 470* 472 480* 510* 519* activ 000101 automatic fixed bin(17,0) dcl 291 set ref 297* 328* 328 343 353 374 adb_p parameter pointer dcl 169 set ref 167 510* 511 520* 529 531 536 538 776 791 805 1022 1024 1030 1041 1052 1059 1063 1087* 1090 1104 1137* 1202 1209 1229 1232 addr builtin function dcl 1533 ref 61 381 381 561 561 570 656 842 920 946 946 1112 1212 1234 1250 1399 1413 1418 1463 1463 1503 1504 1506 1511 1512 1512 1515 1515 1518 1518 1525 af_len 000346 automatic fixed bin(21,0) dcl 721 set ref 705* 706 af_ptr 000344 automatic pointer dcl 720 set ref 705* 706 af_val based varying char dcl 719 set ref 706* ain_l parameter fixed bin(21,0) dcl 793 set ref 776 791 852 912* 949* ain_p parameter pointer dcl 793 ref 776 791 851 all_des constant fixed bin(17,0) initial dcl 3-61 ref 1259 area_p 000100 automatic pointer dcl 80 set ref 229* 231* arg based char packed unaligned dcl 81 set ref 657 711* 733 735 738* 1459 arg_bufs 000102 automatic fixed bin(17,0) dcl 82 set ref 1106* 1107 1107* 1107 1109 1109 arg_l 000103 automatic fixed bin(21,0) dcl 83 set ref 647* 648 657 711 711 730* 733 735 738 738 1003* 1010* 1010 1011 1013 1446* 1448 1457* 1459 1459 1463 1463* 1466 1468 arg_list_1 20 based fixed bin(17,0) level 2 dcl 1-13 ref 1405 1445 1456 arg_list_n 21 based fixed bin(17,0) level 2 dcl 1-13 ref 1405 1445 1456 arg_list_p 16 based pointer level 2 dcl 1-13 set ref 1446* 1457* arg_no 000736 automatic fixed bin(17,0) dcl 1442 set ref 1445* 1446* 1456* 1457* arg_p 000104 automatic pointer dcl 84 set ref 647* 657 711 730* 733 735 738 1446* 1457* 1459 argct 265 based fixed bin(17,0) level 2 dcl 2-31 set ref 1106 1405* 1438 1452 asn parameter fixed bin(17,0) dcl 1032 set ref 1030 1042 1042* 1044 1044* 1046 1046* 1048* 1052 1060 1061 asp parameter pointer dcl 1032 set ref 1030 1042* 1044* 1046* 1048* ast 130 based fixed bin(17,0) level 3 dcl 3-67 set ref 1454* at_break 270 based fixed bin(17,0) level 2 dcl 2-31 set ref 771* atest parameter bit(1) packed unaligned dcl 1092 set ref 1090 1115 1120* 1162 1193 b based structure level 1 unaligned dcl 3-67 set ref 1258* b1 000104 automatic bit(1) packed unaligned dcl 294 set ref 327* 328 331* b_ based structure level 2 unaligned dcl 3-67 set ref 1422 b_c based char(1) array packed unaligned dcl 3-58 set ref 1463 1463 1469* b_s based char packed unaligned dcl 3-59 set ref 564* 575* 1459* base_ne_envir 000242 stack reference condition dcl 548 ref 547 bp 000426 automatic pointer dcl 3-66 set ref 561* 562 562 563 563 564 564 564* 570* 571 571 575 575 575 575 575 575 575 656* 657 659* 661 663 667* 671* 672* 674 674 675 675 675 679 689 698 704 842* 843* 846* 850* 875* 876 900 903 920* 921 946* 959 959 959 959 962 962 962 968 969 969 970 970 971 971 972 972 973 973 974 974 987* 992 998 998 998* 1000 1002 1003 1006 1011 1013 1014 1014 1015 1015 1016 1016 1016 1025* 1112* 1113 1113 1117 1121 1121 1121 1121 1121 1121 1121 1121 1121 1121 1121 1121 1150 1150 1150 1150 1150 1153 1153 1154 1156 1156 1156 1158 1158 1160 1161 1162 1164 1164 1164 1172 1175 1177 1178 1180* 1180 1180 1180 1181 1181 1183 1190 1212* 1213 1213 1213* 1216 1216 1216 1222 1222 1222 1222 1222 1222 1222 1222 1234* 1235 1235 1235 1418* 1419* 1420* 1421 1422 1425* 1426* 1427 1428 1432* 1433 1440* 1441 1450* 1451 1451 1452 1453 1454 1459 1459 1459 1463 1463 1463 1463 1463 1468 1468 1469 1469 1475* 1476 1506* 1507 1515 1515 1515 1518 1518 1518 buf_ct 000403 automatic fixed bin(21,0) dcl 1100 set ref 1105* 1119* 1119 1132 buf_des based structure array level 1 unaligned dcl 3-11 set ref 1260* bufnum 271 based fixed bin(17,0) level 2 dcl 2-31 set ref 569 655 914 1109 1211 1233 1249* 1249 1250 1271* 1275 1275 1505 bwd 2 based pointer level 2 in structure "dbase" dcl 2-31 in procedure "tedmgr_" set ref 61* 64 517* 549 550* 755 bwd 2 000022 internal static pointer initial level 2 in structure "envir" dcl 158 in procedure "tedmgr_" set ref 47 59 517 518* 521* 547 549* 591* 654 748 771 807 cb 762 based structure array level 2 unaligned dcl 68 set ref 561 561 570 656 842 920 1112 1212 1234 1250 1399 1413 1418 1503 1504 1506 1512 1512 1525 cb_c_r 273 based bit(18) level 2 dcl 2-31 set ref 875 1121 1222 1476* cb_name parameter char(32) packed unaligned dcl 1242 set ref 1240 1255 1265 1271* cb_ptr parameter pointer dcl 1242 set ref 1240 1250* 1255 1258 1260 1262 1263 1264 1264 1265 1266 1267 1268 1269 1270 1275* cba_p 4 based pointer level 2 dcl 2-31 set ref 1399* 1504* char builtin function dcl 1533 ref 903 1275 1275 1460 check_code parameter fixed bin(17,0) dcl 1204 set ref 1202 1210* 1219 1221* ck_ptr_sw 234(18) based bit(1) level 4 packed packed unaligned dcl 3-67 set ref 663 998 1213 1235* cleaning 000240 automatic bit(1) packed unaligned dcl 535 set ref 532* 543* 559 602* 613 cleanup 000106 stack reference condition dcl 85 ref 223 clock builtin function dcl 161 ref 218 cname 224 based char(32) level 3 packed packed unaligned dcl 3-67 set ref 1121* 1222* 1268* code 000114 automatic fixed bin(35,0) dcl 86 set ref 261 502* 609* 613* 622* 624* 629 633 633* 647* 648 650* 674* 675* 694* 695 705* 730* 731 946* 950 1003* 1004 1007* 1042* 1044* 1046* 1048* 1446* 1457* 1498* 1499 com_err_ 000050 constant entry external dcl 121 ref 205 266 272 633 650 711 1341 1373 1487 comment 307 based varying char(256) level 2 dcl 2-31 set ref 338 338* convert builtin function dcl 161 ref 205 205 619 689 1331 convert_status_code_ 000154 constant entry external dcl 1073 ref 1075 create 000347 automatic bit(1) packed unaligned dcl 802 set ref 787* 804* 927 cu_$af_arg_count 000144 constant entry external dcl 716 ref 694 cu_$af_return_arg 000146 constant entry external dcl 717 ref 705 cu_$arg_ptr 000052 constant entry external dcl 122 ref 647 730 cu_$arg_ptr_rel 000054 constant entry external dcl 123 ref 1446 1457 cur 1106 based structure array level 3 in structure "DATABASE" unaligned dcl 68 in procedure "tedmgr_" set ref 1522 cur 124 based structure level 2 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" set ref 1262* 1421 curp 754 based pointer level 3 dcl 2-31 set ref 1413* 1525* cv_dec_check_ 000056 constant entry external dcl 124 ref 417 d_name 000261 automatic char(168) packed unaligned dcl 713 set ref 679* 680 date_time_$format 000142 constant entry external dcl 637 ref 331 495 db_dir 000115 automatic varying char(168) dcl 87 set ref 179* 181* 183* 198* 231 248 261 266* 272* 500 502 1319 1364 1397 db_output 36 000166 external static pointer level 2 dcl 6-11 set ref 48* 61* 66* 304* 315* 521* 540* 591* 602* 665* 691* 758* 1271* 1320* 1382* 1394* 1478* db_select 000004 constant char(26) initial packed unaligned dcl 525 set ref 231* 502* db_util 16 000166 external static bit(1) level 3 dcl 6-11 ref 304 315 521 539 591 602 659 665 672 691 750 753 758 1271 1275 1320 1382 1394 1478 1491 1528 dbase based structure level 1 unaligned dcl 2-31 dbase_lock 000250 automatic bit(36) packed unaligned dcl 556 set ref 554* 602 622 dbase_p 000424 automatic pointer dcl 2-29 set ref 47* 48* 48 51 53* 221* 224 224* 303* 304 304 308 308 310 310 313 315 315 321 322 327 331 331 331 331 331 336 336 338 338 451* 453* 468* 469 495 509* 511* 515 516 517 518 520 531* 538* 540* 541* 544 547 549 550 553 554 555 561 561 566 566 569 570 580 583 584 585 601 609 624 654* 655 656 669 669 677 685 687 748* 753* 755* 755 758* 761 761 763 805* 807 807* 809 842 875 875 914 915 918 920 946* 1007* 1024* 1041* 1059* 1060 1061 1104* 1106 1109 1112 1121 1209* 1211 1212 1222 1232* 1233 1234 1249 1249 1250 1250 1271 1275 1275 1292 1295 1295 1299 1302 1315 1329 1330 1332 1333 1355 1355 1396 1397 1398 1399 1399 1400 1401 1404 1405 1406 1406 1407 1408 1409 1412 1413 1413 1414 1415 1418 1421 1422 1433 1438 1452 1476 1485 1487 1491* 1493 1493 1494 1495 1497 1498 1503 1503 1504 1504 1505 1506 1509 1509 1511 1512 1512 1515 1518 1522 1522 1523 1524 1525 1525 1526 1528* dbase_vers_3 constant fixed bin(17,0) initial dcl 2-30 ref 270 1401 1485 delete_$path 000062 constant entry external dcl 126 ref 261 580 624 629 delete_$ptr 000060 constant entry external dcl 125 ref 622 dir_db 660 based char(168) level 2 packed packed unaligned dcl 2-31 set ref 48* 336* 609 624* 677 685 1332 1397* dirname 000634 automatic char(168) packed unaligned dcl 1306 set ref 1319* 1320 1320* 1332* 1336 1338* 1341* 1367 1373 1373 divide builtin function dcl 1533 ref 675 675 1010 dl 000343 automatic fixed bin(21,0) dcl 715 set ref 679* 680 dname 142 based char(168) level 3 packed packed unaligned dcl 3-67 set ref 1121* 1222* 1266* e_c 000170 automatic fixed bin(17,0) dcl 100 set ref 222* 231* 233 245 246 247 277 300 418 422* 484 487 502* 504 504* 504 e_ca 000171 automatic fixed bin(17,0) dcl 101 set ref 246* 252* 252 282 284 287 300 374 447* 447 448 458* 458 e_name 000333 automatic char(32) packed unaligned dcl 714 set ref 679* 682 e_p 000172 automatic pointer dcl 102 set ref 221* 231* 248 261 266 272 484 502* ename 000717 automatic char(32) packed unaligned dcl 1308 in procedure "get_seg" set ref 1314* 1317* 1318* 1320* 1330* 1331* 1338* 1341* 1367* 1367 1373* ename 214 based char(32) level 3 in structure "b" packed packed unaligned dcl 3-67 in procedure "tedmgr_" set ref 1121* 1222* 1267* entries based structure array level 1 dcl 72 ref 484 env_ct 000021 internal static fixed bin(17,0) initial dcl 157 set ref 48* 205 205 213 514* 514 515 521* 551* 551 591* 641 725 736 747 749 766 1271* 1409 1523 envir 000022 internal static structure level 1 unaligned dcl 158 err_go 742(09) based char(16) level 2 packed packed unaligned dcl 2-31 set ref 1408* error_table_$action_not_performed 000026 external static fixed bin(35,0) dcl 89 ref 203 480 error_table_$dirseg 000030 external static fixed bin(35,0) dcl 89 ref 253 error_table_$invalid_lock_reset 000032 external static fixed bin(35,0) dcl 89 ref 319 470 error_table_$locked_by_this_process 000034 external static fixed bin(35,0) dcl 89 ref 324 error_table_$namedup 000036 external static fixed bin(35,0) dcl 89 ref 1373 error_table_$no_component 000042 external static fixed bin(35,0) dcl 89 ref 1079 error_table_$noentry 000040 external static fixed bin(35,0) dcl 89 ref 256 1077 error_table_$unimplemented_version 000044 external static fixed bin(35,0) dcl 89 set ref 272* error_table_$zero_length_seg 000046 external static fixed bin(35,0) dcl 89 ref 1081 eval_p 6 based pointer level 2 dcl 2-31 set ref 1400* 1433* 1503* ex 14 based structure level 2 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" set ref 1263* ex 776 based structure array level 3 in structure "DATABASE" unaligned dcl 68 in procedure "tedmgr_" file_d 140 based structure level 2 in structure "b" packed packed unaligned dcl 3-67 in procedure "tedmgr_" file_d 1122 based structure array level 3 in structure "DATABASE" packed packed unaligned dcl 68 in procedure "tedmgr_" file_sw 234(09) based bit(1) level 4 packed packed unaligned dcl 3-67 set ref 1121* 1156 1158 1222* fixed builtin function dcl 1533 ref 735 1466 flag parameter bit(1) packed unaligned dcl 1143 ref 1141 1178 force 000103 automatic bit(1) packed unaligned dcl 293 set ref 286* 287 300 347 349* func 000174 automatic fixed bin(17,0) dcl 103 set ref 401* 406* 411* 415* 433 get_bit_count 234(13) based bit(1) level 4 packed packed unaligned dcl 3-67 set ref 698* 1000 1002* get_default_wdir_ 000064 constant entry external dcl 128 ref 179 629 629 1367 1367 get_lock_id_ 000066 constant entry external dcl 129 ref 219 get_pdir_ 000114 constant entry external dcl 144 ref 175 get_system_free_area_ 000070 constant entry external dcl 130 ref 229 get_temp_segment_ 000072 constant entry external dcl 131 ref 1348 hcs_$append_link 000074 constant entry external dcl 132 ref 1367 hcs_$fs_get_path_name 000076 constant entry external dcl 133 ref 679 hcs_$initiate 000100 constant entry external dcl 135 ref 248 hcs_$make_seg 000102 constant entry external dcl 137 ref 1338 hcs_$set_bc_seg 000104 constant entry external dcl 139 ref 674 hcs_$star_ 000106 constant entry external dcl 140 ref 231 502 hcs_$status_mins 000152 constant entry external dcl 816 ref 1003 hcs_$terminate_noname 000110 constant entry external dcl 142 ref 456 613 hcs_$truncate_seg 000112 constant entry external dcl 143 ref 566 675 1060 hold_maxln 000612 automatic fixed bin(21,0) dcl 1148 set ref 1161* 1195 i 000727 automatic fixed bin(17,0) dcl 1309 in procedure "get_seg" set ref 1358* 1359* i 000175 automatic fixed bin(21,0) dcl 104 in procedure "tedmgr_" set ref 247* 248 248 250 261 266 270 272* 300* 301 303 304 315 331* 374* 377* 380 417* 418 418 424* 427 429* 430* 434 437 440* 445 446 451 456 457 460 463* 468 477 487* 488* 569* 570 571* 584* 585 587* 601 619 735* 736 747* 752 1211* 1212* 1444* 1448* 1448 1450* 1455* 1460 1461* 1461 1494* 1495 1497 1498 1498* 1505* 1506 1509 1509 1511 1512 1512* i 000545 automatic fixed bin(21,0) dcl 828 in begin block on line 818 set ref 889* 890 907 908 914* 915 915 918 920* i21 000237 automatic fixed bin(21,0) dcl 196 set ref 381* 417 417 ii 000176 automatic fixed bin(21,0) dcl 105 in procedure "tedmgr_" set ref 400* 405* 410* 414* 417 417 417 417 1109* 1112* 1233* 1234* ii 000622 automatic fixed bin(17,0) dcl 1246 in procedure "allocate_cb" set ref 1259* 1260* in_c based char(1) array packed unaligned dcl 826 set ref 855 874 910 933 946 946 958 in_l 000544 automatic fixed bin(21,0) dcl 824 set ref 852* 853 871 879 886 890 908 945 954 in_p 000542 automatic pointer dcl 823 set ref 851* 853 855 871 874 879 890 908 910 933 946 946 954 958 in_s based char packed unaligned dcl 825 ref 853 871 879 890 908 954 in_window 000422 automatic bit(1) packed unaligned dcl 1140 set ref 1166* 1170* 1181 1185 index builtin function dcl 1533 ref 859 1292 inext_in 000563 automatic fixed bin(21,0) dcl 835 set ref 854* 954 954 initiate 1216(17) based bit(1) array level 5 packed packed unaligned dcl 68 set ref 1509 inuse_seg 250 based bit(72) level 2 dcl 2-31 set ref 1061* 1292 1302* 1329* ioa_ 000116 constant entry external dcl 145 ref 239 284 287 331 336 338 343 357 359 362 368 378 388 392 393 394 395 422 429 440 463 474 495 504 644 695 727 738 743 768 1121 1219 1222 ioa_$ioa_switch 000122 constant entry external dcl 147 ref 48 61 66 304 315 521 540 591 602 665 691 758 761 1271 1320 1382 1394 1478 ioa_$nnl 000120 constant entry external dcl 146 ref 753 iox_$error_output 000124 external static pointer dcl 148 set ref 761* iox_$get_line 000126 constant entry external dcl 149 ref 381 iox_$user_input 000130 external static pointer dcl 151 set ref 381* its based structure level 1 dcl 7-5 j 000546 automatic fixed bin(21,0) dcl 829 in begin block on line 818 set ref 890* 891 893 899 907 j 000177 automatic fixed bin(21,0) dcl 106 in procedure "tedmgr_" set ref 655* 656 694* 705* 749* 752 753* 756* 756 758* kind 234 based char(1) level 3 packed packed unaligned dcl 3-67 set ref 1121 1121* 1222 1222* 1269* l 52 based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" l 1026 based structure array level 4 in structure "DATABASE" unaligned dcl 68 in procedure "tedmgr_" l 000162 external static structure level 2 in structure "tedcommon_$no_data" unaligned dcl 6-8 in procedure "tedmgr_" l 1056 based structure array level 4 in structure "DATABASE" unaligned dcl 68 in procedure "tedmgr_" l 60 based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" l based structure array level 2 in structure "buf_des" unaligned dcl 3-11 in procedure "tedmgr_" l 000547 automatic fixed bin(21,0) dcl 830 in begin block on line 818 set ref 886* 887 890 l 776 based structure array level 4 in structure "DATABASE" unaligned dcl 68 in procedure "tedmgr_" l based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" set ref 970 l 6 based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" l 1004 based structure array level 4 in structure "DATABASE" unaligned dcl 68 in procedure "tedmgr_" l 1050 based structure array level 4 in structure "DATABASE" unaligned dcl 68 in procedure "tedmgr_" l 12 based structure level 3 in structure "sv" unaligned dcl 4-4 in procedure "tedmgr_" l 14 based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" l 762 based structure array level 4 in structure "DATABASE" unaligned dcl 68 in procedure "tedmgr_" l 16 based structure level 5 in structure "DATABASE" unaligned dcl 68 in procedure "tedmgr_" l 22 based structure array level 3 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" set ref 970* l 66 based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" l 16 based structure level 4 in structure "dbase" unaligned dcl 2-31 in procedure "tedmgr_" l 1042 based structure array level 4 in structure "DATABASE" unaligned dcl 68 in procedure "tedmgr_" l 74 based structure array level 3 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" l 770 based structure array level 4 in structure "DATABASE" unaligned dcl 68 in procedure "tedmgr_" l 44 based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" l 1034 based structure array level 4 in structure "DATABASE" unaligned dcl 68 in procedure "tedmgr_" l 4 based structure level 3 in structure "sv" unaligned dcl 4-4 in procedure "tedmgr_" le 26 based fixed bin(21,0) array level 4 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 973* 1014* 1451* 1465* le 4 based fixed bin(21,0) level 4 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 563* 575 575 1150 le 1 based fixed bin(21,0) level 4 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 562 1150 1164 1180* le 23 based fixed bin(21,0) array level 4 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 971 1014* le 15 based fixed bin(21,0) level 4 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 1264* length builtin function dcl 1533 ref 338 381 381 691 691 900 903 level 760 based fixed bin(21,0) level 3 dcl 2-31 set ref 1414* 1526* line_counts 000404 automatic varying char(24) dcl 1101 set ref 1121* 1187* 1192* 1196* 1196 1197* 1197 ln 22 based fixed bin(21,0) array level 4 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 968* 1016* ln 25 based fixed bin(21,0) array level 4 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 969* 1016* ln 3 based fixed bin(21,0) level 4 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 969 1181* ln_sw parameter bit(1) packed unaligned dcl 1092 in procedure "tedmgr_" set ref 1090 1120* ln_sw parameter bit(1) packed unaligned dcl 1143 in procedure "fix_buffer_data" ref 1141 1162 1193 lock 272 based bit(36) level 2 packed packed unaligned dcl 2-31 set ref 304* 308* 310 313* 315* 321* 437 460 469* 516* 554 555* lockid 000010 internal static bit(36) initial packed unaligned dcl 107 set ref 219 219* 516 longinfo 000352 automatic char(100) packed unaligned dcl 1072 set ref 1075* 1084 low builtin function dcl 161 ref 564 575 ltrim builtin function dcl 161 ref 903 1275 1275 1460 max builtin function dcl 161 ref 669 1405 maxl 253 based fixed bin(21,0) level 2 dcl 3-67 set ref 564 564 575 1164 1459 maxln 254 based fixed bin(21,0) level 2 dcl 3-67 set ref 1016* 1154* 1161 1162* 1172* 1175 1177 1178 1180* 1181 1183 1190* 1452* 1466* mod_sw 234(11) based bit(1) level 4 packed packed unaligned dcl 3-67 set ref 704* 1121* 1153* 1156* 1216 msg 000430 automatic varying char(168) dcl 5-6 set ref 205* 214* 235* 239* 680* 681* 681 682* 682 685* 686* 686 687* 687 688* 688 689* 689 691 691 691* 695* 706 861* 895* 902* 903* 903 904* 904 935* 946* 952* 952 954* 954 955* 955 978* 984* 985* 985 986* 986 989 1006* 1007* 1077* 1079* 1081* 1083* 1084* 1084 1085* 1085 1086* 1086 1087* 1134* 1135* 1135 1136* 1136 1137* 1351* mylock 000102 automatic fixed bin(17,0) dcl 292 set ref 299* 324* 324 359 362 362 362* 368 myname 000706 automatic varying char(32) dcl 1307 set ref 1323* 1333* 1341* 1348 n_p 000200 automatic pointer dcl 108 set ref 221* 231* 248 261 266 272 486 502* name 235 based char(16) level 2 in structure "b" packed packed unaligned dcl 3-67 in procedure "tedmgr_" set ref 657 876 900 903 1006 1113 1117 1121* 1156 1216 1222* 1265* name 1217 based char(16) array level 3 in structure "DATABASE" packed packed unaligned dcl 68 in procedure "tedmgr_" set ref 915 918 names based char(32) array packed unaligned dcl 76 set ref 248* 261* 266* 272* 486 ndx parameter fixed bin(21,0) dcl 597 ref 595 602 617 629 new 000623 automatic bit(1) packed unaligned dcl 1247 set ref 1251* 1256* 1271* next 761 based fixed bin(21,0) level 3 dcl 2-31 set ref 1415* next_in 000540 automatic fixed bin(17,0) dcl 822 set ref 853* 854 855 867* 867 871 873* 873 874 879 883* 883 886 889 907* 910 912 933 945 946 946 948* 948 949 954 958 nindex 0(18) based fixed bin(17,0) array level 2 packed packed unaligned dcl 72 ref 248 261 266 272 noref 252(08) based bit(1) level 2 packed packed unaligned dcl 3-67 set ref 921* 1113 1441* 1467* not_pasted 234(16) based bit(1) level 4 packed packed unaligned dcl 3-67 set ref 1121* 1153* 1160* 1216 not_read_ct 267 based fixed bin(17,0) level 2 dcl 2-31 set ref 669* 669 null builtin function dcl 1533 ref 51 60 221 224 250 301 427 446 457 477 488 502 502 509 550 566 585 807 809 811 850 987 1300 1315 1335 1339 1355 1359 1400 1412 1495 1497 1524 nulreq 741(27) based char(2) level 2 packed packed unaligned dcl 2-31 set ref 1407* old 116 based structure level 2 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" old 1100 based structure array level 3 in structure "DATABASE" unaligned dcl 68 in procedure "tedmgr_" part1 10 based structure level 3 unaligned dcl 2-31 set ref 1421* 1522* part2 16 based structure level 3 unaligned dcl 2-31 set ref 1422* pdir 000011 internal static char(32) initial packed unaligned dcl 109 set ref 175 175* 580* pend 132 based structure level 2 unaligned dcl 3-67 person 732 based char(22) level 2 packed packed unaligned dcl 2-31 set ref 331* 1406* pic3 automatic picture(3) packed unaligned dcl 110 ref 619 689 1331 pic7 000610 automatic picture(7) packed unaligned dcl 1147 set ref 1175* 1177* 1183* 1188 1192 1195* 1197 present 252 based bit(1) array level 2 packed packed unaligned dcl 3-67 set ref 959 962 974* 974* project 737(18) based char(9) level 2 packed packed unaligned dcl 2-31 set ref 331* 1406* ps 000100 automatic pointer array dcl 245 set ref 248* 250 270 301 303 304* 315* 427 434* 437 445* 446* 451 456* 457* 460 468 477* 488 pseudo 234(19) based bit(1) level 4 packed packed unaligned dcl 3-67 set ref 571 1453* ptr builtin function dcl 161 ref 875 ptr_2 based pointer array dcl 58 set ref 61* r 3 based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" set ref 972 r 25 based structure array level 3 in structure "b" unaligned dcl 3-67 in procedure "tedmgr_" set ref 972* rc parameter fixed bin(35,0) dcl 1065 set ref 1063 1075* 1077 1079 1081 re 2 based fixed bin(21,0) level 4 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 562* 575 575 575 674 675 675 1011 1013* 1150 1459 1463 1463 1468* 1468 1469 re 27 based fixed bin(21,0) array level 4 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 973 1015* 1451* 1465* re 24 based fixed bin(21,0) array level 4 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 971* 1015* re 5 based fixed bin(21,0) level 4 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 563 1150 1164 1180* re 16 based fixed bin(21,0) level 4 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 1264 recurs 1 based fixed bin(17,0) level 2 dcl 2-31 set ref 61* 304* 308 310* 315* 322* 327 331* 515* 544 761* 1409* 1523* rel builtin function dcl 161 ref 1121 1222 1476 release_temp_segment_ 000132 constant entry external dcl 152 ref 609 remote_sw 275(05) based bit(1) level 3 packed packed unaligned dcl 2-31 set ref 336 1378* reply 000202 automatic char(32) packed unaligned dcl 111 set ref 381 381 381 381 384 386 388 390 398 403 408 417 417 request_id_ 000136 constant entry external dcl 154 ref 508 reset 256 based label variable level 2 dcl 2-31 set ref 61 763 rl 10 based structure level 2 unaligned dcl 2-31 rq_id 746(09) based char(19) level 2 packed packed unaligned dcl 2-31 set ref 580 583 687 1330 1398* rqid 000212 automatic char(19) packed unaligned dcl 112 set ref 508* 1317 1398 rtrim builtin function dcl 161 ref 179 183 682 685 1084 1367 1373 1373 search builtin function dcl 1533 ref 890 seg_ct 264 based fixed bin(17,0) level 2 dcl 2-31 set ref 584 1295 1295* 1362* 1494 seg_des based structure level 1 unaligned dcl 2-20 seg_dp parameter pointer dcl 1285 set ref 1279 1283 1299* 1300 1311 1335* 1338* 1339 1348* 1355 1359 1361 1361 1362 1363 1378 1382* seg_id_no parameter fixed bin(17,0) dcl 1285 set ref 1279 1281* 1283 1292 1292* 1295 1295 1299 1302 1311 1329 1331 1355 1382* seg_p 24 based pointer array level 2 dcl 2-31 set ref 566 566* 585 601 1060* 1299 1355* 1359* 1361* 1493* 1495 1497* 1498* 1515 1518 seg_use parameter char(8) packed unaligned dcl 1285 set ref 1279 1283 1311 1382* segid 000251 automatic char(32) packed unaligned dcl 557 set ref 582* 583* 617* 619* 624* 629* segno 0(03) based bit(15) level 2 packed packed unaligned dcl 7-5 set ref 1511* 1515* 1515 1518* 1518 select parameter char(16) packed unaligned dcl 1092 ref 1090 1117 1117 1135 set_lock_$lock 000134 constant entry external dcl 153 ref 313 469 shortinfo 000350 automatic char(8) packed unaligned dcl 1071 set ref 1075* shown 000100 automatic fixed bin(17,0) dcl 291 set ref 296* 330* 330 347 350* 353 355 374 sn 134 based fixed bin(17,0) level 3 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 1518 1518 sn 126 based fixed bin(17,0) level 3 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 571 661 689 1121 1150 1235 1463* 1507 1515 1515 sp 132 based pointer level 3 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 1518 sp 124 based pointer level 3 in structure "b" dcl 3-67 in procedure "tedmgr_" set ref 564 575 674* 675* 679* 1003* 1459 1463 1463 1469 1515 sp 1106 based pointer array level 4 in structure "DATABASE" dcl 68 in procedure "tedmgr_" set ref 1511 start$start 000150 constant entry external dcl 773 ref 772 startup 000220 automatic fixed bin(71,0) dcl 113 set ref 218* 508* 1404 status_only 000222 automatic bit(1) packed unaligned dcl 114 set ref 184* 199* 237 277 284 287 300 345 482* 493 stk_info 754 based structure level 2 unaligned dcl 2-31 string builtin function dcl 161 set ref 1175* 1363* substr builtin function dcl 1533 set ref 384 386 388 390 398 403 408 417 417 575* 583* 617* 619* 680 871 879 890 908 954 985 1061* 1292 1302* 1317* 1318* 1329* 1330* 1331* 1459* sws 275 based structure level 2 in structure "dbase" packed packed unaligned dcl 2-31 in procedure "tedmgr_" set ref 1363* sws 234(09) based structure level 3 in structure "b" packed packed unaligned dcl 3-67 in procedure "tedmgr_" sws 4 000166 external static structure level 2 in structure "tedcommon_$etc" unaligned dcl 6-11 in procedure "tedmgr_" sws 1216(09) based structure array level 4 in structure "DATABASE" packed packed unaligned dcl 68 in procedure "tedmgr_" tbp 000740 automatic pointer dcl 1443 set ref 1460* 1463* 1465 1465 1466 1467 tch 000550 automatic char(1) packed unaligned dcl 831 set ref 855* 856 858 859 865 868* 874* 910* 930 958* 976 ted_data based structure level 1 unaligned dcl 1-13 ted_data_p parameter pointer dcl 169 ref 167 177 179 179 183 185 227 1323 1373 1396 1405 1405 1445 1445 1446 1456 1456 1457 ted_mode 15 based fixed bin(17,0) level 2 dcl 1-13 ref 179 179 227 tedaddr_ 000172 constant entry external dcl 1543 ref 946 tedck_ptr_ 000174 constant entry external dcl 1558 ref 667 998 1213 1512 tedcloseup_ 000200 constant entry external dcl 1567 ref 671 tedcommon_$etc 000166 external static structure level 1 unaligned dcl 6-11 tedcommon_$no_data 000162 external static structure level 1 unaligned dcl 6-8 ref 1260 1263 tedcommon_$no_seg 000164 external static structure level 1 unaligned dcl 6-9 ref 1262 tedcount_lines_ 000176 constant entry external dcl 1559 ref 1180 tederror_ 000156 constant entry external dcl 5-3 ref 1087 1137 tederror_rc_ 000160 constant entry external dcl 5-4 ref 1007 tedmgr_$list 000170 constant entry external dcl 1542 ref 750 tedname 276 based varying char(32) level 2 in structure "dbase" dcl 2-31 in procedure "tedmgr_" set ref 331* 553 761* 1333 1396* 1487* tedname based varying char(32) level 2 in structure "ted_data" dcl 1-13 in procedure "tedmgr_" set ref 185 1323 1373* 1396 tedpromote_ 000202 constant entry external dcl 1572 ref 1420 1426 1450 tedpseudo_ 000204 constant entry external dcl 1578 ref 1463 tedshow_ 000206 constant entry external dcl 1586 ref 53 453 541 659 672 1275 1491 1528 temp_dir 35 based char(168) level 2 packed packed unaligned dcl 1-13 ref 183 tempdir parameter char packed unaligned dcl 191 ref 189 198 terminate 1216(12) based bit(1) array level 5 in structure "DATABASE" packed packed unaligned dcl 68 in procedure "tedmgr_" set ref 1509 terminate 234(12) based bit(1) level 4 in structure "b" packed packed unaligned dcl 3-67 in procedure "tedmgr_" set ref 998 1213 1235 1428* the_name 000223 automatic char(32) packed unaligned dcl 115 set ref 185* 200* 205* 261* 266* 272* 504* 553* 580* 609* 622* 624* 629* 633* time 262 based fixed bin(71,0) level 2 dcl 2-31 set ref 331* 495* 1404* tname 000552 automatic char(32) packed unaligned dcl 833 set ref 843* 846* 858* 876* 882* 908* 918 985 tnl 000551 automatic fixed bin(21,0) dcl 832 set ref 864* 881* 899* 900 908 985 top 756 based pointer level 3 dcl 2-31 set ref 1412* 1524* tp 000234 automatic pointer dcl 116 in procedure "tedmgr_" set ref 59* 60 61* 61 61 61 64* 64 tp 000536 automatic pointer dcl 599 in procedure "wipeout" set ref 601* 602* 609* 613* 622* trust_sw 234(10) based bit(1) level 4 packed packed unaligned dcl 3-67 set ref 1121 1158* 1270* tw_sw 252(03) based bit(1) level 2 packed packed unaligned dcl 3-67 set ref 1427* unspec builtin function dcl 161 set ref 1258* used 000236 automatic fixed bin(21,0) dcl 117 set ref 945* 946* 948 user_info_ 000140 constant entry external dcl 155 ref 1406 verify builtin function dcl 1533 ref 733 853 version based fixed bin(17,0) level 2 in structure "dbase" dcl 2-31 in procedure "tedmgr_" set ref 270 1401* 1485 version 11 based fixed bin(35,0) level 2 in structure "ted_data" dcl 1-13 in procedure "tedmgr_" ref 177 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. COM internal static fixed bin(24,0) initial dcl 2-3 ITP_MODIFIER internal static bit(6) initial packed unaligned dcl 7-56 ITS_MODIFIER internal static bit(6) initial packed unaligned dcl 7-55 NORMAL internal static fixed bin(24,0) initial dcl 2-3 call_stk based structure level 1 unaligned dcl 4-21 itp based structure level 1 dcl 7-18 itp_unsigned based structure level 1 dcl 7-43 its_unsigned based structure level 1 dcl 7-30 live_des internal static fixed bin(17,0) initial dcl 3-61 msg_ptr automatic pointer dcl 5-7 pstr based char(256) packed unaligned dcl 4-19 rc_close internal static fixed bin(24,0) initial dcl 2-8 rc_fail internal static fixed bin(24,0) initial dcl 2-9 rc_keyerr internal static fixed bin(24,0) initial dcl 2-11 rc_nop internal static fixed bin(24,0) initial dcl 2-10 reloc_first internal static fixed bin(17,0) initial dcl 3-61 reloc_last internal static fixed bin(17,0) initial dcl 3-61 rl_b automatic fixed bin(21,0) dcl 2-14 rl_c based char(1) array packed unaligned dcl 2-17 rl_i defined fixed bin(21,0) dcl 2-15 rl_l defined fixed bin(21,0) dcl 2-16 rl_s based char packed unaligned dcl 2-18 sv based structure level 1 unaligned dcl 4-4 sv_p automatic pointer dcl 4-3 ted_ 000000 constant entry external dcl 1-8 ted_data_version_1 internal static fixed bin(17,0) initial dcl 1-11 tedcommon_$id external static structure level 1 unaligned dcl 6-5 tederror_table_$ted_com_abort external static fixed bin(35,0) dcl 1-48 NAMES DECLARED BY EXPLICIT CONTEXT. Bmd 007145 constant label dcl 978 ref 887 893 Bnn 006554 constant label dcl 895 ref 865 abort_no_print 001623 constant label dcl 208 ref 1343 1489 abort_print 001554 constant label dcl 205 ref 1352 1499 add_str 007012 constant label dcl 952 set ref 862 897 905 936 980 addr_check 006730 constant label dcl 930 ref 877 923 allocate_cb 011351 constant entry internal dcl 1240 ref 846 1425 1432 1440 1460 1475 buf_comm 005033 constant label dcl 641 buffer 005026 constant entry external dcl 639 check_bc 010747 constant entry internal dcl 996 ref 922 1026 1115 common_get 006360 constant label dcl 805 ref 788 displ 002441 constant label dcl 297 ref 386 displ_1 002414 constant label dcl 287 ref 351 err_out 007205 constant label dcl 987 ref 956 exit 012435 constant label dcl 1382 ref 1303 find_buffer 006401 constant label dcl 818 fix_buffer_data 011055 constant entry internal dcl 1141 ref 1120 1215 freum 004017 constant label dcl 480 ref 372 384 freum2 004025 constant label dcl 484 ref 345 get_base 011670 constant entry internal dcl 1311 ref 510 get_out 004366 constant label dcl 521 ref 208 get_seg 011621 constant entry internal dcl 1279 ref 1042 get_seg_n 011625 constant entry internal dcl 1283 ref 1044 1046 1048 1498 getline 003251 constant label dcl 381 set ref 396 425 431 436 442 450 454 465 475 hold_clean 004532 constant label dcl 544 ref 533 list 001254 constant entry external dcl 56 make_buf 007216 constant entry internal dcl 838 ref 929 nil_action 001551 constant label dcl 203 ref 215 242 no_envir 002005 constant label dcl 235 ref 282 448 out 007233 constant label dcl 992 out_only 007235 constant label dcl 994 ref 1008 re_alloc 011366 constant entry internal dcl 1255 ref 843 1419 restart 013253 constant entry internal dcl 1482 ref 497 rsfunc 000000 constant label array(4) dcl 434 ref 433 somehow 001624 constant label dcl 210 ref 186 start 012475 constant entry internal dcl 1389 ref 512 status_1 001716 constant label dcl 229 ref 201 tedbreak_ 006260 constant entry external dcl 764 tedcheck_buffer_state_ 007242 constant entry external dcl 1022 tedcheck_buffers_ 010163 constant entry external dcl 1202 tedcleanup_ 004446 constant entry external dcl 536 ref 224 445 tederror_rc_ 007467 constant entry external dcl 1063 tedfree_segment_ 007421 constant entry external dcl 1052 tedget_buffer_ 006342 constant entry external dcl 791 tedget_existing_buffer_ 006322 constant entry external dcl 776 tedget_segment_ 007272 constant entry external dcl 1030 tedhold_ 004427 constant entry external dcl 529 tedinit_ 001361 constant entry external dcl 167 tedlist_buffers_ 007641 constant entry external dcl 1090 ref 434 tedmgr_ 001161 constant entry external dcl 44 tedreset_ 005737 constant entry external dcl 722 tedset_ck_ptr_ 010364 constant entry external dcl 1229 tedstatus_ 001513 constant entry external dcl 189 term 004060 constant entry internal dcl 455 ref 275 488 wipeout 010426 constant entry internal dcl 595 ref 587 590 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 15276 15506 14271 15306 Length 16266 14271 210 543 1004 16 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME tedmgr_ 1146 external procedure is an external procedure. on unit on line 223 68 on unit begin block on line 244 256 begin block uses auto adjustable storage. term internal procedure shares stack frame of begin block on line 244. wipeout internal procedure shares stack frame of external procedure tedmgr_. begin block on line 818 begin block shares stack frame of external procedure tedmgr_. make_buf internal procedure shares stack frame of external procedure tedmgr_. check_bc internal procedure shares stack frame of external procedure tedmgr_. fix_buffer_data internal procedure shares stack frame of external procedure tedmgr_. allocate_cb internal procedure shares stack frame of external procedure tedmgr_. get_seg internal procedure shares stack frame of external procedure tedmgr_. start internal procedure shares stack frame of external procedure tedmgr_. restart internal procedure shares stack frame of external procedure tedmgr_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 lockid tedmgr_ 000011 pdir tedmgr_ 000021 env_ct tedmgr_ 000022 envir tedmgr_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME begin block on line 244 000100 ps begin block on line 244 000100 shown begin block on line 244 000101 activ begin block on line 244 000102 mylock begin block on line 244 000103 force begin block on line 244 000104 b1 begin block on line 244 tedmgr_ 000100 area_p tedmgr_ 000102 arg_bufs tedmgr_ 000103 arg_l tedmgr_ 000104 arg_p tedmgr_ 000114 code tedmgr_ 000115 db_dir tedmgr_ 000170 e_c tedmgr_ 000171 e_ca tedmgr_ 000172 e_p tedmgr_ 000174 func tedmgr_ 000175 i tedmgr_ 000176 ii tedmgr_ 000177 j tedmgr_ 000200 n_p tedmgr_ 000202 reply tedmgr_ 000212 rqid tedmgr_ 000220 startup tedmgr_ 000222 status_only tedmgr_ 000223 the_name tedmgr_ 000234 tp tedmgr_ 000236 used tedmgr_ 000237 i21 tedmgr_ 000240 cleaning tedmgr_ 000250 dbase_lock tedmgr_ 000251 segid tedmgr_ 000261 d_name tedmgr_ 000333 e_name tedmgr_ 000343 dl tedmgr_ 000344 af_ptr tedmgr_ 000346 af_len tedmgr_ 000347 create tedmgr_ 000350 shortinfo tedmgr_ 000352 longinfo tedmgr_ 000403 buf_ct tedmgr_ 000404 line_counts tedmgr_ 000413 Window tedmgr_ 000422 in_window tedmgr_ 000424 dbase_p tedmgr_ 000426 bp tedmgr_ 000430 msg tedmgr_ 000536 tp wipeout 000540 next_in begin block on line 818 000542 in_p begin block on line 818 000544 in_l begin block on line 818 000545 i begin block on line 818 000546 j begin block on line 818 000547 l begin block on line 818 000550 tch begin block on line 818 000551 tnl begin block on line 818 000552 tname begin block on line 818 000562 MTi begin block on line 818 000563 inext_in begin block on line 818 000610 pic7 fix_buffer_data 000612 hold_maxln fix_buffer_data 000622 ii allocate_cb 000623 new allocate_cb 000634 dirname get_seg 000706 myname get_seg 000717 ename get_seg 000727 i get_seg 000736 arg_no start 000740 tbp start THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a r_e_as r_ne_as alloc_char_temp cat_realloc_chars enter_begin_block leave_begin_block call_ext_in call_ext_out_desc call_ext_out return_mac tra_ext_1 tra_ext_2 alloc_auto_adj signal_op enable_op shorten_stack ext_entry ext_entry_desc int_entry index_bs_1_eis any_to_any_truncate_op_freen_ clock_mac THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ convert_status_code_ cu_$af_arg_count cu_$af_return_arg cu_$arg_ptr cu_$arg_ptr_rel cv_dec_check_ date_time_$format delete_$path delete_$ptr get_default_wdir_ get_lock_id_ get_pdir_ get_system_free_area_ get_temp_segment_ hcs_$append_link hcs_$fs_get_path_name hcs_$initiate hcs_$make_seg hcs_$set_bc_seg hcs_$star_ hcs_$status_mins hcs_$terminate_noname hcs_$truncate_seg ioa_ ioa_$ioa_switch ioa_$nnl iox_$get_line release_temp_segment_ request_id_ set_lock_$lock start$start tedaddr_ tedck_ptr_ tedcloseup_ tedcount_lines_ tederror_ tederror_rc_ tedmgr_$list tedpromote_ tedpseudo_ tedshow_ user_info_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$action_not_performed error_table_$dirseg error_table_$invalid_lock_reset error_table_$locked_by_this_process error_table_$namedup error_table_$no_component error_table_$noentry error_table_$unimplemented_version error_table_$zero_length_seg iox_$error_output iox_$user_input tedcommon_$etc tedcommon_$no_data tedcommon_$no_seg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 44 001160 47 001166 48 001170 51 001227 53 001233 54 001252 56 001253 59 001261 60 001264 61 001270 64 001330 65 001333 66 001334 67 001354 167 001355 175 001373 177 001412 179 001420 181 001454 182 001455 183 001456 184 001476 185 001477 186 001506 189 001507 198 001531 199 001543 200 001545 201 001550 203 001551 205 001554 208 001623 210 001624 213 001626 214 001632 215 001637 218 001640 219 001642 221 001653 222 001657 223 001660 224 001674 226 001707 227 001710 229 001716 231 001725 233 002002 235 002005 237 002012 239 002014 240 002025 242 002026 244 002027 245 002032 248 002041 246 002043 247 002045 248 002054 250 002143 252 002155 253 002157 255 002163 256 002164 261 002166 265 002241 266 002243 268 002303 270 002304 272 002310 275 002351 276 002352 277 002353 281 002360 282 002363 284 002371 286 002413 287 002414 296 002440 297 002441 299 002442 300 002443 301 002463 303 002473 304 002476 308 002540 310 002546 313 002552 315 002566 319 002635 321 002642 322 002644 324 002645 327 002650 328 002654 330 002656 331 002657 336 002767 338 003016 342 003043 343 003046 345 003067 347 003072 349 003076 350 003100 351 003101 353 003102 355 003104 357 003106 359 003122 362 003140 367 003172 368 003173 372 003216 374 003217 377 003230 378 003231 380 003245 381 003251 384 003276 386 003303 388 003305 390 003325 392 003333 393 003347 394 003363 395 003377 396 003415 398 003416 400 003420 401 003422 402 003424 403 003425 405 003427 406 003431 407 003433 408 003434 410 003436 411 003440 412 003442 414 003443 415 003445 417 003447 418 003504 422 003514 424 003534 425 003536 427 003537 429 003546 430 003566 431 003570 433 003571 434 003573 436 003616 437 003617 440 003623 442 003643 445 003644 446 003652 447 003661 448 003663 450 003671 451 003672 453 003675 454 003714 460 003715 463 003721 465 003741 467 003742 468 003743 469 003747 470 003763 472 003771 474 003773 475 004006 477 004007 478 004015 480 004017 482 004023 484 004025 486 004027 487 004032 488 004044 490 004053 491 004056 455 004060 456 004061 457 004077 458 004106 459 004110 493 004111 495 004113 497 004170 498 004171 500 004172 502 004177 504 004256 508 004314 509 004325 510 004327 511 004346 512 004351 514 004352 515 004354 516 004357 517 004361 518 004363 519 004364 520 004365 521 004366 524 004423 529 004424 531 004437 532 004442 533 004443 536 004444 538 004456 539 004461 540 004465 541 004511 543 004530 544 004532 547 004535 549 004545 550 004551 551 004554 553 004556 554 004563 555 004565 559 004566 561 004571 562 004575 563 004601 564 004604 565 004611 566 004620 569 004642 570 004651 571 004655 575 004665 578 004675 580 004677 582 004741 583 004744 584 004750 585 004755 587 004763 589 004765 590 004770 591 004773 594 005024 639 005025 641 005033 644 005036 645 005052 647 005053 648 005071 650 005075 651 005127 654 005130 655 005133 656 005143 657 005147 659 005155 661 005177 663 005203 665 005206 667 005230 669 005237 671 005246 672 005255 674 005277 675 005316 677 005336 679 005343 680 005376 681 005406 682 005415 683 005441 685 005442 686 005462 687 005474 688 005506 689 005515 691 005540 694 005575 695 005606 698 005630 704 005633 705 005635 706 005655 708 005666 710 005667 711 005671 712 005735 722 005736 725 005744 727 005747 728 005763 730 005764 731 006002 733 006004 735 006020 736 006033 738 006037 739 006064 741 006065 743 006066 744 006102 746 006103 747 006104 748 006107 749 006112 750 006114 752 006123 753 006127 755 006160 756 006163 757 006165 758 006166 761 006220 763 006254 764 006257 766 006265 768 006270 769 006304 771 006305 772 006310 774 006314 776 006315 787 006336 788 006337 791 006340 804 006356 805 006360 807 006363 809 006372 811 006376 813 006400 850 006401 851 006403 852 006407 853 006411 854 006423 855 006424 856 006430 858 006433 859 006436 861 006447 862 006454 864 006455 865 006457 867 006461 868 006462 869 006464 871 006465 873 006471 874 006473 875 006500 876 006505 877 006510 879 006511 881 006515 882 006517 883 006522 884 006524 886 006525 887 006530 889 006532 890 006535 891 006550 893 006552 895 006554 897 006561 899 006562 900 006564 902 006566 903 006573 904 006630 905 006642 907 006643 908 006646 910 006653 912 006660 913 006663 914 006664 915 006675 918 006710 920 006714 921 006717 922 006721 923 006722 926 006723 927 006725 929 006727 930 006730 933 006733 935 006741 936 006746 945 006747 946 006753 948 007000 949 007004 950 007007 952 007012 954 007024 955 007044 956 007056 958 007057 959 007065 962 007103 966 007111 968 007112 969 007115 970 007117 971 007124 972 007126 973 007134 974 007136 976 007142 978 007145 980 007152 982 007153 984 007154 985 007161 986 007173 987 007205 989 007207 991 007215 838 007216 840 007217 842 007221 843 007225 844 007227 846 007230 848 007232 992 007233 994 007235 1022 007236 1024 007256 1025 007261 1026 007264 1027 007265 1030 007266 1041 007304 1042 007307 1044 007331 1046 007353 1048 007375 1050 007414 1052 007415 1059 007433 1060 007436 1061 007455 1062 007462 1063 007463 1075 007501 1077 007515 1079 007530 1081 007540 1083 007550 1084 007555 1085 007601 1086 007610 1087 007623 1088 007633 1090 007634 1104 007651 1105 007654 1106 007655 1107 007657 1109 007661 1112 007673 1113 007700 1115 007707 1117 007716 1119 007731 1120 007732 1121 007742 1131 010071 1132 010112 1134 010114 1135 010121 1136 010135 1137 010147 1139 010160 1202 010161 1209 010173 1210 010176 1211 010200 1212 010207 1213 010213 1215 010226 1216 010233 1219 010243 1221 010265 1222 010270 1227 010357 1228 010361 1229 010362 1232 010374 1233 010377 1234 010407 1235 010413 1237 010423 1238 010425 595 010426 601 010430 602 010435 609 010504 613 010533 617 010550 619 010557 622 010575 624 010627 629 010661 633 010727 636 010746 996 010747 998 010750 1000 010764 1002 010770 1003 010772 1004 011010 1006 011012 1007 011020 1008 011033 1010 011034 1011 011037 1013 011042 1014 011043 1015 011046 1016 011051 1020 011054 1141 011055 1150 011057 1153 011070 1154 011074 1155 011075 1156 011076 1158 011107 1160 011115 1161 011117 1162 011121 1164 011136 1166 011144 1167 011145 1168 011146 1170 011147 1171 011151 1172 011156 1175 011160 1177 011166 1178 011176 1180 011205 1181 011222 1183 011227 1185 011240 1187 011242 1188 011247 1189 011261 1190 011270 1191 011272 1192 011273 1193 011300 1195 011314 1196 011324 1197 011336 1200 011350 1240 011351 1249 011353 1250 011355 1251 011361 1252 011363 1255 011365 1256 011370 1258 011372 1259 011377 1260 011407 1261 011422 1262 011424 1263 011437 1264 011443 1265 011446 1266 011452 1267 011455 1268 011460 1269 011463 1270 011465 1271 011467 1275 011531 1278 011617 1279 011621 1281 011623 1283 011624 1292 011627 1295 011643 1299 011651 1300 011655 1302 011661 1303 011666 1311 011667 1313 011672 1314 011674 1315 011677 1317 011703 1318 011706 1319 011711 1320 011715 1323 011761 1324 011771 1329 011772 1330 011777 1331 012002 1332 012021 1333 012024 1335 012031 1336 012034 1338 012040 1339 012077 1341 012104 1343 012143 1345 012144 1346 012145 1348 012146 1349 012177 1351 012203 1352 012210 1355 012211 1358 012224 1359 012231 1360 012240 1361 012242 1362 012246 1363 012252 1364 012253 1367 012260 1371 012353 1373 012357 1377 012427 1378 012431 1382 012435 1387 012474 1389 012475 1394 012476 1396 012523 1397 012534 1398 012540 1399 012543 1400 012545 1401 012550 1404 012552 1405 012555 1406 012570 1407 012607 1408 012613 1409 012616 1412 012622 1413 012624 1414 012630 1415 012632 1418 012634 1419 012636 1420 012643 1421 012656 1422 012666 1425 012673 1426 012700 1427 012713 1428 012716 1432 012720 1433 012725 1438 012730 1440 012733 1441 012740 1444 012743 1445 012744 1446 012757 1448 013001 1449 013005 1450 013007 1451 013020 1452 013024 1453 013027 1454 013031 1455 013032 1456 013034 1457 013047 1459 013071 1460 013101 1461 013143 1463 013145 1465 013171 1466 013175 1467 013201 1468 013203 1469 013210 1470 013214 1475 013216 1476 013223 1478 013226 1481 013252 1482 013253 1485 013254 1487 013257 1489 013305 1491 013306 1493 013334 1494 013336 1495 013347 1497 013356 1498 013361 1499 013402 1502 013404 1503 013406 1504 013412 1505 013416 1506 013425 1507 013431 1509 013435 1511 013442 1512 013445 1515 013456 1518 013471 1521 013503 1522 013505 1523 013514 1524 013521 1525 013523 1526 013527 1528 013531 1529 013556 ----------------------------------------------------------- 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