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 pulnk_:
14           procedure( pc, word, relwrd ) ;
15 
16 /* N. Adleman on June 24, 1970 at 1011  */
17 /* Modified for separate static on 06/15/75 by Eugene E Wiatrowski */
18 
19           /* makes calls to stack the linkage words and stack the
20             associated relocation bits in the scratch segment */
21 
22 declare (pc, word, relwrd) fixed bin (26);
23 declare (lbits, rbits, itemp, nl, nr, i, ik, ival ) fixed bin ( 17 ) aligned ;
24 
25 declare eb_data_$stat_len ext fixed bin(26);
26 declare eb_data_$separate_static ext bit(1) aligned;
27 
28 % include objnfo ;
29 
30           /* EXTERNAL ENTRIES */
31 declare   object_$objlk ext entry (fixed bin (26), fixed bin (26)),
32           object_$wrblk ext entry (fixed bin (26), fixed bin (26)),
33           object_$gtblk ext entry (fixed bin, fixed bin, fixed bin) ;
34 
35 /* ^L     */
36 
37           call object_$objlk( pc, word ) ;        /* write the linkage into the scratch segment */
38 
39           call object_$wrblk( pc, relwrd ) ;      /* insert the relocation bits into the proper place in the scratch segment */
40 
41 
42           return ;
43 
44 
45 
46 
47 lnkcnt:   entry( ival ) ;     /* entry to count the number of relocation bits for the linkage portion */
48 
49           ival = 0 ;
50 
51           if eb_data_$separate_static
52              then do;
53                   itemp = (eb_data_$stat_len + ilkpc) - 1;
54                   ik = eb_data_$stat_len;
55                   end;
56              else do;
57                   itemp = ilkpc - 1;
58                   ik = 0;
59                   end;
60 
61 label_1000:
62           do i = ik to itemp ;
63 
64                     call object_$gtblk( i, lbits, rbits ) ;
65 
66                     nl = 1 ;
67 
68                     nr = 1 ;
69 
70                     if lbits ^= 0 then nl = 5 ;
71 
72                     if rbits ^= 0 then nr = 5 ;
73 
74                     ival = nl + nr + ival ;
75 
76 end label_1000 ;
77 
78           ilkcnt = ival ;
79 
80 end pulnk_ ;