1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17 comp_:
18 proc;
19
20
21
22 dcl ascii_width fixed bin;
23 dcl blank_count fixed bin init (0);
24 dcl BREAK bit (1) static options (constant) init ("1"b);
25 dcl break_type fixed bin;
26 dcl CBARS bit (1) static options (constant) init ("1"b);
27
28 dcl char_index (1020) fixed bin (9)
29
30 unsigned unaligned based (char_index_ptr);
31 dcl char_index_ptr ptr;
32 dcl col_space fixed bin (31);
33 dcl EMPTY bit (1) static options (constant) init ("1"b);
34 dcl endinput bit (1);
35 dcl EPILOGUE fixed bin static options (constant) init (4);
36 dcl ercd fixed bin (35);
37 dcl fill_count fixed bin;
38 dcl head_used fixed bin (31);
39 dcl htab_shift char (7) based (DCxx_p);
40
41 dcl 1 htab_space like dclong_val;
42 dcl (i, j) fixed bin;
43 dcl (ii, jj, k) fixed bin;
44
45 dcl 1 meas1 aligned like text_entry.cur;
46 dcl 1 meas2 aligned like text_entry.cur;
47 dcl strndx fixed bin;
48 dcl TEXT bit (1) static options (constant) init ("1"b);
49 dcl text_added bit (1) aligned;
50 dcl text_flag bit (1);
51 dcl TRIM bit (1) static options (constant) init ("1"b);
52 dcl txtwidth fixed bin (31) init (0);
53
54
55
56
57 dcl (addrel, before, bin, copy, divide, index, length, max, min, mod, null,
58 rtrim, search, substr)
59 builtin;
60 dcl (comp_abort, end_output)
61 condition;
62
63 dcl iox_$put_chars entry (ptr, ptr, fixed (24), fixed (35));
64
65 if shared.bug_mode
66 then call ioa_ ("comp_: (^d ^d ^a pass=^d)", call_stack.index,
67 insert_data.index, shared.input_filename, shared.pass_counter);
68
69 htab_space.mark = DC1;
70 htab_space.type = type_slx;
71 htab_space.leng = 4;
72 DCxx_p = addr (htab_space);
73 call_box_ptr = call_stack.ptr (call_stack.index);
74
75 char_index_ptr = addrel (ctl.ptr, 1);
76
77 call_box.lineno = 0;
78 if call_stack.index = 0
79 then call_box.lineno0 = 0;
80 else call_box.lineno0 = call_box0.lineno;
81
82 endinput = shared.end_input;
83 shared.end_input = "0"b;
84 on end_output goto end_output_;
85
86 read:
87 if shared.end_input
88 then goto end_input_;
89 if shared.end_output
90 then goto end_output_;
91
92 call comp_read_$line (call_stack.ptr (call_stack.index), ctl_line, "0"b);
93 ctl.info = call_box.info;
94
95 if shared.end_input
96 then goto end_input_;
97
98 if shared.literal_mode
99 then
100 do;
101 if shared.lit_count = 0
102 then shared.literal_mode = "0"b;
103 else
104 shared.lit_count = shared.lit_count - 1;
105 end;
106
107 ctl.DVctl = "0"b;
108 ctl.font = ctl.cur.font;
109
110 if index (ctl_line, " ") ^= 0
111 then
112 do;
113 ascii_width = 0;
114 i, j = 1;
115 do while (j > 0);
116 j = index (substr (ctl_line, i), " ");
117
118
119 if j > 0
120 then
121 do;
122
123 if j > 1
124 then
125 do;
126 do k = i to i + j - 2;
127 if char_index (k) >= 32 & char_index (k) <= 126
128 then ascii_width = ascii_width + 1;
129 else if char_index (k) = 8
130 then ascii_width = ascii_width - 1;
131 end;
132 ii = i + j - 1;
133 end;
134 else ii = i;
135
136 blank_count =
137 10 - mod (ascii_width, 10);
138 ctl_line = substr (ctl_line, 1, ii - 1) ||
139
140 copy (" ", blank_count) || substr (ctl_line, ii + 1);
141 i = ii + blank_count;
142 ascii_width = ascii_width + blank_count;
143 end;
144 end;
145 end;
146
147 if shared.table_mode
148 then
149 do;
150 tblfmtptr = tbldata.fmt (tbldata.ndx).ptr;
151 tblcolndx = tblfmt.ccol;
152 tblcolptr = tblfmt.colptr (tblcolndx);
153 if tblcolndx = 0
154 then break_type = block_break;
155 else break_type = format_break;
156 end;
157
158 text_added = "1"b;
159
160 if length (ctl_line) = 0
161 then
162 do;
163 null_line:
164 if shared.blkptr ^= null
165 then
166 do;
167 if text.parms.title_mode
168 then
169 do;
170 text.hdr.eqn_line_count = text.hdr.eqn_line_count - 1;
171
172 if text.hdr.eqn_line_count = 0
173 then text.parms.title_mode = "0"b;
174 end;
175
176 if text.parms.hdrptr ^= null & ^shared.inserting_hfc
177 then call comp_title_block_ (text.parms.hdrptr);
178 end;
179
180 call comp_space_ (current_parms.linespace, shared.blkptr, TEXT, ^TRIM,
181 CBARS, "0"b);
182 if shared.table_mode
183 then call comp_break_ (break_type, -1);
184 else if ^text.parms.art
185 then call comp_break_ (block_break, 0);
186
187 goto read;
188 end;
189
190
191 if shared.indctl.stk (shared.indctl.ndx)
192 then ctl.index = verify (ctl_line, " ");
193 else ctl.index = 1;
194
195
196 if index (substr (ctl_line, ctl.index), ".") = 1
197 & index (substr (ctl_line, ctl.index), ". ") ^= 1
198 & substr (ctl_line, ctl.index) ^= "."
199 & index (substr (ctl_line, ctl.index), ".. ") ^= 1
200 & substr (ctl_line, ctl.index) ^= ".."
201 & index (substr (ctl_line, ctl.index), "...") ^= 1
202 then
203 do;
204 if ^shared.literal_mode
205 | (shared.literal_mode & shared.lit_count < 0
206
207 & (ctl_line = ".bel"
208 | ctl_line = ".be"))
209 then
210 do;
211 tbl_:
212 if shared.table_mode
213 then if tblfmt.context
214 then
215 do;
216
217 if index ("1234567890", substr (ctl_line, 2, 1)) ^= 0
218 then
219 do;
220 ctl.index = ctl.index + 1;
221
222 if bin (substr (ctl_line, ctl.index, 1))
223 > tblfmt.ncols
224 then
225 do;
226 call comp_report_ (2, 0,
227 "Column undefined for this format.",
228 addr (ctl.info), ctl_line);
229 goto read;
230 end;
231
232 if substr (ctl_line, ctl.index, 1) = "0"
233 & tblfmt.ccol ^= 10
234 | substr (ctl_line, ctl.index, 1) ^= "0"
235 & bin (substr (ctl_line, ctl.index, 1))
236 ^= tblfmt.ccol
237 then call comp_tbl_ctls_ (tac_ctl_index);
238
239 tblfmt.context = "1"b;
240
241 if length (ctl_line) > 2
242 then ctl_line = substr (ctl_line, 3);
243 else ctl_line = "";
244
245 if tblfmt.ccol ^= tblcolndx
246 then
247 do;
248 if tblcolndx = 0
249 then
250 do i = 1 to tblfmt.ncols;
251 tblfmt.colptr (i) -> tblcol.depth =
252 tblcol0.depth;
253 end;
254
255 tblcolndx = tblfmt.ccol;
256 tblcolptr = tblfmt.colptr (tblcolndx);
257 ctl.font, ctl.cur.font =
258 tblcol.parms.fntstk
259 .entry (tblcol.parms.fntstk.index);
260
261 if shared.blkptr ^= null ()
262 then
263 do;
264 text.input.font, text.input.cur.font,
265 ctl.font, ctl.cur.font =
266 tblcol.parms.fntstk
267 .entry (tblcol.parms.fntstk.index);
268 text.input.quad, ctl.quad = tblcol.parms.quad;
269 end;
270 end;
271
272 if ctl_line = ""
273 then goto null_line;
274 else goto text_;
275 end;
276
277 else if substr (ctl_line, 1, 3) ^= ".ur"
278 then
279 do;
280 if shared.blkptr ^= null ()
281 then if text.input_line ^= ""
282 then call comp_break_ (format_break, 0);
283 end;
284 end;
285
286 call comp_ctls_ (text_added);
287
288 if text_added & shared.table_mode & substr (ctl_line, 1, 1) = "."
289 & index ("1234567890", substr (ctl_line, 2, 1)) ^= 0
290 then if tbldata.fmt (tbldata.ndx).ptr -> tblfmt.context
291 then goto tbl_;
292 end;
293 end;
294
295 if shared.table_mode & text_added
296 then if tblfmt.context
297 then
298 do;
299 tblcolndx = tblfmt.ccol;
300 if tblcolndx ^= 0
301 then
302 do;
303 if shared.blkptr ^= null ()
304 then if text.input_line ^= ""
305 then call comp_break_ (format_break, 0);
306
307 tblcolndx, tblfmt.ccol = 0;
308 tblcolptr = tblfmt.colptr (0);
309 current_parms = tblcol.parms;
310
311 if shared.blkptr ^= null ()
312 then
313 do;
314 text.parms = current_parms;
315 text.input.quad, ctl.quad = current_parms.quad;
316 end;
317
318 do i = 0 to tblfmt.ncols;
319 tblfmt.colptr (i) -> tblcol.depth = tblfmt.maxdepth;
320 end;
321 end;
322 end;
323
324
325 text_:
326 if text_added
327 then
328 do;
329 if shared.blkptr = null ()
330 then
331 do;
332
333 if ^option.galley_opt & ^page.hdr.headed & page.hdr.col_index >= 0
334 then call comp_head_page_ (head_used);
335
336 call comp_util_$getblk (page.hdr.col_index, shared.blkptr, "tx",
337 addr (current_parms), ^EMPTY);
338 end;
339
340 if (text.blktype = "oh" | text.blktype = "eh" | text.blktype = "of"
341 | text.blktype = "ef" | text.blktype = "tf"
342 | text.blktype = "th" | "0"b)
343
344 then text_flag = "0"b;
345 else text_flag = "1"b;
346
347 if text.parms.hdrptr ^= null & ^shared.inserting_hfc
348 then if ^text.parms.title_mode
349 then call comp_title_block_ (text.parms.hdrptr);
350
351 text.input.lmarg = text.parms.left.indent - text.parms.left.undent;
352 text.input.rmarg =
353 text.parms.measure - text.parms.right.indent
354 + text.parms.right.undent;
355 text.input.net = text.input.rmarg - text.input.lmarg;
356
357 if shared.table_mode & ^text.parms.footnote
358 then
359 do;
360 text.input.lmarg = text.input.lmarg + tblcol.margin.left;
361 text.input.rmarg = text.input.rmarg + tblcol.margin.left;
362 end;
363
364 if ctl_line = ""
365 then goto null_line;
366
367 if text.parms.fill_mode
368 then if index (" ", substr (ctl_line, 1, 1)) ^= 0
369 & length (text.input_line) > 0
370 then
371 do;
372 call comp_break_ (format_break, 0);
373 if text.input.oflo & ^text.parms.keep & text.hdr.colno >= 0
374 & ^shared.table_mode
375 then call comp_break_ (need_break, -2);
376
377 if shared.end_output
378 then goto return_;
379 end;
380
381 if shared.htab_ptr ^= null ()
382 then if htab.chars ^= ""
383 then call do_htabs;
384
385 if ctl_line = ""
386 then goto null_line;
387
388
389 if text.parms.title_mode
390 then
391 do;
392 text.hdr.eqn_line_count = text.hdr.eqn_line_count - 1;
393
394 if text.hdr.eqn_line_count = 0
395 then text.parms.title_mode = "0"b;
396
397 if index (ctl_line, shared.ttl_delim) = 1
398 then
399 do;
400 if length (text.input_line) > 0
401 then call comp_break_ (format_break, 0);
402
403 text.input_line = ctl_line;
404 text.input.info = ctl.info;
405
406
407
408 call comp_hft_ctls_$title (shared.blkptr, addr (text.input),
409 text.input_line, text.parms.linespace);
410
411
412
413
414
415 text.input.art = text.input.art | text.parms.art;
416 if text.input.art
417 then
418 do;
419 text.hdr.art_count = text.hdr.art_count - 1;
420 if text.hdr.art_count = 0
421 then current_parms.art, text.parms.art = "0"b;
422 end;
423 end;
424
425 else goto plain;
426 end;
427
428
429 else if shared.table_mode & tblcol.align.posn > 0
430 then
431 do;
432 strndx = index (ctl_line, tblcol.align.str);
433
434 if strndx > 0
435 then
436 do;
437 unspec (meas1) = "0"b;
438 call comp_measure_ (substr (ctl_line, 1, strndx - 1),
439 addr (text.input.font), "0"b, text.input.art,
440 text.input.quad, 0, addr (meas1), addr (meas2),
441 addr (ctl.info));
442 text.parms.left.undent =
443 text.parms.left.undent + meas1.width + meas1.avg;
444 text.input.lmarg =
445 text.input.lmarg + text.parms.left.indent
446 - text.parms.left.undent;
447 text.input.net = text.input.rmarg - text.input.lmarg;
448 text.input.quad = quadl;
449 end;
450 goto plain;
451 end;
452
453
454 else
455 do;
456 plain:
457 text.input.art = text.input.art | text.parms.art;
458 if text.input.art
459 then
460 do;
461 text.hdr.art_count = text.hdr.art_count - 1;
462 if text.hdr.art_count = 0
463 then current_parms.art, text.parms.art = "0"b;
464 end;
465
466 if ^text.parms.title_mode
467 & text.parms.hdrptr ^= null () & ^shared.inserting_hfc
468 then if text.parms.hdrptr -> hfcblk.hdr.count > 0
469 then call comp_title_block_ (text.parms.hdrptr);
470
471 if ^ctl.DVctl
472 then ctl.linespace = text.parms.linespace;
473 else
474 do;
475 text_flag = "0"b;
476 if ctl_line ^= wait_signal
477 then ctl.linespace = 0;
478 end;
479
480
481 if text.parms.fill_mode & length (ctl_line) > 0
482 & ^text.parms.htab_mode
483 then
484 do;
485 call comp_fill_;
486 if shared.end_output
487 then goto return_;
488 end;
489
490
491 else
492 do;
493 if (text.input.quad & just) | text.parms.htab_mode
494 then text.input.quad = quadl;
495
496 if ctl.DVctl
497 then text.input.linespace = 0;
498
499 if text.input.hanging
500 then
501 do;
502 unspec (meas1) = "0"b;
503 call comp_measure_ (ctl_line, addr (text.input.font), "0"b,
504 text.input.art, text.input.quad, 0, addr (meas1),
505 addr (meas2), addr (ctl.info));
506 if meas1.width + meas1.avg <= text.parms.left.undent
507 then text.input.linespace = 0;
508 else text.input.linespace = text.parms.linespace;
509 end;
510
511 text.input_line = ctl_line;
512 text.input.info = ctl.info;
513 text.input.cbar = text.parms.cbar;
514 text.parms.cbar.del = "0"b;
515
516 call comp_util_$add_text (shared.blkptr,
517 (text.input.quad ^= quadl), ^text.input.art, "0"b,
518 text.input.oflo, addr (text.input));
519 text.input_line = "";
520
521 if text.input.oflo & text.hdr.colno >= 0
522 & ^(shared.table_mode | text.parms.keep | text.parms.art)
523 then call comp_break_ (need_break, -2);
524
525 if shared.end_output
526 then goto end_output_;
527
528 if shared.blkptr ^= null
529 then
530 do;
531 text.input_line = "";
532
533
534 text.parms.left.undent, text.parms.right.undent = 0;
535 text.input.hanging, text.input.und_prot, ctl.hanging =
536 "0"b;
537 text.input.linespace, ctl.linespace = text.parms.linespace;
538
539 text.hdr.nofill_count = text.hdr.nofill_count - 1;
540 if text.hdr.nofill_count = 0
541 then call comp_format_ctls_ (fin_ctl_index);
542 end;
543 end;
544 end;
545 end;
546 goto read;
547 %page;
548 end_input_:
549 if shared.bug_mode
550 then call ioa_ ("end_input: (^d ^d ^a)", call_stack.index,
551 insert_data.index, shared.input_filename);
552
553 if call_stack.index > 0
554 then
555 do;
556 shared.end_input = endinput;
557 goto return_;
558 end;
559 %page;
560 end_output_:
561 if option.db_line_end = -1
562 then shared.bug_mode = "1"b;
563
564 if shared.bug_mode
565 then call ioa_ ("end_output: (^a,^d)", shared.source_filename, ctl.lineno);
566
567 if shared.if_nest.ndx > 0
568 then
569 do;
570 call comp_report_$ctlstr (2, 0,
571 addr (shared.if_nest (shared.if_nest.ndx).info),
572 shared.if_nest (shared.if_nest.ndx).line,
573 "Unterminated conditional execution (if) group.");
574 shared.if_nest.ndx = 0;
575 end;
576
577 ctl_line = "";
578 if option.galley_opt
579 then shared.end_output = "1"b;
580
581 if shared.blkptr ^= null ()
582 then
583 do;
584 if text.parms.title_mode
585 then
586 do;
587
588 call comp_break_ (format_break, 0);
589
590 if text.blktype = "tx"
591 then
592 do;
593 call comp_report_$ctlstr (2, 0, addr (ctl.info), ctl_line,
594 "Unterminated equation block.");
595 end;
596 else
597 do;
598 const.current_parms_ptr = text.hdr.parms_ptr;
599 shared.blkptr = text.hdr.blkptr;
600 end;
601 end;
602
603 if shared.ftn_mode
604 then
605 do;
606 ctl_line = ".bef";
607 call comp_block_ctls_ (bef_ctl_index);
608 end;
609
610 if shared.blkptr ^= null
611 then
612 do;
613 if shared.table_mode
614 then
615 do;
616 ctl.index = 5;
617 ctl_line = ".taf";
618 call comp_tbl_ctls_ (taf_ctl_index);
619 end;
620
621 else if text.blktype = "pi"
622 then call comp_block_ctls_ (bep_ctl_index);
623
624 else
625 do;
626 text.parms.keep, text.parms.art = "0"b;
627 text.input.lmarg =
628 text.parms.left.indent - text.parms.left.undent;
629 text.input.rmarg =
630 text.parms.measure - text.parms.right.indent
631 + text.parms.right.undent;
632 text.input.net = text.input.rmarg - text.input.lmarg;
633
634 if shared.table_mode & ^text.parms.footnote
635 then
636 do;
637 text.input.lmarg = text.input.lmarg + tblcol.margin.left;
638 text.input.rmarg = text.input.rmarg + tblcol.margin.left;
639 end;
640
641 call comp_break_ (block_break, 0);
642 end;
643 end;
644 end;
645
646 if current_parms.cbar.del
647 then
648 do;
649 call comp_space_ (current_parms.linespace, shared.blkptr, "1"b, "1"b,
650 "1"b, "0"b);
651 call comp_break_ (block_break, 0);
652 end;
653
654 if shared.picture.count > 0
655 then call comp_util_$pictures (shared.blkptr);
656
657 if shared.ftnblk_data_ptr ^= null () & shared.ftn_reset = "hold"
658 then if ftnblk_data.highndx > 0
659 then
660 do;
661 shared.purge_ftns = "1"b;
662 ctl_line = ".ift";
663 call comp_ctls_ ("0"b);
664 end;
665
666 if page.hdr.used + col0.hdr.ftn.ct ^= 0 | shared.blkptr ^= null ()
667 then call comp_break_ (page_break, 0);
668
669 if shared.pass_counter <= 1 & ^option.check_opt & page.image_ptr ^= null
670 then
671 do;
672 page_record_ptr = addr (page_image.text_ptr -> record.page_record);
673 page_record.leng = 0;
674 call comp_dvt.outproc (EPILOGUE, 0);
675
676 if page_record.leng > 0
677 then
678 do;
679 call iox_$put_chars ((shared.compout_ptr), addr (page_record.text),
680 page_record.leng, ercd);
681 if ercd ^= 0
682 then
683 do;
684 call comp_report_ (2, ercd, "Writing epilogue.",
685 addr (ctl.info), "");
686 signal comp_abort;
687 return;
688 end;
689 end;
690 end;
691
692 return_:
693 if shared.bug_mode
694 & (shared.input_filename = option.db_file
695 | option.db_file = "ALLFILES")
696 then call ioa_ ("^5x(comp_: ^a)", shared.input_filename);
697 %page;
698 do_htabs:
699 proc;
700 txtwidth =
701 text.parms.left.indent - text.parms.left.undent;
702 i, j = 1;
703
704 if length (ctl_line) > 0
705 then
706 do while (j > 0);
707 j = search (substr (ctl_line, i), htab.chars);
708 if j > 0
709 then
710 do;
711 if j > 1
712 then
713 do;
714 unspec (meas1) = "0"b;
715 call comp_measure_ (substr (ctl_line, i, j - 1),
716 addr (text.input.font), "0"b, text.input.art,
717 text.input.quad, 0, addr (meas1), addr (meas2),
718 addr (ctl.info));
719 txtwidth = txtwidth + meas1.width + meas1.avg;
720 ii = i + j - 1;
721 end;
722 else ii = i;
723
724 jj = index (htab.chars, substr (ctl_line, ii, 1));
725 jj = htab.pats (jj);
726
727 do k = 1 to htab.pattern (jj).count
728 while (txtwidth
729 >= htab.pattern (jj).stop (k) - shared.EN_width);
730 end;
731
732 if k <= htab.pattern (jj).count
733
734 then
735 do;
736 htab_space.v1 =
737 htab.pattern (jj).stop (k) - txtwidth - shared.EN_width;
738
739 if htab_space.v1 > 0
740 then
741 do;
742 if htab.pattern (jj).fill (k) = ""
743
744 then
745 do;
746 ctl_line =
747 substr (ctl_line, 1, ii - 1) || htab_shift
748 || substr (ctl_line, ii + 1);
749 ii = ii + 7;
750 end;
751
752 else
753 do;
754 unspec (meas1) = "0"b;
755 call comp_measure_ ((htab.pattern (jj).fill (k)),
756 addr (text.input.font), "0"b, "0"b, "0"b, 0,
757 addr (meas1), addr (meas2), addr (ctl.info));
758 fill_count =
759 divide (htab_space.v1, meas1.width + meas1.avg,
760 17, 0);
761 htab_space.v1 = htab_space.v1 -
762
763 fill_count * (meas1.width + meas1.avg);
764 if htab_space.v1 > 0
765 then
766 do;
767 ctl_line =
768 substr (ctl_line, 1, ii - 1) || htab_shift
769 || substr (ctl_line, ii);
770 ii = ii + 7;
771 end;
772 ctl_line = substr (ctl_line, 1, ii - 1) ||
773
774 copy (htab.pattern (jj).fill (k), fill_count)
775 || substr (ctl_line, ii + 1);
776 ii = ii
777 + fill_count
778 * length (htab.pattern (jj).fill (k));
779 end;
780
781 i = ii;
782 txtwidth = htab.pattern (jj).stop (k) - shared.EN_width;
783 end;
784
785 else
786 ctl_line =
787 substr (ctl_line, 1, ii - 1)
788 || substr (ctl_line, ii + 1);
789 end;
790
791 else i = ii + 1;
792 end;
793 end;
794 end do_htabs;
795 %page;
796 %include comp_brktypes;
797 %include comp_ctl_index;
798 %include comp_text;
799 %include comp_column;
800 %include comp_DCdata;
801 %include comp_dvid;
802 %include comp_dvt;
803 %include comp_entries;
804 %include comp_fntstk;
805 %include comp_footnotes;
806 %include comp_htab;
807 %include comp_insert;
808 %include comp_metacodes;
809 %include comp_option;
810 %include comp_output;
811 %include comp_page;
812 %include comp_shared;
813 %include comp_table;
814 %include compstat;
815
816 end comp_;