1 /****^  ***********************************************************
 2         *                                                         *
 3         * Copyright, (C) Honeywell Bull Inc., 1988                *
 4         *                                                         *
 5         * Copyright, (C) Honeywell Information Systems Inc., 1986 *
 6         *                                                         *
 7         *********************************************************** */
 8 
 9 
10 
11 /****^  HISTORY COMMENTS:
12   1) change(86-10-01,JRGray), approve(86-10-01,MCR7507),
13      audit(86-10-27,RWaters), install(86-11-12,MR12.0-1202):
14      Created to allow for joining blocks to the definition section.
15                                                    END HISTORY COMMENTS */
16 
17 pudef_:
18           procedure( pc, word, relwrd ) ;
19 
20           /* makes calls to stack the definition words and stack the
21            associated relocation bits in the scratch segment */
22 
23 declare   (pc, word, relwrd) fixed bin (26);
24 declare   (lbits, rbits, itemp, nl, nr, i, ival ) fixed bin ( 17 ) aligned ;
25 
26 % include objnfo ;
27 
28 declare   object_$objdf ext entry (fixed bin (26), fixed bin (26)),
29           object_$wrbdf ext entry (fixed bin (26), fixed bin (26)),
30           object_$getbdf ext entry (fixed bin, fixed bin, fixed bin) ;
31 
32           call object_$objdf( pc, word ) ;        /* write the symbol into the scratch segment */
33 
34           call object_$wrbdf( pc, relwrd ) ;      /* insert the relocation bits into the proper place in the scratch segment */
35 
36 
37           return ;
38 
39 
40 
41 
42 defcnt:   entry( ival ) ;     /* entry to count the number of relocation bits for the definition portion */
43 
44           ival = 0 ;
45 
46           itemp = idfpc - 1 ;
47 
48 label_1000:
49           do i = 0 to itemp ;
50 
51                     call object_$getbdf( i, lbits, rbits ) ;
52 
53                     nl = 1 ;
54 
55                     nr = 1 ;
56 
57                     if lbits ^= 0 then nl = 5 ;
58 
59                     if rbits ^= 0 then nr = 5 ;
60 
61                     ival = nl + nr + ival ;
62 
63 end label_1000 ;
64 
65 
66           idfcnt = ival ;
67 
68 end pudef_ ;