1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    *********************************************************** */
  6 attempt_thunk:
  7      procedure (P_encoded_value, P_blockp, P_stackp, P_refp, P_code) returns (fixed bin (35));
  8 
  9 /* ATTEMPT_THUNK -- This procedure is used by stu_ to call a thunk: a small
 10    procedure that is used to encode a value that cannot be expressed at
 11    compile time, such as the location of a value that is determined by
 12    a refer extent, or adjustable automatic.  The thunk is a non-quick internal
 13    procedure with access to its parent's stack frame, and in theory must be
 14    called with an entry variable containing a pointer to that stack frame.
 15    In many cases, however (such as refer extents for based variables), the
 16    thunk never references its parent's stack frame, but only references the
 17    data itself (for which it is supplied a pointer) and makes some of its
 18    own calculations to determine the address.
 19 
 20    Thus, it is often possible to call a thunk even without a stack frame
 21    pointer, and that's what this program does: it examines the object code
 22    of the thunk to see whether it looks like it will work without a valid
 23    stack frame pointer for display chasing (linkage section references are
 24    also prohibited), and if it looks safe, calls it.  Of course, if there
 25    is a valid stack frame pointer supplied by our caller, it uses that,
 26    instead, and doesn't go through all these heuristics.
 27 
 28    Well, yes: I KNOW this is a kludge, but it does seem to work. Sure would
 29    be nifty if this information were in the symbol table, though, and there
 30    is even room elsewhere in a thunk-encoded value to put it (n1 and n2).
 31 
 32    23 Jun 83, W. Olin Sibert: Initial coding, for azm and display_data_.
 33    */
 34 
 35           declare P_encoded_value        fixed bin (35) parameter;
 36           declare P_blockp               pointer parameter;
 37           declare P_stackp               pointer parameter;
 38           declare P_refp                 pointer parameter;
 39           declare P_code                 fixed bin (35) parameter;
 40 
 41           declare refp                   pointer;
 42           declare blockp                 pointer;
 43           declare value                  fixed bin (35);
 44 
 45           declare 1 ev                   aligned like encoded_value;
 46 
 47           declare thunk_entry            variable entry (pointer, fixed bin (35));
 48           declare 1 entry_template       aligned,
 49                     2 location           pointer,
 50                     2 stack_frame        pointer;
 51 
 52           declare thunk_ptr              pointer;
 53           declare thunk_lth              fixed bin;
 54           declare thunk                  (thunk_lth) bit (36) aligned based (thunk_ptr);
 55 
 56           declare (addr, binary, hbound, null, pointer) builtin;
 57 
 58 /* ^L */
 59 
 60           refp = P_refp;
 61           sp = P_stackp;
 62           blockp = P_blockp;
 63           unspec (ev) = unspec (P_encoded_value);
 64 
 65 /* First, see if the encoded value actually represents a thunk. If not, give
 66    up immediately, since our caller should have handled the other types. */
 67 
 68           if (binary (ev.code, 4) ^= 8) then call punt (1); /* 8 is thunk-type */
 69 
 70 /* Next, see if we got a valid stack pointer. If so, then we will just call
 71    the thunk entry variable and be done with it. */
 72 
 73           if (sp ^= null ()) then do;
 74                     thunk_ptr = pointer (sp -> stack_frame.entry_ptr, ev.n3);
 75                     entry_template.location = thunk_ptr;
 76                     entry_template.stack_frame = sp;
 77                     unspec (thunk_entry) = unspec (entry_template);
 78 
 79                     call thunk_entry (refp, value);
 80 
 81                     P_code = 0;                             /* Successful */
 82                     return (value);
 83                end;
 84 
 85 /* If we have no stack frame pointer, first we find the thunk, assuming that
 86    is is in the segment that the block pointer indicates, and then we check
 87    the code to ensure that it does nothing untoward. */
 88 
 89           if (blockp = null ()) then call punt (2);
 90 
 91           thunk_ptr = pointer (blockp, ev.n3);
 92           entry_template.location = thunk_ptr;
 93           entry_template.stack_frame = baseptr (""b);       /* Guaranteed unusable */
 94           unspec (thunk_entry) = unspec (entry_template);   /* thunk_ptr may be changed after this. */
 95 
 96           call find_thunk_bounds ();
 97 
 98           call check_thunk_code ();
 99 
100           call thunk_entry (refp, value);
101 
102           P_code = 0;
103           return (value);
104 
105 /* ^L */
106 
107 find_thunk_bounds:
108      procedure ();
109 
110           declare idx                    fixed bin;
111 
112 
113 /*^ This procedure verifies that the thunk entry sequence starts as follows:
114           lxl7      stack_frame_size,dl
115           epp2      pr7|34,*
116           tsp2      pr2|1047            int_entry
117           zero      2,0
118           zero      0,0
119    After doing so, it adjusts thunk_ptr to point to the beginning of the
120    executable code for the thunk.
121    */
122 
123           thunk_lth = 5;                                    /* To look at the beginning */
124           if (substr (thunk (1), 19, 18) ^= "727007"b3) then call punt (3);
125           if (thunk (2) ^= "700034352120"b3) then call punt (3);
126           if (thunk (3) ^= "201047272100"b3) then call punt (3);
127           if (thunk (4) ^= "000002000000"b3) then call punt (3);
128           if (thunk (5) ^= "000000000000"b3) then call punt (3);
129 
130           thunk_ptr = addrel (thunk_ptr, 5);
131           thunk_lth = 200;                                  /* More than 200 instructions seems unlikely */
132 
133 /* Now, go looking for the end of the thunk, searching for the transfer to
134    the return operator:
135           tra       pr0|631             return
136    */
137 
138           do idx = 1 to hbound (thunk, 1);
139                if (thunk (idx) = "000631710100"b3) then do;
140                          thunk_lth = idx - 1;
141                          return;
142                     end;
143           end;
144 
145           call punt (4);                                    /* No return operator found */
146 
147      end find_thunk_bounds;
148 
149 /* ^L */
150 
151 check_thunk_code:
152      procedure ();
153 
154           declare idx                    fixed bin;
155           declare jdx                    fixed bin;
156           declare opcode                 bit (12) aligned;
157           declare TRANSFERS              (24) bit (12) aligned internal static options (constant) init
158                                          ("7100"b3 /* tra */,
159                                          "6050"b3 /* tpl */,
160                                          "6040"b3 /* tmi */,
161                                          "6054"b3 /* tpnz */,
162                                          "6000"b3 /* tze */,
163                                          "6010"b3 /* tnz */,
164                                          "6070"b3 /* ttf */,
165                                          "6064"b3 /* ttn */,
166                                          "7000"b3 /* tsx0 */,
167                                          "7010"b3 /* tsx1 */,
168                                          "7020"b3 /* tsx2 */,
169                                          "7030"b3 /* tsx3 */,
170                                          "7040"b3 /* tsx4 */,
171                                          "7050"b3 /* tsx5 */,
172                                          "7060"b3 /* tsx6 */,
173                                          "7070"b3 /* tsx7 */,
174                                          "2700"b3 /* tsp0 */,
175                                          "2710"b3 /* tsp1 */,
176                                          "2720"b3 /* tsp2 */,
177                                          "2730"b3 /* tsp3 */,
178                                          "6700"b3 /* tsp4 */,
179                                          "6710"b3 /* tsp5 */,
180                                          "6720"b3 /* tsp6 */,
181                                          "6730"b3 /* tsp7 */);
182 
183           declare 1 inst                 aligned,
184                     2 offset             fixed bin (18) unsigned unaligned,
185                     2 opcode             bit (10) unaligned,
186                     2 pad                bit (2) unaligned,
187                     2 pr_flag            bit (1) unaligned,
188                     2 tag                bit (6) unaligned;
189           declare 1 pr_inst              aligned,
190                     2 pr_no              fixed bin (3) unsigned unaligned,
191                     2 offset             fixed bin (14) unaligned,
192                     2 opcode             bit (10) unaligned,
193                     2 pad                bit (2) unaligned,
194                     2 pr_flag            bit (1) unaligned,
195                     2 tag                bit (6) unaligned;
196 
197 /* ^L */
198 
199 /* By rights, this should do more checking: it's easily confused by EIS, and
200    I'm not sure what else could go wrong. I believe I've gotten most of the
201    important cases, though. The other ones will just fault, I suppose. */
202 
203           do idx = 1 to thunk_lth;
204                unspec (inst) = thunk (idx);
205                unspec (pr_inst) = thunk (idx);
206 
207 /* The most important check is for stack frame references: we allow only
208    references to the argument pointer and to variables within the variable
209    portion of the stack frame. Note that this will also disallow linkage
210    section references, since it prohibits loading the LP from the frame. */
211 
212                if inst.pr_flag then
213                     if (pr_inst.pr_no = 6) then
214                          if (pr_inst.offset < 64) then /* random variable */
215                               if (pr_inst.offset ^= 26) then /* arg pointer */
216                                    call punt (5);
217 
218 /* Next, check to be sure it's not a transfer instruction. */
219 
220                opcode = inst.opcode || "00"b;
221                do jdx = 1 to hbound (TRANSFERS, 1);
222                     if (opcode = TRANSFERS (jdx)) then call punt (6);
223                end;
224           end;
225 
226           return;
227      end check_thunk_code;
228 
229 /* ^L */
230 
231 PUNT:
232           return (0);
233 
234 
235 
236 punt:
237      procedure (why);
238 
239           declare why                    fixed bin (35) parameter;
240 
241           P_code = why;
242           goto PUNT;
243 
244      end punt;
245 
246 %page; %include runtime_symbol;
247 %page; %include stack_frame;
248 
249      end attempt_thunk;