Subversion Repositories tendra.SVN

Rev

Rev 2 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1 
/*
2 
    		 Crown Copyright (c) 1997
3 
 
4 
    This TenDRA(r) Computer Program is subject to Copyright
5 
    owned by the United Kingdom Secretary of State for Defence
6 
    acting through the Defence Evaluation and Research Agency
7 
    (DERA).  It is made available to Recipients with a
8 
    royalty-free licence for its use, reproduction, transfer
9 
    to other parties and amendment for any purpose not excluding
10 
    product development provided that any such use et cetera
11 
    shall be deemed to be acceptance of the following conditions:-
12 
 
13 
        (1) Its Recipients shall ensure that this Notice is
14 
        reproduced upon any copies or amended versions of it;
15 
 
16 
        (2) Any amended version of it shall be clearly marked to
17 
        show both the nature of and the organisation responsible
18 
        for the relevant amendment or amendments;
19 
 
20 
        (3) Its onward transfer from a recipient to another
21 
        party shall be deemed to be that party's acceptance of
22 
        these conditions;
23 
 
24 
        (4) DERA gives no warranty or assurance as to its
25 
        quality or suitability for any purpose and DERA accepts
26 
        no liability whatsoever in relation to any use to which
27 
        it may be put.
28 
*/
29 
 
30 
 
31 
/**********************************************************************
32 
$Author: release $
33 
$Date: 1998/01/17 15:56:06 $
34 
$Revision: 1.1.1.1 $
35 
$Log: locate.c,v $
36 
 * Revision 1.1.1.1  1998/01/17  15:56:06  release
37 
 * First version to be checked into rolling release.
38 
 *
39 
 * Revision 1.3  1995/09/12  10:59:30  currie
40 
 * gcc pedanttry
41 
 *
42 
 * Revision 1.2  1995/08/16  16:06:50  currie
43 
 * Shortened some .h names
44 
 *
45 
 * Revision 1.1  1995/04/13  09:08:06  currie
46 
 * Initial revision
47 
 *
48 
***********************************************************************/
49 
/* locate.c
50 
     discovers "where" an "exp" is;
51 
     The where coding of an address tells one whether the result of
52 
      evaluating an exp is in a register or directly or literally in store,
53 
*/
54 
 
55 
 
56 
#include "config.h"
57 
#include "addrtypes.h"
58 
#include "expmacs.h"
59 
#include "tags.h"
60 
#include "inst_fmt.h"
61 
#include "mips_ins.h"
62 
#include "bitsmacs.h"
63 
#include "exp.h"
64 
#include "procrectypes.h"
65 
#include "guard.h"
66 
#include "eval.h"
67 
#include "regexps.h"
68 
#include "shapemacs.h"
69 
#include "psu_ops.h"
70 
#include "getregs.h"
71 
#include "move.h"
72 
#include "handle_sregs.h"
73 
#include "common_types.h"
74 
#include "frames.h"
75 
#include "code_here.h"
76 
#include "locate.h"
77 
#include "basicread.h"
78 
 
79 
extern  FILE * as_file;
80 
 
81 
long  locals_offset;		/* the offset in bits of start of current
82 
				   locals */
83 
long  frame_size;		/* the size of the current stack frame in
84 
				   bits */
85 
 
86 
 
87 
baseoff boff
88 
    PROTO_N ( (id) )
89 
    PROTO_T ( exp id )
90 
{		/* decodes id to give a baseoff suitable
91 
				   for ls_ins etc */
92 
  baseoff an;
93 
  if (isglob (id)) {		/* globals */
94 
    dec * gl = brog(id);
95 
    long sno = gl->dec_u.dec_val.sym_number;
96 
    an.base = -(sno + 1);
97 
    an.offset = 0;
98 
  }
99 
  else {
100 
    int   x = no (id);
101 
    int   b = x & 0x3f;
102 
    if (name(son(id))==caller_name_tag) {
103 
    	an.base = 29;
104 
    	an.offset = (x-b)>>4;
105 
    	/* caller tags */
106 
    }
107 
    else
108 
    if (b == 29) {
109 
      an.base = 29;
110 
      an.offset = ((x - b) >> 4) + (locals_offset >> 3);
111 
      /* locally declared things accessed by sp*/
112 
    }
113 
    else
114 
    if ((b==30 && Has_fp) ) {
115 
      an.base = b;
116 
      an.offset = (((x - b)) >> 4) + (locals_offset >> 3)
117 
      			- ((frame_size+callee_size)>>3);
118 
      /* locally declared things accessed by fp  */
119 
    }
120 
    else
121 
    if ( (b == local_reg && Has_vcallees)) {
122 
      an.base = b;
123 
      an.offset = (((x - b)) >> 4) + (locals_offset >> 3)
124 
      			- (frame_size>>3);
125 
      /* locally declared things accessed by local_reg */
126 
    }
127 
    else
128 
      if (b <= 31) {
129 
	an.base = b;
130 
	an.offset = ((x - b) >> 4);
131 
	/* other base offsets */
132 
      }
133 
      else
134 
	if (b == 32) {
135 
	  an.base = -((x - b) >> 6);
136 
	  an.offset = 0;
137 
	  /* global names  */
138 
	}
139 
	else
140 
	  if (b == 33) {
141 
	    an.base = (x - b) >> 6;
142 
	    an.offset = 0;
143 
	    /* global anonymous */
144 
	  }
145 
	  else {
146 
	    failer ("not a baseoff in boff ");
147 
	  }
148 
  }
149 
  return an;
150 
}
151 
 
152 
where locate PROTO_S ((exp e, space sp, shape s, int dreg));
153 
 /* locate differs from locate1 only in that it looks to see e has already
154 
    been evaluated somehow */
155 
 
156 
where locate1
157 
    PROTO_N ( (e, sp, s, dreg) )
158 
    PROTO_T ( exp e X space sp X shape s X int dreg )
159 
{
160 
				/* finds the address of e using shape s;
161 
				   sp gives available t-regs for any inner
162 
				   evaluation. dreg is historical. */
163 
  ash a;
164 
  ans aa;
165 
  where wans;
166 
  a = ashof (s);
167 
 
168 
/*  while (name (e) == diag_tag || name (e) == fscope_tag
169 
      || name (e) == cscope_tag) {
170 
    e = son (e);
171 
  }
172 
*/
173 
  switch (name (e)) {
174 
    case name_tag:
175 
      {
176 
	exp decx = son (e);
177 
	bool var = isvar (decx);
178 
				/* this a locally declared name ... */
179 
	  if (props (decx) & defer_bit) {
180 
				/* ... it has been identified with a
181 
				   simple expression which is better
182 
				   evaluated every time */
183 
	    where w;
184 
	    w = locate (son (decx), sp, sh (son (decx)), dreg);
185 
 
186 
	    if (no (e) == 0) {
187 
	      aa = w.answhere;
188 
	    }
189 
	    else {
190 
	      instore is;
191 
	      switch (w.answhere.discrim) {
192 
		case notinreg:
193 
		  {
194 
		    is = insalt (w.answhere);
195 
		    is.b.offset += (no (e) / 8);
196 
		    break;
197 
		  }
198 
		default:
199 
		  failer ("NOT deferable");
200 
	      }
201 
 
202 
	      setinsalt (aa, is);
203 
	    }
204 
	  }
205 
	  else
206 
	    if (props (decx) & inreg_bits) {
207 
				/* ... it has been allocated in a fixed
208 
				   point reg */
209 
	      if (var) {
210 
		setregalt (aa, no (decx));
211 
	      }
212 
	      else {
213 
		instore b;
214 
		b.b.base = no (decx);
215 
		b.b.offset = 0;
216 
		b.adval = 1;
217 
		setinsalt (aa, b);
218 
	      }
219 
	    }
220 
	    else
221 
	      if (props (decx) & infreg_bits) {
222 
				/* ... it has been allocated in a floating
223 
				   point reg */
224 
		freg fr;
225 
		fr.fr = no (decx);
226 
		fr.dble = (a.ashsize == 64) ? 1 : 0;
227 
		setfregalt (aa, fr);
228 
	      }
229 
	      else {		/* ... it is in memory */
230 
		instore is;
231 
		if (var || (name (sh (e)) == prokhd &&
232 
		      (son (decx) == nilexp || name (son (decx)) == proc_tag
233 
	                || name (son (decx)) == general_proc_tag))) {
234 
		  is.adval = 1;
235 
		}
236 
		else {
237 
		  is.adval = 0;
238 
		}
239 
		is.b = boff (decx);
240 
		is.b.offset += (no (e) / 8);
241 
		setinsalt (aa, is);
242 
	      }
243 
	wans.answhere = aa;
244 
	wans.ashwhere = a;
245 
	return wans;
246 
      }
247 
 
248 
    case addptr_tag:
249 
      {
250 
	exp sum = son (e);
251 
	where wsum;
252 
	int   addend;
253 
	space nsp;
254 
	int   reg;
255 
	int   ind;
256 
	instore is;
257 
	ans asum;
258 
	wsum = locate (sum, sp, sh (sum), 0);
259 
	asum = wsum.answhere;
260 
	/* answer is going to be wsum displaced by integer result of
261 
	   evaluating bro(sum) */
262 
 
263 
	switch (asum.discrim) {
264 
	  case notinreg:
265 
	    {
266 
	      is = insalt (asum);
267 
	      if (is.adval) {	/* wsum is a literal address in store ...
268 
				*/
269 
		baseoff b;
270 
		b = is.b;
271 
		if (b.base < 0 || b.base > 31) {
272 
				/* ... it is not a base-offset , so make
273 
				   it one */
274 
		  reg = getreg (sp.fixed);
275 
		  ls_ins (i_la, reg, b);
276 
		  keepreg (sum, reg);
277 
		  b.base = reg;
278 
		  b.offset = 0;
279 
		}
280 
		nsp = guardreg (b.base, sp);
281 
 
282 
		addend = reg_operand (bro (sum), nsp);
283 
		/* evaluate the displacement ... */
284 
		if (dreg == 0)
285 
		  dreg = getreg (nsp.fixed);
286 
		rrr_ins (i_addu, dreg, b.base, addend);
287 
		/* ... add it to the base register into new reg */
288 
		b.base = dreg;
289 
		is.b = b;
290 
		setinsalt (aa, is);
291 
		wans.answhere = aa;
292 
		wans.ashwhere = a;
293 
		/* ...and use it as base a literal base-offset result */
294 
		keepexp (e, aa);
295 
		return wans;
296 
	      }
297 
	      else {		/* wsum represents an actual pointer in
298 
				   store... */
299 
		ind = getreg (sp.fixed);
300 
		ls_ins (i_lw, ind, is.b);
301 
		/* ... so load it into a good register */
302 
	      }
303 
	      goto breakpt;
304 
	      /* should be break - thought there was cc error */
305 
 
306 
	    }			/* end notinreg */
307 
 
308 
	  case inreg:
309 
	    /* wsum is already in reg */
310 
	    {
311 
	      ind = regalt (asum);
312 
	      goto breakpt;
313 
	    }
314 
 
315 
	  default: {
316 
	      failer ("Locate ? reg");
317 
	    }
318 
	}			/* end case */
319 
 
320 
    breakpt: 			/* register ind contains the evaluation of
321 
				   1st operand of addptr */
322 
	nsp = guardreg (ind, sp);
323 
	if (name(bro(sum)) == env_offset_tag
324 
		|| name(bro(sum)) == general_env_offset_tag ) {
325 
          is.b.base = ind;
326 
          is.b.offset = frame_offset(son(bro(sum)));
327 
	}
328 
	else {
329 
          addend = reg_operand (bro (sum), nsp);
330 
          /* evaluate displacement .... */
331 
          if (dreg == 0)
332 
            dreg = getreg (nsp.fixed);
333 
          rrr_ins (i_addu, dreg, ind, addend);
334 
          /* ... add it to ind in new reg */
335 
          is.b.base = dreg;
336 
          is.b.offset = 0;
337 
        }
338 
	is.adval = 1;
339 
	setinsalt (aa, is);
340 
	wans.answhere = aa;
341 
	wans.ashwhere = a;
342 
	/* ... and deliver literal base_offset */
343 
	keepexp (e, aa);
344 
	return wans;
345 
      }				/* end add_ptr */
346 
 
347 
    case subptr_tag: 		/* this is nugatory - previous transforms
348 
				   make it into addptr or reff */
349 
      {
350 
	exp sum = son (e);
351 
	int   ind = reg_operand (sum, sp);
352 
	instore isa;
353 
	isa.adval = 1;
354 
	sum = bro (sum);
355 
	if (name (sum) == val_tag) {
356 
	  instore isa;
357 
	  isa.b.base = ind;
358 
	  isa.b.offset = -no (e);
359 
	  setinsalt (aa, isa);
360 
	}
361 
	else {
362 
	  if (dreg == 0)
363 
	    dreg = getreg (sp.fixed);
364 
	  rrr_ins (i_subu, dreg, ind,
365 
	      reg_operand (sum, guardreg (ind, sp)));
366 
	  isa.b.base = dreg;
367 
	  isa.b.offset = 0;
368 
	}
369 
	setinsalt (aa, isa);
370 
	wans.answhere = aa;
371 
	wans.ashwhere = a;
372 
	keepexp (e, aa);
373 
	return wans;
374 
      }				/* end subptr */
375 
 
376 
    case reff_tag: {
377 
	instore isa;
378 
 
379 
	wans = locate (son (e), sp, sh (son (e)), 0);
380 
	/* answer is going to be wans displaced by no(e) */
381 
 
382 
	switch (wans.answhere.discrim) {
383 
	  case notinreg: {
384 
 
385 
	      isa = insalt (wans.answhere);
386 
	      if (!isa.adval) {
387 
		/* wans is an actual pointer  in store, so make it into a
388 
		   literal address.... */
389 
		int   reg = getreg (sp.fixed);
390 
		ls_ins (i_lw, reg, isa.b);
391 
		isa.b.offset = 0;
392 
		isa.b.base = reg;
393 
		isa.adval = 1;
394 
	      }
395 
	      /* ... and add appropriate displacement to give result */
396 
	      isa.b.offset += no (e) / 8;
397 
	      setinsalt (wans.answhere, isa);
398 
	      keepexp (e, wans.answhere);
399 
	      break;
400 
	    }
401 
	  case inreg: {
402 
	      /* wans is a pointer in a register */
403 
	      isa.b.base = regalt (wans.answhere);
404 
	      isa.adval = 1;
405 
	      isa.b.offset = no (e) / 8;
406 
	      setinsalt (wans.answhere, isa);
407 
	      break;
408 
	    }
409 
	  default: {
410 
	      failer ("Locate ? reg ");
411 
	    }
412 
	}
413 
	wans.ashwhere = a;
414 
	return wans;
415 
 
416 
      }				/* end reff */
417 
 
418 
    case cont_tag:
419 
    case contvol_tag:
420 
      {
421 
	exp s = son (e);
422 
	ans ason;
423 
	instore isa;
424 
	int   reg;
425 
	where fc;
426 
	fc = locate (s, sp, sh (e), 0);
427 
	ason = fc.answhere;
428 
	/* answer is going to be the contents of address represented by fc
429 
	   */
430 
 
431 
	switch (ason.discrim) {
432 
	  case notinreg:
433 
	    {
434 
	      isa = insalt (ason);
435 
	      if (isa.adval) {	/* fc is a literal store address, so make
436 
				   it into a direct one */
437 
		isa.adval = 0;
438 
		setinsalt (aa, isa);
439 
	      }
440 
	      else {		/* fc is an actual pointer in store ....
441 
				*/
442 
		reg = getreg (sp.fixed);
443 
		ls_ins (i_lw, reg, isa.b);
444 
		/* .... so load it into reg and deliver direct base-offset
445 
		   (reg,0) */
446 
		isa.b.base = reg;
447 
		isa.b.offset = 0;
448 
		setinsalt (aa, isa);
449 
		if (name (e) != contvol_tag && fc.ashwhere.ashalign != 1)
450 
		  keepexp (e, aa);
451 
	      }
452 
	      goto breakson;
453 
 
454 
	    }			/* end notinrg */
455 
 
456 
	  case inreg:
457 
	    /* this one is fraught - it depends on only being used in
458 
	       lh-value positions from vars- take care */
459 
	    {
460 
	      isa.b.base = regalt (ason);
461 
	      isa.b.offset = 0;
462 
	      isa.adval = 1;
463 
	      setinsalt (aa, isa);
464 
	      /* fc is in register, so deliver literal(!? ) base-offset */
465 
	      goto breakson;
466 
	    }
467 
 
468 
	  case infreg: 		/* ditto caveat above */
469 
	    {
470 
	      aa = ason;
471 
	      goto breakson;
472 
	    }
473 
 
474 
	  default: {
475 
	      failer ("Locate ? reg");
476 
	    }
477 
	}
478 
    breakson:
479 
	wans.answhere = aa;
480 
	wans.ashwhere = a;
481 
	return wans;
482 
 
483 
      }				/* end cont */
484 
 
485 
    case top_tag: 		/* does this ever happen ? */
486 
      {
487 
	setregalt (aa, 0);
488 
	wans.answhere = aa;
489 
	wans.ashwhere = a;
490 
	return wans;
491 
      }				/* end top */
492 
 
493 
 
494 
 
495 
    case field_tag: {
496 
	instore isa;
497 
	wans = locate (son (e), sp, sh (son (e)), 0);
498 
	/* answer is wans displace literally by no(e); it should always be
499 
	   a literal store adress */
500 
 
501 
	switch (wans.answhere.discrim) {
502 
	  case notinreg: {
503 
 
504 
	      isa = insalt (wans.answhere);
505 
	      isa.b.offset += no (e) / 8;
506 
	      setinsalt (wans.answhere, isa);
507 
	      break;
508 
	    }
509 
	  default:
510 
	    failer (" field should be transformed ");
511 
	}
512 
	wans.ashwhere = a;
513 
	return wans;
514 
      }				/* end field */
515 
 
516 
 
517 
 
518 
 
519 
 
520 
 
521 
 
522 
    default:
523 
      /* general catch all; evaluate e into register and deliver it as a
524 
         literal store address */
525 
      {
526 
	int   r = reg_operand (e, sp);
527 
	instore is;
528 
	if (r == 2) {		/* guard possible result from proc - can
529 
				   do better */
530 
	  r = getreg (sp.fixed);
531 
	  mon_ins (i_move, r, 2);
532 
	}
533 
	is.b.base = r;
534 
	is.b.offset = 0;
535 
	is.adval = 1;
536 
	setinsalt (aa, is);
537 
	wans.answhere = aa;
538 
	wans.ashwhere = a;
539 
	return wans;
540 
      }
541 
 
542 
  }
543 
}
544 
 
545 
where locate
546 
    PROTO_N ( (e, sp, s, dreg) )
547 
    PROTO_T ( exp e X space sp X shape s X int dreg )
548 
{
549 
  ans ak;
550 
  where w;
551 
  ak = iskept (e);
552 
  if (ak.discrim == inreg && (regalt (ak) == 0)) {
553 
    where w;
554 
    w = locate1 (e, sp, s, dreg);
555 
    return w;
556 
  }
557 
  else {			/* e has been evaluated into a register */
558 
    w.answhere = ak;
559 
    w.ashwhere = ashof (s);
560 
  }
561 
  return w;
562 
}