Subversion Repositories tendra.SVN

Rev

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

Rev Author Line No. Line
6 7u83 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 
 */
31 
/*
32 
    		 Crown Copyright (c) 1997
33 
 
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:-
42 
 
43 
        (1) Its Recipients shall ensure that this Notice is
44 
        reproduced upon any copies or amended versions of it;
45 
 
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;
49 
 
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;
53 
 
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 
/* 80x86/codec.c */
62 
 
63 
/**********************************************************************
64 
$Author: release $
65 
$Date: 1998/01/17 15:55:51 $
66 
$Revision: 1.1.1.1 $
67 
$Log: codec.c,v $
68 
 * Revision 1.1.1.1  1998/01/17  15:55:51  release
69 
 * First version to be checked into rolling release.
70 
 *
71 
 * Revision 1.28  1997/08/23  13:45:19  pwe
72 
 * initial ANDF-DE
73 
 *
74 
 * Revision 1.27  1996/10/07  13:30:54  pwe
75 
 * push make_value, and env_offset v id out_of_line
76 
 *
77 
 * Revision 1.26  1996/05/20  14:30:00  pwe
78 
 * improved 64-bit handling
79 
 *
80 
 * Revision 1.25  1996/05/13  12:51:44  pwe
81 
 * undo premature commit
82 
 *
83 
 * Revision 1.23  1996/02/01  09:34:31  pwe
84 
 * PIC oddities for AVS
85 
 *
86 
 * Revision 1.22  1996/01/31  12:24:11  pwe
87 
 * is_crc v is_opnd  &  end_contop must not preceed move_reg
88 
 *
89 
 * Revision 1.21  1995/12/01  10:48:31  pwe
90 
 * PIC static variables
91 
 *
92 
 * Revision 1.20  1995/10/11  17:16:08  pwe
93 
 * error treatment for remainder
94 
 *
95 
 * Revision 1.19  1995/09/19  15:42:41  pwe
96 
 * round, fp overflow etc
97 
 *
98 
 * Revision 1.18  1995/09/13  14:25:04  pwe
99 
 * tidy for gcc
100 
 *
101 
 * Revision 1.17  1995/08/30  16:06:12  pwe
102 
 * prepare exception trapping
103 
 *
104 
 * Revision 1.16  1995/08/23  09:42:21  pwe
105 
 * track fpu control word for trap etc
106 
 *
107 
 * Revision 1.15  1995/08/14  13:53:15  pwe
108 
 * several corrections, tail calls and error jumps
109 
 *
110 
 * Revision 1.14  1995/08/04  08:28:53  pwe
111 
 * 4.0 general procs implemented
112 
 *
113 
 * Revision 1.13  1995/03/07  14:00:12  pwe
114 
 * offset_pad byte->bit conversion
115 
 *
116 
 * Revision 1.12  1995/02/24  16:11:03  pwe
117 
 * dynamic offsets, including mixed bit/byte representations
118 
 *
119 
 * Revision 1.11  1995/02/23  11:05:26  pwe
120 
 * offset_div change variety after 32_bit division
121 
 *
122 
 * Revision 1.10  1995/02/13  11:16:56  pwe
123 
 * REM etc should ignore overflow flag
124 
 *
125 
 * Revision 1.9  1995/02/10  14:36:39  pwe
126 
 * consequence of correct test(reff,..) etc
127 
 *
128 
 * Revision 1.8  1995/02/10  12:58:11  pwe
129 
 * correct test(reff,..) etc
130 
 *
131 
 * Revision 1.7  1995/02/08  17:21:03  pwe
132 
 * remove incorrect overflow test after div
133 
 *
134 
 * Revision 1.6  1995/02/06  15:15:18  pwe
135 
 * correct fp overflow check
136 
 *
137 
 * Revision 1.5  1995/02/02  15:17:21  pwe
138 
 * implement offset_max as max
139 
 *
140 
 * Revision 1.4  1995/01/30  12:55:57  pwe
141 
 * Ownership -> PWE, tidy banners
142 
 *
143 
 * Revision 1.3  1994/11/24  14:11:50  jmf
144 
 * Cleared cond1_set after retcells
145 
 *
146 
 * Revision 1.2  1994/11/08  10:06:58  jmf
147 
 * Added power not implemented
148 
 *
149 
 * Revision 1.1  1994/10/27  14:15:22  jmf
150 
 * Initial revision
151 
 *
152 
 * Revision 1.1  1994/07/12  14:26:39  jmf
153 
 * Initial revision
154 
 *
155 
**********************************************************************/
156 
 
157 
 
158 
/**********************************************************************
159 
 
160 
                            codec.c
161 
 
162 
   codec produces code for operations which produce values.
163 
   e is the operation and dest is where the result is to be put.
164 
 
165 
**********************************************************************/
166 
 
167 
#include "config.h"
168 
#include "common_types.h"
169 
 
170 
#include "expmacs.h"
171 
#include "exp.h"
172 
#include "instr386.h"
173 
#include "tags.h"
174 
#include "operand.h"
175 
#include "shapemacs.h"
176 
#include "instrmacs.h"
177 
#include "basicread.h"
178 
#include "flags.h"
179 
#include "coder.h"
180 
#include "install_fns.h"
181 
#include "codermacs.h"
182 
#include "instr.h"
183 
#include "flpt.h"
184 
#include "messages_8.h"
185 
#include "reg_record.h"
186 
#include "readglob.h"
187 
#include "externs.h"
188 
 
189 
#include "codec.h"
190 
 
191 
 
192 
/* PROCEDURES */
193 
 
194 
/* returns true if is_o(e) but not a possible 80386 operand */
121 7u83 195 
int is_crc
196 
(exp e)
6 7u83 197 
{
121 7u83 198 
		/* make sure (is_o && is_crc -> !is_opnd) */
199 
  if (name(e) == name_tag) {
200 
    if (isvar(son(e)))
201 
      return(!isglob(son(e)) || PIC_code);
202 
    /* else */
203 
      return(son(son(e)) == nilexp ||
204 
	(isglob(son(e)) && PIC_code && name(sh(son(e))) == prokhd &&
205 
			!(brog(son(e)) -> dec_u.dec_val.extnamed)) ||
206 
	(name(son(son(e))) == ident_tag && isparam(son(son(e)))));
207 
  }
6 7u83 208 
 
121 7u83 209 
  if (name(e) == reff_tag || name(e) == field_tag)
210 
    return 1;
6 7u83 211 
 
121 7u83 212 
  if (name(e)!= cont_tag)
213 
    return 0;
6 7u83 214 
 
121 7u83 215 
  if (name(son(e)) == cont_tag)
216 
    return 1;
6 7u83 217 
 
121 7u83 218 
  return name(son(e)) == reff_tag &&
219 
	  name(son(son(e))) == cont_tag;
6 7u83 220 
}
221 
 
121 7u83 222 
/* op is a procedure for encoding a unary
223 
   operation. If a is a possible 80386
224 
   operand, uop applies this operator to
225 
   produce the code for a, leaving the
226 
   result in dest. sha gives the shape for
227 
   the operation. If a is not a possible
228 
   80386 operand, then uop produces code
229 
   for a to put it into eax (reg0) and
230 
   then applies op to eax, putting the
231 
   result into dest. */
232 
void uop
233 
(void(*op)(shape, where, where), shape sha, exp a, where dest, ash stack)
6 7u83 234 
{
121 7u83 235 
  if (!is_o(name(a)) || is_crc(a)) {
236 
    where qw;
237 
    if (!inmem(dest))
238 
      qw.where_exp = copyexp(dest.where_exp);
239 
    else
240 
      qw.where_exp = copyexp(reg0.where_exp);
241 
    sh(qw.where_exp) = sha;
242 
    qw.where_off = 0;
243 
    coder(qw, stack, a);
244 
   (*op)(sha, qw, dest);
245 
    retcell(qw.where_exp);
246 
    cond1_set = 0;
247 
    return;
248 
  };
249 
 (*op)(sha, mw(a, 0), dest);
250 
  return;
6 7u83 251 
}
252 
 
121 7u83 253 
static int no_reg_needed
254 
(exp e)
6 7u83 255 
{
121 7u83 256 
  if (name(e) == val_tag)
257 
    return 1;
258 
  if (name(e) == cont_tag &&
259 
	name(son(e)) == name_tag &&
260 
	isvar(son(son(e))) &&
261 
	ptno(son(son(e)))!= reg_pl)
262 
    return 1;
263 
  if (name(e) == name_tag &&
264 
	!isvar(son(e)) &&
265 
	ptno(son(e))!= reg_pl)
266 
    return 1;
267 
  return 0;
6 7u83 268 
}
269 
 
121 7u83 270 
/* op is a procedure for encoding a binary
271 
   operation. Not more than one of a and b
272 
   will not be a possible 80386 operand.
273 
   This has been ensured by scan2. If a
274 
   and b are both possible 80386 operands,
275 
   bop applies this operator to produce
276 
   the code, leaving the result in dest.
277 
   sha gives the shape for the operation.
278 
   If either a or b is not a possible
279 
   80386 operand, then bop produces code
280 
   for it to put it into eax (reg0) and
281 
   then applies op to eax and the other
282 
   operand, putting the result into dest.
283 
*/
284 
void bop
285 
(void(*op)(shape, where, where, where), shape sha, exp a, exp b, where dest, ash stack)
6 7u83 286 
{
121 7u83 287 
  where qw;
6 7u83 288 
 
121 7u83 289 
  if (!is_o(name(a)) || is_crc(a)) {
290 
    if (!inmem(dest) && no_reg_needed(b))
291 
      qw.where_exp = copyexp(dest.where_exp);
292 
    else
293 
      qw.where_exp = copyexp(reg0.where_exp);
294 
    sh(qw.where_exp) = sha;
295 
    qw.where_off = 0;
296 
    coder(qw, stack, a);
297 
   (*op)(sha, qw, mw(b, 0), dest);
298 
    retcell(qw.where_exp);
299 
    cond1_set = 0;
300 
    return;
301 
  };
302 
  if (!is_o(name(b)) || is_crc(b)) {
303 
    if (!inmem(dest) && no_reg_needed(a))
304 
      qw.where_exp = copyexp(dest.where_exp);
305 
    else
306 
      qw.where_exp = copyexp(reg0.where_exp);
307 
    sh(qw.where_exp) = sha;
308 
    qw.where_off = 0;
309 
    coder(qw, stack, b);
310 
   (*op)(sha, mw(a, 0), qw, dest);
311 
    retcell(qw.where_exp);
312 
    cond1_set = 0;
313 
    return;
314 
  };
6 7u83 315 
 
121 7u83 316 
 (*op)(sha, mw(a, 0), mw(b, 0), dest);
317 
  return;
6 7u83 318 
}
319 
 
121 7u83 320 
/* process the binary logical operation
321 
   exp. op is the compiling procedure for
322 
   the operation. It is commutative and
323 
   associative, the operation takes a
324 
   variable number of arguments. It is
325 
   therefore necessary to avoid the
326 
   mistake of assigning to the destination
327 
   (dest) inappropriately if its value is
328 
   used in the expression. At most one of
329 
   the arguments will not be a possible
330 
   80386 operand. If there is such an
331 
   argument, logop precomputes it, putting
332 
   the value into reg0. */
333 
static void logop
334 
(void(*op)(shape, where, where, where), exp e, where dest, ash stack)
6 7u83 335 
{
121 7u83 336 
  exp arg1 = son(e);
337 
  exp arg2 = bro(arg1);
338 
  shape sha = sh(e);
339 
  exp t, u;
340 
  where qw;
6 7u83 341 
 
121 7u83 342 
  if (last(arg1)) {
343 
    coder(dest, stack, arg1);
344 
    return;
345 
  };
6 7u83 346 
 
121 7u83 347 
  if (last (arg2)) {		/* just two arguments. */
348 
    bop(op, sha, arg1, arg2, dest, stack);
349 
    return;
350 
  };
351 
  /* need to take care about overlap between dest and args or to avoid
352 
     extra push. So use reg0. */
353 
  qw.where_exp = copyexp(reg0.where_exp);
354 
  sh(qw.where_exp) = sha;
355 
  qw.where_off = 0;
356 
  t = arg1;
357 
  /* now look for an argument which is not a possible 80386 operand */
358 
  while (1) {
359 
    if (!is_o(name(t)) || is_crc(t))
360 
      break;
361 
    if (last(t)) {
362 
      t = nilexp;
363 
      break;
364 
    };
365 
    t = bro(t);
366 
  };
6 7u83 367 
 
121 7u83 368 
  if (t == nilexp) {		/* all arguments are possible 80386
369 
				   operands */
370 
   (*op)(sha, mw(arg1, 0), mw(arg2, 0), qw);
371 
    t = bro(arg2);
372 
    while (!last(t)) {
373 
      (*op) (sha, mw (t, 0), qw, qw);/* encode operations in turn */
374 
      t = bro(t);
375 
    };
376 
    (*op) (sha, mw (t, 0), qw, dest);/* encode final operation */
377 
    retcell(qw.where_exp);
378 
    cond1_set = 0;
379 
    return;
380 
  };
6 7u83 381 
 
121 7u83 382 
  coder (qw, stack, t);		/* encode the single argument which is not
383 
				   a possible 80386 operend */
384 
  u = arg1;
385 
  /* now encode the remaining operations */
386 
  while (1) {
387 
    if (t != u) {
388 
      if (last(u) || (bro(u) == t && last(bro(u))))
389 
	(*op)(sha, mw(u, 0), qw, dest);
390 
      else
391 
	(*op)(sha, mw(u, 0), qw, qw);
392 
    };
393 
    if (last(u))
394 
      break;
395 
    u = bro(u);
396 
  };
397 
  retcell(qw.where_exp);
398 
  cond1_set = 0;
399 
  return;
6 7u83 400 
}
401 
 
121 7u83 402 
/* process the multiply operation
403 
   exp. op is the compiling procedure for
404 
   the operation. It is commutative and
405 
   associative, the operation takes a
406 
   variable number of arguments. It is
407 
   therefore necessary to avoid the
408 
   mistake of assigning to the destination
409 
   (dest) inappropriately if its value is
410 
   used in the expression. At most one of
411 
   the arguments will not be a possible
412 
   80386 operand. If there is such an
413 
   argument, it is precomputed, putting
414 
   the value into reg0. */
415 
static void multop
416 
(void(*op)(shape, where, where, where), exp e, where dest, ash stack)
6 7u83 417 
{
121 7u83 418 
  exp arg1 = son(e);
419 
  exp arg2 = bro(arg1);
420 
  exp t, u;
421 
  where qw;
6 7u83 422 
 
121 7u83 423 
  if (last(arg1)) {
424 
    coder(dest, stack, arg1);
425 
    return;
426 
  };
6 7u83 427 
 
121 7u83 428 
  if (last (arg2)) {		/* just two arguments. */
429 
    bop(op, sh(e), arg1, arg2, dest, stack);
430 
    return;
431 
  };
432 
  /* need to take care about overlap between dest and args or to avoid
433 
     extra push. So use reg0. */
434 
  qw.where_exp = copyexp(reg0.where_exp);
435 
  sh(qw.where_exp) = sh(e);
436 
  qw.where_off = 0;
437 
  t = arg1;
438 
  /* now look for an argument which is not a possible 80386 operand */
439 
  while (1) {
440 
    if (!is_o(name(t)) || is_crc(t))
441 
      break;
442 
    if (last(t)) {
443 
      t = nilexp;
444 
      break;
445 
    };
446 
    t = bro(t);
447 
  };
6 7u83 448 
 
121 7u83 449 
  if (t == nilexp) {		/* all arguments are possible 80386
450 
				   operands */
451 
   (*op)(sh(e), mw(arg1, 0), mw(arg2, 0), qw);
452 
    t = bro(arg2);
453 
    while (!last(t)) {
454 
      (*op) (sh (e), mw (t, 0), qw, qw);/* encode operations in turn */
455 
      t = bro(t);
456 
    };
457 
    (*op) (sh (e), mw (t, 0), qw, dest);/* encode final operation */
458 
    retcell(qw.where_exp);
459 
    cond1_set = 0;
460 
    return;
461 
  };
6 7u83 462 
 
121 7u83 463 
  coder (qw, stack, t);		/* encode the single argument which is not
464 
				   a possible 80386 operend */
465 
  u = arg1;
466 
  /* now encode the remaining operations */
467 
  while (1) {
468 
    if (t != u) {
469 
      if (last(u) || (bro(u) == t && last(bro(u))))
470 
	(*op)(sh(e), mw(u, 0), qw, dest);
471 
      else
472 
	(*op)(sh(e), mw(u, 0), qw, qw);
473 
    };
474 
    if (last(u))
475 
      break;
476 
    u = bro(u);
477 
  };
478 
  retcell(qw.where_exp);
479 
  cond1_set = 0;
480 
  return;
6 7u83 481 
}
482 
 
121 7u83 483 
/* if a is a negation form b-son(a)
484 
   otherwise b+a in dest */
485 
static void addsub
486 
(shape sha, where a, where b, where dest, exp e)
6 7u83 487 
{
121 7u83 488 
  UNUSED(e);
489 
  if (name(a.where_exp) == neg_tag)
490 
    sub(sha, mw(son(a.where_exp), 0), b, dest);
491 
  else
492 
    add(sha, a, b, dest);
493 
  return;
6 7u83 494 
}
495 
 
496 
 
121 7u83 497 
 
6 7u83 498 
/***********************************************************************
499 
   codec outputs the code which evaulates e and puts the result into
500 
   dest.
501 
 ***********************************************************************/
502 
 
121 7u83 503 
 
504 
/* encode e, putting the result into dest.
505 
   stack is the current stack level */
506 
void codec
507 
(where dest, ash stack, exp e)
6 7u83 508 
{
121 7u83 509 
  switch (name(e)) {
510 
    case plus_tag:
511 
      {				/* at most one of the arguments will not
512 
				   be a possible 80386 operand */
513 
	exp arg1 = son(e);
514 
	exp arg2 = bro(arg1);
515 
	exp t, u, v;
516 
	where qw;
517 
	exp old_overflow_e = overflow_e;
6 7u83 518 
 
121 7u83 519 
	if (last (arg1)) {	/* there is only one argument */
520 
	  coder(dest, stack, arg1);
521 
	  return;
522 
	};
6 7u83 523 
 
121 7u83 524 
	if (!optop(e))
525 
          overflow_e = e;
6 7u83 526 
 
121 7u83 527 
	if (last(arg2) && is_o(name(arg1)) && !is_crc(arg1) &&
528 
	   ((is_o(name(arg2)) && !is_crc(arg2)) ||
529 
	     (name(arg2) == neg_tag &&
530 
	       !is_crc(son(arg2)) &&
531 
	       is_o(name(son(arg2)))))) {
532 
	  /* just two arguments. */
533 
	  addsub(sh(e), mw(arg2, 0), mw(arg1, 0), dest, e);
534 
          overflow_e = old_overflow_e;
535 
	  return;
536 
	};
537 
	/* need to take care about overlap between dest and args or to
538 
	   avoid extra push. So use reg0. */
539 
	t = arg1;
540 
	qw.where_exp = copyexp(reg0.where_exp);
541 
	sh(qw.where_exp) = sh(e);
542 
	qw.where_off = 0;
6 7u83 543 
 
121 7u83 544 
	/* now look for argument which is not a possible 80386 operand */
545 
	while (1) {
546 
	  if ((!is_o(name(t)) || is_crc(t)) &&
547 
	     (name(t)!= neg_tag || !is_o(name(son(t))) ||
548 
	       is_crc(son(t))))
549 
	    break;
550 
	  if (last(t)) {
551 
	    t = nilexp;
552 
	    break;
553 
	  };
554 
	  t = bro(t);
555 
	};
6 7u83 556 
 
121 7u83 557 
	if (t == nilexp && name(arg1) == neg_tag &&
558 
	    name(arg2) == neg_tag)
559 
	  t = arg1;
6 7u83 560 
 
121 7u83 561 
	if (t == nilexp) {	/* all arguments are possible 80386
562 
				   operands */
563 
	  t = bro(arg2);
564 
	  if (name(arg1) == neg_tag)
565 
	    addsub(sh(e), mw(arg1, 0), mw(arg2, 0),
566 
		(t == e)? dest : qw, e);
567 
	  else
568 
	    addsub(sh(e), mw(arg2, 0), mw(arg1, 0),
569 
		(t == e)? dest : qw, e);
570 
	  if (t == e)
571 
           {
572 
             overflow_e = old_overflow_e;
573 
	     return;
574 
           };
575 
	  while (!last(t)) {
576 
	    u = bro(t);
577 
	    addsub(sh(e), mw(t, 0), qw, qw, e);
578 
	    t = u;
579 
	  };
580 
	  addsub(sh(e), mw(t, 0), qw, dest, e);
581 
          overflow_e = old_overflow_e;
582 
	  return;
583 
	};
6 7u83 584 
 
121 7u83 585 
	coder (qw, stack, t);	/* encode the argument which is not a
586 
				   possible 80386 operand */
587 
	u = arg1;
588 
	/* now encode the remaining operations */
589 
	while (1) {
590 
	  v = bro(u);
591 
	  if (t != u) {
592 
	    if (last(u) || (v == t && last(v)))
593 
	      addsub(sh(e), mw(u, 0), qw, dest, e);
594 
	    else
595 
	      addsub(sh(e), mw(u, 0), qw, qw, e);
596 
	  };
597 
	  if (last(u))
598 
	    break;
599 
	  u = v;
600 
	};
601 
	retcell(qw.where_exp);
602 
        cond1_set = 0;
603 
        overflow_e = old_overflow_e;
604 
	return;
605 
      };
606 
    case addptr_tag: {		/* use index operation */
607 
	mova(mw(e, 0), dest);
608 
	return;
609 
      };
610 
    case chvar_tag: {
611 
	exp a = son(e);
612 
	exp old_overflow_e = overflow_e;
613 
        if (!optop(e))
614 
          overflow_e = e;
615 
	if (!is_o(name(a)) || is_crc(a)) {
616 
				/* argument is not a possible 80386
617 
				   operand, so evaluate it in reg0 */
618 
	  if (inmem(dest) ||
619 
		(shape_size(sh(a)) == 8 && bad_from_reg(dest)) ||
620 
		shape_size(sh(a)) == 64) {
621 
	    where qw;
622 
	    qw.where_exp = copyexp(reg0.where_exp);
623 
	    sh(qw.where_exp) = sh(a);
624 
	    qw.where_off = 0;
625 
	    coder(qw, stack, a);
626 
	    change_var_check(sh(e), qw, dest);
627 
	    overflow_e = old_overflow_e;
628 
	    retcell(qw.where_exp);
629 
            cond1_set = 0;
630 
	    return;
631 
	  };
632 
	  coder(dest, stack, a);
633 
	  if (name(sh(e)) > name(sh(a)))
634 
	    change_var_sh(sh(e), sh(a), dest, dest);
635 
	  overflow_e = old_overflow_e;
636 
	  return;
637 
	};
638 
	change_var_check(sh(e), mw(a, 0), dest);
639 
	overflow_e = old_overflow_e;
640 
	return;
641 
      };
642 
    case minus_tag:
643 
      {
644 
	exp old_overflow_e = overflow_e;
645 
        if (!optop(e))
646 
          overflow_e = e;
647 
	bop(sub, sh(e), bro(son(e)), son(e), dest, stack);
648 
	overflow_e = old_overflow_e;
649 
	return;
650 
      };
651 
    case subptr_tag:
652 
    case minptr_tag:
653 
    case make_stack_limit_tag:
654 
      {
655 
	bop(sub, sh(e), bro(son(e)), son(e), dest, stack);
656 
	return;
657 
      };
658 
    case mult_tag:
659 
      {
660 
        if (!optop(e))
661 
          {
662 
	    exp old_overflow_e = overflow_e;
663 
            overflow_e = e;
664 
	    multop(multiply, e, dest, stack);
665 
            overflow_e = old_overflow_e;
666 
          }
667 
        else
668 
	  multop(mult, e, dest, stack);
669 
	return;
670 
      };
671 
    case div2_tag:
672 
      {
673 
	exp old_overflow_e = overflow_e;
674 
        if (errhandle(e))
675 
          overflow_e = e;
676 
	bop(div2, sh(e), bro(son(e)), son(e), dest, stack);
677 
	overflow_e = old_overflow_e;
678 
	return;
679 
      };
680 
    case div1_tag:
681 
      {
682 
	exp old_overflow_e = overflow_e;
683 
        if (errhandle(e))
684 
          overflow_e = e;
685 
	bop(div1, sh(e), bro(son(e)), son(e), dest, stack);
686 
	overflow_e = old_overflow_e;
687 
	return;
688 
      };
689 
    case div0_tag:
690 
      {
691 
	exp old_overflow_e = overflow_e;
692 
        if (errhandle(e))
693 
          overflow_e = e;
694 
	bop(div0, sh(e), bro(son(e)), son(e), dest, stack);
695 
	overflow_e = old_overflow_e;
696 
	return;
697 
      };
698 
    case neg_tag:
699 
      {
700 
	exp old_overflow_e = overflow_e;
701 
        if (!optop(e))
702 
          overflow_e = e;
703 
	uop(negate, sh(e), son(e), dest, stack);
704 
	overflow_e = old_overflow_e;
705 
	return;
706 
      };
707 
    case shl_tag:
708 
      {
709 
	exp old_overflow_e = overflow_e;
710 
	overflow_e = e;
711 
        if (!optop(e))
712 
          overflow_e = e;
713 
	bop(shiftl, sh(e), bro(son(e)), son(e), dest, stack);
714 
	overflow_e = old_overflow_e;
715 
	return;
716 
      };
717 
    case shr_tag:
718 
      {
719 
	bop(shiftr, sh(e), bro(son(e)), son(e), dest, stack);
720 
	return;
721 
      };
722 
    case rotl_tag:
723 
      {
724 
	bop(rotatel, sh(e), bro(son(e)), son(e), dest, stack);
725 
	return;
726 
      };
727 
    case rotr_tag:
728 
      {
729 
	bop(rotater, sh(e), bro(son(e)), son(e), dest, stack);
730 
	return;
731 
      };
732 
    case mod_tag:
733 
      {
734 
	exp old_overflow_e = overflow_e;
735 
        if (errhandle(e))
736 
          overflow_e = e;
737 
	bop(mod, sh(e), bro(son(e)), son(e), dest, stack);
738 
	overflow_e = old_overflow_e;
739 
	return;
740 
      };
741 
    case rem2_tag:
742 
      {
743 
	exp old_overflow_e = overflow_e;
744 
        if (errhandle(e))
745 
          overflow_e = e;
746 
	bop(rem2, sh(e), bro(son(e)), son(e), dest, stack);
747 
	overflow_e = old_overflow_e;
748 
	return;
749 
      };
750 
    case rem0_tag:
751 
      {
752 
	exp old_overflow_e = overflow_e;
753 
        if (errhandle(e))
754 
          overflow_e = e;
755 
	bop(rem0, sh(e), bro(son(e)), son(e), dest, stack);
756 
	overflow_e = old_overflow_e;
757 
	return;
758 
      };
759 
    case round_tag:
760 
      {
761 
	shape s = sh(e);
762 
	where d;
763 
	d = dest;
764 
	if (shape_size(s) < 32) {
765 
	  s = slongsh;
766 
	  if (inmem(dest))
767 
	    d = reg0;
6 7u83 768 
	}
121 7u83 769 
        setup_fl_ovfl(e);
770 
	switch (round_number(e)) {
771 
	  case 0:
772 
		uop(frnd0, s, son(e), d, stack);
773 
		break;
774 
	  case 1:
775 
		uop(frnd1, s, son(e), d, stack);
776 
		break;
777 
	  case 2:
778 
		uop(frnd2, s, son(e), d, stack);
779 
		break;
780 
	  case 3:
781 
		uop(frnd3, s, son(e), d, stack);
782 
		break;
783 
	  case 4:
784 
		uop(frnd4, s, son(e), d, stack);
785 
		break;
786 
	};
787 
        test_fl_ovfl(e, d);
788 
	if (name(s)!= name(sh(e))) {
789 
	  exp old_overflow_e = overflow_e;
790 
          if (!optop(e))
791 
            overflow_e = e;
792 
	  change_var_sh(sh(e), s, d, dest);
793 
	  overflow_e = old_overflow_e;
6 7u83 794 
	}
121 7u83 795 
	return;
796 
      };
797 
    case fplus_tag:
798 
      {
799 
        setup_fl_ovfl(e);
800 
	fl_multop(fplus_tag, sh(e), son(e), dest);
801 
        test_fl_ovfl(e, dest);
802 
	return;
803 
      };
804 
    case fmult_tag:
805 
      {
806 
        setup_fl_ovfl(e);
807 
	fl_multop(fmult_tag, sh(e), son(e), dest);
808 
        test_fl_ovfl(e, dest);
809 
	return;
810 
      };
811 
    case fminus_tag:
812 
      {
813 
        setup_fl_ovfl(e);
814 
	fl_binop(fminus_tag, sh(e), mw(bro(son(e)), 0),
815 
	    mw(son(e), 0), dest, bro(son(e)));
816 
        test_fl_ovfl(e, dest);
817 
	return;
818 
      };
819 
    case fdiv_tag:
820 
      {
821 
        setup_fl_ovfl(e);
822 
	fl_binop(fdiv_tag, sh(e), mw(bro(son(e)), 0),
823 
	      mw(son(e), 0), dest, bro(son(e)));
824 
        test_fl_ovfl(e, dest);
825 
	return;
826 
      };
827 
    case fneg_tag: {
828 
        setup_fl_ovfl(e);
829 
	fl_neg(sh(e), mw(son(e), 0), dest);
830 
        test_fl_ovfl(e, dest);
831 
	return;
832 
      };
833 
    case fabs_tag: {
834 
        setup_fl_ovfl(e);
835 
	fl_abs(sh(e), mw(son(e), 0), dest);
836 
        test_fl_ovfl(e, dest);
837 
	return;
838 
      };
839 
    case float_tag: {
840 
        setup_fl_ovfl(e);
841 
	floater(sh(e), mw(son(e), 0), dest);
842 
        test_fl_ovfl(e, dest);
843 
	return;
844 
      };
845 
    case chfl_tag: {
846 
	if (name(sh(e)) < name(sh(son(e))))
847 
	  setup_fl_ovfl(e);
848 
	changefl(sh(e), mw(son(e), 0), dest);
849 
	if (name(sh(e)) < name(sh(son(e))))
850 
	  test_fl_ovfl(e, dest);
851 
	return;
852 
      };
853 
    case and_tag: {
854 
	logop(and, e, dest, stack);
855 
	return;
856 
      };
857 
    case or_tag: {
858 
	logop(or, e, dest, stack);
859 
	return;
860 
      };
861 
    case xor_tag: {
862 
	logop(xor, e, dest, stack);
863 
	return;
864 
      };
865 
    case not_tag: {
866 
	uop(not, sh(e), son(e), dest, stack);
867 
	return;
868 
      };
869 
    case offset_pad_tag:
870 
      if (al2(sh(son(e))) >= al2(sh(e)))
871 
	{
872 
	  if (al2(sh(e))!= 1 || al2(sh(son(e))) == 1)
873 
            coder(dest, stack, son(e));
874 
	  else {
875 
	    coder(reg0, stack, son(e));
876 
	    shiftl(slongsh, mw(zeroe, 3), reg0, dest);
877 
	  }
6 7u83 878 
	}
121 7u83 879 
      else
880 
        {
881 
          int al = al2(sh(e)) /8;
882 
          coder(reg0, stack, son(e));
883 
	  if (al2(sh(son(e))) == 1) {
884 
            add(slongsh, mw(zeroe, al*8 -1), reg0, reg0);
885 
	    shiftr(slongsh, mw(zeroe, 3), reg0, reg0);
886 
	  }
887 
	  else
888 
            add(slongsh, mw(zeroe, al-1), reg0, reg0);
889 
          and(slongsh, mw(zeroe, -al), reg0, dest);
890 
        };
891 
      return;
892 
    case offset_add_tag:
893 
      {
894 
	bop(add, sh(e), son(e), bro(son(e)), dest, stack);
895 
	return;
896 
      };
897 
    case abs_tag:
898 
      {
899 
	exp old_overflow_e = overflow_e;
900 
        if (!optop(e))
901 
          overflow_e = e;
902 
	uop(absop, sh(e), son(e), dest, stack);
903 
	overflow_e = old_overflow_e;
904 
	return;
905 
      };
906 
    case offset_max_tag:
907 
    case max_tag:
908 
      {
909 
	bop(maxop, sh(e), son(e), bro(son(e)), dest, stack);
910 
	return;
911 
      };
912 
    case min_tag:
913 
      {
914 
	bop(minop, sh(e), son(e), bro(son(e)), dest, stack);
915 
	return;
916 
      };
917 
   case offset_subtract_tag:
918 
      {
919 
	bop(sub, sh(e), bro(son(e)), son(e), dest, stack);
920 
	return;
921 
      };
922 
    case offset_mult_tag:
923 
      {
924 
	bop(mult, slongsh, son(e), bro(son(e)), dest, stack);
925 
	return;
926 
      };
927 
    case offset_negate_tag: {
928 
	uop(negate, sh(e), son(e), dest, stack);
929 
	return;
930 
      };
931 
    case offset_div_by_int_tag:
932 
      {
933 
	bop(div0, sh(e), bro(son(e)), son(e), dest, stack);
934 
	return;
935 
      };
936 
    case offset_div_tag:
937 
      {
938 
	if (shape_size(sh(e)) == 32)
939 
	  bop(div0, sh(e), bro(son(e)), son(e), dest, stack);
940 
	else
941 
	if (inmem(dest)) {
942 
	  bop(div0, sh(son(e)), bro(son(e)), son(e), reg0, stack);
943 
	  change_var(sh(e), reg0, dest);
6 7u83 944 
	}
121 7u83 945 
	else {
946 
	  bop(div0, sh(son(e)), bro(son(e)), son(e), dest, stack);
947 
	  change_var(sh(e), dest, dest);
6 7u83 948 
	}
121 7u83 949 
	return;
950 
      };
951 
    case absbool_tag:
952 
      {
953 
	failer(NO_SETCC);
954 
        return;
955 
      };
6 7u83 956 
 
121 7u83 957 
    case int_to_bitf_tag:
958 
     {
959 
       int mask = lsmask[shape_size(sh(e))];
960 
       move(slongsh, mw(son(e), 0), dest);
961 
       and(slongsh, mw(zeroe, mask), dest, dest);
962 
       return;
963 
     };
964 
    case bitf_to_int_tag:
965 
      coder(reg0, stack, son(e));
966 
      change_var_sh(sh(e), sh(son(e)), reg0, dest);
967 
      return;
968 
    case alloca_tag:
969 
      coder(dest, stack, e);
970 
      return;
971 
    case power_tag:
972 
      failer("integer power not implemented");
973 
      return;
974 
    case cont_tag:
975 
      if (!newcode && name(sh(e)) == bitfhd)
976 
        {
977 
          mem_to_bits(e, sh(e), dest, stack);
978 
          return;
979 
        };
980 
       /* deliberate fall through into default */
981 
    default:
982 
      {
983 
	if (!is_o (name (e))) {	/* e is not a possible 80386 operand,
984 
				   precompute it into reg0 and move to
985 
				   dest */
986 
	  where qw;
987 
	  qw.where_exp = copyexp(reg0.where_exp);
988 
	  sh(qw.where_exp) = sh(e);
989 
	  qw.where_off = 0;
990 
	  coder(qw, stack, e);
991 
	  move(sh(e), qw, dest);
992 
	  retcell(qw.where_exp);
993 
          cond1_set = 0;
994 
	  return;
995 
	};
6 7u83 996 
 
121 7u83 997 
	if (is_crc(e) && name(e)!= name_tag
998 
		 && name(e)!= reff_tag && name(e)!= field_tag) {
999 
	  exp s = son(e);
1000 
	  exp ss = son(s);
1001 
	  exp sss = ss;
1002 
	  exp * p = & son(e);
6 7u83 1003 
 
121 7u83 1004 
	  if (name(s) == reff_tag) {
1005 
	    sss = son(ss);
1006 
	    p = & son(s);
1007 
	  }
6 7u83 1008 
 
121 7u83 1009 
	  if (name(sss) == name_tag && ptno(son(sss)) == reg_pl) {
1010 
	    move(sh(e), mw(e, 0), dest);
1011 
	    return;
1012 
	  }
1013 
	  else {
1014 
	    exp temp = copyexp(reg0.where_exp);
1015 
	    exp preserve = *p;
1016 
	    coder(reg0, stack, *p);
1017 
	    *p = temp;
1018 
	    move(sh(e), mw(e, 0), dest);
1019 
	    *p = preserve;	/* may still be needed for diags */
1020 
	    return;
1021 
	  }
1022 
	}
6 7u83 1023 
 
1024 
 
121 7u83 1025 
	if (name(e) == reff_tag &&
1026 
	   (name(son(e)) == name_tag ||
1027 
	     (name(son(e)) == cont_tag &&
1028 
		name(son(son(e))) == name_tag))) {
1029 
	  /* look for case when reff should be done by add */
1030 
	  add(slongsh, mw(son(e), 0), mw(zeroe, no(e) / 8), dest);
1031 
	  return;
1032 
	};
6 7u83 1033 
 
121 7u83 1034 
	if ((name(e) == name_tag && isvar(son(e))) ||
1035 
	    name(e) == reff_tag ||
1036 
           (PIC_code && name(e) == name_tag && isglob(son(e)) &&
1037 
               name(sh(son(e))) == prokhd &&
1038 
               !brog(son(e)) ->  dec_u.dec_val.extnamed)) {
1039 
          if (ptno(son(e))!= nowhere_pl)
1040 
	    mova(mw(e, 0), dest);
1041 
	  return;
1042 
	};
6 7u83 1043 
 
121 7u83 1044 
        if (name(e) == clear_tag)
1045 
          {
1046 
            if ((name(sh(e)) >= shrealhd && name(sh(e)) <= doublehd &&
1047 
		!inmem(dest)) || name(dest.where_exp) == apply_tag)
1048 
              move(sh(e), fzero, dest);
1049 
            return;
1050 
          };
6 7u83 1051 
 
1052 
 
121 7u83 1053 
	/* other values */
1054 
 
1055 
	if (name(e)!= top_tag && name(e)!= prof_tag)
1056 
	  move(sh(e), mw(e, 0), dest);
1057 
	else
1058 
	  top_regsinuse = regsinuse;
1059 
	return;
1060 
      };
1061 
  };
6 7u83 1062 
}