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 63... Line 93...
63
 * Revision 1.1  1995/04/06  10:42:55  currie
93
 * Revision 1.1  1995/04/06  10:42:55  currie
64
 * Initial revision
94
 * Initial revision
65
 *
95
 *
66
***********************************************************************/
96
***********************************************************************/
67
 
97
 
68
 
98
 
69
#include "config.h"
99
#include "config.h"
70
#include "common_types.h"
100
#include "common_types.h"
71
#include "readglob.h"
101
#include "readglob.h"
72
#include "table_fns.h"
102
#include "table_fns.h"
73
#include "basicread.h"
103
#include "basicread.h"
Line 79... Line 109...
79
#include "tags.h"
109
#include "tags.h"
80
#include "externs.h"
110
#include "externs.h"
81
#include "dg_aux.h"
111
#include "dg_aux.h"
82
#include "mark_scope.h"
112
#include "mark_scope.h"
83
#endif
113
#endif
84
 
114
 
85
#include "main_reads.h"
115
#include "main_reads.h"
86
#include "check.h"
116
#include "check.h"
87
#include "dg_fns.h"
117
#include "dg_fns.h"
88
#include "diag_fns.h"
118
#include "diag_fns.h"
89
 
119
 
90
 
120
 
91
/* PROCEDURES */
121
/* PROCEDURES */
92
 
122
 
93
 
123
 
94
#ifdef NEWDIAGS
124
#ifdef NEWDIAGS
95
 
125
 
96
 
126
 
97
exp diag_locate
127
exp
98
    PROTO_N ( (e) )
-
 
99
    PROTO_T ( exp e )
128
diag_locate(exp e)
100
{
129
{
101
  /* need contents for var locations, old diags */
130
	/* need contents for var locations, old diags */
102
  exp id = son(e);
131
	exp id = son(e);
103
  if (isglob (id)) {
132
	if (isglob(id)) {
104
    if (brog(id)->dec_u.dec_val.dec_var)
133
		if (brog(id)->dec_u.dec_val.dec_var) {
105
      e = f_contents (brog(id)->dec_u.dec_val.dec_shape, e);
134
			e = f_contents(brog(id)->dec_u.dec_val.dec_shape, e);
106
  }
135
		}
107
  else {
136
	} else {
108
    if (isvar (id))
137
		if (isvar(id)) {
109
      e = f_contents (sh(son(id)), e);
138
			e = f_contents(sh(son(id)), e);
110
  }
139
		}
-
 
140
	}
111
  return e;
141
	return e;
112
}
142
}
113
 
143
 
114
 
144
 
115
 
145
exp
116
exp read_exp_to_source
146
read_exp_to_source(exp body)
117
    PROTO_N ( (body) )
-
 
118
    PROTO_T ( exp body )
-
 
119
{
147
{
120
  dg_sourcepos s1, s2;
148
	dg_sourcepos s1, s2;
121
  int was_within_diags = within_diags;
149
	int was_within_diags = within_diags;
122
  within_diags = 1;
150
	within_diags = 1;
123
  s1 = d_sourcemark();
151
	s1 = d_sourcemark();
124
  s2 = d_sourcemark();
152
	s2 = d_sourcemark();
125
  within_diags = was_within_diags;
153
	within_diags = was_within_diags;
126
  if (s1.file == s2.file) {
154
	if (s1.file == s2.file) {
127
    s2.sp_key = SP_SPAN;
155
		s2.sp_key = SP_SPAN;
128
    s2.to_file = s2.file;
156
		s2.to_file = s2.file;
129
    s2.to_line = s2.from_line;
157
		s2.to_line = s2.from_line;
130
    s2.to_column = s2.from_column;
158
		s2.to_column = s2.from_column;
131
    s2.from_line = s1.from_line;
159
		s2.from_line = s1.from_line;
132
    s2.from_column = s1.from_column;
160
		s2.from_column = s1.from_column;
133
  }
161
	}
134
  if (name(body) == proc_tag || name(body) == general_proc_tag)
162
	if (name(body) == proc_tag || name(body) == general_proc_tag) {
135
    return body;
163
		return body;
-
 
164
	}
136
  body = f_dg_exp (body, f_singlestep_dg (s1));
165
	body = f_dg_exp(body, f_singlestep_dg(s1));
137
  body = f_dg_exp (body, f_sourcepos_dg (s2));
166
	body = f_dg_exp(body, f_sourcepos_dg(s2));
-
 
167
	return body;
-
 
168
}
-
 
169
 
-
 
170
 
-
 
171
exp
-
 
172
read_diag_id_scope(exp body)
-
 
173
{
-
 
174
	dg_idname nam;
-
 
175
	exp acc;
-
 
176
	dg_type typ;
-
 
177
	dg_name dgn;
-
 
178
	int was_within_diags = within_diags;
-
 
179
	within_diags = 1;
-
 
180
	nam = f_dg_sourcestring_idname(d_tdfstring());
-
 
181
	acc = hold_check(d_exp());
-
 
182
	typ = d_diag_type();
-
 
183
	within_diags = was_within_diags;
-
 
184
	dgn = f_dg_object_name(nam, f_dg_null_sourcepos, typ,
-
 
185
			       yes_exp_option(diag_locate(acc)),
-
 
186
			       no_dg_accessibility_option);
-
 
187
 
-
 
188
	if (isparam(son(acc)) ||
-
 
189
	    (son(son(acc)) != nilexp && name(son(son(acc))) == chvar_tag &&
-
 
190
	     shape_size(sh(son(son(acc)))) < 32 &&
-
 
191
	     name(son(son(son(acc)))) == cont_tag &&
-
 
192
	     name(son(son(son(son(acc))))) == name_tag &&
-
 
193
	     isparam(son(son(son(son(son(acc)))))))) {
-
 
194
		dg_info x = dgf(body);
-
 
195
		if (x && x->key == DGA_PARAMS) {
-
 
196
			dgn->next = x->data.i_param.args;
-
 
197
			x->data.i_param.args = dgn;
-
 
198
		} else {
-
 
199
			body = f_dg_exp(body, f_params_dg(dgn, no_exp_option));
-
 
200
		}
-
 
201
	} else {
-
 
202
		body = f_dg_exp(body, f_name_decl_dg(dgn));
-
 
203
		mark_scope(body);
-
 
204
	}
-
 
205
	return(body);
-
 
206
}
-
 
207
 
-
 
208
 
-
 
209
exp
-
 
210
read_diag_type_scope(exp body)
-
 
211
{
-
 
212
	dg_idname nam;
-
 
213
	dg_type typ;
-
 
214
	dg_name dgn;
-
 
215
	int was_within_diags = within_diags;
-
 
216
	within_diags = 1;
-
 
217
	nam = f_dg_sourcestring_idname(d_tdfstring());
-
 
218
	typ = d_diag_type();
-
 
219
	within_diags = was_within_diags;
-
 
220
	dgn = f_dg_type_name(nam, f_dg_null_sourcepos,
-
 
221
			     no_dg_accessibility_option, typ, f_false,
-
 
222
			     no_bool_option, no_dg_constraint_list_option);
-
 
223
	body = f_dg_exp(body, f_name_decl_dg(dgn));
-
 
224
	mark_scope2(body);
138
  return body;
225
	return body;
-
 
226
}
-
 
227
 
-
 
228
 
-
 
229
#else
-
 
230
 
-
 
231
diag_info *
-
 
232
read_exp_to_source(void)
-
 
233
{
-
 
234
	diag_info *new = (diag_info *)xcalloc(1, sizeof(diag_info));
-
 
235
 
-
 
236
	new->key = DIAG_INFO_SOURCE;
-
 
237
	new->data.source.beg = d_sourcemark();
-
 
238
	new->data.source.end = d_sourcemark();
-
 
239
 
-
 
240
	return new;
-
 
241
}
-
 
242
 
-
 
243
 
-
 
244
diag_info *
-
 
245
read_diag_id_scope(void)
-
 
246
{
-
 
247
	diag_info *new = (diag_info *)xcalloc(1, sizeof(diag_info));
-
 
248
 
-
 
249
	new->key = DIAG_INFO_ID;
-
 
250
	new->data.id_scope.nme = d_tdfstring();
-
 
251
	new->data.id_scope.access = hold_check(d_exp());
-
 
252
	IGNORE hold(hold(new->data.id_scope.access));
-
 
253
	new->data.id_scope.typ = d_diag_type();
-
 
254
	return(new);
139
}
255
}
140
 
256
 
141
 
257
 
142
exp read_diag_id_scope
258
diag_info *
143
    PROTO_N ( (body) )
-
 
144
    PROTO_T ( exp body )
259
read_diag_type_scope(void)
145
{
260
{
146
  dg_idname nam;
-
 
147
  exp acc;
-
 
148
  dg_type typ;
-
 
149
  dg_name dgn;
-
 
150
  int was_within_diags = within_diags;
-
 
151
  within_diags = 1;
-
 
152
  nam = f_dg_sourcestring_idname (d_tdfstring());
261
	diag_info *new = (diag_info *)xcalloc(1, sizeof(diag_info));
153
  acc = hold_check (d_exp());
-
 
154
  typ = d_diag_type();
-
 
155
  within_diags = was_within_diags;
-
 
156
  dgn = f_dg_object_name (
-
 
157
	nam,
-
 
158
	f_dg_null_sourcepos,
-
 
159
	typ,
-
 
160
	yes_exp_option (diag_locate (acc)),
-
 
161
	no_dg_accessibility_option);
-
 
162
 
262
 
163
  if (isparam(son(acc)) || (son(son(acc)) != nilexp &&
-
 
164
		name(son(son(acc))) == chvar_tag &&
-
 
165
		shape_size(sh(son(son(acc)))) < 32 &&
-
 
166
		name(son(son(son(acc)))) == cont_tag &&
-
 
167
		name(son(son(son(son(acc))))) == name_tag &&
-
 
168
		isparam (son(son(son(son(son(acc)))))) )) {
-
 
169
    dg_info x = dgf(body);
-
 
170
    if (x && x->key == DGA_PARAMS) {
263
	new->key = DIAG_INFO_TYPE;
171
      dgn->next = x->data.i_param.args;
-
 
172
      x->data.i_param.args = dgn;
-
 
173
    }
-
 
174
    else {
-
 
175
      body = f_dg_exp (body, f_params_dg (dgn, no_exp_option));
-
 
176
    }
-
 
177
  }
-
 
178
  else {
-
 
179
    body = f_dg_exp (body, f_name_decl_dg (dgn));
-
 
180
    mark_scope (body);
-
 
181
  }
-
 
182
  return (body);
-
 
183
}
-
 
184
 
-
 
185
 
-
 
186
exp read_diag_type_scope
-
 
187
    PROTO_N ( (body) )
-
 
188
    PROTO_T ( exp body )
-
 
189
{
-
 
190
  dg_idname nam;
-
 
191
  dg_type typ;
-
 
192
  dg_name dgn;
-
 
193
  int was_within_diags = within_diags;
-
 
194
  within_diags = 1;
-
 
195
  nam = f_dg_sourcestring_idname (d_tdfstring());
264
	new->data.type_scope.nme = d_tdfstring();
196
  typ = d_diag_type();
265
	new->data.type_scope.typ = d_diag_type();
197
  within_diags = was_within_diags;
-
 
198
  dgn = f_dg_type_name (
-
 
199
	nam,
-
 
200
	f_dg_null_sourcepos,
-
 
201
	no_dg_accessibility_option,
-
 
202
	typ,
-
 
203
	f_false,
-
 
204
	no_bool_option,
-
 
205
	no_dg_constraint_list_option);
-
 
206
  body = f_dg_exp (body, f_name_decl_dg (dgn));
-
 
207
  mark_scope2 (body);
-
 
208
  return body;
266
	return(new);
209
}
267
}
210
 
268
 
211
 
269
 
212
#else
-
 
213
 
-
 
214
diag_info * read_exp_to_source
270
diag_info *
215
    PROTO_Z ()
271
read_diag_tag_scope(void)
216
{
272
{
217
  diag_info * new = (diag_info *) xcalloc(1,sizeof(diag_info));
273
	diag_info *new = (diag_info *)xcalloc(2, sizeof(diag_info));
218
 
274
 
219
  new->key = DIAG_INFO_SOURCE;
-
 
220
  new->data.source.beg 	= d_sourcemark();
-
 
221
  new->data.source.end 	= d_sourcemark();
-
 
222
 
-
 
223
  return new;
-
 
224
}
-
 
225
 
-
 
226
diag_info * read_diag_id_scope
-
 
227
    PROTO_Z ()
-
 
228
{
-
 
229
  diag_info * new = (diag_info *) xcalloc(1,sizeof(diag_info));
-
 
230
 
-
 
231
  new->key 		= DIAG_INFO_ID;
-
 
232
  new->data.id_scope.nme = d_tdfstring();
-
 
233
  new->data.id_scope.access = hold_check(d_exp());
-
 
234
  IGNORE hold(hold(new->data.id_scope.access));
-
 
235
  new->data.id_scope.typ = d_diag_type();
-
 
236
  return (new);
-
 
237
}
-
 
238
 
-
 
239
diag_info * read_diag_type_scope
-
 
240
    PROTO_Z ()
-
 
241
{
-
 
242
  diag_info * new = (diag_info *) xcalloc(1,sizeof(diag_info));
-
 
243
 
-
 
244
  new->key 		= DIAG_INFO_TYPE;
-
 
245
  new->data.type_scope.nme = d_tdfstring();
-
 
246
  new->data.type_scope.typ = d_diag_type();
-
 
247
  return (new);
-
 
248
}
-
 
249
 
-
 
250
diag_info * read_diag_tag_scope
-
 
251
    PROTO_Z ()
-
 
252
{
-
 
253
  diag_info * new = (diag_info *) xcalloc(1,sizeof(diag_info));
-
 
254
 
-
 
255
  new->key 		= DIAG_INFO_TAG;
275
	new->key = DIAG_INFO_TAG;
256
  new->data.tag_scope.nme = d_tdfstring();
276
	new->data.tag_scope.nme = d_tdfstring();
257
  new->data.tag_scope.typ = d_diag_type();
277
	new->data.tag_scope.typ = d_diag_type();
258
  return (new);
278
	return(new);
259
}
279
}
260
 
-
 
261
 
280
 
262
#endif
281
#endif