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 86... Line 116...
86 
 
 116 
 
87 
 
 117 
 
88 
/* PROCEDURES */
 118 
/* PROCEDURES */
89 
 
 119 
 
90 
speci special_fn
 120 
speci special_fn
91 
    PROTO_N ( (a1, a2, s) )
 - 
 
92 
    PROTO_T ( exp a1 X exp a2 X shape s )
 121 
(exp a1, exp a2, shape s)
93 
{
 122 
{
94 
				/* look for special functions */
 123 
				/* look for special functions */
95 
  speci spr;
 124 
  speci spr;
96 
  dec* dp = brog (son (a1));
 125 
  dec* dp = brog(son(a1));
97 
  char *id = dp -> dec_u.dec_val.dec_id;
 126 
  char *id = dp -> dec_u.dec_val.dec_id;
98 
  spr.is_special = 0;
 127 
  spr.is_special = 0;
99 
  if (id == (char *) 0)
 128 
  if (id == (char *)0)
100 
    return (spr);
 129 
    return(spr);
101 
  id += prefix_length;
 130 
  id += prefix_length;
102 
 
 131 
 
103 
  if (a2 != nilexp && last(a2) && !strcmp (id, "__trans386_special")) {
 132 
  if (a2 != nilexp && last(a2) && !strcmp(id, "__trans386_special")) {
104 
    exp r = me_b3(s, a1, a2, apply_tag);
 133 
    exp r = me_b3(s, a1, a2, apply_tag);
105 
    setbuiltin(r);	/* dummy proc, so ignore state of do_special_fns */
 134 
    setbuiltin(r);	/* dummy proc, so ignore state of do_special_fns */
106 
    spr.is_special = 1;
 135 
    spr.is_special = 1;
107 
    spr.special_exp = r;
 136 
    spr.special_exp = r;
108 
    return (spr);
 137 
    return(spr);
109 
  };
 138 
  };
110 
 
 139 
 
111 
  if (!strcmp (id, "setjmp")) {
 140 
  if (!strcmp(id, "setjmp")) {
112 
    has_setjmp = 1;
 141 
    has_setjmp = 1;
113 
    module_has_setjmp = 1;
 142 
    module_has_setjmp = 1;
114 
  };
 143 
  };
115 
 
 144 
 
116 
  if (!strcmp (id, "longjmp")) {
 145 
  if (!strcmp(id, "longjmp")) {
117 
    exp r = getexp(f_bottom, nilexp, 0, a1, nilexp, 0, 0,apply_tag);
 146 
    exp r = getexp(f_bottom, nilexp, 0, a1, nilexp, 0, 0,apply_tag);
118 
    has_setjmp = 1;
 147 
    has_setjmp = 1;
119 
    if (last(a2) || bro(a2) == nilexp)
 148 
    if (last(a2) || bro(a2) == nilexp)
120 
      return spr;
 149 
      return spr;
121 
    bro(a1) = a2;
 150 
    bro(a1) = a2;
Line 134... Line 163...
134 
        otherwise registers are not reset.
 163 
        otherwise registers are not reset.
135 
        so don't do do_special_fns test until after longjmp test. */
 164 
        so don't do do_special_fns test until after longjmp test. */
136 
  if (!do_special_fns)
 165 
  if (!do_special_fns)
137 
    return spr;
 166 
    return spr;
138 
 
 167 
 
139 
  if (a2 != nilexp && last(a2) && !strcmp (id, "__builtin_alloca")) {
 168 
  if (a2 != nilexp && last(a2) && !strcmp(id, "__builtin_alloca")) {
140 
    exp r = getexp (s, nilexp, 0, a2, nilexp, 0,
 169 
    exp r = getexp(s, nilexp, 0, a2, nilexp, 0,
141 
	0, alloca_tag);
 170 
	0, alloca_tag);
142 
    setfather(r, son(r));
 171 
    setfather(r, son(r));
143 
    has_alloca = 1;
 172 
    has_alloca = 1;
144 
    spr.is_special = 1;
 173 
    spr.is_special = 1;
145 
    spr.special_exp = r;
 174 
    spr.special_exp = r;
146 
    kill_exp (a1, a1);
 175 
    kill_exp(a1, a1);
147 
    return (spr);
 176 
    return(spr);
148 
  };
 177 
  };
149 
 
 178 
 
150 
  if (a2 != nilexp && last(a2) && !strcmp (id, "exit")) {
 179 
  if (a2 != nilexp && last(a2) && !strcmp(id, "exit")) {
151 
    exp r = me_b3(f_bottom, a1, a2, apply_tag);
 180 
    exp r = me_b3(f_bottom, a1, a2, apply_tag);
152 
    spr.is_special = 1;
 181 
    spr.is_special = 1;
153 
    spr.special_exp = r;
 182 
    spr.special_exp = r;
154 
    return (spr);
 183 
    return(spr);
155 
  };
 184 
  };
156 
 
 185 
 
157 
  if (a2 == nilexp && !strcmp (id, "abort")) {
 186 
  if (a2 == nilexp && !strcmp(id, "abort")) {
158 
    exp r = me_u3(f_bottom, a1, apply_tag);
 187 
    exp r = me_u3(f_bottom, a1, apply_tag);
159 
    spr.is_special = 1;
 188 
    spr.is_special = 1;
160 
    spr.special_exp = r;
 189 
    spr.special_exp = r;
161 
    return (spr);
 190 
    return(spr);
162 
  };
 191 
  };
163 
 
 192 
 
164 
  return (spr);
 193 
  return(spr);
165 
}
 194 
}