1 /* ***********************************************************
 2    *                                                         *
 3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
 4    *                                                         *
 5    * Copyright (c) 1972 by Massachusetts Institute of        *
 6    * Technology and Honeywell Information Systems, Inc.      *
 7    *                                                         *
 8    *********************************************************** */
 9 
10 
11 peek:     proc(string);
12 
13 /*        Modified: 1 April 1980 by PCK to add by_name_agg  */
14 
15 dcl       string char(*);
16 
17 dcl       p ptr static,
18           set bit(1) aligned,
19           debug entry,
20           (index,null,ptr,substr) builtin,
21           pl1_stat_$root ptr ext,
22           cu_$arg_count entry returns(fixed bin),
23           cv_oct_ entry(char(*) aligned) returns(fixed bin),
24           n fixed bin;
25 
26 %include by_name_agg;
27 %include reference;
28 %include operator;
29 %include symbol;
30 %include statement;
31 %include label;
32 %include list;
33 %include block;
34 %include context;
35 %include token;
36 %include cross_reference;
37 %include machine_state;
38 %include temporary;
39 %include array;
40 %include default;
41 %include sf_par;
42 %include fdata_nodes;
43 
44           set = "0"b;
45 
46 join:     if cu_$arg_count() = 0 then p = null;
47           else do;
48                n = index(string,"|");
49                if n = 0 then p = ptr(pl1_stat_$root,cv_oct_((string)));
50                else p = ptr(baseptr(cv_oct_(substr(string,1,n-1))),cv_oct_(substr(string,n+1)));
51                end;
52 
53           if ^ set then call debug;
54 
55           return;
56 
57 l:        p -> reference.symbol,
58           p -> symbol.reference,
59           p -> operator.operand(1),
60           p -> block.son,
61           p -> token.next,
62           p -> temporary.next,
63           p -> context.next,
64           p -> label.next,
65           p -> cross_reference.next,
66           p -> list.element(1),
67           p -> machine_state.next,
68           p -> array.bounds,
69           p -> bound.lower,
70           p -> default.next,
71           p -> sf_par.parsym,
72           p -> data_list.next,
73           p -> by_name_agg.next,
74           p -> statement.root = p;
75           return;
76 
77 peek$set: entry(string);
78 
79           set = "1"b;
80           goto join;
81 
82           end;