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 putxt_:   procedure( pc, word, relwrd ) ;
14 
15           /* Last modified by NA on June 25, 1970 at 1626 */
16 
17           /* makes calls to write the object text and stack the
18            associated relocation bits */
19 
20 declare   (pc, word, relwrd) fixed bin (26);
21 declare   (lbits, rbits, itemp, nl, nr, i, ival ) fixed bin ( 17) aligned ;
22 
23 % include objnfo ;
24 
25           /* EXTERNAL ENTRIES */
26 declare   object_$object_ ext entry (fixed bin (26), fixed bin (26)),
27           object_$wrbtx ext entry (fixed bin (26), fixed bin (26)),
28           object_$getbtx ext entry ( fixed bin, fixed bin, fixed bin) ;
29 
30           call object_$object_( pc, word ) ;      /* write the text directly into the object segment */
31 
32           call object_$wrbtx( pc, relwrd ) ;      /* insert the relocation bits into the proper place in the scratch segment */
33 
34           return ;
35 
36 
37 
38 
39 txtcnt:   entry( ival ) ;     /* entry to count the number of relocation bits for the text portion */
40 
41           ival = 0 ;
42 
43           itemp = itxpc - 1 ;
44 
45 label_1000:
46           do i = 0 to itemp ;
47 
48                     call object_$getbtx( i, lbits, rbits ) ;
49 
50                     nl = 1 ;
51 
52                     nr = 1 ;
53 
54                     if lbits ^= 0 then nl = 5 ;
55 
56                     if rbits ^= 0 then nr = 5 ;
57 
58                     ival = nl + nr + ival ;
59 
60 end label_1000 ;
61 
62           itxcnt = ival ;
63 
64 end putxt_ ;