1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1988                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         *********************************************************** */
  8 
  9 
 10 /****^  HISTORY COMMENTS:
 11   1) change(86-10-01,JRGray), approve(86-10-01,MCR7507),
 12      audit(86-10-27,RWaters), install(86-11-12,MR12.0-1202):
 13      Modified to allow for joining to the definition section.
 14   2) change(88-08-02,JRGray), approve(88-08-05,MCR7952),
 15      audit(88-09-30,WAAnderson), install(88-10-17,MR12.2-1169):
 16      Modified to call alm_symtab_ as part of symbol table support.
 17                                                    END HISTORY COMMENTS */
 18 
 19 
 20 /* post pass2 processor for the eplbsa assembler. */
 21 
 22 /* ******************************************************
 23    *                                                    *
 24    *                                                    *
 25    * Copyright (c) 1972 by Massachusetts Institute of   *
 26    * Technology and Honeywell Information Systems, Inc. *
 27    *                                                    *
 28    *                                                    *
 29    ****************************************************** */
 30 
 31 postp2_:
 32      procedure;
 33 
 34 /* Postp2 is called after pass two to generate non-source output.
 35    There are three regions to this subroutine,
 36    one to append information
 37    to the text segment (literals, etc), one to put out the
 38    symbolic definition region (to either text or link) and one to
 39    put out the linkage file
 40    (including entry and call interludes).
 41    The arrangement of the output information is determined by the
 42    two flags tprot (for transfer vector and error call) and
 43    tmvdef (for moving definitions to the linkage file).
 44    Tprot should imply tmvdef.
 45    If the definitions are to go in the linkage file,
 46    a pre-pass must be made to assign locations
 47    before the information is put out
 48    because the links must be assigned first. */
 49 /* Modified for separate static on 06/15/75 by Eugene E Wiatrowski */
 50 /* Modified on 07/25/72 at 04:13:13 by R F Mabee.
 51    by RFM on 6 May 1972 to add definition pointer to entry point.
 52    by RFM on 21 March 1972 for new object segment format.
 53    by RHG on 15 May 1971 to fix last fix
 54    by RHG on 1 April 1971 to fix making itxlen even.
 55    November 1970, R H Campbell, for cleavage.
 56    by RHG on 17 Sept 1970 for new listing package
 57    by RHG on 11 August 1970 at 1345 to fix bug in rel_symbol link
 58    by RHG on 7 August 1970 at 0107 for new symbol table header
 59    */
 60 /* AUTOMATIC VARIABLES USED BY POST_PASS_2 */
 61 dcl (argout, calblk, iexp1,
 62      ilc, ilnkno, ioffst,
 63      isegno, ispc, itemp, itxlen, ival, l,
 64      ldef, statlen, lnklen,
 65      lword (4), nwrds, rblock (10), rleft, rlkdef,
 66      rright, rsydef, val, words (4)) fixed bin (26) ;
 67 dcl  iaddr fixed bin (18);
 68 dcl (ientlc, ientpc) pointer;
 69 dcl  iexp pointer;
 70 dcl (ileft, iright) fixed bin (18);
 71 dcl (isym, iname) pointer;
 72 dcl (j, k) pointer;
 73 dcl (lcl, lcptr, lcr) pointer;
 74 dcl  lnkorg fixed bin (26);
 75 declare  header_done bit (1) aligned;
 76                                                             /* Headings placed in listing (watch for form-feeds). */
 77 dcl  SYMBOL_TABLE_HEADER_nl static character (25) aligned initial ("SYMBOL TABLE HEADER
 78      ");
 79 dcl  ff_ERROR_RETURN_CALL_nl static character (23) aligned initial ("ERROR RETURN CALL
 80      ");
 81 dcl  ff_LINKAGE_INFORMATION_nl static character (27) aligned initial ("^LLINKAGE INFORMATION
 82      ");
 83 dcl  ff_LITERALS_nl static character (15) aligned initial ("^LLITERALS
 84      ");
 85 dcl  nl_NO_LITERALS_nl static character (18) aligned initial ("
 86 NO LITERALS
 87      ");
 88 dcl  ff_SYMBOL_INFORMATION_nl static character (25) aligned initial ("^LSYMBOL INFORMATION
 89      ");
 90 dcl  ff_TRANSFER_VECTOR_nl static character (22) aligned initial ("^LTRANSFER VECTOR
 91      ");
 92 dcl  ff_ENTRY_SEQUENCES_nl internal static char (22) aligned initial ("^LENTRY SEQUENCES
 93 ");
 94 dcl  nl_FIRST_REFERENCE_TRAP_LIST_nl internal static char (32) aligned initial ("
 95 FIRST REFERENCE TRAP LIST
 96 ");
 97                                                             /* EXTERNAL DATA USED BY POST_PASS_2 */
 98                                                             /* eb_data_$bases is overlayed with eb_data_$symbas */
 99 dcl (eb_data_$anames (0: 5), eb_data_$bases (0: 7), eb_data_$blanks (2),
100      eb_data_$calseq (4), eb_data_$entseq (5),
101      eb_data_$maos, eb_data_$meax0,
102      eb_data_$meax7) external fixed bin (26);
103 dcl  eb_data_$lavptr external pointer;
104 dcl  eb_data_$stat_len ext fixed bin(26);
105 dcl  eb_data_$separate_static external bit(1);
106                                                             /* EXTERNAL ENTRIES CALLED BY POST_PASS_2 */
107 dcl  alm_definitions_$assign_definitions entry;
108 declare  alm_definitions_$fix_entries ext entry;
109 declare  alm_symtab_$count_words ext entry(fixed bin(26));
110 declare  alm_symtab_$emit ext entry(fixed bin(26));
111 
112 dcl  alm_definitions_$emit_definitions entry (fixed bin (26), fixed bin (26), fixed bin (26));
113 dcl  litevl_$litasn entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26));
114 dcl  prlst_$prlst_ entry (character (*) aligned);
115 dcl  prnam_$prnam2 entry (pointer, pointer);
116 dcl  prnam_$prnam_ entry (pointer);
117 dcl  prnter_$abort1 entry;
118 dcl  prnter_$prnter_ entry (character (*) aligned);
119 dcl  pulnk_$lnkcnt entry (fixed bin (26));
120 dcl  pulnk_$pulnk_ entry (fixed bin (26), fixed bin (26), fixed bin (26));
121 dcl  pudef_$pudef_ entry (fixed bin (26), fixed bin (26), fixed bin (26));
122 dcl  pudef_$defcnt entry (fixed bin (26));
123 dcl  pusmb_$symcnt entry (fixed bin (26));
124 dcl  putout_$putblk entry (fixed bin (26), pointer, fixed bin (26), fixed bin (26), pointer);
125 dcl  putout_$putlst entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26));
126 dcl  putout_$putwrd entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26));
127 dcl  putxt_$putxt_ entry (fixed bin (26), fixed bin (26), fixed bin (26));
128 dcl  putxt_$txtcnt entry (fixed bin (26));
129                                                             /* EXTERNAL FUNCTIONS CALLED BY POST_PASS_2 */
130 dcl (lstman_$blkasn entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26)),
131      lstman_$lnkasn entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26)),
132      lstman_$namasn entry (fixed bin (26)),
133      utils_$makins entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26))
134      ) returns (fixed bin);
135                                                             /* LABEL VARIABLES USED IN POST_PASS_2 */
136 dcl  control_1020 (3) label local static;
137 dcl  control_1030 (5) label local static;
138 dcl  first_time bit (1) static initial ("1"b);
139 dcl  twop18 static fixed bin (19) initial (1000000000000000000b);
140 dcl  deforg fixed bin;
141 declare  symtab_words fixed bin(26);
142 dcl (null, convert, fixed) builtin;
143 
144 /* INCLUDE FILES */
145 %         include alm_lc;
146 
147 %         include alm_list_beads;
148 
149 /* multiple word bit patterns for standard sequences */
150 %         include alm_prototypes;
151 
152 /* miscellaneous whole words for use with relocation processing */
153 %         include alm_relocation_bits;
154 
155 %         include concom;
156 
157 %         include objnfo;
158 
159 /* common for symbol table header processing. */
160 %         include sthedr;
161 
162 %         include varcom;
163 
164 %         include alm_options;
165 
166 /* END OF DECLARATIONS */
167 /* ^L */
168 /* POST_PASS_TWO PROGRAM STARTS HERE. */
169           if first_time /* in the process */ then
170                do;                                          /* initialize the labels & stuff */
171                control_1020 (1) = label_1030;               /* Normal link pair. */
172                control_1020 (2) = label_1040;               /* Entry point. */
173                control_1020 (3) = label_1070;               /* Call out. */
174                control_1030 (1) = label_1031;               /* Type 1 link: <*section>|x */
175                control_1030 (2) = label_1032;               /* Type 2 link: base|[symbol] */
176                control_1030 (3) = label_1033;               /* Type 3 link: <segment>|x */
177                control_1030 (4) = label_1034;               /* Type 4 link: <segment>|[symbol] */
178                control_1030 (5) = label_1035;               /* Type 5 link: <*section>|[symbol] */
179                first_time = "0"b;
180           end;
181 
182           if dlclst > 0 then do;        /* calculate length of explicit definitions */
183                     curlc = dlclst;
184                     idfpc = 0;
185                     j = pointer(eb_data_$lavptr, curlc);
186                     do while(j->location_counter_bead.right_join ^= "0"b);
187                               idfpc = idfpc + convert(idfpc, j->location_counter_bead.max_value);
188                               curlc = convert(curlc, j->location_counter_bead.right_join);
189                               j = pointer(eb_data_$lavptr, curlc);
190                       end;
191             end;
192                                                             /* part 2 of postp2. */
193                                                             /* Put out terminal information in the text segment. */
194                                                             /* output order is transfer vector, error call, and literals. */
195                                                             /* In addition if (tmvdef), all definitions are preassigned. */
196           lnkorg = convert (lnkorg, pointer (eb_data_$lavptr, lpsect) -> location_counter_bead.origin);
197           if (tprot ^= 0) then
198                do;
199                call prlst_$prlst_ (ff_TRANSFER_VECTOR_nl);
200                pc = 0;
201                curlc = lptv;
202                j = pointer (eb_data_$lavptr, tvlst);
203                do while (rel (j));
204                     tinhib = convert (tinhib, j -> transfer_vector_bead.inhibit);
205                     val = convert (val, j -> transfer_vector_bead.location);
206                     k = pointer (eb_data_$lavptr, j -> transfer_vector_bead.location_counter);
207                     if rel (k) then
208                          val = val + fixed (k -> location_counter_bead.origin, 18);
209                     call putout_$putwrd (pc, utils_$makins (0, (val), mtra, 0, 0), i642, (iltext));
210                     j = pointer (eb_data_$lavptr, j -> transfer_vector_bead.next);
211                end;
212                                                             /* put out error call. */
213                tinhib = 0;
214                if (tcall ^= 0) then
215                     do;
216                     pc = 0;
217                     curlc = lpcall;
218                     call prlst_$prlst_ (ff_ERROR_RETURN_CALL_nl);
219                     call litevl_$litasn (argout, dzero (1), 2, 0);
220                     slcall (3) = utils_$makins (0, argout + litorg, meapap, 0, 0);
221                     nslbit (3) = iltext;
222                     calblk = lstman_$blkasn (4, lstman_$namasn (smxer (1)), lstman_$namasn (sretrn (1)), 0);
223                     slcall (5) = utils_$makins (lp, lstman_$lnkasn (calblk, 0, 0, 0) + lnkorg, mtra, 1, mri);
224                     nslbit (5) = ilkptr * twop18;           /* glpl_$glwrd (ilkptr, 0) */
225                     call putout_$putlst (pc, slcall (1), i642, nslcal, nslbit (1));
226                     call putout_$putwrd (pc, 0, i642, 0);
227                end;
228           end;
229 
230 /*  For new object segment format, put out text-section entry sequences.
231    These merely call an operator, because the full entry sequence is fairly long.  */
232 
233           if tnewobject ^= 0 then do;
234                call alm_definitions_$fix_entries ();
235                header_done = "0"b;
236                j = pointer (eb_data_$lavptr, lnklst);       /* Chain of links, entries, etc. */
237                curlc = lpentries;
238                pc = 0;
239                do while (rel (j));
240                     if j -> entry_bead.kind = bit (binary (2, 18), 18) then do;
241                          if ^ header_done then do;
242                               call prlst_$prlst_ (ff_ENTRY_SEQUENCES_nl);
243                               header_done = "1"b;
244                          end;
245                          tinhib = convert (tinhib, j -> entry_bead.inhibit);
246                          ientpc = pointer (eb_data_$lavptr, j -> entry_bead.transfer_vector);
247                          ioffst = convert (ioffst, ientpc -> transfer_vector_bead.location);
248                          ientlc = pointer (eb_data_$lavptr, ientpc -> transfer_vector_bead.location_counter);
249                          ival = fixed (ientlc -> location_counter_bead.origin, 18) + ioffst;
250 
251                          new_entlst (1) = fixed (j -> entry_bead.link_no, 18) * twop18;
252                          new_entlst (3) = utils_$makins (0, ival, new_entlst (3), 0, 0);
253                          call putout_$putlst (pc, new_entlst (1), i642, new_nentls, new_entbit (1));
254                     end;
255                     j = pointer (eb_data_$lavptr, j -> entry_bead.next);
256                end;
257           end;
258 
259 /* punch out literals in order of definition. */
260           if pointer (eb_data_$lavptr, lplit) -> location_counter_bead.value then
261                do;
262                curlc = lplit;
263                call prlst_$prlst_ (ff_LITERALS_nl);
264                j = pointer (eb_data_$lavptr, litlst);
265                do while (rel (j));
266                     pc = convert (pc, j -> literal_bead.location);
267                     nwrds = convert (nwrds, j -> literal_bead.size);
268                     lcptr = pointer (eb_data_$lavptr, j -> literal_bead.location_counters);
269                     if rel (lcptr) then                     /* */
270 label_280a:              do l = 1 to nwrds;
271                          lcl = pointer (eb_data_$lavptr, lcptr -> location_counters (l).left);
272                          lcr = pointer (eb_data_$lavptr, lcptr -> location_counters (l).right);
273                          ileft = convert (ileft, j -> literal_bead.words (l).left);
274                          iright = convert (iright, j -> literal_bead.words (l).right);
275                          rleft = 0;
276                          rright = 0;
277                          if rel (lcl) then
278                               do;
279                               ileft = ileft + fixed (lcl -> location_counter_bead.origin, 18);
280                               rleft = ibits (fixed (lcl -> location_counter_bead.section, 18));
281                          end;
282                          if rel (lcr) then
283                               do;
284                               iright = iright + fixed (lcr -> location_counter_bead.origin, 18);
285                               rright = ibits (fixed (lcr -> location_counter_bead.section, 18));
286                          end;
287                          j -> literal_bead.words (l).left = convert (literal_bead.words (1).left, ileft);
288                          j -> literal_bead.words (l).right = convert (literal_bead.words (1).right, iright);
289                          rblock (l) = rleft * twop18 + rright; /* glpl_$glwrd (rleft, rright) */
290                     end label_280a;
291                     else                                    /* */
292 label_211a:         do l = 1 to nwrds;
293                          rblock (l) = 0;
294                     end label_211a;
295                     call putout_$putblk (pc, addr (j -> literal_bead.words), i66, nwrds, addr (rblock));
296                     j = pointer (eb_data_$lavptr, j -> literal_bead.next);
297                end;
298           end;
299           else
300           call prlst_$prlst_ (nl_NO_LITERALS_nl);
301 
302           itxpc, deforg = fixed (pointer (eb_data_$lavptr, lplit) -> location_counter_bead.origin, 18) + litc;
303 
304 /* assign locations to definitions, if required. */
305           if (tmvdef = 0) then
306                do;
307                new_text_offset = 0;
308                new_text_length, new_definition_offset = deforg;
309                pointer (eb_data_$lavptr, lpdefs) -> location_counter_bead.origin = bit (fixed (deforg, 18), 18);
310                call alm_definitions_$emit_definitions (lnkorg, rlkdef, rsydef); /* Put out the definitions. */
311                new_definition_length = defc;
312                                                             /* save the length of the text segment - slave procedure. */
313                itxlen = defc + fixed (pointer (eb_data_$lavptr, lpdefs) -> location_counter_bead.origin, 18);
314           end;
315           else
316           do;
317                pointer (eb_data_$lavptr, lpdefs) -> location_counter_bead.origin =
318                     bit (fixed (fixed (pointer (eb_data_$lavptr, lpsect) -> location_counter_bead.origin, 18) + lnkno, 18), 18);
319                call alm_definitions_$assign_definitions;    /* Merely assign definitions for later output. */
320                itxlen = fixed (pointer (eb_data_$lavptr, lplit) -> location_counter_bead.origin, 18) + litc;
321           end;
322 
323 /* force the linkage to begin on an even word boundary */
324           if (mod (itxlen + idfpc, 2) ^= 0) then do;
325                curlc = lptext;
326                call putout_$putwrd (itxlen, 0, i66, 0);
327                /* The pad word is part of the defn section only when there is
328                   more stuff to be added to the defn section. */
329                if idfpc > 0 then new_definition_length = new_definition_length + 1;
330           end;
331                                                             /* Put out links, entries, and call - outs. */
332                                                             /* comment, initialize, and generate the eight word header. */
333           if tnewobject = 0 then itxpc = itxlen;
334           text_section_length = itxlen;
335           call prlst_$prlst_ (ff_LINKAGE_INFORMATION_nl);
336           tpulnk = 1;
337           if eb_data_$separate_static
338              then lnkc = eb_data_$stat_len;
339              else lnkc = 0;
340           curlc = lphead;
341           if pointer (eb_data_$lavptr, lphead) -> location_counter_bead.value then
342                do;
343                call prnter_$prnter_ ("alm: fatal processing error in POSTP2 in the assembler");
344                call prnter_$abort1;
345           end;
346           tinhib = 0;
347                                                             /* put def ptr in header. */
348           if (tmvdef = 0) then
349                do;
350                ldef = 0;
351                words (1) = 0;
352           end;
353           else
354           do;
355                ldef = defcnt;
356                words (1) = mri;
357           end;
358           lnklen = lnkno + ldef + lnkorg;
359           words (2) = convert (words (2), pointer (eb_data_$lavptr, lpdefs) -> location_counter_bead.origin) * twop18;
360           lword (1) = 0;
361           lword (2) = iltext;
362           if (tmvdef ^= 0) then
363                lword (2) = illink;
364 
365           if tfirstreftrap ^= 0 then do;
366                words (2) = words (2) + lnklen;
367                lword (2) = lword (2) + ilink;
368                lnklen = lnklen + 3;
369                lnkno = lnkno + 3;
370           end;
371           call putout_$putlst (lnkc, words (1), i66, 2, lword (1));
372                                                             /* nxt blk ptr and pre blk ptr are 0 since only one */
373                                                             /* linkage block is currently produced by eplbsa. */
374           words (1) = 0;
375           words (2) = 0;
376           words (3) = 0;
377           words (4) = 0;
378           call putout_$putlst (lnkc, words (1), i66, 4, words (1));
379                                                             /* put loc of links and block length in 7th word of header and */
380                                                             /* segment length in 8th word. */
381           words (1) = lnkorg * twop18 + lnklen;
382           lword (1) = illink + ilink;
383           if ^ eb_data_$separate_static
384              then words (2) = lnkorg - 8;
385              else words (2) = eb_data_$stat_len;
386           statlen = words (2);
387           lword (2) = ilink;
388           call putout_$putlst (lnkc, words (1), i66, 2, lword (1));
389 
390 /* put out links, entries, and call - outs. */
391 
392           if eb_data_$separate_static
393              then lnkc = eb_data_$stat_len;
394              else lnkc = 0;
395           curlc = lpsect;
396           l = lnkorg;
397           j = pointer (eb_data_$lavptr, lnklst);
398 label_1020:
399           do while (rel (j));
400                go to control_1020 (fixed (j -> link_bead.kind, 18));
401 
402 /* type 1 in list, normal link pair, generate fi pair. */
403 /* print proper names according to the type no. of the link. */
404 /* see mspm bd.7.01 for a discussion of the 5 link types. */
405 label_1030:    tinhib = 0;
406                                                             /* print the symbols corresponding to the link types. */
407                                                             /* but ignoring the internal expression values of the link. */
408                iexp = pointer (eb_data_$lavptr, pointer (eb_data_$lavptr,
409                     j -> link_bead.expression) -> expression_bead.type_pair);
410                iexp1 = convert (iexp1, iexp -> type_pair_bead.segment);
411                iname = addr (eb_data_$anames (2 * iexp1));
412                isym = pointer (eb_data_$lavptr, pointer (eb_data_$lavptr,
413                     iexp -> type_pair_bead.symbol) -> name_bead.name);
414                if isym = eb_data_$lavptr then
415                     isym = addr (eb_data_$blanks);
416                ilnkno = convert (ilnkno, iexp -> type_pair_bead.type); /* Extract the type no. of the link. */
417                go to control_1030 (ilnkno);                 /* Branch on the link type. */
418 
419 /* type 1 link, print *name only. */
420 label_1031:    isym = addr (eb_data_$blanks);
421                go to label_1037;
422 
423 /* type 2 link, print base and symbol. */
424 label_1032:    iname = addr (eb_data_$bases (divide (iexp1, 32768, 26, 0)));
425                go to label_1037;
426 
427 /* type 3 link, print segment name only. */
428 label_1033:    isym = addr (eb_data_$blanks);
429                                                             /* type 4 link, print segment and symbol */
430 label_1034:    iname = pointer (eb_data_$lavptr, pointer (eb_data_$lavptr, iexp1) -> name_bead.name);
431 label_1035:                                                 /* type 5 link, print *name and symbol. */
432 label_1037:    call prnam_$prnam2 (iname, isym);            /* Print the segment and symbol characters for the fi pair. */
433                words (1) = - l * twop18 + mfi;
434                lword (1) = imblok * twop18;
435                words (2) = fixed (pointer (eb_data_$lavptr,
436                     j -> link_bead.expression) -> expression_bead.location || j -> link_bead.modifier, 18);
437                lword (2) = ildefs;
438                                                             /* put out the binary fi word pair. */
439                call putout_$putlst (lnkc, words (1), i642, 2, lword (1));
440                l = l + 2;
441                go to label_1080;
442 
443 /* type 2, entry point, generate entry interlude. */
444 /* print entry sequence */
445 label_1040:    if tnewobject ^= 0 then goto label_1080;     /* Entries already processed. */
446                call prnam_$prnam_ (addr (eb_data_$entseq));
447                tinhib = convert (tinhib, j -> entry_bead.inhibit);
448                if (tprot = 0) then
449                     do;
450                     ientpc = pointer (eb_data_$lavptr, j -> entry_bead.transfer_vector);
451                     ioffst = convert (ioffst, ientpc -> transfer_vector_bead.location);
452                     ientlc = pointer (eb_data_$lavptr, ientpc -> transfer_vector_bead.location_counter);
453                     ival = fixed (ientlc -> location_counter_bead.origin, 18) + ioffst;
454                     words (1) = utils_$makins (0, - l, meaplp, 0, mpc);
455                     words (2) = utils_$makins (0, 3, eb_data_$maos, 0, mpc);
456                     words (3) = utils_$makins (0, ival, eb_data_$meax7, 0, 0);
457                     words (4) = utils_$makins (0, fixed (j -> entry_bead.link_no, 18) - l - 3 + lnkorg, mtra, 0, mpci);
458                     lword (1) = imlink * twop18;
459                     lword (2) = iselfr * twop18;
460                                                             /* extract the segment number to determine proper relocation. */
461                     isegno = convert (isegno, ientlc -> location_counter_bead.section);
462                     itemp = ibits (isegno);
463                     lword (3) = itemp * twop18;
464                     lword (4) = lword (2);
465                     call putout_$putlst (lnkc, words (1), i642, 4, lword (1));
466                     words (1) = 0;
467                     words (2) = 0;
468                     lword (1) = 0;
469                     lword (2) = 0;
470                     call putout_$putlst (lnkc, words (1), i66, 2, lword (1)); /* changed to i66 to keep inhibit bit off */
471                     l = l + 6;
472                end;
473                else
474                do;
475                                                             /* mastermode or execute only entry sequence */
476                     call putout_$putwrd (lnkc,
477                          utils_$makins (0, (fixed (j -> entry_bead.transfer_vector_no, 18)), eb_data_$meax0, 0, 0), i642, 0);
478                     l = l + 1;
479                     words (1) = utils_$makins (0, - l, meaplp, 0, mpc);
480                     words (2) = utils_$makins (0, 2, eb_data_$maos, 0, mpc);
481                     words (3) = utils_$makins (0, fixed (j -> entry_bead.link_no, 18) - l - 2 + lnkorg, mtra, 0, mpci);
482                     lword (1) = imlink * twop18;
483                     lword (2) = iselfr * twop18;
484                     lword (3) = lword (2);
485                     call putout_$putlst (lnkc, words (1), i642, 3, lword (1));
486                     call putout_$putwrd (lnkc, 0, i66, 0);
487                     l = l + 4;
488                     call putout_$putwrd (lnkc, 0, i66, 0);
489                     l = l + 1;
490                end;
491                go to label_1080;
492 
493 /* type 3, call - out, in mastermode put out call interlude. */
494 /* print call sequence comment; */
495 label_1070:    call prnam_$prnam_ (addr (eb_data_$calseq));
496                words (1) = utils_$makins (0, fixed (j -> call_out_bead.transfer_vector_no, 18), eb_data_$meax0, 0, 0);
497                words (2) = utils_$makins (0, fixed (j -> call_out_bead.type_pair, 18) - l - 1 + lnkorg, mtra, 0, mpci);
498                lword (1) = 0;
499                lword (2) = iselfr * twop18;
500                tinhib = convert (tinhib, j -> call_out_bead.inhibit);
501                call putout_$putlst (lnkc, words (1), i642, 2, lword (1));
502                l = l + 2;
503                                                             /* link through link list. */
504 label_1080:    j = pointer (eb_data_$lavptr, j -> link_bead.next);
505           end label_1020;
506 
507 /* First-reference trap array goes at end of links. */
508 
509           if tfirstreftrap ^= 0 then do;
510                call prlst_$prlst_ (nl_FIRST_REFERENCE_TRAP_LIST_nl);
511                words (1) = 1;                               /* Declaration version. */
512                words (2) = 1;                               /* Number of trap pointers. */
513                words (3) = first_ref_trap_proc_linkno * twop18 + first_ref_trap_arg_linkno;
514                lword (1), lword (2) = 0;
515                if first_ref_trap_arg_linkno = 0 then lword (3) = illink;
516                else lword (3) = illink + ilink;
517                call putout_$putlst (lnkc, words (1), i66, 3, lword (1));
518           end;
519 
520 /* end of links, decide to put out definitions or pointer. */
521 
522           if (tmvdef ^= 0) then                             /* */
523                call alm_definitions_$emit_definitions (lnkorg, rlkdef, rsydef); /* Put out the definitions now. */
524                                                             /* Check for phase error in linkage file. */
525           ilkpc = lnklen;
526           if (tmvdef ^= 0) then
527                lnkc = lnkc + defc;
528           if (lnkc ^= (lnkno + ldef) + eb_data_$stat_len) then
529                do;
530                call prnter_$prnter_ ("Phase error in the assembler while generating the linkage segment.");
531                call prnter_$abort1;
532           end;
533 
534           if ^ eb_data_$separate_static
535              then eb_data_$stat_len = statlen;
536 
537 /* force linkage to be an even length */
538 
539           if (mod (ilkpc, 2) ^= 0) then
540                do;
541                call putout_$putwrd (lnkc, 0, i66, 0);
542                lnklen = lnklen + 1;
543                ilkpc = ilkpc + 1;
544           end;
545           call prlst_$prlst_ (ff_SYMBOL_INFORMATION_nl);
546           ilc = curlc;
547           curlc = lpst;
548                                                             /* assembler produced header always */
549                                                             /* begins following joined data of symbol segment. */
550           ispc = fixed (pointer (eb_data_$lavptr, lprtx) -> location_counter_bead.origin, 18);
551           if mod (ispc, 2) ^= 0 then ispc = ispc + 1;
552           call prlst_$prlst_ (SYMBOL_TABLE_HEADER_nl);
553                                                             /* if the symbol table header is changed */
554                                                             /* then the following calls must be */
555                                                             /* changed accordingly. */
556                                                             /* complete the symbol table header */
557                                                             /* store the text length and linkage length */
558           sthedr_$text_and_link_lengths.text_length = bit (fixed (itxlen, 18), 18);
559           sthedr_$text_and_link_lengths.link_length = bit (fixed (lnklen, 18), 18);
560           if tnewobject ^= 0 then do;
561                call alm_symtab_$count_words (symtab_words);
562                optional_truncate = bit (fixed (ispc + new_sthedr_$hdrlen, 18), 18);
563                pointer (eb_data_$lavptr, lprtx) -> location_counter_bead.origin, rel_text, default_truncate =
564                     bit (fixed (fixed (optional_truncate, 18) + symtab_words, 18), 18);
565                text_boundary = bit (fixed (itxtmod, 18), 18);
566                link_boundary = bit (fixed (ilnkmod, 18), 18);
567           end;
568           else pointer (eb_data_$lavptr, lprtx) -> location_counter_bead.origin = bit (fixed (ispc + sthedr_$hdrlen, 18), 18);
569 
570           call putxt_$txtcnt (val);                         /* Count relocation bits. */
571           if tnewobject = 0 then if tmvdef = 0 then val = val + 8; /* Adjust for rlkdef, rsydef output later. */
572           tpc = convert (tpc, pointer (eb_data_$lavptr, lprtx) -> location_counter_bead.origin);
573                                                             /* call pusmb_$pusmb_ (tpc, val, 0); DONE BY PAKBIT. */
574           itxcnt = val;
575           nwrds = divide (val + 35, 36, 26, 0) + 1;
576           if tnewobject ^= 0 then nwrds = nwrds + 1;
577           iaddr = nwrds + fixed (pointer (eb_data_$lavptr, lprtx) -> location_counter_bead.origin, 18);
578           pointer (eb_data_$lavptr, lprlk) -> location_counter_bead.origin =
579                bit (fixed (iaddr, 18), 18);
580 
581           if tnewobject = 0 then if tmvdef = 0 then
582                     call putxt_$putxt_ (rlkdef, iaddr * twop18 + 2, ilsymb);
583                else                                         /* */
584                call pulnk_$pulnk_ (rlkdef, iaddr * twop18 + 2, ilsymb);
585           else rel_link = bit (fixed (iaddr - ispc, 18), 18);
586 
587           call pulnk_$lnkcnt (val);
588           if (tmvdef ^= 0) then
589                val = val + 4;
590           tpc = convert (tpc, pointer (eb_data_$lavptr, lprlk) -> location_counter_bead.origin);
591                                                             /* call pusmb_$pusmb_ (tpc, val, 0); DONE BY PAKBIT. */
592           ilkcnt = val;
593           nwrds = divide (val + 35, 36, 26, 0) + 1;
594           if tnewobject ^= 0 then nwrds = nwrds + 1;
595           iaddr = iaddr + nwrds;
596           pointer (eb_data_$lavptr, lpdefs) -> location_counter_bead.origin =
597                bit (fixed (iaddr, 18), 18);
598 
599           if tnewobject = 0 then if tmvdef = 0 then
600                     call putxt_$putxt_ (rsydef, iaddr * twop18 + 2, ilsymb);
601                else                                         /* */
602                call pulnk_$pulnk_ (rsydef, iaddr * twop18 + 2, ilsymb);
603           else rel_def = bit (fixed (iaddr - ispc, 18), 18);
604 
605           l = itxpc;          /* l(def) = l(def+text)-l(text)+l(exp def) */
606           itxpc = itxpc + new_definition_length;
607           call putxt_$txtcnt(idfcnt);
608           itxpc = l;          /* restore value of itxpc */
609           call putxt_$txtcnt(val);
610           l = idfcnt - val;   /* l(def+text) - l(text) */
611           call pudef_$defcnt(val);      /* calculate length of reloc info for definition section */
612           val = val + l;
613           if (tmvdef ^= 0) then
614                val = val + 4;
615           tpc = convert (tpc, pointer (eb_data_$lavptr, lpdefs) -> location_counter_bead.origin);
616                                                             /* call pudef_$pudef_ (tpc, val, 0); DONE BY PAKBIT. */
617           idfcnt = val;
618           nwrds = divide (val + 35, 36, 26, 0) + 1;
619           if tnewobject ^= 0 then nwrds = nwrds + 1;
620           iaddr = iaddr + nwrds;
621           pointer (eb_data_$lavptr, lprst) -> location_counter_bead.origin =
622                bit (fixed (iaddr, 18), 18);
623 
624           if tnewobject = 0 then if tmvdef = 0 then
625                     call putxt_$putxt_ (rsydef, iaddr * twop18 + 2, ilsymb);
626                else                                         /* */
627                call pulnk_$pulnk_ (rsydef, iaddr * twop18 + 2, ilsymb);
628           else rel_symbol = bit (fixed (iaddr - ispc, 18), 18);
629 
630           new_sthedr_$block_size.block_size =
631                bit (fixed (iaddr - ispc + divide (fixed (default_truncate, 18) + 17, 18, 17, 0) + 2, 18), 18);
632                                                             /*  *** ASSUMING all absolute relocation for symbol header. *** */
633 
634           ilc = curlc;
635           curlc = lpst;
636           if tnewobject = 0 then call putout_$putblk (ispc, addr (sthedr_$sthedr_), i66, sthedr_$hdrlen, null ());
637           else do;
638                call putout_$putblk (ispc, addr (new_sthedr_$new_sthedr_), i66, new_sthedr_$hdrlen, addr (new_sthedr_$relocinfo));
639                call alm_symtab_$emit (ispc);
640           end;
641           istpc = ispc;
642           curlc = ilc;
643           call pusmb_$symcnt (itemp);
644      end postp2_;