1 /* ***********************************************************
  2    *                                                         *
  3    *                                                         *
  4    * Copyright, (C) Honeywell Information Systems Inc., 1981 *
  5    * Copyright, (C) Honeywell Information Systems Inc., 1980 *
  6    *                                                         *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 /* compose subroutine to process input files */
 11 
 12 /* This routine is recursive since the controls processor must call it
 13    to process inserted files. */
 14 
 15 /* format: style2,ind2,ll79,dclind4,idind15,comcol41,linecom */
 16 
 17 comp_:
 18   proc;
 19 
 20 /* LOCAL STORAGE */
 21 
 22     dcl ascii_width    fixed bin;       /* width of ctl line in chars */
 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                                         /* count of blanks inserted */
 28     dcl char_index     (1020) fixed bin (9)
 29                                         /* for width measurement */
 30                        unsigned unaligned based (char_index_ptr);
 31     dcl char_index_ptr ptr;
 32     dcl col_space      fixed bin (31);  /* to advance table columns */
 33     dcl EMPTY          bit (1) static options (constant) init ("1"b);
 34     dcl endinput       bit (1);         /* local copy of shared flag */
 35     dcl EPILOGUE       fixed bin static options (constant) init (4);
 36     dcl ercd           fixed bin (35);  /* error code */
 37     dcl fill_count     fixed bin;       /* tab fill count */
 38     dcl head_used      fixed bin (31);  /* space taken by page header */
 39     dcl htab_shift     char (7) based (DCxx_p);
 40                                         /* ctl string for htabbing */
 41     dcl 1 htab_space   like dclong_val; /* for inserting htab WS */
 42     dcl (i, j)         fixed bin;       /* working index and string index */
 43     dcl (ii, jj, k)    fixed bin;       /* working index */
 44                                         /* for htab measuring */
 45     dcl 1 meas1        aligned like text_entry.cur;
 46     dcl 1 meas2        aligned like text_entry.cur;
 47     dcl strndx         fixed bin;       /* working line scan index */
 48     dcl TEXT           bit (1) static options (constant) init ("1"b);
 49     dcl text_added     bit (1) aligned; /* text added to output buffer */
 50     dcl text_flag      bit (1);         /* current block is in-line text */
 51     dcl TRIM           bit (1) static options (constant) init ("1"b);
 52     dcl txtwidth       fixed bin (31) init (0);
 53                                         /* measured text width */
 54 
 55 /* EXTERNAL STORAGE */
 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;         /* setup for htabbing */
 71     htab_space.leng = 4;
 72     DCxx_p = addr (htab_space);
 73     call_box_ptr = call_stack.ptr (call_stack.index);
 74                                         /* set ctl line overlay pointer */
 75     char_index_ptr = addrel (ctl.ptr, 1);
 76 
 77     call_box.lineno = 0;                /* clear line counter for this file */
 78     if call_stack.index = 0             /* set source file lineno */
 79     then call_box.lineno0 = 0;
 80     else call_box.lineno0 = call_box0.lineno;
 81 
 82     endinput = shared.end_input;        /* copy shared flag for recursion */
 83     shared.end_input = "0"b;            /* and reset it */
 84     on end_output goto end_output_;     /* end_output signal chain ends here */
 85 
 86 read:
 87     if shared.end_input                 /* did somebody signal? */
 88     then goto end_input_;
 89     if shared.end_output
 90     then goto end_output_;              /**/
 91                                         /* read an input line */
 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                 /* input EOF? */
 96     then goto end_input_;
 97 
 98     if shared.literal_mode              /* a literal block? */
 99     then
100       do;
101         if shared.lit_count = 0         /* if thats all, reset the flag */
102         then shared.literal_mode = "0"b;
103         else                            /* count lines */
104              shared.lit_count = shared.lit_count - 1;
105       end;
106 
107     ctl.DVctl = "0"b;                   /* reset device ctl flag */
108     ctl.font = ctl.cur.font;            /* propagate any font changes */
109 
110     if index (ctl_line, "     ") ^= 0   /* if any HTs in the line */
111     then
112       do;
113         ascii_width = 0;                /* set up loop counters */
114         i, j = 1;                       /* and control indices */
115         do while (j > 0);               /* as long as HTs are found */
116           j = index (substr (ctl_line, i), "      ");
117                                         /* look for an HT */
118 
119           if j > 0                      /* if one was found */
120           then
121             do;
122 
123               if j > 1                  /* measure preceding text */
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;       /* position of HT in line */
133                 end;
134               else ii = i;              /* HT is the next character */
135 
136               blank_count =             /* blanks to next Multics tab */
137                    10 - mod (ascii_width, 10);
138               ctl_line = substr (ctl_line, 1, ii - 1) ||
139                                         /* insert them */
140                    copy (" ", blank_count) || substr (ctl_line, ii + 1);
141               i = ii + blank_count;     /* adjust counters */
142               ascii_width = ascii_width + blank_count;
143             end;
144         end;
145       end;
146 
147     if shared.table_mode
148     then
149       do;                               /* record current table column */
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;                  /* preset text flag */
159 
160     if length (ctl_line) = 0            /* special handling for null lines */
161     then
162       do;
163 null_line:
164         if shared.blkptr ^= null        /* if there is an active block */
165         then
166           do;
167             if text.parms.title_mode    /* a title block? */
168             then
169               do;                       /* count lines */
170                 text.hdr.eqn_line_count = text.hdr.eqn_line_count - 1;
171                                         /* if thats all, reset flag */
172                 if text.hdr.eqn_line_count = 0
173                 then text.parms.title_mode = "0"b;
174               end;                      /**/
175                                         /* is there a header pending? */
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                                         /* indented controls? then */
190                                         /* find first nonblank */
191     if shared.indctl.stk (shared.indctl.ndx)
192     then ctl.index = verify (ctl_line, " ");
193     else ctl.index = 1;                 /* else start a 1 */
194 
195 /* control line? */
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         /* if not in literal mode */
205              | (shared.literal_mode & shared.lit_count < 0
206                                         /* or a non-cntng literal */
207              & (ctl_line = ".bel"       /* and end literal */
208              | ctl_line = ".be"))       /* or end all */
209         then
210           do;
211 tbl_:
212             if shared.table_mode        /* table mode? */
213             then if tblfmt.context      /* and format in context mode */
214                  then
215                    do;                  /**/
216                                         /* if there is a column index */
217                      if index ("1234567890", substr (ctl_line, 2, 1)) ^= 0
218                      then
219                        do;
220                          ctl.index = ctl.index + 1;
221                                         /* bad column? */
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                                         /* changing? */
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                                         /* assure context mode */
239                          tblfmt.context = "1"b;
240                                         /* strip column off input line */
241                          if length (ctl_line) > 2
242                          then ctl_line = substr (ctl_line, 3);
243                          else ctl_line = "";
244                                         /* if changing columns */
245                          if tblfmt.ccol ^= tblcolndx
246                          then
247                            do;          /* leaving column 0? */
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                                         /* set to new column */
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                                         /* for a null line */
272                          if ctl_line = ""
273                          then goto null_line;
274                          else goto text_;
275                        end;             /**/
276                                         /* a real control line */
277                      else if substr (ctl_line, 1, 3) ^= ".ur"
278                      then
279                        do;              /* clean up */
280                          if shared.blkptr ^= null ()
281                          then if text.input_line ^= ""
282                               then call comp_break_ (format_break, 0);
283                        end;
284                    end;                 /**/
285                                         /* call control processor */
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   /* text line in table mode? */
296     then if tblfmt.context              /* and format in context mode? */
297          then
298            do;
299              tblcolndx = tblfmt.ccol;
300              if tblcolndx ^= 0          /* going back to column 0? */
301              then
302                do;                      /* clean up */
303                  if shared.blkptr ^= null ()
304                  then if text.input_line ^= ""
305                       then call comp_break_ (format_break, 0);
306                                         /* switch to column 0 */
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                                         /* advance short columns */
318                  do i = 0 to tblfmt.ncols;
319                    tblfmt.colptr (i) -> tblcol.depth = tblfmt.maxdepth;
320                  end;
321                end;
322            end;
323 
324 /* text line */
325 text_:
326     if text_added                       /* if there's text to be added */
327     then
328       do;
329         if shared.blkptr = null ()      /* get a text block if one is needed */
330         then
331           do;                           /**/
332                                         /* head page if needed */
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                                         /* NAMED BLOCKS REPLACE "0"b */
344         then text_flag = "0"b;
345         else text_flag = "1"b;          /**/
346                                         /* is there a header pending? */
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 = ""                /* a null line */
365         then goto null_line;            /**/
366                                         /* if a filled block with leading */
367         if text.parms.fill_mode         /* white space & there are leftovers */
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                                         /* any active htabs? */
381         if shared.htab_ptr ^= null ()
382         then if htab.chars ^= ""
383              then call do_htabs;
384 
385         if ctl_line = ""                /* if its empty after all that */
386         then goto null_line;
387 
388 /* title block */
389         if text.parms.title_mode
390         then
391           do;                           /* count lines */
392             text.hdr.eqn_line_count = text.hdr.eqn_line_count - 1;
393                                         /* if thats all, reset flag */
394             if text.hdr.eqn_line_count = 0
395             then text.parms.title_mode = "0"b;
396                                         /* a <title> line? */
397             if index (ctl_line, shared.ttl_delim) = 1
398             then
399               do;                       /* clean up leftovers */
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 /****           if text.hdr.colno >= 0
407 /****           then */
408                 call comp_hft_ctls_$title (shared.blkptr, addr (text.input),
409                      text.input_line, text.parms.linespace);
410 /****           else call comp_util_$add_text (shared.blkptr, "0"b, "0"b, "0"b,
411 /****                (text.input.quad ^= quadl), ^text.input.art, "0"b,*/
412 /****                     "0"b,         /* text.input.oflo, */
413 /****                     addr (text.input));*/
414 
415                 text.input.art = text.input.art | text.parms.art;
416                 if text.input.art       /* if an artwork line */
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;            /* free line in a formatted block */
426           end;
427 
428 /* column aligned table? */
429         else if shared.table_mode & tblcol.align.posn > 0
430         then
431           do;                           /* find the string */
432             strndx = index (ctl_line, tblcol.align.str);
433 
434             if strndx > 0               /* if its there */
435             then
436               do;                       /* measure preceding text */
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));  /* add to left margin undent */
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 /* plain text */
454         else
455           do;
456 plain:
457             text.input.art = text.input.art | text.parms.art;
458             if text.input.art           /* if an artwork line */
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                                         /* if not building a formatted block */
466             if ^text.parms.title_mode   /* insert pending text heading */
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 /* if filling */
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 /* not filling */
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/* is there still an active block? */
529                 then
530                   do;
531                     text.input_line = "";
532                                         /* erase */
533                                         /* undents are used */
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;    /* restore the shared flag */
557         goto return_;
558       end;
559 %page;
560 end_output_:
561     if option.db_line_end = -1          /* debugging end_output? */
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           /* open if nest? */
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 = "";                      /* erase a possible control line */
578     if option.galley_opt                /* force the flag in galley */
579     then shared.end_output = "1"b;
580 
581     if shared.blkptr ^= null ()         /* if there is a block */
582     then
583       do;
584         if text.parms.title_mode        /* unterminated special block */
585         then
586           do;                           /**/
587                                         /* clean it up */
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              /* unclosed footnote */
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        /* exit 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" /* unterminated picture? */
622             then call comp_block_ctls_ (bep_ctl_index);
623 
624             else                        /* reset mode switches */
625               do;                       /* and finish the block */
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           /* orphan delete mark? */
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         /* put any pictures */
655     then call comp_util_$pictures (shared.blkptr);
656                                         /* are footnotes held? */
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                                         /* any leftovers? */
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 =                          /* set loop counters */
701          text.parms.left.indent - text.parms.left.undent;
702     i, j = 1;                           /* set line scan controls */
703 
704     if length (ctl_line) > 0            /* adjust tabs */
705     then
706       do while (j > 0);
707         j = search (substr (ctl_line, i), htab.chars);
708         if j > 0                        /* if a tab char was found */
709         then
710           do;
711             if j > 1                    /* measure the preceding text */
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;                /* tab char is next, no new text */
723                                         /* which tab character? */
724             jj = index (htab.chars, substr (ctl_line, ii, 1));
725             jj = htab.pats (jj);        /* pattern index for that character */
726                                         /* find the stop column */
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                                         /* if within given stops */
734             then
735               do;
736                 htab_space.v1 =         /* space needed */
737                      htab.pattern (jj).stop (k) - txtwidth - shared.EN_width;
738 
739                 if htab_space.v1 > 0    /* if any to be inserted */
740                 then
741                   do;
742                     if htab.pattern (jj).fill (k) = ""
743                                         /* if no given fill string */
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;               /* construct the fill string */
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 =    /* number of fill strings needed */
759                              divide (htab_space.v1, meas1.width + meas1.avg,
760                              17, 0);
761                         htab_space.v1 = htab_space.v1 -
762                                         /* extra space */
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                                         /* insert fill string */
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;             /* adjust counters */
782                     txtwidth = htab.pattern (jj).stop (k) - shared.EN_width;
783                   end;
784 
785                 else                    /* htab char is next, just remove it */
786                      ctl_line =
787                           substr (ctl_line, 1, ii - 1)
788                           || substr (ctl_line, ii + 1);
789               end;
790 
791             else i = ii + 1;            /* not within given stops, step over it */
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_;