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
6
    acting through the Defence Evaluation and Research Agency
36
    acting through the Defence Evaluation and Research Agency
7
    (DERA).  It is made available to Recipients with a
37
    (DERA).  It is made available to Recipients with a
8
    royalty-free licence for its use, reproduction, transfer
38
    royalty-free licence for its use, reproduction, transfer
9
    to other parties and amendment for any purpose not excluding
39
    to other parties and amendment for any purpose not excluding
10
    product development provided that any such use et cetera
40
    product development provided that any such use et cetera
11
    shall be deemed to be acceptance of the following conditions:-
41
    shall be deemed to be acceptance of the following conditions:-
12
    
42
 
13
        (1) Its Recipients shall ensure that this Notice is
43
        (1) Its Recipients shall ensure that this Notice is
14
        reproduced upon any copies or amended versions of it;
44
        reproduced upon any copies or amended versions of it;
15
    
45
 
16
        (2) Any amended version of it shall be clearly marked to
46
        (2) Any amended version of it shall be clearly marked to
17
        show both the nature of and the organisation responsible
47
        show both the nature of and the organisation responsible
18
        for the relevant amendment or amendments;
48
        for the relevant amendment or amendments;
19
    
49
 
20
        (3) Its onward transfer from a recipient to another
50
        (3) Its onward transfer from a recipient to another
21
        party shall be deemed to be that party's acceptance of
51
        party shall be deemed to be that party's acceptance of
22
        these conditions;
52
        these conditions;
23
    
53
 
24
        (4) DERA gives no warranty or assurance as to its
54
        (4) DERA gives no warranty or assurance as to its
25
        quality or suitability for any purpose and DERA accepts
55
        quality or suitability for any purpose and DERA accepts
26
        no liability whatsoever in relation to any use to which
56
        no liability whatsoever in relation to any use to which
27
        it may be put.
57
        it may be put.
28
*/
58
*/
Line 34... Line 64...
34
#include "tags.h"
64
#include "tags.h"
35
#include "exp.h"
65
#include "exp.h"
36
#include "expmacs.h"
66
#include "expmacs.h"
37
#include "shapemacs.h"
67
#include "shapemacs.h"
38
#include "externs.h"
68
#include "externs.h"
39
 
69
 
40
 
70
 
41
extern exp * ptr_position PROTO_S ((exp e));
71
extern exp * ptr_position(exp e);
42
 
72
 
43
/* replaces uses of extern in procs by local identification of address;
73
/* replaces uses of extern in procs by local identification of address;
44
 
74
 
45
   initially replace usage chain by
75
   initially replace usage chain by
46
     name:0; pt: usage chain in proc P; son: P; props: !=0 if in loop
76
     name:0; pt: usage chain in proc P; son: P; props: !=0 if in loop
47
	no: no of usages in proc; bro: last in usage chain;
77
	no: no of usages in proc; bro: last in usage chain;
48
    in usages[no of procs]
78
    in usages[no of procs]
49
    Use this to determine if and where to identify global to a proc local	
79
    Use this to determine if and where to identify global to a proc local
50
 
80
 
51
*/
81
*/
52
 
82
 
53
exp * usages;
83
exp * usages;
54
 
84
 
55
static bool enter_parents
85
static bool enter_parents
56
    PROTO_N ( ( e ) )
-
 
57
    PROTO_T ( exp e )
86
(exp e)
58
{
87
{
59
  exp dad =e;
88
  exp dad =e;
60
  bool inloop = 0;
89
  bool inloop = 0;
61
  Assert(name(e)==name_tag);
90
  Assert(name(e) ==name_tag);
62
  for(;;) {
91
  for (;;) {
63
    dad = father(dad);
92
    dad = father(dad);
64
    if (name(dad)==rep_tag) {
93
    if (name(dad) ==rep_tag) {
65
      inloop=1;
94
      inloop=1;
66
    }
95
    }
67
    else if (name(dad)==proc_tag) {
96
    else if (name(dad) ==proc_tag) {
68
      exp nu = usages[no(dad)];
97
      exp nu = usages[no(dad)];
69
      if (nu == nilexp) {
98
      if (nu == nilexp) {
70
	nu = getexp(sh(e), e, 1, dad, nilexp, 0,0, 0);
99
	nu = getexp(sh(e), e, 1, dad, nilexp, 0,0, 0);
71
	usages[no(dad)] = nu;
100
	usages[no(dad)] = nu;
72
      }
101
      }
73
      props(nu) |= inloop;
102
      props(nu) |= inloop;
74
      pt(e) = pt(nu); 
103
      pt(e) = pt(nu);
75
				/* remember pt(e) before entry */
104
				/* remember pt(e) before entry */
76
      pt(nu) = e;
105
      pt(nu) = e;
77
      no(nu)++;
106
      no(nu) ++;
78
      return 1;
107
      return 1;
79
    }
108
    }
80
    else if (name(dad)== ident_tag && isglob(dad)) {
109
    else if (name(dad) == ident_tag && isglob(dad)) {
81
      return 0;
110
      return 0;
82
    }
111
    }
83
    else if (name(dad) == 102 || name(dad) == hold_tag) {
112
    else if (name(dad) == 102 || name(dad) == hold_tag) {
84
      /* thou shalt use descriptive names for constants (102 ?) */
113
      /* thou shalt use descriptive names for constants (102 ?) */
85
 
114
 
Line 90... Line 119...
90
}
119
}
91
 
120
 
92
 
121
 
93
 
122
 
94
void global_usages
123
void global_usages
95
    PROTO_N ( ( id, nop ) )
-
 
96
    PROTO_T ( exp id X int nop )
124
(exp id, int nop)
97
{
125
{
98
  exp plist, nextpl;
126
  exp plist, nextpl;
99
  int i;
127
  int i;
100
  Assert(name(id)==ident_tag && isglob(id) && son(id)==nilexp);
128
  Assert(name(id) ==ident_tag && isglob(id) && son(id) ==nilexp);
101
  if (no(id)==0) return;
129
  if (no(id) ==0) return;
102
  for(i=0; i<nop; i++) {
130
  for (i=0; i<nop; i++) {
103
    usages[i] = nilexp;
131
    usages[i] = nilexp;
104
  }
132
  }
105
  plist = pt(id);
133
  plist = pt(id);
106
  nextpl = pt(plist);
134
  nextpl = pt(plist);
107
  pt(id) = nilexp;
135
  pt(id) = nilexp;
108
  no(id) = 0;
136
  no(id) = 0;
109
  for(;;) {
137
  for (;;) {
110
    if (!enter_parents(plist)) {
138
    if (!enter_parents(plist)) {
111
      pt(plist) = pt(id);
139
      pt(plist) = pt(id);
112
      pt(id) = plist;
140
      pt(id) = plist;
113
      no(id)++;
141
      no(id) ++;
114
    }
142
    }
115
    if ((plist = nextpl) == nilexp) break;
143
    if ((plist = nextpl) == nilexp)break;
116
    nextpl = pt(plist);
144
    nextpl = pt(plist);
117
  }
145
  }
118
  for(i=0; i<nop; i++) {
146
  for (i=0; i<nop; i++) {
119
    exp ui = usages[i];
147
    exp ui = usages[i];
120
    if (ui != nilexp) {
148
    if (ui != nilexp) {
121
      if (props(ui) != 0  ) {
149
      if (props(ui)!= 0 ) {
122
	/* id is used enough in proc i - 
150
	/* id is used enough in proc i -
123
	   so identify it locally */		
151
	   so identify it locally */
124
	exp * pi;
152
	exp * pi;
125
	shape sname = f_pointer(f_alignment(sh(id)));
153
	shape sname = f_pointer(f_alignment(sh(id)));
126
	for(pi= &son(son(ui));;) {
154
	for (pi= &son(son(ui));;) {
127
	  if (name(*pi)== ident_tag && isparam(*pi)) {
155
	  if (name(*pi) == ident_tag && isparam(*pi)) {
128
	    pi = &bro(son(*pi));
156
	    pi = &bro(son(*pi));
129
	  }
157
	  }
130
	  else if (name(*pi) == diagnose_tag || name(*pi) == prof_tag) {
158
	  else if (name(*pi) == diagnose_tag || name(*pi) == prof_tag) {
131
	    pi = &son(*pi);
159
	    pi = &son(*pi);
132
	  }	
160
	  }
133
	  else {
161
	  else {
134
	    /* invent new def to identify global ... */	
162
	    /* invent new def to identify global ... */
135
	    exp nl = getexp(sname,
163
	    exp nl = getexp(sname,
136
			    *pi, 0, id, pt(id), 0, 0, name_tag);
164
			    *pi, 0, id, pt(id), 0, 0, name_tag);
137
	    exp ndef = getexp(sh(*pi), bro(*pi),last(*pi),
165
	    exp ndef = getexp(sh(*pi), bro(*pi),last(*pi),
138
			      nl, nilexp, 0x10/*don't defer */, 
166
			      nl, nilexp, 0x10/*don't defer */,
139
			      0, ident_tag);
167
			      0, ident_tag);
140
	    exp lu = pt(ui);
168
	    exp lu = pt(ui);
141
	    setlast(*pi); bro(*pi) = ndef;
169
	    setlast(*pi); bro(*pi) = ndef;
142
	    pt(id) = nl; no(id)++;
170
	    pt(id) = nl; no(id) ++;
143
	    setcaonly(ndef);
171
	    setcaonly(ndef);
144
	    *pi = ndef;
172
	    *pi = ndef;
145
	    /*... and replace uses of global by ndef */
173
	    /*... and replace uses of global by ndef */
146
	    while(lu != nilexp) {
174
	    while (lu != nilexp) {
147
	      exp nlu = pt(lu);
175
	      exp nlu = pt(lu);
148
	      if (no(lu)!=0) {
176
	      if (no(lu)!=0) {
149
		exp * plu = ptr_position(lu);
177
		exp * plu = ptr_position(lu);
150
		exp nrf = getexp(sh(lu), bro(lu), last(lu),
178
		exp nrf = getexp(sh(lu), bro(lu), last(lu),
151
				 lu, nilexp, 0, no(lu), reff_tag);
179
				 lu, nilexp, 0, no(lu), reff_tag);
Line 154... Line 182...
154
		bro(lu) = nrf; setlast(lu);
182
		bro(lu) = nrf; setlast(lu);
155
		*plu = nrf;
183
		*plu = nrf;
156
	      }
184
	      }
157
	      son(lu) = ndef;
185
	      son(lu) = ndef;
158
	      pt(lu) = pt(ndef);
186
	      pt(lu) = pt(ndef);
159
	      pt(ndef)= lu; no(ndef)++;				
187
	      pt(ndef) = lu; no(ndef) ++;
160
	      lu = nlu;
188
	      lu = nlu;
161
	    }
189
	    }
162
	    break;
190
	    break;
163
	  }
191
	  }
164
	}
192
	}
165
      }
193
      }
166
      else {
194
      else {
167
	/* restore normal usage chain */
195
	/* restore normal usage chain */
168
	pt(bro(ui)) = pt(id);
196
	pt(bro(ui)) = pt(id);
169
	pt(id) = pt(ui);
197
	pt(id) = pt(ui);
170
	no(id)+= no(ui);
198
	no(id) += no(ui);
171
      }
199
      }
172
      retcell(ui);
200
      retcell(ui);
173
    }
201
    }
174
  }
202
  }
175
}		
203
}
176
					
204
 
177
				 
205
 
178
 
206
 
179
 
207