1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44 tedmgr_:
45 proc;
46
47 dbase_p = envir.bwd;
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:
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;%skip(5);
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
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
167 tedinit_:
168 entry (ted_data_p, adb_p, acode);
169 dcl (
170 ted_data_p ptr,
171 adb_p ptr,
172 acode fixed bin (35)
173 ) parm;
174
175 if (pdir = "")
176 then pdir = get_pdir_();
177 if ted_data.version = 1000
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
189 tedstatus_:
190 entry (tempdir, acode);
191 dcl (
192 tempdir char (*)
193
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
259
260
261 call delete_$path ((db_dir), names (entries (i).nindex),
262 "100010"b, the_name, (code));
263
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;
287 displ_1:
288 if (e_ca > 1) | status_only
289 | force
290 then call ioa_ (" # Started, by whom, as what");
291 dcl (shown, activ) fixed bin;
292 dcl mylock fixed bin;
293 dcl force bit (1);
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);
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;
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
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));
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):
435 call tedlist_buffers_ (ps (i), "", "0"b, "0"b);
436 goto getline;
437 rsfunc (2):
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):
452 dbase_p = ps (i);
453 call tedshow_ (dbase_p, "base");
454 goto getline; %skip (4);
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):
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;
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;
517 dbase.bwd = envir.bwd;
518 envir.bwd = dbase_p;
519 acode = 0;
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
528 %page;
529 tedhold_:
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_:
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;
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;
563 b.b_.r.le = b.b_.r.re + 1;
564 b_s = low (b.maxl);
565 end;
566 if (dbase.seg_p (3) ^= null())
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)
572 & (i ^= 2)
573 & ^b.pseudo
574 then do;
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);
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; %skip (5);
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
608
609 if (dbase.dir_db = "")
610 then call release_temp_segment_ (the_name, tp, code);
611 else do;
612
613 if ^cleaning
614 then call hcs_$terminate_noname (tp, code);
615 else do;
616
617 if (ndx = 0)
618 then substr (segid, 26) = "X ";
619 else substr (segid, 26) = convert (pic3, i);
620
621
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
627
628
629 if (ndx = 0)
630 then call delete_$path (get_default_wdir_ (), segid, "100010"b,
631 the_name, (code));
632 end;
633 if (code ^= 0)
634 then call com_err_ (code, the_name);
635 end;
636 end wipeout; %page;
637 dcl date_time_$format entry (char(*), fixed bin(71), char(*), char(*))
638 returns(char(250) var);
639 buffer:
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)
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);
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
700
701
702
703
704 b.mod_sw = "1"b;
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); %page;
722 tedreset_:
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; %page;
764 tedbreak_:
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; %page;
775
776 tedget_existing_buffer_:
777 entry (adb_p, ain_p, ain_l, abp, a_msg);
778
779
780
781
782
783
784
785
786
787 create = "0"b;
788 goto common_get;
789
790
791 tedget_buffer_:
792 entry (adb_p, ain_p, ain_l, abp, a_msg);
793 dcl (
794
795 ain_p ptr,
796 ain_l fixed bin (21),
797
798 abp ptr
799
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
820
821
822 dcl next_in fixed bin;
823 dcl in_p ptr;
824 dcl in_l fixed bin (21);
825 dcl in_s char (in_l) based (in_p);
826 dcl in_c (in_l) char (1) based (in_p);
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
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;
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 ^= "("
857 then do;
858 tname = tch;
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;
868 tch = ")";
869 end;
870 else do;
871 if (substr (in_s, next_in + 1, 1) = "@")
872 then do;
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;
887 if l < 2
888 then goto Bmd;
889 i = next_in + 1;
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;
908 tname = substr (in_s, i, tnl);
909 end;
910 tch = in_c (next_in - 1);
911 end;
912 ain_l = next_in - 1;
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;
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
939
940
941
942
943
944
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;
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
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;
984 msg = "Bnf) b(";
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;
992 out:
993 abp = bp;
994 out_only:
995 return; %page;
996 check_bc: proc;
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;
1014 b.a_.l.le (0), b.a_.r.le (0) = 1;
1015 b.a_.l.re (0), b.a_.r.re (0) = -1;
1016 b.maxln,
1017 b.a_.r.ln (0), b.a_.l.ln (0) = -1;
1018 end;
1019 end;
1020 end check_bc;
1021
1022 tedcheck_buffer_state_: entry (adb_p, abp, a_msg);
1023
1024 dbase_p = adb_p;
1025 bp = abp;
1026 call check_bc;
1027 return;
1028 %page;
1029
1030 tedget_segment_:
1031 entry (adb_p, asp, asn);
1032 dcl (
1033
1034 asp ptr,
1035 asn fixed bin
1036
1037
1038
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; %skip (5);
1051
1052 tedfree_segment_:
1053 entry (adb_p, asn);
1054
1055
1056
1057
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; %page;
1063 tederror_rc_:
1064 entry (adb_p, a_msg, rc);
1065 dcl (
1066
1067 a_msg char (168) var,
1068 rc fixed bin (35)
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
1077 if (rc = error_table_$noentry)
1078 then msg = "Cnf) ";
1079 else if (rc = error_table_$no_component)
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; %page;
1089
1090 tedlist_buffers_:
1091 entry (adb_p, select, atest, ln_sw);
1092 dcl (
1093
1094 select char (16),
1095 atest bit (1),
1096
1097 ln_sw bit (1)
1098 ) parm;
1099
1100 dcl buf_ct fixed bin (21);
1101 dcl line_counts char (24)var;
1102 dcl Window char (24)var;
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;
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));
1128
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; %page;
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
1147 dcl pic7 pic "
1148 dcl hold_maxln fixed bin (21);
1149
1150 if (b.cur.sn = 0)
1151 | (b.b_.l.le > b.b_.l.re) & (b.b_.r.le > b.b_.r.re)
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;
1166 in_window = ""b;
1167 Window = "";
1168 end;
1169 else do;
1170 in_window = "1"b;
1171 Window = " windowed(";
1172 b.maxln = -1;
1173 end;
1174
1175 if (b.maxln < 0)
1176 then string (pic7) = " ??";
1177 else pic7 = b.maxln;
1178 if flag & (b.maxln < 0)
1179 then do;
1180 call tedcount_lines_ (bp, b.b_.l.le, b.b_.r.re, b.maxln);
1181 if ^in_window
1182 then b.b_.r.ln = b.maxln;
1183 pic7 = b.maxln;
1184 end;
1185 if in_window
1186 then do;
1187 line_counts = " ??";
1188 Window = Window || pic7;
1189 Window = Window || ")";
1190 b.maxln = -1;
1191 end;
1192 else line_counts = pic7;
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; %page;
1201
1202 tedcheck_buffers_:
1203 entry (adb_p, check_code);
1204 dcl (
1205
1206 check_code fixed bin
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
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; %page;
1229 tedset_ck_ptr_:
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; %skip (3);
1239
1240 allocate_cb: proc (cb_ptr, cb_name);
1241
1242 dcl cb_ptr ptr,
1243 cb_name char (32);
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;
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; %skip (4);
1279 get_seg: proc (seg_dp, seg_id_no, seg_use, a_code);
1280
1281 seg_id_no = 0;
1282
1283 get_seg_n: entry (seg_dp, seg_id_no, seg_use, a_code);
1284
1285 dcl (
1286 seg_dp ptr,
1287 seg_id_no fixed bin,
1288 seg_use char (8),
1289 a_code fixed bin (35)
1290 ) parm;
1291
1292 if (seg_id_no = 0)
1293 then
1294 seg_id_no = index (substr (dbase.inuse_seg, 4), "0"b) + 3;
1295 if (seg_id_no > dbase.seg_ct)
1296 then dbase.seg_ct = seg_id_no;
1297
1298
1299 seg_dp = dbase.seg_p (seg_id_no);
1300 if (seg_dp ^= null ())
1301 then do;
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 ())
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;
1326
1327
1328
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 ^= "")
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;
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;
1359 seg_dp -> dbase.seg_p (i) = null ();
1360 end;
1361 seg_dp -> dbase.seg_p (0) = seg_dp;
1362 seg_dp -> dbase.seg_ct = 2;
1363 string (seg_dp -> dbase.sws) = "0"b;
1364 if (db_dir ^= "")
1365 then do;
1366
1367 call hcs_$append_link (get_default_wdir_ (), ename,
1368 rtrim (dirname) || ">" || ename, a_code);
1369
1370
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 %page;
1389 start: proc;
1390
1391
1392
1393
1394 if db_util then call ioa_$ioa_switch (db_output,
1395 "begin start");
1396 dbase.tedname = ted_data.tedname;
1397 dbase.dir_db = db_dir;
1398 dbase.rq_id = rqid;
1399 dbase.cba_p = addr (cb (1));
1400 dbase.eval_p = null ();
1401 dbase.version = dbase_vers_3;
1402
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
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
1418 bp = addr (cb (0));
1419 call re_alloc (bp, "(request line)");
1420 call tedpromote_ (bp, 4096);
1421 dbase.rl.part1 = b.cur;
1422 dbase.rl.part2 = b.b_;
1423
1424
1425 call allocate_cb (bp, "(ted)");
1426 call tedpromote_ (bp, 4096);
1427 b.tw_sw = "1"b;
1428 b.terminate = "0"b;
1429
1430
1431
1432 call allocate_cb (bp, "(val)");
1433 dbase.eval_p = bp;
1434
1435
1436
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;
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);
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;
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
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
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; %page;
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)
1516 then addr (b.cur.sp) -> its.segno
1517 = addr (dbase.seg_p (b.cur.sn)) -> its.segno;
1518 if (b.pend.sn > 0)
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; %page;
1533 dcl (addr, char, divide, fixed, index, length, null, search, substr,
1534 verify) builtin;
1535
1536 %include ted_;
1537 %include tedbase;
1538 %include tedbcb;
1539 %include tedstk;
1540 %include tederror_;
1541 %include tedcommon_;
1542 dcl tedmgr_$list entry;
1543 dcl tedaddr_ entry (
1544 ptr,
1545 ptr,
1546 fixed bin (21),
1547
1548
1549 ptr,
1550 char (168) var,
1551 fixed bin (35),
1552
1553
1554
1555 );
1556
1557
1558 dcl tedck_ptr_ entry (ptr);
1559 dcl tedcount_lines_ entry (
1560 ptr,
1561 fixed bin (21),
1562 fixed bin (21),
1563 fixed bin (21)
1564 );
1565
1566
1567 dcl tedcloseup_ entry (
1568 ptr
1569 );
1570
1571
1572 dcl tedpromote_ entry (
1573 ptr,
1574 fixed bin (21)
1575 );
1576
1577
1578 dcl tedpseudo_ entry (
1579 ptr,
1580 fixed bin,
1581 ptr,
1582 fixed bin (21)
1583 );
1584
1585
1586 dcl tedshow_ entry options (variable);
1587 %include its;
1588 end tedmgr_;