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 support special definition relocation (part of join to
19      definition section support).
20                                                    END HISTORY COMMENTS */
21 
22 
23 getbit_:
24           procedure (iaddr, basno, b29, relwrd);
25 
26           /* Modified for separate static on 06/15/75 by Eugene E Wiatrowski */
27           /* Modified on 11/02/72 at 18:46:27 by R F Mabee. */
28           /* Modified on 2 November 1972 by R F Mabee to allow linkage relocation on any base reference. */
29           /* Modified on 6 May 1972 by R F Mabee to distinguish linkage relocation from internal static. */
30           /* Modified by NA on June 23, 1970 at 1956 for ext entry dcln's */
31 
32  declare   (iaddr, basno, b29, relwrd, itemp) fixed binary (26);
33  declare   eb_data_$separate_static ext bit(1) aligned;
34 
35 % include relbit;
36 
37 % include lcsect;
38 
39 % include alm_options;
40 
41  declare  glpl_$crh external entry (fixed bin (26)) returns (fixed bin (26));
42 
43 
44           relwrd = 0;
45           if iaddr = 0 then return;
46 
47           itemp = glpl_$crh (iaddr+4);
48 
49           if b29 = 0
50 /* If 18-bit address field. */
51           then if itemp = 1 then if tnewobject = 0 then relwrd = ilink;
52                                  else if iaddr = lpsect then relwrd = ilink;    /* Reference to links. */
53                                  else relwrd = ilblok;      /* New 18-bit internal static address. */
54                else relwrd = ibits (itemp + 1);   /* Text or symbol section. */
55 /* Else 15-bit address field. */
56           else if itemp = 1 then if tnewobject = 0 then relwrd = ilkptr;
57                               else if iaddr = lpsect then relwrd = ilkptr;      /* 15-bit reference to links. */
58                               else relwrd = imblok;         /* New internal static 15-bit address. */
59                else;                    /* Base reference, not in linkage section, absolute. */
60 
61           if itemp = 8 then relwrd = 27; /* defn (33 octal) */
62           else if itemp = 4
63              then if eb_data_$separate_static
64                      then if b29 = 0
65                              then relwrd = ilblok;
66                              else relwrd = imblok;
67 
68           return;
69 
70 end getbit_;