Subversion Repositories tendra.SVN

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1
/*
2
    		 Crown Copyright (c) 1997
3
 
4
    This TenDRA(r) Computer Program is subject to Copyright
5
    owned by the United Kingdom Secretary of State for Defence
6
    acting through the Defence Evaluation and Research Agency
7
    (DERA).  It is made available to Recipients with a
8
    royalty-free licence for its use, reproduction, transfer
9
    to other parties and amendment for any purpose not excluding
10
    product development provided that any such use et cetera
11
    shall be deemed to be acceptance of the following conditions:-
12
 
13
        (1) Its Recipients shall ensure that this Notice is
14
        reproduced upon any copies or amended versions of it;
15
 
16
        (2) Any amended version of it shall be clearly marked to
17
        show both the nature of and the organisation responsible
18
        for the relevant amendment or amendments;
19
 
20
        (3) Its onward transfer from a recipient to another
21
        party shall be deemed to be that party's acceptance of
22
        these conditions;
23
 
24
        (4) DERA gives no warranty or assurance as to its
25
        quality or suitability for any purpose and DERA accepts
26
        no liability whatsoever in relation to any use to which
27
        it may be put.
28
*/
29
 
30
 
31
/* 80x86/spec.c */
32
 
33
/**********************************************************************
34
$Author: release $
35
$Date: 1998/01/17 15:55:52 $
36
$Revision: 1.1.1.1 $
37
$Log: spec.c,v $
38
 * Revision 1.1.1.1  1998/01/17  15:55:52  release
39
 * First version to be checked into rolling release.
40
 *
41
 * Revision 1.4  1995/09/06  16:29:32  pwe
42
 * exceptions now OK
43
 *
44
 * Revision 1.3  1995/09/05  16:25:12  pwe
45
 * specials and exception changes
46
 *
47
 * Revision 1.2  1995/01/30  12:56:51  pwe
48
 * Ownership -> PWE, tidy banners
49
 *
50
 * Revision 1.1  1994/10/27  14:15:22  jmf
51
 * Initial revision
52
 *
53
 * Revision 1.2  1994/07/12  15:21:29  jmf
54
 * exit, abort and longjmp produce bottom shape.
55
 *
56
 * Revision 1.1  1994/07/12  14:41:19  jmf
57
 * Initial revision
58
 *
59
**********************************************************************/
60
 
61
 
62
/**********************************************************************
63
 
64
                               spec.c
65
 
66
  Defines special_fn which recognises and replaces some special
67
  function calls.
68
 
69
**********************************************************************/
70
 
71
#include "config.h"
72
#include "common_types.h"
73
#include "tags.h"
74
#include "externs.h"
75
#include "expmacs.h"
76
#include "shapemacs.h"
77
#include "exp.h"
78
#include "basicread.h"
79
#include "flags.h"
80
#include "table_fns.h"
81
#include "installglob.h"
82
#include "check.h"
83
#include "localflags.h"
84
#include "me_fns.h"
85
#include "spec.h"
86
 
87
 
88
/* PROCEDURES */
89
 
90
speci special_fn
91
    PROTO_N ( (a1, a2, s) )
92
    PROTO_T ( exp a1 X exp a2 X shape s )
93
{
94
				/* look for special functions */
95
  speci spr;
96
  dec* dp = brog (son (a1));
97
  char *id = dp -> dec_u.dec_val.dec_id;
98
  spr.is_special = 0;
99
  if (id == (char *) 0)
100
    return (spr);
101
  id += prefix_length;
102
 
103
  if (a2 != nilexp && last(a2) && !strcmp (id, "__trans386_special")) {
104
    exp r = me_b3(s, a1, a2, apply_tag);
105
    setbuiltin(r);	/* dummy proc, so ignore state of do_special_fns */
106
    spr.is_special = 1;
107
    spr.special_exp = r;
108
    return (spr);
109
  };
110
 
111
  if (!strcmp (id, "setjmp")) {
112
    has_setjmp = 1;
113
    module_has_setjmp = 1;
114
  };
115
 
116
  if (!strcmp (id, "longjmp")) {
117
    exp r = getexp(f_bottom, nilexp, 0, a1, nilexp, 0, 0,apply_tag);
118
    has_setjmp = 1;
119
    if (last(a2) || bro(a2) == nilexp)
120
      return spr;
121
    bro(a1) = a2;
122
    clearlast(a1);
123
    parked(a2) = 0;
124
    clearlast(a2);
125
    a2 = bro(a2);
126
    setlast(a2);
127
    parked(a2) = 0;
128
    bro(a2) = r;
129
    spr.is_special = 1;
130
    spr.special_exp = r;
131
  };
132
 
133
     /* we must always set has_setjmp if it is longjmp,
134
        otherwise registers are not reset.
135
        so don't do do_special_fns test until after longjmp test. */
136
  if (!do_special_fns)
137
    return spr;
138
 
139
  if (a2 != nilexp && last(a2) && !strcmp (id, "__builtin_alloca")) {
140
    exp r = getexp (s, nilexp, 0, a2, nilexp, 0,
141
	0, alloca_tag);
142
    setfather(r, son(r));
143
    has_alloca = 1;
144
    spr.is_special = 1;
145
    spr.special_exp = r;
146
    kill_exp (a1, a1);
147
    return (spr);
148
  };
149
 
150
  if (a2 != nilexp && last(a2) && !strcmp (id, "exit")) {
151
    exp r = me_b3(f_bottom, a1, a2, apply_tag);
152
    spr.is_special = 1;
153
    spr.special_exp = r;
154
    return (spr);
155
  };
156
 
157
  if (a2 == nilexp && !strcmp (id, "abort")) {
158
    exp r = me_u3(f_bottom, a1, apply_tag);
159
    spr.is_special = 1;
160
    spr.special_exp = r;
161
    return (spr);
162
  };
163
 
164
  return (spr);
165
}