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 
/*
7 7u83 2 
 * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.
3 
 * All rights reserved.
4 
 *
5 
 * Redistribution and use in source and binary forms, with or without
6 
 * modification, are permitted provided that the following conditions are met:
7 
 *
8 
 * 1. Redistributions of source code must retain the above copyright notice,
9 
 *    this list of conditions and the following disclaimer.
10 
 * 2. Redistributions in binary form must reproduce the above copyright notice,
11 
 *    this list of conditions and the following disclaimer in the documentation
12 
 *    and/or other materials provided with the distribution.
13 
 * 3. Neither the name of The TenDRA Project nor the names of its contributors
14 
 *    may be used to endorse or promote products derived from this software
15 
 *    without specific, prior written permission.
16 
 *
17 
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
18 
 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
19 
 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
20 
 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
21 
 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
22 
 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
23 
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
24 
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
25 
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
26 
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
27 
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28 
 *
29 
 * $Id$
30 
 */
31 
/*
2 7u83 32 
    		 Crown Copyright (c) 1997
33 
 
34 
    This TenDRA(r) Computer Program is subject to Copyright
35 
    owned by the United Kingdom Secretary of State for Defence
36 
    acting through the Defence Evaluation and Research Agency
37 
    (DERA).  It is made available to Recipients with a
38 
    royalty-free licence for its use, reproduction, transfer
39 
    to other parties and amendment for any purpose not excluding
40 
    product development provided that any such use et cetera
41 
    shall be deemed to be acceptance of the following conditions:-
42 
 
43 
        (1) Its Recipients shall ensure that this Notice is
44 
        reproduced upon any copies or amended versions of it;
45 
 
46 
        (2) Any amended version of it shall be clearly marked to
47 
        show both the nature of and the organisation responsible
48 
        for the relevant amendment or amendments;
49 
 
50 
        (3) Its onward transfer from a recipient to another
51 
        party shall be deemed to be that party's acceptance of
52 
        these conditions;
53 
 
54 
        (4) DERA gives no warranty or assurance as to its
55 
        quality or suitability for any purpose and DERA accepts
56 
        no liability whatsoever in relation to any use to which
57 
        it may be put.
58 
*/
59 
 
60 
 
61 
/* 80x86/translate.c */
62 
 
63 
/**********************************************************************
64 
$Author: release $
65 
$Date: 1998/03/16 11:25:21 $
66 
$Revision: 1.2 $
67 
$Log: translate.c,v $
68 
 * Revision 1.2  1998/03/16  11:25:21  release
69 
 * Modifications prior to version 4.1.2.
70 
 *
71 
 * Revision 1.1.1.1  1998/01/17  15:55:52  release
72 
 * First version to be checked into rolling release.
73 
 *
74 
 * Revision 1.25  1997/12/04  20:01:21  pwe
75 
 * ANDF-DE V1.9
76 
 *
77 
 * Revision 1.24  1997/10/10  18:25:36  pwe
78 
 * prep ANDF-DE revision
79 
 *
80 
 * Revision 1.23  1997/08/23  13:45:50  pwe
81 
 * initial ANDF-DE
82 
 *
83 
 * Revision 1.22  1997/03/20  16:24:13  pwe
84 
 * dwarf2
85 
 *
86 
 * Revision 1.21  1997/02/18  11:43:11  pwe
87 
 * NEWDIAGS for debugging optimised code
88 
 *
89 
 * Revision 1.20  1996/08/01  11:11:16  pwe
90 
 * PIC id_dec v checkext
91 
 *
92 
 * Revision 1.19  1996/04/19  16:14:08  pwe
93 
 * simplified use of global id = id, correcting linux call problem
94 
 *
95 
 * Revision 1.18  1996/02/20  14:45:15  pwe
96 
 * linux/elf return struct
97 
 *
98 
 * Revision 1.17  1996/02/01  09:34:42  pwe
99 
 * PIC oddities for AVS
100 
 *
101 
 * Revision 1.16  1996/01/05  16:25:37  pwe
102 
 * env_size and env_offset within constant expressions
103 
 *
104 
 * Revision 1.15  1995/12/19  13:34:22  pwe
105 
 * PIC global idents, and static vars
106 
 *
107 
 * Revision 1.14  1995/12/01  16:25:37  pwe
108 
 * correct directive re solaris proc equality
109 
 *
110 
 * Revision 1.13  1995/12/01  11:53:42  pwe
111 
 * solaris proc equality
112 
 *
113 
 * Revision 1.12  1995/10/23  17:34:28  pwe
114 
 * dynamic initialisation PIC, and sco diags
115 
 *
116 
 * Revision 1.11  1995/10/20  14:11:25  pwe
117 
 * PIC globals
118 
 *
119 
 * Revision 1.10  1995/10/09  15:14:12  pwe
120 
 * dynamic initialisation etc
121 
 *
122 
 * Revision 1.9  1995/09/20  12:00:27  pwe
123 
 * svr4 and solaris initial_value, and solaris 64 bit correction
124 
 *
125 
 * Revision 1.8  1995/08/04  08:29:47  pwe
126 
 * 4.0 general procs implemented
127 
 *
128 
 * Revision 1.7  1995/03/24  09:21:41  pwe
129 
 * global proc renaming avoided for SCO
130 
 *
131 
 * Revision 1.6  1995/03/20  18:54:33  pwe
132 
 * stabs initialisation
133 
 *
134 
 * Revision 1.5  1995/03/17  18:29:39  pwe
135 
 * stabs diagnostics for solaris and linux
136 
 *
137 
 * Revision 1.4  1995/02/20  14:08:53  pwe
138 
 * correct Global tag identity
139 
 *
140 
 * Revision 1.3  1995/02/08  13:01:21  pwe
141 
 * Global tag identity - may need more?
142 
 *
143 
 * Revision 1.2  1995/01/30  12:56:57  pwe
144 
 * Ownership -> PWE, tidy banners
145 
 *
146 
 * Revision 1.1  1994/10/27  14:15:22  jmf
147 
 * Initial revision
148 
 *
149 
 * Revision 1.1  1994/07/12  14:43:00  jmf
150 
 * Initial revision
151 
 *
152 
**********************************************************************/
153 
 
154 
 
155 
 
156 
#include "config.h"
157 
#include "common_types.h"
158 
#include "installglob.h"
159 
#include "tags.h"
160 
#include "exp.h"
161 
#include "expmacs.h"
162 
#include "optimise.h"
163 
#include "flags.h"
164 
#include "coder.h"
165 
#include "shapemacs.h"
166 
#include "instr.h"
167 
#include "out.h"
168 
#include "scan2.h"
169 
#include "weights.h"
170 
#include "instr386.h"
171 
#include "operand.h"
172 
#include "machine.h"
173 
#include "codermacs.h"
174 
#include "flpt.h"
175 
#include "flpttypes.h"
176 
#include "localflags.h"
177 
#include "localtypes.h"
178 
#include "diag_fns.h"
179 
#include "assembler.h"
180 
#include "cproc.h"
181 
#include "evaluate.h"
182 
#include "externs.h"
183 
#include "readglob.h"
184 
#include "tv_callees.h"
185 
#include "basicread.h"
186 
#ifdef NEWDWARF
187 
#include "dw2_iface.h"
188 
#include "dw2_config.h"
189 
#endif
190 
 
191 
 
192 
#define ptg(x) ((x)->ptf.glob)		/* addition to expmacs */
193 
 
194 
 
195 
static exp delayed_const_list = nilexp;
196 
 
197 
static int const_ready
7 7u83 198 
(exp e)
2 7u83 199 
{
7 7u83 200 
  unsigned char  n = name(e);
2 7u83 201 
  if (n == env_size_tag)
7 7u83 202 
    return(brog(son(son(e))) -> dec_u.dec_val.processed);
2 7u83 203 
  if (n == env_offset_tag)
7 7u83 204 
    return(name(son(e)) == 0);
2 7u83 205 
  if (n == name_tag || son(e) == nilexp)
206 
    return 1;
207 
  e = son(e);
208 
  while (!last(e)) {
209 
    if (!const_ready(e))
210 
      return 0;
211 
    e = bro(e);
212 
  }
7 7u83 213 
  return(const_ready(e));
2 7u83 214 
}
215 
 
216 
static void eval_if_ready
7 7u83 217 
(exp t, int now)
2 7u83 218 
{
219 
  if (now || const_ready(son(t))) {
220 
    if (isglob(t)) {
221 
	dec * d = ptg(t);
222 
	if (!writable_strings &&
7 7u83 223 
	   (!isvar(t) || (d -> dec_u.dec_val.acc & f_constant)) &&
2 7u83 224 
	    !PIC_code) {
225 
          out_readonly_section();
7 7u83 226 
	  outnl();
2 7u83 227 
#ifdef NEWDWARF
228 
	  if (dwarf2)
7 7u83 229 
	    note_ro(d -> dec_u.dec_val.dec_id);
2 7u83 230 
#endif
231 
	}
232 
	else {
233 
	  if (do_prom)
7 7u83 234 
	    failer("prom data");
235 
	  outs(".data");
236 
	  outnl();
2 7u83 237 
#ifdef NEWDWARF
238 
	  if (dwarf2)
7 7u83 239 
	    note_data(d -> dec_u.dec_val.dec_id);
2 7u83 240 
#endif
241 
	};
7 7u83 242 
	evaluate(son(t),
243 
                 (-1),
2 7u83 244 
                  d -> dec_u.dec_val.dec_id,
7 7u83 245 
		 (!isvar(t)),
246 
                 (int)(d -> dec_u.dec_val.extnamed),
2 7u83 247 
                  d -> dec_u.dec_val.diag_info);
248 
    }
249 
    else {
7 7u83 250 
	if (!writable_strings && name(son(t))!= res_tag) {
2 7u83 251 
             out_readonly_section();
7 7u83 252 
	     outnl();
2 7u83 253 
	   }
254 
	else {
255 
	     if (do_prom)
7 7u83 256 
	       failer("prom data");
257 
	     outs(".data");
258 
	     outnl();
2 7u83 259 
	   };
7 7u83 260 
	evaluate(son(t), no(t), (char *)0,
261 
	       (name(son(t))!= res_tag), 0,(diag_global*)0);
2 7u83 262 
    }
7 7u83 263 
    retcell(t);
2 7u83 264 
  }
265 
  else {
266 
    bro(t) = delayed_const_list;
267 
    delayed_const_list = t;
268 
  }
269 
  return;
270 
}
271 
 
272 
 
273 
/* PROCEDURES */
274 
 
275 
void make_code
7 7u83 276 
(dec * my_def)
2 7u83 277 
{
278 
  exp tg = my_def -> dec_u.dec_val.dec_exp;
279 
  char *id = my_def -> dec_u.dec_val.dec_id;
280 
 
7 7u83 281 
  if (son(tg)!= nilexp && shape_size(sh(son(tg))) == 0 && name(son(tg)) == asm_tag) {
2 7u83 282 
    ash stack;
283 
    stack.ashsize = stack.ashalign = 0;
7 7u83 284 
    if (props(son(tg))!= 0)
285 
      failer("~asm not in ~asm_sequence");
286 
    check_asm_seq(son(son(tg)), 1);
287 
    outs(".text");
288 
    coder(zero, stack, son(tg));
289 
    outnl();
2 7u83 290 
  }
291 
 
7 7u83 292 
  if (son(tg)!= nilexp && (my_def -> dec_u.dec_val.extnamed || no(tg)!= 0)) {
293 
    if (name(son(tg)) == proc_tag || name(son(tg)) == general_proc_tag) {
294 
      if (strncmp("__I.TDF", id+prefix_length, 7) ==0) {
295 
	out_initialiser(id);
2 7u83 296 
	set_proc_uses_external (son (tg));	/* for PIC_code, should be done in install_fns? */
297 
      }
7 7u83 298 
      outs(".text");
299 
      outnl();
2 7u83 300 
      if (isvar(tg)) {
301 
        char * newid = make_local_name();
302 
	if (my_def -> dec_u.dec_val.extnamed) {
303 
	  my_def -> dec_u.dec_val.extnamed = 0;
304 
	  outs(".globl ");
305 
	  outs(id);
306 
	  outnl();
307 
	}
308 
	dot_align(4);
309 
        outs(id);
310 
	outs(":");
311 
	outnl();
312 
	outlong();
313 
	outs(newid);
314 
	outnl();
315 
	id = newid;
316 
	my_def -> dec_u.dec_val.extnamed = 0;
317 
      }
318 
      my_def -> dec_u.dec_val.index =	/* for use in constant evaluation */
7 7u83 319 
	cproc(son(tg), id,(-1), (int)(my_def -> dec_u.dec_val.extnamed),
2 7u83 320 
                my_def -> dec_u.dec_val.diag_info);
321 
      while (const_list != nilexp) {
322 
	/* put in the constants required by the procedure */
323 
	exp t = const_list;
7 7u83 324 
	const_list = bro(const_list);
2 7u83 325 
	eval_if_ready(t,0);
326 
      };
327 
    }
328 
    else {			/* global values */
329 
     diag_global * diag_props = my_def -> dec_u.dec_val.diag_info;
330 
 
331 
      if (shape_size(sh(son(tg))) == 0) {;
332 
	if (my_def -> dec_u.dec_val.extnamed) {
333 
	  outs(".globl ");
334 
	  outs(id);
335 
	  outnl();
336 
	}
337 
	else
338 
	if (issol86) {
339 
	  outs(".local ");
340 
	  outs(id);
341 
	  outnl();
342 
	}
343 
#if islinux || isfreebsd
344 
	outs(".data");
345 
	outnl();
346 
	outs(id);
347 
	outs(":");
348 
	outnl();
349 
#else
350 
	outs(".set ");
351 
	outs(id);
352 
	outs(",");
353 
	outn((long)0);
354 
	outnl();
355 
#endif
356 
      }
357 
      else
358 
      if (!PIC_code && !isvar(tg) && name(son(tg)) == null_tag &&
359 
	  name(sh(son(tg))) == prokhd) {
360 
	if (my_def -> dec_u.dec_val.extnamed) {
361 
	  outs(".globl ");
362 
	  outs(id);
363 
	  outnl();
364 
	}
365 
	else
366 
	if (issol86) {
367 
	  outs(".local ");
368 
	  outs(id);
369 
	  outnl();
370 
	}
371 
	outs(".set ");
372 
	outs(id);
373 
	outs(",");
374 
	outn((long)no(son(tg)));
375 
	outnl();
376 
      }
377 
      else {
378 
      if (!my_def -> dec_u.dec_val.isweak &&
379 
          is_comm(son(tg)))
380 
       {
381 
	 int is_ext = (my_def -> dec_u.dec_val.extnamed);
382 
         if (diag_props)
383 
#ifdef NEWDWARF
7 7u83 384 
           DIAG_VAL_BEGIN(diag_props, is_ext, -1, id);
2 7u83 385 
#else
386 
           diag_val_begin(diag_props, is_ext, -1, id);
387 
#endif
388 
	 if (name(son(tg)) == clear_tag && no(son(tg)) == -1) {
389 
				/* prom global data */
390 
	   if (is_ext) {
391 
	     outs(".globl ");
392 
	     outs(id);
393 
	     outnl();
394 
	   }
395 
           out_bss(id, sh(son(tg)));
396 
#ifdef NEWDWARF
397 
	   if (dwarf2)
7 7u83 398 
	     note_data(id);
2 7u83 399 
#endif
400 
	 }
401 
	 else
402 
	 if (is_ext)
403 
           out_dot_comm(id, sh(son(tg)));
404 
	 else
405 
           out_dot_lcomm(id, sh(son(tg)));
406 
         if (diag_props) {
407 
#ifdef NEWDWARF
7 7u83 408 
           DIAG_VAL_END(diag_props);
2 7u83 409 
#else
410 
           diag_val_end(diag_props);
411 
#endif
412 
	 }
413 
       }
414 
 
415 
      else {			/* global values */
416 
 
7 7u83 417 
	exp t = getexp(f_bottom, nilexp, 0, son(tg), nilexp, props(tg), -1, 0);
2 7u83 418 
	ptg(t) = my_def;
7 7u83 419 
	eval_if_ready(t, 0);
2 7u83 420 
 
421 
      };
422 
     };
423 
    };
424 
  };
425 
 
7 7u83 426 
  if (son(tg)!= nilexp) {
2 7u83 427 
     my_def -> dec_u.dec_val.processed = 1;
428 
  };
429 
  return;
430 
}
431 
 
432 
void mark_unaliased
7 7u83 433 
(exp e)
2 7u83 434 
{
7 7u83 435 
  exp p = pt(e);
2 7u83 436 
  int ca = 1;
437 
  while (p != nilexp && ca) {
438 
#ifdef NEWDIAGS
439 
    if ((bro(p) == nilexp ||
440 
#else
441 
    if (bro(p) == nilexp ||
442 
#endif
7 7u83 443 
       (!(last(p) && name(bro(p)) == cont_tag) &&
444 
	 !(!last(p) && last(bro(p)) &&
445 
                 name(bro(bro(p))) == ass_tag)))
2 7u83 446 
#ifdef NEWDIAGS
447 
	&& !isdiaginfo(p))
448 
#endif
449 
      ca = 0;
7 7u83 450 
    p = pt(p);
2 7u83 451 
  };
452 
  if (ca)
7 7u83 453 
    setcaonly(e);
2 7u83 454 
  return;
455 
}
456 
 
457 
 
458 
void translate_capsule
7 7u83 459 
(void)
2 7u83 460 
{
461 
  dec * my_def;
462 
 
463 
#ifdef STABS
464 
#ifdef NEWDWARF
465 
  if (diagnose && !dwarf2)
466 
#else
467 
  if (diagnose)
468 
#endif
7 7u83 469 
    init_stab_aux();
2 7u83 470 
#endif
471 
 
472 
 
473 
  my_def = top_def;
7 7u83 474 
  while (my_def != (dec *)0) {
2 7u83 475 
    exp crt_exp = my_def -> dec_u.dec_val.dec_exp;
476 
    if (PIC_code) {
477 
      exp idval = son(crt_exp);
478 
      if (!(my_def -> dec_u.dec_val.dec_var) &&
7 7u83 479 
	  (idval == nilexp || (name(idval)!= val_tag && name(idval)!= real_tag &&
2 7u83 480 
		name(idval) != null_tag )	/* optimised out in opt_all_exps/checkext */
7 7u83 481 
	  ) &&
482 
	  (name(sh(crt_exp))!= prokhd ||
483 
		(idval != nilexp && name(idval)!= null_tag &&
484 
		  name(idval)!= proc_tag && name(idval)!= general_proc_tag)
485 
	  ))
2 7u83 486 
      {
487 
		/* make variable, and change all uses to contents */
488 
	exp p = pt(crt_exp);
489 
	if (my_def -> dec_u.dec_val.extnamed)
490 
	  sh(crt_exp) = f_pointer(f_alignment(sh(crt_exp)));
491 
	else
492 
	  setvar(crt_exp);
493 
	while (p != nilexp) {
494 
	  exp np = pt(p);
7 7u83 495 
	  exp* ptr = refto(father(p), p);
496 
	  exp c = getexp(sh(p), bro(p), last(p), p, nilexp, 0, 0, cont_tag);
497 
	  setfather(c, p);
498 
	  if (no(p)!= 0) {
499 
	    exp r = getexp(sh(p), c, 1, p, nilexp, 0, no(p), reff_tag);
2 7u83 500 
	    no(p) = 0;
501 
	    son(c) = r;
7 7u83 502 
	    setfather(r, p);
2 7u83 503 
	  }
504 
	  *ptr = c;
505 
	  p = np;
506 
	}
507 
      }
508 
    }
509 
    else {	/* !PIC_code; make indirect global idents direct */
510 
      exp tg = crt_exp;
7 7u83 511 
      while (!isvar(tg) && son(tg)!= nilexp && name(son(tg)) == name_tag && no(son(tg)) == 0)
2 7u83 512 
	tg = son(son(tg));
513 
      if (tg != crt_exp) {
514 
	exp p = pt(crt_exp);
515 
	while (p != nilexp) {
516 
	  exp np = pt(p);
7 7u83 517 
	  if (son(p)!= crt_exp)
518 
	    failer("not simple name");
2 7u83 519 
	  son(p) = tg;
520 
	  pt(p) = pt(tg);
521 
	  pt(tg) = p;
522 
	  ++no(tg);
523 
	  p = np;
524 
	}
525 
	pt(crt_exp) = nilexp;
526 
	no(crt_exp) = 0;
527 
      }
528 
    };
529 
    my_def = my_def -> def_next;
530 
  }
531 
 
7 7u83 532 
  opt_all_exps();
2 7u83 533 
 
7 7u83 534 
  transform_var_callees();
2 7u83 535 
 
536 
      /* mark static unaliased */
537 
    my_def = top_def;
7 7u83 538 
    while (my_def != (dec *)0) {
2 7u83 539 
      exp crt_exp = my_def -> dec_u.dec_val.dec_exp;
7 7u83 540 
      if (son(crt_exp)!= nilexp &&
2 7u83 541 
	  !my_def -> dec_u.dec_val.extnamed &&
7 7u83 542 
   	  isvar(crt_exp))
543 
        mark_unaliased(crt_exp);
2 7u83 544 
      my_def = my_def -> def_next;
545 
    };
546 
 
547 
  /* compile procedures, evaluate constants, put in the .comm entries for
548 
     undefined objects */
549 
 
550 
#ifdef NEWDWARF
551 
  if (dwarf2) {
7 7u83 552 
    outs(".text\n");
553 
    dwarf2_prelude();
2 7u83 554 
  }
555 
#endif
556 
 
557 
  my_def = top_def;
558 
 
7 7u83 559 
  while (my_def != (dec *)0) {
2 7u83 560 
    if (!my_def -> dec_u.dec_val.processed)
7 7u83 561 
       make_code(my_def);
2 7u83 562 
    my_def = my_def -> def_next;
563 
  };
564 
 
565 
  while (delayed_const_list != nilexp) {
566 
    exp t = delayed_const_list;
7 7u83 567 
    delayed_const_list = bro(delayed_const_list);
2 7u83 568 
    eval_if_ready(t,1);
569 
  }
570 
 
7 7u83 571 
  outs(".text\n");
2 7u83 572 
#ifdef NEWDWARF
573 
  if (dwarf2) {
7 7u83 574 
    dwarf2_postlude();
2 7u83 575 
  }
576 
#endif
577 
  return;
578 
 
579 
}
580 
 
581 
void translate_tagdef
7 7u83 582 
(void)
2 7u83 583 
{
584 
  return;
585 
}
586 
 
587 
void translate_unit
7 7u83 588 
(void)
2 7u83 589 
{
590 
  return;
591 
}
592