1 /* ******************************************************
 2    *                                                    *
 3    *                                                    *
 4    * Copyright (c) 1972 by Massachusetts Institute of   *
 5    * Technology and Honeywell Information Systems, Inc. *
 6    *                                                    *
 7    *                                                    *
 8    ****************************************************** */
 9 
10 /* Procedure to find symbol header of a specified program
11 
12    Modified: 25 September 1972 by BLW for std obj segments
13    Modified: 11 June 1975 by JMB for version 2 object info
14                                                                       */
15 
16 find_header: proc(seg_pt,name,bc) returns(ptr);
17 
18 dcl       seg_pt    ptr,                /* points at text segment */
19           name      char(32) aligned,   /* name of segment */
20           bc        fixed bin;          /* bit count */
21 
22 dcl       (p,q) ptr,
23           dir char(168),
24           ent char(32),
25           (n,code,size) fixed bin,
26           hcs_$make_ptr entry(ptr,char(*) aligned,char(*) aligned,ptr,fixed bin),
27           hcs_$status_mins entry(ptr,fixed bin,fixed bin,fixed bin),
28           object_info_$brief entry(ptr,fixed bin,ptr,fixed bin),
29           component_info_$name entry(ptr,char(32) aligned,ptr,fixed bin);
30 
31 dcl       (index,null,ptr,substr) builtin;
32 
33 dcl       1 oi structure aligned like object_info;
34 
35 %include object_info;
36 %include component_info;
37 
38           if seg_pt ^= null then p = seg_pt;
39           else do;
40                n = index(name," ");
41                if n = 0 then n = 33;
42                call hcs_$make_ptr(null,substr(name,1,n-1),"symbol_table",p,code);
43                if code ^= 0 then goto no;
44                end;
45 
46           if bc ^= 0 then n = bc;
47           else do;
48                call hcs_$status_mins(p,size,n,code);
49                if code ^= 0 then goto no;
50                end;
51 
52           p = ptr(p,0);
53 
54           oi.version_number = object_info_version_2;
55           call object_info_$brief(p,n,addr(oi),code);
56 
57           if code ^= 0 then goto no;
58 
59           /* if segment is not bound, there is only one symbol header and
60              that's the one we'll use */
61 
62           if ^ oi.bound then return(oi.symbp);
63 
64           call component_info_$name(p,name,addr(ci),code);
65 
66           if code ^= 0 then goto no;
67 
68           return(ci.symb_start);
69 
70 no:       return(null);
71 
72           end;