Subversion Repositories tendra.SVN

Rev

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

Rev Author Line No. Line
2 7u83 1 
/*
6 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
6 7u83 33 
 
2 7u83 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:-
6 7u83 42 
 
2 7u83 43 
        (1) Its Recipients shall ensure that this Notice is
44 
        reproduced upon any copies or amended versions of it;
6 7u83 45 
 
2 7u83 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;
6 7u83 49 
 
2 7u83 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;
6 7u83 53 
 
2 7u83 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 
#include "config.h"
62 
#include "extern_adds.h"
63 
#include "common_types.h"
64 
#include "tags.h"
65 
#include "exp.h"
66 
#include "expmacs.h"
67 
#include "shapemacs.h"
68 
#include "externs.h"
69 
 
70 
 
6 7u83 71 
extern exp * ptr_position(exp e);
2 7u83 72 
 
73 
/* replaces uses of extern in procs by local identification of address;
74 
 
75 
   initially replace usage chain by
76 
     name:0; pt: usage chain in proc P; son: P; props: !=0 if in loop
77 
	no: no of usages in proc; bro: last in usage chain;
78 
    in usages[no of procs]
6 7u83 79 
    Use this to determine if and where to identify global to a proc local
2 7u83 80 
 
81 
*/
82 
 
83 
exp * usages;
84 
 
85 
static bool enter_parents
6 7u83 86 
(exp e)
2 7u83 87 
{
88 
  exp dad =e;
89 
  bool inloop = 0;
6 7u83 90 
  Assert(name(e) ==name_tag);
91 
  for (;;) {
2 7u83 92 
    dad = father(dad);
6 7u83 93 
    if (name(dad) ==rep_tag) {
2 7u83 94 
      inloop=1;
95 
    }
6 7u83 96 
    else if (name(dad) ==proc_tag) {
2 7u83 97 
      exp nu = usages[no(dad)];
98 
      if (nu == nilexp) {
99 
	nu = getexp(sh(e), e, 1, dad, nilexp, 0,0, 0);
100 
	usages[no(dad)] = nu;
101 
      }
102 
      props(nu) |= inloop;
6 7u83 103 
      pt(e) = pt(nu);
2 7u83 104 
				/* remember pt(e) before entry */
105 
      pt(nu) = e;
6 7u83 106 
      no(nu) ++;
2 7u83 107 
      return 1;
108 
    }
6 7u83 109 
    else if (name(dad) == ident_tag && isglob(dad)) {
2 7u83 110 
      return 0;
111 
    }
112 
    else if (name(dad) == 102 || name(dad) == hold_tag) {
113 
      /* thou shalt use descriptive names for constants (102 ?) */
114 
 
115 
      /* could be leftover from exp token expansion with no pars */
116 
      return 0;
117 
    }
118 
  }
119 
}
120 
 
121 
 
122 
 
123 
void global_usages
6 7u83 124 
(exp id, int nop)
2 7u83 125 
{
126 
  exp plist, nextpl;
127 
  int i;
6 7u83 128 
  Assert(name(id) ==ident_tag && isglob(id) && son(id) ==nilexp);
129 
  if (no(id) ==0) return;
130 
  for (i=0; i<nop; i++) {
2 7u83 131 
    usages[i] = nilexp;
132 
  }
133 
  plist = pt(id);
134 
  nextpl = pt(plist);
135 
  pt(id) = nilexp;
136 
  no(id) = 0;
6 7u83 137 
  for (;;) {
2 7u83 138 
    if (!enter_parents(plist)) {
139 
      pt(plist) = pt(id);
140 
      pt(id) = plist;
6 7u83 141 
      no(id) ++;
2 7u83 142 
    }
6 7u83 143 
    if ((plist = nextpl) == nilexp)break;
2 7u83 144 
    nextpl = pt(plist);
145 
  }
6 7u83 146 
  for (i=0; i<nop; i++) {
2 7u83 147 
    exp ui = usages[i];
148 
    if (ui != nilexp) {
6 7u83 149 
      if (props(ui)!= 0 ) {
150 
	/* id is used enough in proc i -
151 
	   so identify it locally */
2 7u83 152 
	exp * pi;
153 
	shape sname = f_pointer(f_alignment(sh(id)));
6 7u83 154 
	for (pi= &son(son(ui));;) {
155 
	  if (name(*pi) == ident_tag && isparam(*pi)) {
2 7u83 156 
	    pi = &bro(son(*pi));
157 
	  }
158 
	  else if (name(*pi) == diagnose_tag || name(*pi) == prof_tag) {
159 
	    pi = &son(*pi);
6 7u83 160 
	  }
2 7u83 161 
	  else {
6 7u83 162 
	    /* invent new def to identify global ... */
2 7u83 163 
	    exp nl = getexp(sname,
164 
			    *pi, 0, id, pt(id), 0, 0, name_tag);
165 
	    exp ndef = getexp(sh(*pi), bro(*pi),last(*pi),
6 7u83 166 
			      nl, nilexp, 0x10/*don't defer */,
2 7u83 167 
			      0, ident_tag);
168 
	    exp lu = pt(ui);
169 
	    setlast(*pi); bro(*pi) = ndef;
6 7u83 170 
	    pt(id) = nl; no(id) ++;
2 7u83 171 
	    setcaonly(ndef);
172 
	    *pi = ndef;
173 
	    /*... and replace uses of global by ndef */
6 7u83 174 
	    while (lu != nilexp) {
2 7u83 175 
	      exp nlu = pt(lu);
176 
	      if (no(lu)!=0) {
177 
		exp * plu = ptr_position(lu);
178 
		exp nrf = getexp(sh(lu), bro(lu), last(lu),
179 
				 lu, nilexp, 0, no(lu), reff_tag);
180 
		sh(lu) = sname;
181 
		no(lu) = 0;
182 
		bro(lu) = nrf; setlast(lu);
183 
		*plu = nrf;
184 
	      }
185 
	      son(lu) = ndef;
186 
	      pt(lu) = pt(ndef);
6 7u83 187 
	      pt(ndef) = lu; no(ndef) ++;
2 7u83 188 
	      lu = nlu;
189 
	    }
190 
	    break;
191 
	  }
192 
	}
193 
      }
194 
      else {
195 
	/* restore normal usage chain */
196 
	pt(bro(ui)) = pt(id);
197 
	pt(id) = pt(ui);
6 7u83 198 
	no(id) += no(ui);
2 7u83 199 
      }
200 
      retcell(ui);
201 
    }
202 
  }
6 7u83 203 
}
2 7u83 204 
 
205 
 
6 7u83 206 
 
207