1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1988                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 
 14 
 15 /****^  HISTORY COMMENTS:
 16   1) change(86-10-01,JRGray), approve(86-10-01,MCR7507),
 17      audit(86-10-27,RWaters), install(86-11-12,MR12.0-1202):
 18      Modified to allow for joining to the definition section.
 19                                                    END HISTORY COMMENTS */
 20 
 21 
 22 postp1_:            procedure ;
 23 
 24           /*  modified for separate static on 06/15/75 by Eugene E Wiatrowski  */
 25           /*  modified on 03/30/72 at 23:52:53 by R F Mabee. */
 26 
 27           /*   post pass1 processor for eplbsa. ;
 28            postp1 has the job of originating all lcs.
 29           counters. each location counter has an entry in the
 30           assignment table as follows--
 31 
 32             zero   name,next in hash table
 33             vfd 15/flags,3/class,18/current value
 34             zero left join,right join
 35             zero origin,max value
 36             vfd 15/unused,1/sixty-four,1/eight,1/even,18/segment
 37 
 38                     postp1 does not see the assignment table, but instead,
 39           four lists strung together with the left and right
 40           join pointers--
 41 
 42             ulclst  location counters never join#ed
 43             tlclst  text segment location counters
 44             llclst  link segment location counters
 45             slclst  symbol segment location counters
 46             dlclst  definition segment location counters
 47 
 48           in addition ulcend points to the end of ulclst.
 49 
 50           postp1 first moves ulclst to the beginning of tlclst,
 51           then goes down the three remaining lists filling in
 52           #origin#. it uses only the following information out
 53           of the entry--
 54 
 55             right join
 56             max value
 57                       current value
 58             sixty-four
 59             eight
 60             even
 61 
 62           the field #segment# just duplicates the information
 63           given by membership in the appropriate list.
 64 
 65           late addition to the work of postp1-- check max against current
 66           value to save work for mills.
 67 
 68           later addition--set current value to zero. */
 69 
 70 dcl eb_data_$stat_len ext fixed bin(26);
 71 dcl eb_data_$separate_static ext bit(1);
 72 
 73 
 74 
 75 dcl  linkage_done bit(1) aligned;
 76           dcl ( text, radix, maxv, curv, cur, mode, jut, splice, j, symbol, definition, mods, link) fixed bin (26) ;
 77 
 78 % include alm_lc;
 79 
 80           /* EXTERNAL FUNCTIONS */
 81 
 82 declare   glpl_$clh ext entry (fixed bin) returns (fixed bin),
 83           glpl_$crh ext entry (fixed bin) returns (fixed bin) ;
 84 
 85           /* EXTERNAL ENTRIES */
 86 
 87 declare   glpl_$storr ext entry (fixed bin (26), fixed bin (26)),
 88           glpl_$storl ext entry (fixed bin (26), fixed bin (26)),
 89           putxt_$putxt_ ext entry (fixed bin (26), fixed bin (26), fixed bin (26)),
 90           pulnk_$pulnk_ ext entry (fixed bin (26), fixed bin (26), fixed bin (26)),
 91           pudef_$pudef_ ext entry (fixed bin (26), fixed bin (26), fixed bin (26)),
 92           pusmb_$pusmb_ ext entry (fixed bin (26), fixed bin (26), fixed bin (26)) ;
 93 
 94           % include concom ;
 95           % include varcom;
 96 
 97 
 98           /*        put ulclst onto the beginning of tlclst. */
 99 
100              if (ulclst = 0) then go to label_100;
101            call glpl_$storl(tlclst+2,(ulcend)) ;
102            call glpl_$storr(ulcend+2,(tlclst)) ;
103            tlclst = ulclst;
104            ulclst = 0;
105            ulcend = 0;
106           itxtmod, ilnkmod = 2;
107 label_100:
108 
109           /* go through the text location counters assigning
110             origins, etc. */
111 
112              text = 0;
113              cur = tlclst;
114 label_1000:          if (cur = 0) then go to label_1999;
115 
116              mods = glpl_$clh(cur+4) ;
117              curv = glpl_$crh(cur+1) ;
118              maxv = glpl_$crh(cur+3) ;
119 
120              radix = 1;
121              if (mods ^= 0) then radix = mods;
122 
123                     jut = text - divide(text,radix,26,0) * radix ;
124              if (jut = 0) then go to label_1200 ;
125              splice = radix-jut ;
126 
127 label_1100:
128              do j = 1 to splice ;
129                call putxt_$putxt_(text+j-1,mnopdu,0) ;
130 
131 end label_1100 ;
132 
133           text = text + splice ;
134 
135 label_1200:
136 
137           /* check max vs. current values. */
138 
139              if (curv < maxv) then go to label_1300 ;
140                     maxv = curv;
141                     call glpl_$storr(cur+3,maxv);
142 label_1300:
143 
144           /* Accumulate per-segment mod (boundary) info. */
145 
146           if mods ^= 0 then if itxtmod = 0 then itxtmod = mods;
147                               else if mod (mods, itxtmod) = 0 then itxtmod = mods;
148                               else if mod (itxtmod, mods) ^= 0 then itxtmod = itxtmod * mods;
149 
150           /* set origin */
151 
152              call glpl_$storl(cur+3,text);
153              text = text+maxv ;
154 
155           /* set current value to zero */
156 
157              call glpl_$storr(cur+1,0) ;
158 
159           /* and loop around */
160 
161              cur = glpl_$crh(cur+2);
162              go to label_1000;
163 label_1999:
164 
165           /*  For the case of separate static we have to change the list
166               of location counters of the form:
167 
168                     L = (slc1  lc1 ... lci ... lcn  slc2)
169 
170               where slc1 and slc2 are two system-location counters
171               and (lc1 ... lci ... lcn) is a list posibly empty of user
172               defined location counters
173 
174               into two separate lists:
175                                         a) L1 = (lc1 ... lci ... lcn)
176                               and       b) L2 = (slc1  slc2).             */
177 
178 
179            /* go through the link location counters assigning
180             origins, etc. */
181 
182              link = 0;
183              eb_data_$stat_len = 0;
184              if eb_data_$separate_static
185                 then do;
186                      cur = lpsect;
187                      cur = glpl_$clh(cur+2);
188                      call glpl_$storr(cur+2,0);
189                      cur = llclst;
190                      cur = glpl_$crh(cur+2);
191                      call glpl_$storl(cur+2,0);
192                      end;
193                 else cur = llclst;
194 
195              linkage_done = "0"b;
196 
197 label_2000:          if (cur = 0) then go to label_2888;
198 
199              mods = glpl_$clh(cur+4) ;
200              curv = glpl_$crh(cur+1) ;
201              maxv = glpl_$crh(cur+3) ;
202 
203              radix = 1;
204              if (mods ^= 0) then radix = mods;
205 
206                     jut = link - divide(link,radix,26,0) * radix ;
207              if (jut = 0) then go to label_2200;
208              splice = radix-jut;
209 
210 label_2100:
211              do j = 1 to splice ;
212                 call pulnk_$pulnk_(link+j-1,mnopdu,0) ;
213 
214 end label_2100 ;
215 
216           link = link + splice ;
217 
218 label_2200:
219 
220           /* check max vs. current values. */
221 
222              if (curv < maxv) then go to label_2300 ;
223                     maxv = curv;
224                     call glpl_$storr(cur+3,maxv);
225 label_2300:
226 
227           if mods ^= 0 then if ilnkmod = 0 then ilnkmod = mods;
228                               else if mod (mods, ilnkmod) = 0 then ilnkmod = mods;
229                               else if mod (ilnkmod, mods) ^= 0 then ilnkmod = ilnkmod * mods;
230 
231           /* set origin */
232 
233              call glpl_$storl(cur+3,link);
234              link = link+maxv;
235 
236           /* set current value to zero. */
237 
238              call glpl_$storr(cur+1,0) ;
239 
240           /* and loop around */
241 
242              cur = glpl_$crh(cur+2);
243              go to label_2000;
244 label_2888:
245              if eb_data_$separate_static
246                 then do;
247                      if linkage_done then goto label_2999;
248                      cur = llclst;
249                      call glpl_$storr(cur+2,lpsect);
250                      call glpl_$storl(lpsect+2,cur);
251                      eb_data_$stat_len = link + mod(link,2);
252                      link = 0;
253                      linkage_done = "1"b;
254                      goto label_2000;
255                      end;
256 
257 label_2999:
258 
259           /* now go through and do the same for symbol
260             segment location counters. */
261 
262              symbol = 0 ;
263              cur = slclst;
264 label_3000:          if (cur = 0) then go to label_3999;
265 
266              mods = glpl_$clh(cur+4) ;
267              curv = glpl_$crh(cur+1) ;
268              maxv = glpl_$crh(cur+3) ;
269 
270              radix = 1 ;
271              if (mods ^= 0) then radix = mods;
272 
273                     jut = symbol - divide(symbol, radix, 26, 0 ) * radix ;
274              if (jut = 0) then go to label_3200;
275              splice = radix-jut;
276 label_3100:
277              do j = 1 to splice ;
278                call pusmb_$pusmb_(symbol+j-1,mnopdu,0) ;
279 
280 end label_3100 ;
281 
282           symbol = symbol + splice ;
283 
284 label_3200:
285 
286           /* check max vs. current values. */
287 
288              if (curv < maxv) then go to label_3300 ;
289            maxv = curv;
290            call glpl_$storr(cur+3,maxv);
291 label_3300:
292 
293           /* set origin */
294 
295              call glpl_$storl(cur+3,symbol);
296              symbol = symbol+maxv ;
297 
298           /* set current value to zero. */
299 
300              call glpl_$storr(cur+1,0) ;
301 
302           /* and loop around */
303 
304              cur = glpl_$crh(cur+2);
305              go to label_3000;
306 
307 label_3999:
308           /* definition section */
309           definition = 0;
310           cur = dlclst;
311 label_4000:
312           if (cur = 0) then goto label_4999;
313           mods = glpl_$clh(cur+4);
314           curv = glpl_$crh(cur+1) ;
315           maxv = glpl_$crh(cur+3) ;
316 
317           radix = 1;
318           if (mods ^= 0) then radix = mods;
319 
320           jut = definition - divide(definition,radix,26,0) * radix ;
321           if (jut = 0) then go to label_4200 ;
322           splice = radix - jut;
323 
324           do j = 1 to splice;
325                      call pudef_$pudef_(definition+j-1,mnopdu,0);
326             end;
327           definition = definition + splice;
328 label_4200:
329           if curv < maxv then goto label_4300;
330                maxv = curv;
331                call glpl_$storr(cur+3,maxv);
332 
333 label_4300:
334           call glpl_$storl(cur+3,definition);
335           definition = definition + maxv;
336           call glpl_$storr(cur+1,0);
337           cur = glpl_$crh(cur+2);
338           goto label_4000;
339 
340 label_4999:
341           /* and that seems to be all */
342 
343 end postp1_ ;