Subversion Repositories tendra.SVN

Rev

Rev 2 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 2 Rev 7
Line -... Line 1...
- 
 
 1 
/*
- 
 
 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 
 */
1 
/*
 31 
/*
2 
    		 Crown Copyright (c) 1997
 32 
    		 Crown Copyright (c) 1997
3 
 
 33 
 
4 
    This TenDRA(r) Computer Program is subject to Copyright
 34 
    This TenDRA(r) Computer Program is subject to Copyright
5 
    owned by the United Kingdom Secretary of State for Defence
 35 
    owned by the United Kingdom Secretary of State for Defence
Line 66... Line 96...
66 
#include "exp.h"
 96 
#include "exp.h"
67 
#include "tv_callees.h"
 97 
#include "tv_callees.h"
68 
 
 98 
 
69 
 
 99 
 
70 
void transform_var_callees
 100 
void transform_var_callees
71 
    PROTO_Z ()
 101 
(void)
72 
				/* Transforms caller arguments of general
 102 
				/* Transforms caller arguments of general
73 
				   procs with variable callees, to appear
 103 
				   procs with variable callees, to appear
74 
				   like a structure whose address is
 104 
				   like a structure whose address is
75 
				   another callee. This enables consistent
 105 
				   another callee. This enables consistent
76 
				   coding without demanding a separate
 106 
				   coding without demanding a separate
77 
				   register for caller argument addressing.
 107 
				   register for caller argument addressing.
78 
					Also, record need for env_size.
 108 
					Also, record need for env_size.
79 
				*/
 109 
				*/
80 
{
 110 
{
81 
  dec * my_def = top_def;
 111 
  dec * my_def = top_def;
82 
  while (my_def != (dec *) 0) {
 112 
  while (my_def != (dec *)0) {
83 
    exp tg = my_def -> dec_u.dec_val.dec_exp;
 113 
    exp tg = my_def -> dec_u.dec_val.dec_exp;
84 
    if (son(tg) != nilexp && name(son(tg)) == general_proc_tag
 114 
    if (son(tg)!= nilexp && name(son(tg)) == general_proc_tag
85 
		&& proc_has_vcallees(son(tg))) {
 115 
		&& proc_has_vcallees(son(tg))) {
86 
      shape pc_sh = f_pointer(f_callers_alignment(0));
 116 
      shape pc_sh = f_pointer(f_callers_alignment(0));
87 
      int param_offset = 0;
 117 
      int param_offset = 0;
88 
      exp gp_body = son(son(tg));
 118 
      exp gp_body = son(son(tg));
89 
      exp newdec = getexp (sh(gp_body), nilexp, 1, nilexp, nilexp, 0, 0, ident_tag);
 119 
      exp newdec = getexp(sh(gp_body), nilexp, 1, nilexp, nilexp, 0, 0, ident_tag);
90 
      exp newlist = nilexp;
 120 
      exp newlist = nilexp;
91 
      son(newdec) = getexp (pc_sh, nilexp, 0, nilexp, nilexp, 0, 0, formal_callee_tag);
 121 
      son(newdec) = getexp(pc_sh, nilexp, 0, nilexp, nilexp, 0, 0, formal_callee_tag);
92 
 
 122 
 
93 
      while (name(gp_body) == ident_tag && isparam(gp_body)
 123 
      while (name(gp_body) == ident_tag && isparam(gp_body)
94 
		&& name(son(gp_body)) != formal_callee_tag) {
 124 
		&& name(son(gp_body))!= formal_callee_tag) {
95 
	exp arg_id = gp_body;
 125 
	exp arg_id = gp_body;
96 
	exp oldlist = pt(arg_id);
 126 
	exp oldlist = pt(arg_id);
97 
	gp_body = bro(son(gp_body));
 127 
	gp_body = bro(son(gp_body));
98 
	while (oldlist != nilexp) {
 128 
	while (oldlist != nilexp) {
99 
	  exp this_n = oldlist;
 129 
	  exp this_n = oldlist;
100 
	  exp new_n = getexp (pc_sh, this_n, 1, newdec, newlist, 0, 0, name_tag);
 130 
	  exp new_n = getexp(pc_sh, this_n, 1, newdec, newlist, 0, 0, name_tag);
101 
	  oldlist = pt(oldlist);
 131 
	  oldlist = pt(oldlist);
102 
	  newlist = new_n;
 132 
	  newlist = new_n;
103 
	  no(newdec) ++;
 133 
	  no(newdec) ++;
104 
	  if (isvar(arg_id)) {
 134 
	  if (isvar(arg_id)) {
105 
	    name(this_n) = reff_tag;
 135 
	    name(this_n) = reff_tag;
106 
	    son(this_n) = new_n;
 136 
	    son(this_n) = new_n;
107 
	    no(this_n) += param_offset;
 137 
	    no(this_n) += param_offset;
108 
	  }
 138 
	  }
109 
	  else {
 139 
	  else {
110 
	    exp r = getexp (f_pointer(f_alignment(sh(son(arg_id)))),
 140 
	    exp r = getexp(f_pointer(f_alignment(sh(son(arg_id)))),
111 
		 this_n, 1, new_n, nilexp, 0, no(this_n)+param_offset, reff_tag);
 141 
		 this_n, 1, new_n, nilexp, 0, no(this_n) +param_offset, reff_tag);
112 
	    bro(new_n) = r;
 142 
	    bro(new_n) = r;
113 
	    name(this_n) = cont_tag;
 143 
	    name(this_n) = cont_tag;
114 
	    son(this_n) = r;
 144 
	    son(this_n) = r;
115 
	  }
 145 
	  }
116 
	  pt(this_n) = nilexp;
 146 
	  pt(this_n) = nilexp;
Line 126... Line 156...
126 
	retcell(son(arg_id));
 156 
	retcell(son(arg_id));
127 
	son(arg_id) = nilexp;
 157 
	son(arg_id) = nilexp;
128 
      }
 158 
      }
129 
      {
 159 
      {
130 
	setparam (newdec);	/* not var */
 160 
	setparam (newdec);	/* not var */
131 
	setcaonly (newdec);
 161 
	setcaonly(newdec);
132 
	bro(son(newdec)) = gp_body;
 162 
	bro(son(newdec)) = gp_body;
133 
	setfather(newdec, gp_body);
 163 
	setfather(newdec, gp_body);
134 
	gp_body = newdec;
 164 
	gp_body = newdec;
135 
      }
 165 
      }
136 
      son(son(tg)) = gp_body;
 166 
      son(son(tg)) = gp_body;
137 
      setfather(son(tg),gp_body);
 167 
      setfather(son(tg),gp_body);
138 
    }
 168 
    }
139 
 
 169 
 
140 
    if (son(tg) != nilexp &&
 170 
    if (son(tg)!= nilexp &&
141 
	(name(son(tg)) == proc_tag || name(son(tg)) == general_proc_tag)) {
 171 
	(name(son(tg)) == proc_tag || name(son(tg)) == general_proc_tag)) {
142 
      exp nlist = pt(tg);
 172 
      exp nlist = pt(tg);
143 
      while (nlist != nilexp) {
 173 
      while (nlist != nilexp) {
144 
	if (name(nlist) == name_tag && last(nlist) && bro(nlist) != nilexp &&
 174 
	if (name(nlist) == name_tag && last(nlist) && bro(nlist)!= nilexp &&
145 
		name(bro(nlist)) == env_size_tag)
 175 
		name(bro(nlist)) == env_size_tag)
146 
	  set_proc_needs_envsize(son(tg));
 176 
	  set_proc_needs_envsize(son(tg));
147 
	nlist = pt(nlist);
 177 
	nlist = pt(nlist);
148 
      }
 178 
      }
149 
    }
 179 
    }