WebSVN – tendra.SVN – Blame – /branches/algol60/src/installers/amd64/common/coder.c

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/coder.c */`
		62
		63	`/**********************************************************************`
		64	$Author: pwe $
		65	$Date: 1998/03/15 16:00:13 $
		66	$Revision: 1.4 $
		67	$Log: coder.c,v $
		68	`* Revision 1.4 1998/03/15 16:00:13 pwe`
		69	`* regtrack dwarf dagnostics added`
		70	`*`
		71	`* Revision 1.3 1998/03/11 11:03:01 pwe`
		72	`* DWARF optimisation info`
		73	`*`
		74	`* Revision 1.2 1998/02/18 11:21:59 pwe`
		75	`* test corrections`
		76	`*`
		77	`* Revision 1.1.1.1 1998/01/17 15:55:51 release`
		78	`* First version to be checked into rolling release.`
		79	`*`
		80	`* Revision 1.49 1997/12/08 16:44:33 pwe`
		81	`* make_compound`
		82	`*`
		83	`* Revision 1.48 1997/12/04 20:00:53 pwe`
		84	`* ANDF-DE V1.9`
		85	`*`
		86	`* Revision 1.47 1997/10/28 10:26:31 pwe`
		87	`* correct extra diags / locations`
		88	`*`
		89	`* Revision 1.46 1997/10/23 09:36:49 pwe`
		90	`* extra_diags`
		91	`*`
		92	`* Revision 1.45 1997/10/10 18:24:55 pwe`
		93	`* prep ANDF-DE revision`
		94	`*`
		95	`* Revision 1.44 1997/08/23 13:45:23 pwe`
		96	`* initial ANDF-DE`
		97	`*`
		98	`* Revision 1.43 1997/04/21 08:31:05 pwe`
		99	`* amend reg record at end of scope`
		100	`*`
		101	`* Revision 1.42 1997/04/17 11:55:34 pwe`
		102	`* dwarf2 improvements`
		103	`*`
		104	`* Revision 1.41 1997/03/20 16:23:29 pwe`
		105	`* dwarf2`
		106	`*`
		107	`* Revision 1.40 1997/02/18 11:42:46 pwe`
		108	`* NEWDIAGS for debugging optimised code`
		109	`*`
		110	`* Revision 1.39 1996/12/13 14:39:13 pwe`
		111	`* prep NEWDIAGS`
		112	`*`
		113	`* Revision 1.38 1996/12/10 15:11:27 pwe`
		114	`* prep NEWDIAGS`
		115	`*`
		116	`* Revision 1.37 1996/11/08 16:18:56 pwe`
		117	`* check_stack to check before modifying stack`
		118	`*`
		119	`* Revision 1.36 1996/10/08 07:58:50 pwe`
		120	`* revised correction to env_offset v id out_of_line`
		121	`*`
		122	`* Revision 1.35 1996/10/07 13:31:00 pwe`
		123	`* push make_value, and env_offset v id out_of_line`
		124	`*`
		125	`* Revision 1.34 1996/07/31 12:56:31 pwe`
		126	`* restore alloca stack after longjump`
		127	`*`
		128	`* Revision 1.33 1996/07/10 15:44:24 pwe`
		129	`* visible ptr top (for AVS 3.0)`
		130	`*`
		131	`* Revision 1.32 1996/05/20 14:30:06 pwe`
		132	`* improved 64-bit handling`
		133	`*`
		134	`* Revision 1.31 1996/05/13 12:51:49 pwe`
		135	`* undo premature commit`
		136	`*`
		137	`* Revision 1.29 1996/03/12 12:44:07 pwe`
		138	`* 64-bit ints compatible with gcc long long`
		139	`*`
		140	`* Revision 1.28 1996/02/20 14:44:55 pwe`
		141	`* linux/elf return struct`
		142	`*`
		143	`* Revision 1.27 1996/01/31 13:02:29 pwe`
		144	`* general proc with postlude used in proc parameter position`
		145	`*`
		146	`* Revision 1.26 1996/01/17 11:24:17 pwe`
		147	`* resurrect performance`
		148	`*`
		149	`* Revision 1.25 1996/01/11 14:02:15 pwe`
		150	`* struct return v postludes (again)`
		151	`*`
		152	`* Revision 1.24 1996/01/10 13:59:42 pwe`
		153	`* apply with varcallees within postlude`
		154	`*`
		155	`* Revision 1.23 1996/01/05 16:25:15 pwe`
		156	`* env_size and env_offset within constant expressions`
		157	`*`
		158	`* Revision 1.22 1995/12/14 16:49:09 pwe`
		159	`* postlude with struct result`
		160	`*`
		161	`* Revision 1.21 1995/11/01 18:41:04 pwe`
		162	`* PIC tail_call and exception handling`
		163	`*`
		164	`* Revision 1.20 1995/10/25 17:41:08 pwe`
		165	`* PIC_code current_env and callees`
		166	`*`
		167	`* Revision 1.19 1995/10/09 15:14:05 pwe`
		168	`* dynamic initialisation etc`
		169	`*`
		170	`* Revision 1.18 1995/09/29 16:17:49 pwe`
		171	`* gcc_compatible default on Linux`
		172	`*`
		173	`* Revision 1.17 1995/09/26 16:46:41 pwe`
		174	`* compare with zero to ignore previous overflow`
		175	`*`
		176	`* Revision 1.16 1995/09/08 12:51:01 pwe`
		177	`* exceptions improved`
		178	`*`
		179	`* Revision 1.15 1995/09/05 16:24:37 pwe`
		180	`* specials and exception changes`
		181	`*`
		182	`* Revision 1.14 1995/09/01 17:29:56 pwe`
		183	`* traps and Build scripts`
		184	`*`
		185	`* Revision 1.13 1995/08/30 16:06:17 pwe`
		186	`* prepare exception trapping`
		187	`*`
		188	`* Revision 1.12 1995/08/23 09:42:27 pwe`
		189	`* track fpu control word for trap etc`
		190	`*`
		191	`* Revision 1.11 1995/08/14 13:53:20 pwe`
		192	`* several corrections, tail calls and error jumps`
		193	`*`
		194	`* Revision 1.10 1995/08/04 08:28:58 pwe`
		195	`* 4.0 general procs implemented`
		196	`*`
		197	`* Revision 1.9 1995/04/13 11:32:16 pwe`
		198	`* catch discards with side effects`
		199	`*`
		200	`* Revision 1.8 1995/03/23 13:25:33 pwe`
		201	`* limit scale in deeply nested repeats`
		202	`*`
		203	`* Revision 1.7 1995/02/27 10:58:52 pwe`
		204	`* local_free val_tag offsets treated similar to alloca`
		205	`*`
		206	`* Revision 1.6 1995/02/23 10:24:13 pwe`
		207	`* correction to compare env_offset`
		208	`*`
		209	`* Revision 1.5 1995/02/22 11:49:14 pwe`
		210	`* compare env_offset`
		211	`*`
		212	`* Revision 1.4 1995/02/01 18:51:13 pwe`
		213	`* correct empty make_nof`
		214	`*`
		215	`* Revision 1.3 1995/01/30 12:56:00 pwe`
		216	`* Ownership -> PWE, tidy banners`
		217	`*`
		218	`* Revision 1.2 1994/11/08 09:00:14 jmf`
		219	`* Corrected ncopies - NOT TO COPY`
		220	`*`
		221	`* Revision 1.1 1994/10/27 14:15:22 jmf`
		222	`* Initial revision`
		223	`*`
		224	`* Revision 1.7 1994/08/19 13:14:15 jmf`
		225	`* goto_tag: do final_dest before elimination of redundant jump,`
		226	`* so that jump to next; jump L is treated better.`
		227	`*`
		228	`* Revision 1.6 1994/08/09 11:54:31 jmf`
		229	`* alloc_reg: change to refuse reals which are variables.`
		230	`*`
		231	`* Revision 1.5 1994/08/04 10:22:36 jmf`
		232	`* Unon`
		233	`* Undone last fix to test and testbit. Changed label_ops`
		234	`*`
		235	`* Revision 1.4 1994/08/04 09:13:25 jmf`
		236	`* test and testbit: only swap labels if there is a single use.`
		237	`*`
		238	`* Revision 1.3 1994/07/12 15:37:26 jmf`
		239	`* Corrected silly synatx error l29`
		240	`*`
		241	`* Revision 1.2 1994/07/12 15:16:42 jmf`
		242	`* Change to align_label(2 in solve`
		243	`* Removed is_tester (now in misc_c.c`
		244	`*`
		245	`* Revision 1.1 1994/07/12 14:28:00 jmf`
		246	`* Initial revision`
		247	`*`
		248	`**********************************************************************/`
		249
		250
		251	`/**********************************************************************`
		252
		253	`coder.c`
		254
		255	`coder produces code for expressions. It calls codec to produce code`
		256	`for expressions which deliver results, and produces code itself for`
		257	`the others.`
		258
		259	`**********************************************************************/`
		260
		261
		262	`#include "config.h"`
		263	`#include <limits.h>`
		264	`#include "common_types.h"`
		265	`#include "weights.h"`
		266	`#include "basicread.h"`
		267	`#include "tags.h"`
		268	`#include "codermacs.h"`
		269	`#include "instr386.h"`
		270	`#include "expmacs.h"`
		271	`#include "exp.h"`
		272	`#include "operand.h"`
		273	`#include "shapemacs.h"`
		274	`#include "instr.h"`
		275	`#include "instrmacs.h"`
		276	`#include "out.h"`
		277	`#include "check.h"`
		278	`#include "flags.h"`
		279	`#include "codec.h"`
		280	`#include "xalloc.h"`
		281	`#include "global_opt.h"`
		282	`#include "reg_record.h"`
		283	`#include "externs.h"`
		284	`#include "install_fns.h"`
		285	`#include "installglob.h"`
		286	`#include "machine.h"`
		287	`#include "localflags.h"`
		288	`#include "diag_fns.h"`
		289	`#include "messages_8.h"`
		290	`#include "assembler.h"`
		291	`#include "natmacs.h"`
		292	`#include "label_ops.h"`
		293	`#include "misc_c.h"`
		294	`#include "readglob.h"`
		295	`#include "cproc.h"`
		296	`#include "coder.h"`
		297
		298	`#ifdef NEWDIAGS`
		299	`#include "dg_aux.h"`
		300	`#include "dg_globs.h"`
		301	`#endif`
		302
		303	`#ifdef NEWDWARF`
		304	`#include "dw2_config.h"`
		305	`#include "dw2_info.h"`
		306	`#include "dw2_basic.h"`
		307	`#include "dw2_extra.h"`
		308	`#endif`
		309
		310
		311	`extern exp hasenvoff_list;`
		312
		313
		314	`/* MACROS */`
		315
		316	`#define crit_noframe 300`
		317
		318	`#define align_crit 10000.0`
		319
		320
		321
		322	`#define noreg 6`
		323	`#define nobigreg 4`
		324	`#define nosmallreg 2`
		325	`#define bigmask1 0x40`
		326	`#define bigmask1ns 0x8`
		327	`#define bigmask2 0x30`
		328	`#define smallmask1 0x2`
		329	`#define smallmask2 0x6`
		330
		331	`#define nofl 6`
		332	`#define nobigfl 3`
		333	`#define bigflmask 0x1000`
		334	`#define smallflmask 0x200`
		335
		336	`/* VARIABLES */`
		337	`/* All variables initialised */`
		338
		339
		340	`float scale = (float)1.0; /* init by cproc */`
		341
		342
		343	`int crt_ret_lab; /* init by cproc */`
		344	`int crt_ret_lab_used; /* init by cproc */`
		345	`int min_rfree; /* init by cproc */`
		346	`int max_stack; /* init by cproc */`
		347	`int regsinuse; /* init by cproc */`
		348	`outofline odd_bits; / init by cproc */`
		349	`int last_odd_bit; /* init by cproc */`
		350	`int doing_odd_bits; /* init by cproc */`
		351	`outofline current_odd_bit; / init by cproc */`
		352	`exp crt_proc_exp; /* init by cproc */`
		353
		354	`int not_in_params = 1; /* init by cproc */`
		355	`int not_in_postlude = 1; /* init by cproc */`
		356	`int repeat_level = 0; /* init by cproc */`
		357	`int callee_size = 0; /* init by cproc */`
		358	`exp vc_pointer; /* init by cproc */`
		359	`int has_dy_callees = 0; /* init by cproc */`
		360	`int has_tail_call = 0; /* init by cproc */`
		361	`int has_same_callees = 0; /* init by cproc */`
		362	`int need_preserve_stack = 0; /* init by cproc */`
		363	`int proc_has_asm = 0; /* init by cproc */`
		364
		365
		366
		367	`/* PROCEDURES */`
		368
		369	`void`
		370	`clean_stack(void)`
		371	`{`
		372	`if (no_frame && not_in_params && not_in_postlude && stack_dec != 0) {`
		373	`stack_return(-stack_dec);`
		374	`}`
		375	`}`
		376
		377
		378	`/* is this a pushable proc argument ? */`
		379	`static int`
		380	`push_arg(exp e)`
		381	`{`
		382	`shape sha = sh(e);`
		383	`unsigned char n = name(sha);`
		384
		385	`if (name(e) == real_tag) {`
		386	`return 1;`
		387	`}`
		388
		389	`if (is_floating(n) \|\| n == cpdhd \|\| n == nofhd) {`
		390	`return 0;`
		391	`}`
		392
		393	`return(1);`
		394	`}`
		395
		396
		397	`static void`
		398	`code_push(ash stack, exp t)`
		399	`{`
		400	`int n = (int)name(t);`
		401	`if (is_o(n)) {`
		402	`coder(pushdest, stack, t);`
		403	`} else {`
		404	`coder(reg0, stack, t);`
		405	`move(sh(t), reg0, pushdest);`
		406	`}`
		407	`return;`
		408	`}`
		409
		410
		411	`/* produce the code for proc params in order from last to first */`
		412	`static void`
		413	`code_pars(ash stack, exp t)`
		414	`{`
		415	`int tsize = shape_size(sh(t));`
		416	`/* last parameter is pushed first */`
		417	`if (last (t)) {`
		418	`code_push(stack,(name(t) == caller_tag) ? son(t) : t);`
		419	`stack_dec -= rounder(tsize, param_align);`
		420	`} else {`
		421	`/* encode the rest of the parameters */`
		422	`code_pars (stack, bro (t));`
		423	`/* code this parameter */`
		424	`code_push (stack, (name(t)==caller_tag) ? son(t) : t);`
		425	`stack_dec -= rounder(tsize, param_align);`
		426	`/* allow for the size */`
		427	`}`
		428	`}`
		429
		430
		431	`/* stack parameters ready for apply_proc */`
		432	`static int`
		433	`procargs(ash stack, exp arg, int has_checkstack)`
		434	`{`
		435	`int use_push = 1;`
		436	`int longs = 0, extra;`
		437	`exp t = arg;`
		438	`while (t != nilexp) {`
		439	`if (name(t) ==caller_tag) {`
		440	`if (use_push && !push_arg(son(t))) {`
		441	`use_push = 0;`
		442	`}`
		443	`no(t) = longs; /* needed for postlude */`
		444	`} else {`
		445	`if (use_push && !push_arg(t)) {`
		446	`use_push = 0;`
		447	`}`
		448	`}`
		449	`longs = rounder(longs + shape_size(sh(t)), param_align);`
		450	`if (last(t)) {`
		451	`break;`
		452	`}`
		453	`t = bro(t);`
		454	`}`
		455	`extra = (longs - stack_dec)% stack_align;`
		456	`longs += extra;`
		457
		458	`if (use_push) {`
		459	`/* push instructions can be used. Note that stack_dec is moved`
		460	`so that instructions which address positively with respect to`
		461	`sp can be changed. */`
		462	`if (extra != 0) {`
		463	`sub(slongsh, mw(zeroe, extra / 8), sp, sp);`
		464	`stack_dec -= extra; /* align stack to param_align */`
		465	`#ifdef NEWDWARF`
		466	`if (diagnose && dwarf2 && no_frame) {`
		467	`dw2_track_sp();`
		468	`}`
		469	`#endif`
		470	`}`
		471	`if (arg != nilexp) {`
		472	`if (has_checkstack && longs > 160) {`
		473	`/* check stack before pushing args if more than`
		474	`* 5 words */`
		475	`checkalloc_stack(mw(zeroe, longs / 8), 0);`
		476	`}`
		477	`code_pars(stack, arg);`
		478	`}`
		479	`} else {`
		480	`/* if push cannot be used, move the stack down first, and then`
		481	`assemble the parameters in place. Again, adjust stack_dec. */`
		482	`int off = extra;`
		483	`if (has_checkstack) {`
		484	`checkalloc_stack(mw(zeroe, longs/8), 1);`
		485	`} else {`
		486	`decstack(longs);`
		487	`}`
		488	`cond1_set = 0;`
		489	`cond2_set = 0;`
		490	`stack_dec -= longs;`
		491	`#ifdef NEWDWARF`
		492	`if (diagnose && dwarf2 && no_frame) {`
		493	`dw2_track_sp();`
		494	`}`
		495	`#endif`
		496
		497	`t = arg;`
		498	`while (1) {`
		499	`coder(mw(ind_sp.where_exp, off), stack,`
		500	`(name(t) == caller_tag ? son(t) : t));`
		501	`off = rounder(off + shape_size(sh(t)), param_align);`
		502	`if (last(t)) {`
		503	`break;`
		504	`}`
		505	`t = bro(t);`
		506	`}`
		507	`}`
		508	`return longs;`
		509	`}`
		510
		511
		512	`/* stack dynamic or same callees */`
		513	`/* %edx and %ecx don't need to be preserved */`
		514	`static int`
		515	`push_cees(exp src, exp siz, int vc, ash stack)`
		516	`{`
		517	`int old_regsinuse = regsinuse;`
		518	`int longs = -1;`
		519	`if (siz == nilexp && callee_size >= 0)`
		520	`longs = callee_size;`
		521	`if (siz != nilexp && name(siz) == val_tag)`
		522	`longs = rounder(no(siz), param_align);`
		523	`if (longs == 0) {`
		524	`if (vc) {`
		525	`ins2(leal, 32, 32, mw(ind_sp.where_exp, longs), reg0);`
		526	`ins0(pusheax);`
		527	`stack_dec -= 32;`
		528	`return(32);`
		529	`}`
		530	`return(0);`
		531	`}`
		532	`if (longs < 0) {`
		533	`must_use_bp = 1; /* scan2 must ensure !no_frame */`
		534	`if (siz == nilexp) {`
		535	`/* calculate size from calling proc callees */`
		536	`outs(" movl 8(%ebp),%eax\n");`
		537	`outs(" subl %ebp,%eax\n");`
		538	`outs(" subl $12,%eax\n");`
		539	`} else {`
		540	`coder(reg0, stack, siz);`
		541	`if (al2(sh(siz)) < param_align) {`
		542	`if (al2(sh(siz)) == 1) {`
		543	`outs(" addl $31,%eax\n");`
		544	`outs(" shrl $3,%eax\n");`
		545	`} else {`
		546	`outs(" addl $3,%eax\n");`
		547	`}`
		548	`outs(" andl $-4,%eax\n");`
		549	`}`
		550	`}`
		551	`ins0(pusheax);`
		552	`stack_dec -= 32;`
		553	`}`
		554	`if (src == nilexp) {`
		555	`if (callee_size >= 0) {`
		556	`outs(" leal 8(%ebp),%eax\n");`
		557	`} else {`
		558	`outs(" leal 12(%ebp),%eax\n");`
		559	`}`
		560	`} else {`
		561	`coder(reg0, stack, src);`
		562	`}`
		563	`move(slongsh, reg5, reg1);`
		564	`move(slongsh, reg0, reg5);`
		565	`if (longs < 0) {`
		566	`ins0(popecx);`
		567	`stack_dec += 32;`
		568	`if (vc) {`
		569	`outs(" movl %esp,%eax\n");`
		570	`}`
		571	`outs(" subl %ecx,%esp\n");`
		572	`outs(" shrl $2,%ecx\n");`
		573	`if (vc)`
		574	`outs(" pushl %eax\n");`
		575	`} else {`
		576	`sub(slongsh, mw(zeroe, longs / 8), sp, sp);`
		577	`stack_dec -= longs;`
		578	`if (vc) {`
		579	`ins2(leal, 32, 32, mw(ind_sp.where_exp, longs), reg0);`
		580	`ins0(pusheax);`
		581	`stack_dec -= 32;`
		582	`}`
		583	`move(slongsh, mw(zeroe, longs / 32), reg2);`
		584	`if (vc) {`
		585	`longs += 32;`
		586	`}`
		587	`}`
		588	`move(slongsh, reg4, reg0);`
		589	`if (vc) {`
		590	`outs(" leal 4(%esp),%edi\n");`
		591	`} else {`
		592	`outs(" movl %esp,%edi\n");`
		593	`}`
		594	`outs(" rep\n movsl\n");`
		595	`move(slongsh, reg0, reg4);`
		596	`move(slongsh, reg1, reg5);`
		597	`regsinuse = old_regsinuse;`
		598	`invalidate_dest(reg1);`
		599	`invalidate_dest(reg2);`
		600	`invalidate_dest(reg4);`
		601	`invalidate_dest(reg5);`
		602	`return longs;`
		603	`}`
		604
		605
		606	`/*********************************************************************`
		607	`alloc_reg tries to choose registers for a value of shape sha.`
		608	`If there is no room, can_do of the result is 0, otherwise 1.`
		609	`If it can, ru_regs of result is the registers (as bit pattern)`
		610	`and ru_reg_free contains the bit pattern for the registers in use.`
		611	`rs is the bit pattern for the registers in use. All the registers must`
		612	`be above br (register number as integer, ie 0 for reg0 etc)`
		613
		614	`*********************************************************************/`
		615	`/* number of bits in the index */`
		616	`int bits_in[16] = {`
		617	`0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4`
		618	`};`
		619
		620	`/* allocate registers ebx esi edi, providing br registers are left */`
		621	`static regu`
		622	`alloc_reg_big(int rs, shape sha, int br, int byteuse)`
		623	`{`
		624	`int sz, nr, mask, i;`
		625	`int reg_left; /* number of registers available */`
		626	`regu ru;`
		627	`int noshort = 0;`
		628	`sz = shape_size(sha);`
		629	`if (sz <= 8 \|\| byteuse) {`
		630	`noshort = 3;`
		631	`}`
		632	`nr = (sz + 31) / 32;`
		633	`reg_left = noreg - noshort - bits_in[rs & 0xf] -`
		634	`bits_in[((unsigned int)rs >> 4) & 0x7];`
		635
		636	`/* can't allocate */`
		637	`if ((reg_left) < (br)) {`
		638	`ru.can_do = 0;`
		639	`return(ru);`
		640	`}`
		641
		642	`/* number of registers needed (consecutive) */`
		643	`switch (nr) {`
		644	`case 1:`
		645	`mask = (noshort == 0) ? bigmask1 : bigmask1ns;`
		646	`i = nobigreg - noshort;`
		647	`break;`
		648	`case 2:`
		649	`mask = bigmask2;`
		650	`i = nobigreg - 1;`
		651	`break;`
		652	`default:`
		653	`SET(mask);`
		654	`SET(i);`
		655	`failer(WRONG_REGSIZE);`
		656	`}`
		657
		658	`while ((rs & mask) != 0 && i > 0) {`
		659	`mask = (int)((unsigned int)mask >> 1);`
		660	`--i;`
		661	`}`
		662
		663	`if (i > 0) {`
		664	`/* allocate registers */`
		665	`min_rfree \|= mask;`
		666	`ru.can_do = 1;`
		667	`ru.ru_regs = mask;`
		668	`ru.ru_reg_free = rs \| mask;`
		669	`} else {`
		670	`ru.can_do = 0;`
		671	`}`
		672
		673	`return(ru);`
		674	`}`
		675
		676
		677	`/* allocate registers ecx edx ebx esi edi if at least br registers are`
		678	`* available */`
		679	`static regu`
		680	`alloc_reg_small(int rs, shape sha, int br, int byteuse)`
		681	`{`
		682	`int sz, nr, mask, i;`
		683	`int reg_left; /* number of registers left */`
		684	`regu ru;`
		685	`int noshort = 0;`
		686	`sz = shape_size(sha);`
		687	`if (sz <= 8 \|\| byteuse) {`
		688	`noshort = 3;`
		689	`}`
		690	`nr = (sz + 31) / 32;`
		691	`reg_left = noreg - noshort - bits_in[rs & 0xf] -`
		692	`bits_in[((unsigned int)rs >> 4) & 0x7];`
		693
		694	`/* can't allocate */`
		695	`if ((reg_left) < (br)) {`
		696	`ru.can_do = 0;`
		697	`return(ru);`
		698	`}`
		699
		700	`/* number of registers needed (consecutive) */`
		701	`switch (nr) {`
		702	`case 1:`
		703	`mask = smallmask1;`
		704	`i = nosmallreg;`
		705	`break;`
		706	`case 2:`
		707	`mask = smallmask2;`
		708	`i = nosmallreg - 1;`
		709	`break;`
		710	`default:`
		711	`SET(mask);`
		712	`SET(i);`
		713	`failer(WRONG_REGSIZE);`
		714	`}`
		715
		716	`while ((rs & mask) != 0 && i > 0) {`
		717	`mask = (int)((unsigned int)mask << 1);`
		718	`--i;`
		719	`}`
		720
		721	`if (i > 0) {`
		722	`/* allocate */`
		723	`min_rfree \|= mask;`
		724	`ru.can_do = 1;`
		725	`ru.ru_regs = mask;`
		726	`ru.ru_reg_free = rs \| mask;`
		727	`return(ru);`
		728	`} else {`
		729	`return alloc_reg_big(rs, sha, br, byteuse);`
		730	`}`
		731
		732	`}`
		733
		734
		735	`/* allocate floating point registers, if at least br are available */`
		736	`static regu`
		737	`alloc_fl_small(int rs, int br)`
		738	`{`
		739	`int mask, i, reg_left;`
		740	`regu ru;`
		741	`reg_left = nofl - bits_in[((unsigned int)rs >> 8) & 0xf] -`
		742	`bits_in[((unsigned int)rs >> 12) & 0xf];`
		743
		744
		745	`if ((reg_left) < (br)) {`
		746	`/* can't allocate */`
		747	`ru.can_do = 0;`
		748	`return(ru);`
		749	`}`
		750
		751	`mask = smallflmask;`
		752	`i = nofl;`
		753
		754	`while ((rs & mask)!= 0 && i > 0) {`
		755	`mask = (int)((unsigned int)mask << 1);`
		756	`--i;`
		757	`}`
		758
		759	`if (i > 0) {`
		760	`/* allocate */`
		761	`ru.can_do = 1;`
		762	`ru.ru_regs = mask;`
		763	`ru.ru_reg_free = rs \| mask;`
		764	`} else {`
		765	`/* can't allocate */`
		766	`ru.can_do = 0;`
		767	`}`
		768
		769	`return(ru);`
		770	`}`
		771
		772
		773	`/* allocate all registers */`
		774	`static regu`
		775	`alloc_reg(int rs, shape sha, int br, int big_reg, exp e)`
		776	`{`
		777	`if (name(sha) >= shrealhd && name(sha) <= doublehd) {`
		778	`#ifdef NEWDIAGS`
		779	`if (big_reg \|\| diag_visible \|\| round_after_flop \|\|`
		780	`#else`
		781	`if (big_reg \|\| diagnose \|\| round_after_flop \|\|`
		782	`#endif`
		783	`(is80586 && isvar(e))) {`
		784	`regu ru;`
		785	`ru.can_do = 0;`
		786	`return(ru);`
		787	`} else {`
		788	`return(alloc_fl_small(rs, br));`
		789	`}`
		790	`}`
		791
		792	`if (big_reg) {`
		793	`return(alloc_reg_big(rs, sha, br, isbyteuse(e)));`
		794	`} else {`
		795	`return(alloc_reg_small(rs, sha, br, isbyteuse(e)));`
		796	`}`
		797	`}`
		798
		799
		800	`/************************************************************************`
		801	`def_where choose where to put a declaration. e is the declaration.`
		802	`def is the definition (for identity) or initialisation (for variable).`
		803	`stack is the ash for the current stack position. The alignment for the`
		804	`stack on the 80386 for the cc implementation is always 32 bits, but it`
		805	`might not be on other implementations.`
		806	`The dcl returned gives`
		807	`dcl_pl - code for where value is (eg reg_pl for registers). These`
		808	`codes are defined in codermacs.h`
		809	`dcl_n - the offset (in bits) where the value starts if it is on the`
		810	`stack.`
		811	`the bit pattern for the registers if it is in registers.`
		812	`dcl_place - the ash for the stack after the allocation. This will`
		813	`be the same as stack if the allocation is in registers.`
		814	`dcl_new - 1 if this is a new declaration. 0 if it renaming an`
		815	`existing value, and the old one is being reused.`
		816
		817	`************************************************************************/`
		818
		819	`static dcl`
		820	`alloc_regable(dcl dc, exp def, exp e, int big_reg)`
		821	`{`
		822	`where alt;`
		823	`int defsize = shape_size(sh(def));`
		824	`regu ru;`
		825	`alt = equiv_reg(mw(def, 0), defsize);`
		826
		827	`if (alt.where_exp != nilexp) {`
		828	`int mask = no(son(alt.where_exp));`
		829	`if (mask != 1 && (!big_reg \|\| mask >= 0x8)) {`
		830	`if ((mask & regsinuse)!= 0 && !isvar(e) &&`
		831	`(defsize > 8 \|\| mask < 0x10)) {`
		832	`if (no_side(bro(son(e)))) {`
		833	`dc.dcl_pl = reg_pl;`
		834	`dc.dcl_n = mask;`
		835	`dc.dcl_new = 0;`
		836	`return(dc);`
		837	`}`
		838	`}`
		839	`}`
		840	`}`
		841
		842	`if (ru = alloc_reg(regsinuse, sh(def), no(e), big_reg, e), ru.can_do) {`
		843	`if (alt.where_exp != nilexp) {`
		844	`int mask = no(son(alt.where_exp));`
		845	`if (mask != 1 && (!big_reg \|\| mask >= 0x8)) {`
		846	`if ((mask & regsinuse) == 0 &&`
		847	`(defsize > 8 \|\| mask < 0x10)) {`
		848	`dc.dcl_pl = reg_pl;`
		849	`dc.dcl_n = mask;`
		850	`return(dc);`
		851	`}`
		852	`}`
		853	`}`
		854
		855	`dc.dcl_pl = reg_pl;`
		856	`dc.dcl_n = ru.ru_regs;`
		857	`return(dc);`
		858	`}`
		859	`dc.dcl_pl = 0;`
		860	`return(dc);`
		861	`}`
		862
		863
		864	`static dcl`
		865	`def_where(exp e, exp def, ash stack)`
		866	`{`
		867	`int big_reg = has_intnl_call(e);`
		868	`dcl dc;`
		869	`ash locash;`
		870	`exp body = bro(def);`
		871	`dc.dcl_place = stack;`
		872	`dc.dcl_new = 1;`
		873
		874	`if (name(sh(def)) == tophd && !isvis(e)) {`
		875	`dc.dcl_pl = nowhere_pl;`
		876	`dc.dcl_n = 0;`
		877	`return(dc);`
		878	`}`
		879
		880	`if (name(def) == name_tag && !isvar(son(def)) &&`
		881	`no(def) == 0 && isloadparam(def)) {`
		882	`if (regable(e) && (name(son(son(def))) == formal_callee_tag ?`
		883	`!has_same_callees : !has_tail_call)) {`
		884	`dcl ndc;`
		885	`ndc = alloc_regable(dc, def, e, big_reg);`
		886	`if (ndc.dcl_pl != 0) {`
		887	`/* local copy of arg in register */`
		888	`return(ndc);`
		889	`}`
		890	`}`
		891	`dc.dcl_pl = ptno(son(def));`
		892	`dc.dcl_n = no(son(def));`
		893	`dc.dcl_new = 0;`
		894	`return dc;`
		895	`}`
		896
		897	`if (!isvar(e) &&`
		898	`((name(def) == name_tag && !isvar(son(def)) &&`
		899	`(!isglob(son(def)))) \|\|`
		900	`(name(def) == cont_tag && name(son(def)) == name_tag &&`
		901	`isvar(son(son(def))) && (!isglob(son(son(def)))) &&`
		902	`no_side(body)))) {`
		903	`/* either we are identifying something already identified or`
		904	`* the contents of a variable which is not altered by the body`
		905	`* of the definition */`
		906	`if (name(def) == name_tag) {`
		907	`dc.dcl_pl = ptno(son(def));`
		908	`dc.dcl_n = no(son(def)) + no(def);`
		909	`} else {`
		910	`dc.dcl_pl = ptno(son(son(def)));`
		911	`dc.dcl_n = no(son(son(def))) + no(son(def));`
		912	`}`
		913
		914	`/* we have the declaration */`
		915	`if (dc.dcl_pl == reg_pl) {`
		916	`/* if the old one was in registers, reuse it. */`
		917	`dc.dcl_new = 0;`
		918	`return(dc);`
		919	`}`
		920
		921	`if (regable(e)) {`
		922	`dcl ndc;`
		923	`ndc = alloc_regable(dc, def, e, big_reg);`
		924	`if (ndc.dcl_pl != 0) {`
		925	`return(ndc);`
		926	`}`
		927	`}`
		928
		929	`/* if there was not room, reuse the old dec */`
		930	`dc.dcl_new = 0;`
		931	`return(dc);`
		932	`}`
		933
		934	`/* try to allocate in registers, except when narrowing fp variety */`
		935	`if (regable(e) &&`
		936	`(name(def)!= chfl_tag \|\| name(sh(def)) >= name(sh(son(def))))) {`
		937	`dcl ndc;`
		938	`ndc = alloc_regable(dc, def, e, big_reg);`
		939	`if (ndc.dcl_pl != 0)`
		940	`return(ndc);`
		941	`}`
		942
		943
		944	`/* otherwise allocate on the stack */`
		945
		946	`{`
		947	`int a = 32;`
		948	`shape s = sh(def);`
		949	`if (stack_aligned_8byte &&`
		950	`(name(s) == realhd \|\| (name(s) == nofhd &&`
		951	`ptno(s) == realhd))) {`
		952	`a = 64;`
		953	`}`
		954
		955	`locash.ashalign = 32;`
		956	`dc.dcl_n = rounder(stack.ashsize, a);`
		957
		958	`locash.ashsize = dc.dcl_n + shape_size(sh(def));`
		959
		960	`dc.dcl_place = locash;`
		961	`dc.dcl_pl = local_pl;`
		962	`return(dc);`
		963	`}`
		964	`}`
		965
		966
		967	`/***********************************************************************`
		968	`solve produces the code for the solve construction.`
		969	`s is the whole list of braches`
		970	`l is the branches of which the label record have not been created.`
		971	`dest is the destination for the value produced by each branch`
		972	`jr is the jump record for the end of the construction.`
		973	`stack is the initial stack ash`
		974	`***********************************************************************/`
		975
		976	`static void`
		977	`solve(exp s, exp l, where dest, exp jr, ash stack)`
		978	`{`
		979	`while (!last (l)) {`
		980	`/* not the last branch */`
		981	`exp record = getexp(f_bottom, nilexp,`
		982	`(bool)(props(son(bro(l))) & 2), nilexp,`
		983	`nilexp, 0, 0, 0);`
		984	`sonno(record) = stack_dec;`
		985	`ptno(record) = next_lab();`
		986	`fstack_pos_of(record) = (prop)fstack_pos; /* CAST:jmf: */`
		987	`/* record the floating point stack position, fstack_pos */`
		988	`/* record is jump record for the label */`
		989	`pt (son (bro (l))) = record;/* put it away */`
		990	`l = bro(l);`
		991	`}`
		992
		993	`{`
		994	`int r1 = regsinuse; /* record regsinuse for the start of`
		995	`each branch and for the end. */`
		996	`exp t;`
		997	`if (name(s)!= goto_tag \|\| pt(s)!= bro(s)) {`
		998	`coder (dest, stack, s); /* code the starting exp */`
		999	`#ifdef NEWDIAGS`
		1000	`} else {`
		1001	`diag_arg(dest, stack, s);`
		1002	`#endif`
		1003	`}`
		1004	`reset_fpucon();`
		1005	`t = s;`
		1006	`do {`
		1007	`regsinuse = r1;`
		1008	`if (name(sh(t)) != bothd) {`
		1009	`jump(jr, in_fstack(dest.where_exp));`
		1010	`}`
		1011	`/* only put in jump if needed */`
		1012	`t = bro(t);`
		1013	`align_label(2, pt(son(t)));`
		1014	`set_label(pt(son(t)));`
		1015	`coder(dest, stack, t);`
		1016	`reset_fpucon();`
		1017	`} while (!last(t));`
		1018	`regsinuse = r1;`
		1019	`return;`
		1020	`}`
		1021	`}`
		1022
		1023
		1024	`/**************************************************************************`
		1025	`caser produces the code for the case construction e, putting the`
		1026	`result into dest.`
		1027	`*************************************************************************/`
		1028
		1029	`static void`
		1030	`caser(exp arg, int exhaustive, exp case_exp)`
		1031	`{`
		1032	`exp t = arg;`
		1033	`int n;`
		1034	`int i;`
		1035	`int *v;`
		1036	`int sz;`
		1037	`int min;`
		1038	`int max;`
		1039
		1040	`min=no(bro(arg));`
		1041	`do {`
		1042	`t=bro(t);`
		1043	`} while (bro(t)!=nilexp);`
		1044	`max = ((son(t) == nilexp) ? no(t) : no(son(t)));`
		1045
		1046	`/* prepare to use jump table */`
		1047	`v = (int *)xcalloc(max - min + 1, sizeof(int));`
		1048	`for (i = 0; i < (max - min + 1); ++i)`
		1049	`v[i] = -1;`
		1050	`t = arg;`
		1051	`do {`
		1052	`exp lab;`
		1053	`t = bro(t);`
		1054	`lab = final_dest(pt(t));`
		1055	`n = ptno(pt(son(lab)));`
		1056	`for (i = no(t); i <= ((son(t) == nilexp)? no(t): no(son(t)));`
		1057	`++i) {`
		1058	`v[i - min] = n;`
		1059	`}`
		1060	`} while (bro(t) != nilexp);`
		1061
		1062	`switch (name(sh(arg)))EXHAUSTIVE {`
		1063	`case scharhd:`
		1064	`case ucharhd:`
		1065	`sz = 8;`
		1066	`break;`
		1067	`case swordhd:`
		1068	`case uwordhd:`
		1069	`sz = 16;`
		1070	`break;`
		1071	`case slonghd:`
		1072	`case ulonghd:`
		1073	`sz = 32;`
		1074	`break;`
		1075	`}`
		1076
		1077	`caseins(sz, arg, min, max,v, exhaustive, 0 , case_exp);`
		1078	`/* put in jump table */`
		1079	`return;`
		1080	`}`
		1081
		1082
		1083	`/********************************************************************`
		1084	`coder produces code for all constructions. It uses codec to`
		1085	`produce the code for the non side-effecting constructions. e is`
		1086	`the construction to be processed, dest is where the result is to go,`
		1087	`stack is the ash for the current stack.`
		1088	`********************************************************************/`
		1089
		1090	`static ash`
		1091	`stack_room(ash stack, where dest, int off)`
		1092	`{`
		1093	`if (name(dest.where_exp) == ident_tag)`
		1094	`{`
		1095	`if (ptno(dest.where_exp)!= local_pl) {`
		1096	`return stack;`
		1097	`}`
		1098	`if ((no(dest.where_exp) + off) > stack.ashsize) {`
		1099	`stack.ashsize = no(dest.where_exp) + off;`
		1100	`}`
		1101	`}`
		1102
		1103	`return stack;`
		1104	`}`
		1105
		1106
		1107	`#ifdef NEWDIAGS`
		1108	`static void`
		1109	`coder1(where dest, ash stack, exp e)`
		1110	`#else`
		1111	`void`
		1112	`coder(where dest, ash stack, exp e)`
		1113	`#endif`
		1114	`{`
		1115	`float old_scale;`
		1116	`switch (name(e)) {`
		1117	`case ident_tag: {`
		1118	`exp def = son(e);`
		1119	`exp body = bro(def);`
		1120	`int sz;`
		1121	`dcl dc;`
		1122	`int old_fstack_pos;`
		1123	`if (isinlined(e) && dest.where_off == 0 &&`
		1124	`name(dest.where_exp) == ident_tag &&`
		1125	`(!has_intnl_call(e) \|\| ptno(dest.where_exp)!= reg_pl \|\|`
		1126	`(no(dest.where_exp) > 4 &&`
		1127	`no(dest.where_exp) < smallflmask))) {`
		1128	`dc.dcl_pl = ptno(dest.where_exp);`
		1129	`dc.dcl_n = no(dest.where_exp);`
		1130	`dc.dcl_place.ashsize =`
		1131	`stack.ashsize + shape_size(sh(def));`
		1132	`dc.dcl_place.ashalign = 32;`
		1133	`dc.dcl_new = 1;`
		1134	`} else {`
		1135	`/* allocate space */`
		1136	`dc = def_where (e, def, stack);`
		1137	`}`
		1138
		1139	`sz = (dc.dcl_place).ashsize;`
		1140
		1141	`/* record the allocation in pt and no for when the value is`
		1142	`* used. */`
		1143	`ptno (e) = dc.dcl_pl;`
		1144	`no(e) = dc.dcl_n;`
		1145
		1146	`if (ptno(e) == reg_pl && name(sh(def)) >= shrealhd &&`
		1147	`name(sh(def)) <= doublehd) {`
		1148	`/* if the value being defined is going in the floating`
		1149	`* point registers, record the floating point stack`
		1150	`* level, so that we can ensure that it is the same at`
		1151	`* the end of the construction */`
		1152	`old_fstack_pos = fstack_pos;`
		1153	`}`
		1154
		1155	`if (isenvoff(e)) {`
		1156	`set_env_off(-dc.dcl_n, e);`
		1157	`}`
		1158
		1159	`if (dc.dcl_new) {`
		1160	`/* if it is new we must evaluate the def */`
		1161	`if (ptno(e) == nowhere_pl) {`
		1162	`/* discard the value */`
		1163	`coder (zero, stack, def);`
		1164	`} else {`
		1165	`coder(mw(e, 0), stack, def);`
		1166	`}`
		1167
		1168	`if (ptno(e) == reg_pl) {`
		1169	`/* modify regsinuse if a register is being`
		1170	`* used */`
		1171	`regsinuse \|= dc.dcl_n;`
		1172	`}`
		1173	`if (ptno(e) == local_pl) {`
		1174	`/* modify max_stack if the stack is being`
		1175	`* used */`
		1176	`if (sz > max_stack) {`
		1177	`max_stack = sz;`
		1178	`}`
		1179	`}`
		1180	`}`
		1181
		1182	`/* code the body */`
		1183	`coder (dest, dc.dcl_place, body);`
		1184
		1185	`if (dc.dcl_new && ptno(e) == reg_pl) {`
		1186	`/* restore regsinuse. It is done by removing the bits`
		1187	`* of this allocation, rather than restoring the old`
		1188	`* value, so that allocation and restoration need not`
		1189	`* nest */`
		1190	`regsinuse &= ~dc.dcl_n;`
		1191	`if (name(sh(def)) >= shrealhd &&`
		1192	`name(sh(def)) <= doublehd &&`
		1193	`fstack_pos != (SET(old_fstack_pos)old_fstack_pos) &&`
		1194	`ptno(e) == reg_pl &&`
		1195	`name(sh(e))!= bothd) {`
		1196	`/* restore the floating point registers if`
		1197	`* necessary */`
		1198
		1199	`if (ptno(e) == reg_pl &&`
		1200	`!in_fstack(dest.where_exp)) {`
		1201	`int rn = get_reg_no(no(e));`
		1202	`if (rn == fstack_pos) {`
		1203	`discard_fstack();`
		1204	`} else {`
		1205	`if (rn < fstack_pos) {`
		1206	`discard_st1();`
		1207	`}`
		1208	`}`
		1209	`}`
		1210	`}`
		1211	`}`
		1212
		1213	`if (dc.dcl_new && ptno(e) == local_pl) {`
		1214	`exp temp = getexp(f_top, nilexp, 1, e, nilexp, 0, 0,`
		1215	`name_tag);`
		1216	`if (isvar(e)) {`
		1217	`temp = getexp(f_top, nilexp, 1, temp, nilexp,`
		1218	`0, 0, cont_tag);`
		1219	`}`
		1220	`invalidate_dest(mw(temp, 0));`
		1221	`if (isvar(e)) {`
		1222	`retcell(son(temp));`
		1223	`}`
		1224	`retcell(temp);`
		1225	`}`
		1226
		1227	`if (isenvoff(e)) {`
		1228	`/* prepare for possible later constant evaluation */`
		1229	`hasenvoff_list = getexp(f_bottom, hasenvoff_list, 0, e,`
		1230	`nilexp, 0, 0, 0);`
		1231	`}`
		1232
		1233	`return;`
		1234	`}`
		1235	`case seq_tag: {`
		1236	`exp t = son(son(e));`
		1237	`int no_bottom;`
		1238	`/* code and discard the statements */`
		1239	`while (coder(zero, stack, t),`
		1240	`no_bottom = (name(sh(t))!= bothd), !last(t)) {`
		1241	`t = bro(t);`
		1242	`}`
		1243	`if (no_bottom) {`
		1244	`coder(dest, stack, bro(son(e)));`
		1245	`#ifdef NEWDIAGS`
		1246	`} else {`
		1247	`if (diagnose) {`
		1248	`/* Beware lost information !!! */`
		1249	`name(bro(son(e))) = top_tag;`
		1250	`son(bro(son(e))) = nilexp;`
		1251	`dgf(bro(son(e))) = nildiag;`
		1252	`}`
		1253	`#endif`
		1254	`}`
		1255	`return;`
		1256	`}`
		1257	`case cond_tag: {`
		1258	`int old_fstack_pos = fstack_pos;`
		1259	`exp first = son(e);`
		1260	`exp alt = bro(first);`
		1261	`exp record; /* jump record for alt */`
		1262	`int r1;`
		1263	`exp jr = nilexp;/* jump record for end of construction */`
		1264
		1265	`if (no(son(alt)) == 0) {`
		1266	`coder(dest, stack, first);`
		1267	`#ifdef NEWDIAGS`
		1268	`if (diagnose) {`
		1269	`/* Beware lost information !!! */`
		1270	`name(bro(son(alt))) = top_tag;`
		1271	`son(bro(son(alt))) = nilexp;`
		1272	`dgf(bro(son(alt))) = nildiag;`
		1273	`}`
		1274	`#endif`
		1275	`return;`
		1276	`}`
		1277
		1278	`clean_stack();`
		1279
		1280	`record = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0, 0, 0);`
		1281	`sonno(record) = stack_dec;`
		1282	`fstack_pos_of(record) = (prop)fstack_pos;`
		1283	`if (pt(son(alt))!= nilexp) {`
		1284	`ptno(record) = ptno(pt(son(alt)));`
		1285	`} else {`
		1286	`ptno(record) = next_lab();`
		1287	`}`
		1288
		1289
		1290	`if (name(bro(son(alt))) == top_tag && stack_dec == 0 &&`
		1291	`!is_loaded_lv(alt)) {`
		1292	`int extract = take_out_of_line(first, alt,`
		1293	`repeat_level > 0, scale);`
		1294
		1295	`if (extract) {`
		1296	`exp t = son(son(first));`
		1297	`exp p, s, z;`
		1298	`int test_n;`
		1299	`shape sha;`
		1300	`outofline * rec;`
		1301	`exp tst = (is_tester(t, 0)) ? t : bro(son(t));`
		1302	`jr = getexp(f_bottom, nilexp, 0, nilexp, nilexp,`
		1303	`0, 0, 0);`
		1304	`sonno(jr) = stack_dec;`
		1305	`ptno(jr) = next_lab();`
		1306	`fstack_pos_of(jr) = (prop)fstack_pos;`
		1307	`sha = sh(son(tst));`
		1308	`rec = (outofline*)xmalloc(sizeof(outofline));`
		1309	`rec->next = odd_bits;`
		1310	`odd_bits = rec;`
		1311	`rec->dest = dest;`
		1312	`rec->stack = stack;`
		1313	`rec->regsinuse = regsinuse;`
		1314	`rec->fstack_pos = fstack_pos;`
		1315	`/* number for outofline bit */`
		1316	`rec->labno = next_lab();`
		1317
		1318	`rec->repeat_level = repeat_level;`
		1319	`rec->scale = (float)0.5 * scale;`
		1320	`/* jump record for return from bit */`
		1321	`rec->jr = jr;`
		1322
		1323	`if (last(t)) {`
		1324	`first = bro(son(first));`
		1325	`} else {`
		1326	`son(son(first)) = bro(son(son(first)));`
		1327	`}`
		1328
		1329	`rec->body = first;`
		1330	`pt(son(alt)) = record;`
		1331
		1332	`test_n = (int)test_number(tst);`
		1333	`if (name(sha) < shrealhd \|\|`
		1334	`name(sha) > doublehd) {`
		1335	`test_n = (int)int_inverse_ntest[test_n];`
		1336	`} else {`
		1337	`test_n =`
		1338	`(int)real_inverse_ntest[test_n];`
		1339	`}`
		1340
		1341	`settest_number(tst, test_n);`
		1342	`z = getexp(f_bottom, nilexp, 0, nilexp, nilexp,`
		1343	`0, 0, 0);`
		1344	`sonno(z) = stack_dec;`
		1345	`fstack_pos_of(z) = (prop)fstack_pos;`
		1346	`ptno(z) = rec->labno;`
		1347	`s = getexp(sha, nilexp, 0, nilexp, z, 0, 0, 0);`
		1348	`p = getexp(sha, tst, 0, s, nilexp, 0, 0, 0);`
		1349	`pt(tst) = p;`
		1350	`coder(zero, stack, t);`
		1351	`if (name(sh(first))!= bothd) {`
		1352	`reset_fpucon();`
		1353	`set_label(jr);`
		1354	`#ifdef NEWDWARF`
		1355	`START_BB();`
		1356	`#endif`
		1357	`clear_reg_record(crt_reg_record);`
		1358	`}`
		1359
		1360	`rec->cond1_set = cond1_set;`
		1361	`rec->cond2_set = cond2_set;`
		1362	`rec->cond1 = cond1;`
		1363	`rec->cond2a = cond2a;`
		1364	`rec->cond2b = cond2b;`
		1365	`#if 0`
		1366	`#ifdef NEWDWARF`
		1367	`if (dwarf2) {`
		1368	`rec->dw2_hi = next_dwarf_label();`
		1369	`rec->dw2_slave = next_dwarf_label();`
		1370	`dw2_extend_scope(rec->labno,`
		1371	`rec->dw2_hi,`
		1372	`rec->dw2_slave);`
		1373	`}`
		1374	`#endif`
		1375	`#endif`
		1376	`return;`
		1377	`}`
		1378	`}`
		1379
		1380	`old_scale = scale;`
		1381	`scale = (float)0.5*scale;`
		1382
		1383	`/* record floating point stack position so that we can align`
		1384	`* the positions */`
		1385	`/* jump record set up for alt */`
		1386	`pt(son(alt)) = record;`
		1387	`/* set the record in for use by jumps in first. */`
		1388
		1389	`/* regsinuse is the same at the start of first and alt, and at`
		1390	`* the end of the construction. */`
		1391	`r1 = regsinuse;`
		1392	`coder(dest, stack, first);`
		1393	`reset_fpucon();`
		1394	`clean_stack();`
		1395
		1396	`/* restore regsinuse for alt */`
		1397	`regsinuse = r1;`
		1398
		1399	`if (name(bro(son(alt))) == top_tag && !is_loaded_lv(alt)) {`
		1400	`/* if alt is only load top, do nothing but set the`
		1401	`* label */`
		1402	`if (name(sh(first)) == bothd && no(son(alt)) != 0) {`
		1403	`align_label(2, record);`
		1404	`}`
		1405
		1406	`if (name(first) == seq_tag &&`
		1407	`name(bro(son(first))) == seq_tag &&`
		1408	`name(bro(son(bro(son(first))))) == apply_tag) {`
		1409	`align_label(0, record);`
		1410	`}`
		1411	`set_label(record);`
		1412	`#ifdef NEWDWARF`
		1413	`START_BB();`
		1414	`#endif`
		1415	`fstack_pos = old_fstack_pos;`
		1416	`clear_reg_record(crt_reg_record);`
		1417	`scale = old_scale;`
		1418	`return;`
		1419	`}`
		1420
		1421	`if (name(sh(first))!= bothd &&`
		1422	`(no(son(alt))!= 0 \|\| name(bro(son(alt)))!= goto_tag)) {`
		1423	`/* if the first did not end with jump or ret, put in a`
		1424	`* jump to the end of the construction, and make a jump`
		1425	`* record for it */`
		1426	`jr = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0, 0,`
		1427	`0);`
		1428	`sonno(jr) = stack_dec;`
		1429	`ptno(jr) = next_lab();`
		1430	`fstack_pos_of(jr) = (prop)fstack_pos;`
		1431	`jump(jr, in_fstack(dest.where_exp));`
		1432	`}`
		1433
		1434	`if (no(son(alt))!= 0 \|\| name(bro(son(alt)))!= goto_tag) {`
		1435	`if (no(son(alt)) != 0) {`
		1436	`align_label(2, record);`
		1437	`}`
		1438	`/* the label for the start of alt */`
		1439	`set_label (record);`
		1440
		1441	`fstack_pos = old_fstack_pos;`
		1442	`coder(dest, stack, alt);`
		1443	`reset_fpucon();`
		1444	`/* restore regsinuse for end of construction */`
		1445	`regsinuse = r1;`
		1446
		1447	`if (name(sh(first))!= bothd) {`
		1448	`/* set the label for the end of the`
		1449	`* construction if first needed it. */`
		1450	`SET(jr);`
		1451	`if (name(sh(alt)) == bothd) {`
		1452	`align_label(2, jr);`
		1453	`}`
		1454	`set_label(jr);`
		1455	`#ifdef NEWDWARF`
		1456	`START_BB();`
		1457	`#endif`
		1458	`}`
		1459	`}`
		1460	`/* we don't know what condition flags are set */`
		1461	`cond1_set = 0;`
		1462	`cond2_set = 0;`
		1463
		1464	`scale = old_scale;`
		1465	`return;`
		1466	`}`
		1467	`case labst_tag: {`
		1468	`/* code a labelled statement */`
		1469	`clear_reg_record(crt_reg_record);`
		1470	`cond1_set = 0;`
		1471	`cond2_set = 0;`
		1472	`fpucon = normal_fpucon;`
		1473
		1474	`if (is_loaded_lv(e)) {`
		1475	`set_lv_label(e);`
		1476	`if (need_preserve_stack) {`
		1477	`restore_stack();`
		1478	`} else if (!has_alloca) {`
		1479	`set_stack_from_bp();`
		1480	`}`
		1481	`}`
		1482	`fstack_pos = (int)fstack_pos_of(pt(son(e)));`
		1483	`stack_dec = sonno(pt(son(e)));`
		1484
		1485	`old_scale = scale;`
		1486	`#ifdef NEWDWARF`
		1487	`START_BB();`
		1488	`#endif`
		1489	`coder(dest, stack, bro(son(e)));`
		1490	`scale = old_scale;`
		1491
		1492	`clear_reg_record(crt_reg_record);`
		1493	`clean_stack();`
		1494	`return;`
		1495	`}`
		1496	`case rep_tag: {`
		1497	`exp start = son(e);`
		1498	`exp body = bro(start);`
		1499	`exp record; /* jump record for loop label */`
		1500	`++repeat_level;`
		1501	`coder(mw(body, 0), stack, start);`
		1502	`/* code the starter of the loop */`
		1503	`reset_fpucon();`
		1504	`clean_stack();`
		1505	`record = getexp(f_bottom, nilexp, 1, nilexp, nilexp, 0, 0, 0);`
		1506	`sonno(record) = stack_dec;`
		1507	`ptno(record) = next_lab();`
		1508	`fstack_pos_of(record) = (prop)fstack_pos;`
		1509	`cond1_set = 0;`
		1510	`cond2_set = 0;`
		1511	`align_label(1, record);`
		1512	`set_label (record); /* set the label at the start of body */`
		1513	`pt(son(body)) = record;`
		1514	`old_scale = scale;`
		1515	`if (scale < 1e30) {`
		1516	`scale = (float)20.0 * scale;`
		1517	`}`
		1518	`coder(dest, stack, body);`
		1519	`scale = old_scale;`
		1520	`--repeat_level;`
		1521	`return;`
		1522	`}`
		1523	`case prof_tag:`
		1524	`scale = (float)no(e);`
		1525	`return;`
		1526	`case goto_tag: {`
		1527	`exp lab;`
		1528	`clean_stack();`
		1529	`lab = final_dest(pt(e));`
		1530	`#ifdef NEWDWARF`
		1531	`if (current_dg_info) {`
		1532	`current_dg_info->data.i_tst.brk = set_dw_text_label();`
		1533	`current_dg_info->data.i_tst.jlab.u.l =`
		1534	`ptno(pt(son(lab)));`
		1535	`current_dg_info->data.i_tst.jlab.k = LAB_CODE;`
		1536	`}`
		1537	`#endif`
		1538	`if (label_is_next(lab, e)) {`
		1539	`int fs_dest = (int)fstack_pos_of(pt(son(lab)));`
		1540	`int good_fs = fstack_pos;`
		1541	`while (fstack_pos > fs_dest) {`
		1542	`discard_fstack();`
		1543	`}`
		1544	`reset_fpucon();`
		1545	`fstack_pos = good_fs;`
		1546	`return;`
		1547	`}`
		1548	`jump(pt(son(lab)), 0);`
		1549	`return;`
		1550	`}`
		1551	`case goto_lv_tag: {`
		1552	`clean_stack();`
		1553	`reset_fpucon();`
		1554	`jumpins(son(e));`
		1555	`return;`
		1556	`}`
		1557	`case long_jump_tag: {`
		1558	`coder(pushdest, stack, bro(son(e)));`
		1559	`extra_stack += 32;`
		1560	`coder(pushdest, stack, son(e));`
		1561	`extra_stack += 32;`
		1562	`check_stack_max;`
		1563	`reset_fpucon();`
		1564	`long_jump(e);`
		1565	`extra_stack -= 64;`
		1566	`return;`
		1567	`}`
		1568	`case testbit_tag: {`
		1569	`/* not more than one argument will not be a possible 80386`
		1570	`* operand */`
		1571	`exp lab = pt(e);`
		1572	`exp temp;`
		1573	`ntest testno = test_number(e);`
		1574	`int isret = 0;`
		1575
		1576	`if (name(lab) == labst_tag) {`
		1577	`exp q = short_next_jump(e);`
		1578	`if (q != nilexp &&`
		1579	`(name(q) == goto_tag \|\|`
		1580	`(name(q) == res_tag && name(son(q)) == top_tag)) &&`
		1581	`label_is_next(lab, q)) {`
		1582	`shape sha = sh(son(e));`
		1583	`if (name(q) == goto_tag) {`
		1584	`temp = pt(q);`
		1585	`pt(q) = lab;`
		1586	`} else {`
		1587	`temp = getexp(f_bottom, nilexp, 0,`
		1588	`nilexp, nilexp, 0, 0, 0);`
		1589	`ptno(temp) = crt_ret_lab;`
		1590	`fstack_pos_of(temp) =`
		1591	`(prop)first_fl_reg;`
		1592	`temp = getexp(f_top, nilexp, 0, nilexp,`
		1593	`temp, 0, 0, 0);`
		1594	`temp = getexp(f_top, lab, 0, temp,`
		1595	`nilexp, 0, 0, labst_tag);`
		1596	`crt_ret_lab_used = 1;`
		1597	`pt(q) = lab;`
		1598	`name(q) = goto_tag;`
		1599	`isret = 1;`
		1600	`}`
		1601	`lab = temp;`
		1602	`pt(e) = lab;`
		1603	`if (name(sha) < shrealhd \|\|`
		1604	`name(sha) > doublehd) {`
		1605	`settest_number(e,`
		1606	`(int)int_inverse_ntest[testno]);`
		1607	`} else {`
		1608	`settest_number(e,`
		1609	`(int)real_inverse_ntest[testno]);`
		1610	`}`
		1611	`#ifdef NEWDIAGS`
		1612	`if (current_dg_info) {`
		1613	`current_dg_info->data.i_tst.inv =`
		1614	`1 - current_dg_info->data.i_tst.inv;`
		1615	`}`
		1616	`#endif`
		1617	`}`
		1618	`}`
		1619	`if (!isret) {`
		1620	`temp = final_dest_test(lab, e);`
		1621	`}`
		1622	`SET(temp);`
		1623	`if (pt(son(temp)) == nilexp) {`
		1624	`++no(son(temp));`
		1625	`pt(son(temp)) = copyexp(pt(son(lab)));`
		1626	`ptno(pt(son(temp))) = next_lab();`
		1627	`} else if (temp != lab) {`
		1628	`--no(son(lab));`
		1629	`++no(son(temp));`
		1630	`}`
		1631	`pt(e) = temp;`
		1632	`{`
		1633	`where qw;`
		1634	`exp lab_exp = pt(e);`
		1635	`exp jr = pt(son(lab_exp));`
		1636	`exp arg1 = son(e);`
		1637	`exp arg2 = bro(arg1);`
		1638	`if (!is_o(name(arg1)) \|\| is_crc(arg1)) {`
		1639	`/* arg1 is not a possible 80386`
		1640	`* operand, precompute it in reg0 */`
		1641	`qw.where_exp = copyexp(reg0.where_exp);`
		1642	`sh(qw.where_exp) = sh(arg1);`
		1643	`qw.where_off = 0;`
		1644	`coder(qw, stack, arg1);`
		1645	`arg1 = qw.where_exp;`
		1646	`}`
		1647	`if (!is_o(name(arg2)) \|\| is_crc(arg2)) {`
		1648	`/* arg2 is not a possible 80386`
		1649	`* operand, precompute it in reg0 */`
		1650	`qw.where_exp = copyexp(reg0.where_exp);`
		1651	`sh(qw.where_exp) = sh(arg2);`
		1652	`qw.where_off = 0;`
		1653	`coder(qw, stack, arg2);`
		1654	`arg2 = qw.where_exp;`
		1655	`}`
		1656
		1657	`clean_stack();`
		1658	`#ifdef NEWDWARF`
		1659	`if (current_dg_info) {`
		1660	`current_dg_info->data.i_tst.brk =`
		1661	`set_dw_text_label();`
		1662	`current_dg_info->data.i_tst.jlab.u.l =`
		1663	`ptno(jr);`
		1664	`current_dg_info->data.i_tst.jlab.k =`
		1665	`LAB_CODE;`
		1666	`}`
		1667	`#endif`
		1668	`test(sh(arg1), mw(arg1, 0), mw(arg2, 0));`
		1669	`branch((int)test_number(e), jr, 1,`
		1670	`(int)name(sh(arg1)));`
		1671	`#ifdef NEWDWARF`
		1672	`START_BB();`
		1673	`if (current_dg_info) {`
		1674	`current_dg_info->data.i_tst.cont =`
		1675	`set_dw_text_label();`
		1676	`}`
		1677	`#endif`
		1678	`return;`
		1679	`}`
		1680	`}`
		1681	`case absbool_tag:`
		1682	`case test_tag: {`
		1683	`/* not more than one argument will not be a possible 80386`
		1684	`* operand */`
		1685	`exp lab = pt(e);`
		1686	`exp temp;`
		1687	`ntest testno = test_number(e);`
		1688	`int isret = 0;`
		1689	`exp original_lab = lab; /* preserve for extra_diags */`
		1690
		1691	`if (name(e) == test_tag) {`
		1692	`if (name(lab) == labst_tag) {`
		1693	`exp q = short_next_jump(e);`
		1694	`if (q != nilexp &&`
		1695	`(name(q) == goto_tag \|\|`
		1696	`(name(q) == res_tag &&`
		1697	`name(son(q)) == top_tag)) &&`
		1698	`label_is_next(lab, q)) {`
		1699	`shape sha = sh(son(e));`
		1700	`if (name(q) == goto_tag) {`
		1701	`temp = pt(q);`
		1702	`pt(q) = lab;`
		1703	`} else {`
		1704	`temp = getexp(f_bottom, nilexp,`
		1705	`0, nilexp, nilexp,`
		1706	`0, 0, 0);`
		1707	`ptno(temp) = crt_ret_lab;`
		1708	`fstack_pos_of(temp) =`
		1709	`(prop)first_fl_reg;`
		1710	`temp = getexp(f_top, nilexp, 0,`
		1711	`nilexp, temp, 0,`
		1712	`0, 0);`
		1713	`temp = getexp(f_top, lab, 0,`
		1714	`temp, nilexp, 0,`
		1715	`0, labst_tag);`
		1716	`crt_ret_lab_used = 1;`
		1717	`pt(q) = lab;`
		1718	`name(q) = goto_tag;`
		1719	`isret = 1;`
		1720	`}`
		1721	`lab = temp;`
		1722	`pt(e) = lab;`
		1723	`if (name(sha) < shrealhd \|\|`
		1724	`name(sha) > doublehd) {`
		1725	`settest_number(e,`
		1726	`(int)int_inverse_ntest[testno]);`
		1727	`} else {`
		1728	`settest_number(e,`
		1729	`(int)real_inverse_ntest[testno]);`
		1730	`}`
		1731	`#ifdef NEWDIAGS`
		1732	`if (current_dg_info) {`
		1733	`current_dg_info->data.i_tst.inv =`
		1734	`1 - current_dg_info->data.i_tst.inv;`
		1735	`}`
		1736	`#endif`
		1737	`}`
		1738	`}`
		1739	`if (!isret) {`
		1740	`temp = final_dest_test(lab, e);`
		1741	`}`
		1742	`SET(temp);`
		1743	`if (pt(son(temp)) == nilexp) {`
		1744	`++no(son(temp));`
		1745	`pt(son(temp)) = copyexp(pt(son(lab)));`
		1746	`ptno(pt(son(temp))) = next_lab();`
		1747	`} else if (temp != lab) {`
		1748	`--no(son(lab));`
		1749	`++no(son(temp));`
		1750	`}`
		1751	`pt(e) = temp;`
		1752	`}`
		1753	`{`
		1754	`where qw;`
		1755	`exp arg1 = son(e);`
		1756	`exp arg2 = bro(arg1);`
		1757	`unsigned char test_n = test_number(e);`
		1758	`exp lab_exp = pt(e);`
		1759	`exp jr;`
		1760	`int sg;`
		1761	`if (name(e) ==test_tag) {`
		1762	`jr = pt(son(lab_exp));`
		1763	`}`
		1764	`if (!is_o(name(arg1)) \|\| is_crc(arg1)) {`
		1765	`/* arg1 is not a possible 80386 operand,`
		1766	`* precompute it in reg0 */`
		1767	`qw.where_exp = copyexp(reg0.where_exp);`
		1768	`sh(qw.where_exp) = sh(arg1);`
		1769	`qw.where_off = 0;`
		1770	`coder(qw, stack, arg1);`
		1771	`arg1 = qw.where_exp;`
		1772	`#ifdef NEWDIAGS`
		1773	`} else {`
		1774	`diag_arg(dest, stack, arg1);`
		1775	`#endif`
		1776	`}`
		1777	`if (!is_o(name(arg2)) \|\| is_crc(arg2)) {`
		1778	`/* arg2 is not a possible 80386 operand,`
		1779	`* precompute it in reg0 */`
		1780	`qw.where_exp = copyexp(reg0.where_exp);`
		1781	`sh(qw.where_exp) = sh(arg2);`
		1782	`qw.where_off = 0;`
		1783	`coder(qw, stack, arg2);`
		1784	`arg2 = qw.where_exp;`
		1785	`#ifdef NEWDIAGS`
		1786	`} else {`
		1787	`diag_arg(dest, stack, arg2);`
		1788	`#endif`
		1789	`}`
		1790
		1791	`switch (name(sh(arg1))) {`
		1792	`case scharhd:`
		1793	`case swordhd:`
		1794	`case slonghd:`
		1795	`case offsethd:`
		1796	`sg = 1;`
		1797	`break;`
		1798	`case ucharhd:`
		1799	`case uwordhd:`
		1800	`case ulonghd:`
		1801	`case shrealhd:`
		1802	`case realhd:`
		1803	`case doublehd:`
		1804	`case ptrhd:`
		1805	`sg = 0;`
		1806	`break;`
		1807	`default:`
		1808	`sg = is_signed(sh(arg1));`
		1809	`break;`
		1810	`}`
		1811
		1812	`if (name(arg1) == val_tag \|\|`
		1813	`name(arg1) == env_offset_tag \|\|`
		1814	`(name(arg1) == name_tag && isvar(son(arg1)) &&`
		1815	`isglob(son(arg1)))) {`
		1816	`/* if only one constant, cmp expects it to be`
		1817	`* arg2 */`
		1818	`exp holde = arg1;`
		1819	`arg1 = arg2;`
		1820	`arg2 = holde;`
		1821	`test_n = exchange_ntest[test_n];`
		1822	`#ifdef NEWDIAGS`
		1823	`if (current_dg_info)`
		1824	`current_dg_info->data.i_tst.inv =`
		1825	`1 - current_dg_info->data.i_tst.inv;`
		1826	`#endif`
		1827	`}`
		1828
		1829	`if (name(arg1) == null_tag) {`
		1830	`failer("test_tag of wrong form");`
		1831	`} else {`
		1832	`clean_stack();`
		1833	`if (name(e) == absbool_tag && sg &&`
		1834	`(test_n == f_greater_than \|\|`
		1835	`test_n == f_less_than_or_equal)) {`
		1836	`/* avoid cmp(0) optimisation to clear`
		1837	`* overflow */`
		1838	`cond1_set = 0;`
		1839	`}`
		1840	`if (cmp(sh(arg1), mw(arg1, 0), mw(arg2, 0),`
		1841	`(int)test_n, e)) {`
		1842	`if (sg) {`
		1843	`/* ignore overflow when testing`
		1844	`* sign bit */`
		1845	`sg = -1;`
		1846	`}`
		1847	`}`
		1848	`if (name(e) == test_tag) {`
		1849	`SET(jr);`
		1850	`#ifdef NEWDWARF`
		1851	`if (current_dg_info) {`
		1852	`current_dg_info->data.i_tst.brk = set_dw_text_label();`
		1853	`current_dg_info->data.i_tst.jlab.u.l = ptno(jr);`
		1854	`current_dg_info->data.i_tst.jlab.k = LAB_CODE;`
		1855	`}`
		1856	`#endif`
		1857	`branch((int)test_n, jr, sg,`
		1858	`(int)name(sh(arg1)));`
		1859	`#ifdef NEWDWARF`
		1860	`START_BB();`
		1861	`if (current_dg_info)`
		1862	`current_dg_info->data.i_tst.cont = set_dw_text_label();`
		1863	`#endif`
		1864	`} else if (!eq_where(dest, zero)) {`
		1865	`setcc((int)int_inverse_ntest[test_n], sg,`
		1866	`(int)name(sh(arg1)));`
		1867	`if (shape_size(sh(e)) > 8) {`
		1868	`and(slongsh, reg0,`
		1869	`mw(zeroe, 0xff),`
		1870	`reg0);`
		1871	`}`
		1872	`move(sh(e), reg0, dest);`
		1873	`}`
		1874	`}`
		1875	`/* may be needed for extra_diags */`
		1876	`pt(e) = original_lab;`
		1877	`return;`
		1878	`}`
		1879	`}`
		1880	`case ass_tag:`
		1881	`case assvol_tag: {`
		1882	`exp assdest = son(e);`
		1883	`exp assval = bro(assdest);`
		1884
		1885	`if (!newcode && name(sh(assval)) == bitfhd) {`
		1886	`bits_to_mem(assval, e, stack);`
		1887	`return;`
		1888	`}`
		1889
		1890	`coder(mw(e, 0), stack, assval);`
		1891	`/* set the destination and code the rest */`
		1892	`return;`
		1893	`}`
		1894	`case concatnof_tag: {`
		1895	`int off = dest.where_off + shape_size(sh(son(e)));`
		1896	`coder(dest, stack, son(e));`
		1897	`coder(mw(dest.where_exp, off), stack_room(stack, dest, off),`
		1898	`bro(son(e)));`
		1899	`return;`
		1900	`}`
		1901	`case ncopies_tag: {`
		1902	`int i;`
		1903	`int sz;`
		1904	`int off;`
		1905	`if (no(e) == 0) {`
		1906	`return;`
		1907	`}`
		1908
		1909	`sz = shape_size(sh(e)) / no(e);`
		1910	`for (i = 0; i < no(e); ++i) {`
		1911	`off = dest.where_off + i * sz;`
		1912	`coder(mw(dest.where_exp, off),`
		1913	`stack_room(stack, dest, off), copyexp(son(e)));`
		1914	`}`
		1915	`return;`
		1916	`}`
		1917	`case nof_tag: {`
		1918	`exp v = son(e);`
		1919	`shape sha;`
		1920	`int off;`
		1921	`int crt = 0;`
		1922
		1923	`if (v == nilexp) {`
		1924	`return;`
		1925	`}`
		1926
		1927	`sha = sh(v);`
		1928	`off = rounder(shape_size(sha), shape_align(sha));`
		1929
		1930	`while (1) {`
		1931	`coder(mw(dest.where_exp, dest.where_off + crt),`
		1932	`stack_room(stack, dest, dest.where_off + crt), v);`
		1933	`if (last(v)) {`
		1934	`return;`
		1935	`}`
		1936	`crt += off;`
		1937	`v = bro(v);`
		1938	`}`
		1939	`}`
		1940	`case compound_tag: {`
		1941	`exp v = son(e);`
		1942	`if (v == nilexp) {`
		1943	`return;`
		1944	`}`
		1945
		1946	`while (1) {`
		1947	`coder(mw(dest.where_exp, dest.where_off + no(v)),`
		1948	`stack_room(stack, dest, dest.where_off + no(v)),`
		1949	`bro(v));`
		1950	`if (last(bro(v))) {`
		1951	`return;`
		1952	`}`
		1953	`v = bro(bro(v));`
		1954	`}`
		1955	`}`
		1956	`case apply_tag:`
		1957	`case apply_general_tag: {`
		1958	`exp proc = son(e);`
		1959	`exp arg = (!last(proc)) ? bro(proc) : nilexp;`
		1960	`exp cees = nilexp;`
		1961	`exp postlude = nilexp;`
		1962	`int untidy_call = 0;`
		1963	`int has_checkstack = 0;`
		1964	`int longs, more_longs, old_regsinuse, prev_use_bp;`
		1965	`int multi_reg = (shape_size(sh(e)) > 32 && reg_result(sh(e)) &&`
		1966	`!is_floating(name(sh(e))));`
		1967	`int old_nip = not_in_params;`
		1968	`int push_result = 0;`
		1969	`int post_offset = 0;`
		1970	`int ret_stack_dec;`
		1971
		1972	`if (builtinproc(e)) {`
		1973	`dec *dp = brog(son(proc));`
		1974	`char *id = dp->dec_u.dec_val.dec_id;`
		1975	`special_ins(id + prefix_length, arg, dest);`
		1976	`return;`
		1977	`}`
		1978
		1979	`if (name(e) ==apply_general_tag) {`
		1980	`arg = son(arg);`
		1981	`cees = bro(bro(proc));`
		1982	`if (name(bro(cees)) != top_tag) {`
		1983	`postlude = bro(cees);`
		1984	`}`
		1985	`untidy_call = call_is_untidy(e);`
		1986	`has_checkstack = call_has_checkstack(e);`
		1987	`}`
		1988
		1989	`not_in_params = 0;`
		1990	`longs = procargs(stack, arg, has_checkstack);`
		1991	`ret_stack_dec = stack_dec;`
		1992
		1993	`/* may be altered by push_cees */`
		1994	`prev_use_bp = must_use_bp;`
		1995	`if (cees == nilexp) {`
		1996	`more_longs = 0;`
		1997	`} else {`
		1998	`switch (name(cees)) {`
		1999	`case make_callee_list_tag: {`
		2000	`more_longs = procargs(stack, son(cees),`
		2001	`has_checkstack);`
		2002	`if (call_has_vcallees(cees)) {`
		2003	`ins2(leal, 32, 32,`
		2004	`mw(ind_sp.where_exp, more_longs),`
		2005	`reg0);`
		2006	`ins0(pusheax);`
		2007	`stack_dec -= 32;`
		2008	`more_longs += 32;`
		2009	`}`
		2010	`break;`
		2011	`}`
		2012	`case make_dynamic_callee_tag: {`
		2013	`exp ptr = son(cees);`
		2014	`exp siz = bro(ptr);`
		2015	`more_longs = push_cees(ptr, siz,`
		2016	`call_has_vcallees(cees),`
		2017	`stack);`
		2018	`break;`
		2019	`}`
		2020	`case same_callees_tag: {`
		2021	`more_longs = push_cees(nilexp, nilexp,`
		2022	`call_has_vcallees(cees),`
		2023	`stack);`
		2024	`break;`
		2025	`}`
		2026	`}`
		2027	`}`
		2028
		2029	`check_stack_max;`
		2030	`reset_fpucon();`
		2031	`not_in_params = old_nip;`
		2032	`if (remove_struct_ref) {`
		2033	`/* struct return address removed by call */`
		2034	`longs -= no(e);`
		2035
		2036	`ret_stack_dec += no(e);`
		2037	`post_offset = no(e);`
		2038	`}`
		2039	`if (postlude == nilexp && !untidy_call) {`
		2040	`old_regsinuse = regsinuse;`
		2041	`if (multi_reg) {`
		2042	`/* prevent callins using pop edx */`
		2043	`regsinuse \|= 0x2;`
		2044	`}`
		2045	`callins(longs, son(e), ret_stack_dec);`
		2046	`regsinuse = old_regsinuse;`
		2047	`} else {`
		2048	`/* delay arg stack return */`
		2049	`callins (0, son(e), ret_stack_dec);`
		2050	`if (untidy_call) {`
		2051	`stack_dec = 0; /* as alloca, must_use_bp */`
		2052	`if (need_preserve_stack)`
		2053	`save_stack();`
		2054	`}`
		2055	`}`
		2056	`must_use_bp = prev_use_bp;`
		2057
		2058	`invalidate_dest(mw(nilexp, 0));`
		2059
		2060	`clear_low_reg_record(crt_reg_record);`
		2061	`/* we don't know the state of the conditions */`
		2062	`cond1_set = 0;`
		2063	`cond2_set = 0;`
		2064
		2065	`if (eq_where(dest, zero)) {`
		2066	`if (reg_result (sh(e))) {`
		2067	`/* answer in register */`
		2068	`if (name(sh(e)) >= shrealhd &&`
		2069	`name(sh(e)) <= doublehd) {`
		2070	`push_fl;`
		2071	`discard_fstack();`
		2072	`}`
		2073	`}`
		2074	`} else {`
		2075	`where temp_dest;`
		2076	`if (postlude == nilexp) {`
		2077	`temp_dest = dest;`
		2078	`} else {`
		2079	`push_result = 1;`
		2080	`temp_dest = pushdest;`
		2081	`}`
		2082	`if (reg_result (sh(e))) {`
		2083	`/* answer in register */`
		2084	`if (name(sh(e)) >= shrealhd &&`
		2085	`name(sh(e)) <= doublehd) {`
		2086	`push_fl;`
		2087	`move(sh(e), flstack, temp_dest);`
		2088	`} else {`
		2089	`move(sh(e), reg0, temp_dest);`
		2090	`}`
		2091	`} else {`
		2092	`failer(STRUCT_RES); /* compound result */`
		2093	`}`
		2094	`}`
		2095
		2096	`if (postlude != nilexp) {`
		2097	`int sz = rounder(shape_size(sh(e)), param_align);`
		2098	`old_nip = not_in_postlude;`
		2099	`not_in_postlude = 0;`
		2100	`while (name(postlude) == ident_tag &&`
		2101	`name(son(postlude)) == caller_name_tag) {`
		2102	`int n = no(son(postlude));`
		2103	`exp a = arg;`
		2104	`while (n != 0) {`
		2105	`a = bro(a);`
		2106	`n--;`
		2107	`}`
		2108	`if (name(a)!= caller_tag) {`
		2109	`failer(BAD_POSTLUDE);`
		2110	`}`
		2111	`no(postlude) = no(a) + stack_dec - post_offset;`
		2112	`ptno(postlude) = callstack_pl;`
		2113	`postlude = bro(son(postlude));`
		2114	`}`
		2115	`if (push_result) {`
		2116	`stack_dec -= sz;`
		2117	`check_stack_max;`
		2118	`}`
		2119	`coder(zero, stack, postlude);`
		2120	`if (push_result) {`
		2121	`if (name(dest.where_exp) == apply_tag) {`
		2122	`move(sh(e), ind_sp, dest);`
		2123	`stack_dec += sz;`
		2124	`} else {`
		2125	`longs += shape_size(sh(e));`
		2126	`if (dest.where_exp ==`
		2127	`ind_sp.where_exp) {`
		2128	`dest.where_off += longs;`
		2129	`}`
		2130	`move(sh(e), ind_sp, dest);`
		2131	`}`
		2132	`}`
		2133	`stack_return(longs);`
		2134	`not_in_postlude = old_nip;`
		2135	`}`
		2136
		2137	`return;`
		2138	`}`
		2139	`case tail_call_tag: {`
		2140	`exp proc = son(e);`
		2141	`exp cees = bro(proc);`
		2142	`int longs;`
		2143	`int prev_use_bp = must_use_bp; /* may be altered by push_cees */`
		2144	`int old_nip = not_in_params;`
		2145	`int old_stack_dec = stack_dec;`
		2146	`not_in_params = 0;`
		2147	`switch (name(cees)) {`
		2148	`case make_callee_list_tag: {`
		2149	`not_in_params = 0;`
		2150	`longs = procargs(stack, son(cees),`
		2151	`call_has_checkstack(e));`
		2152	`not_in_params = old_nip;`
		2153	`break;`
		2154	`}`
		2155	`case make_dynamic_callee_tag: {`
		2156	`longs = push_cees(son(cees), bro(son(cees)), 0, stack);`
		2157	`break;`
		2158	`}`
		2159	`case same_callees_tag: {`
		2160	`longs = 0;`
		2161	`break;`
		2162	`}`
		2163	`}`
		2164	`check_stack_max;`
		2165
		2166	`/* clear off any unwanted fstack registers */`
		2167	`{`
		2168	`int good_fs = fstack_pos;`
		2169	`while (fstack_pos > first_fl_reg) {`
		2170	`discard_fstack();`
		2171	`}`
		2172	`fstack_pos = good_fs;`
		2173	`reset_fpucon();`
		2174	`}`
		2175
		2176	`if (longs == 0) {`
		2177	`coder (reg0, stack, proc); /* proc value to %eax */`
		2178	`restore_callregs(0);`
		2179	`/* stack reduced to old callees and return address */`
		2180
		2181	`if (name(cees) == same_callees_tag) {`
		2182	`if (callee_size < 0 &&`
		2183	`!call_has_vcallees(cees)) {`
		2184	`outs(" popl %ecx\n");`
		2185	`outs(" movl %ecx, (%esp)\n");`
		2186	`}`
		2187	`if (callee_size >= 0 &&`
		2188	`call_has_vcallees(cees)) {`
		2189	`outs(" popl %ecx\n");`
		2190	`outs(" leal ");`
		2191	`outn((long)callee_size / 8);`
		2192	`outs("(%esp),%edx\n");`
		2193	`outs(" pushl %edx\n");`
		2194	`outs(" pushl %ecx\n");`
		2195	`}`
		2196	`} else {`
		2197	`if (callee_size != 0 \|\|`
		2198	`call_has_vcallees(cees)) {`
		2199	`outs(" popl %ecx\n");`
		2200	`if (callee_size < 0) {`
		2201	`outs(" popl %edx\n");`
		2202	`outs(" movl %edx,%esp\n");`
		2203	`} else if (callee_size == 0) {`
		2204	`outs(" movl %esp %edx\n");`
		2205	`} else {`
		2206	`outs(" leal ");`
		2207	`outn((long)callee_size / 8);`
		2208	`outs("(%esp),%edx\n");`
		2209	`outs(" movl %edx,%esp\n");`
		2210	`}`
		2211	`if (call_has_vcallees(cees)) {`
		2212	`outs(" pushl %edx\n");`
		2213	`}`
		2214	`outs(" pushl %ecx\n");`
		2215	`}`
		2216	`}`
		2217	`outs(" jmp *%eax\n\n");`
		2218	`} else {`
		2219	`/* callees have been pushed */`
		2220	`if (call_has_vcallees(cees)) {`
		2221	`if (callee_size >= 0) {`
		2222	`outs(" leal ");`
		2223	`rel_ap(4 + callee_size / 8, 1);`
		2224	`outs(",%eax\n");`
		2225	`ins0(pusheax);`
		2226	`} else {`
		2227	`outs(" pushl ");`
		2228	`rel_ap(4, 1);`
		2229	`}`
		2230	`outnl();`
		2231	`stack_dec -= 32;`
		2232	`}`
		2233	`outs(" pushl ");`
		2234	`rel_ap (0, 1); /* push return address after callees */`
		2235	`outnl();`
		2236	`stack_dec -= 32;`
		2237	`/* push proc for call by return */`
		2238	`coder(pushdest, stack, proc);`
		2239
		2240	`stack_dec -= 32;`
		2241	`check_stack_max;`
		2242	`if (longs < 0) {`
		2243	`/* must be dynamic_callees */`
		2244	`exp sz = bro(son(cees));`
		2245	`move(slongsh, mw(sz, 0), reg2);`
		2246	`if (al2(sh(sz)) < param_align) {`
		2247	`if (al2(sh(sz)) == 1) {`
		2248	`outs(" addl $31,%ecx\n");`
		2249	`outs(" shrl $3,%ecx\n");`
		2250	`} else {`
		2251	`outs(" addl $3,%ecx\n");`
		2252	`}`
		2253	`outs(" andl $-4,%ecx\n");`
		2254	`}`
		2255	`}`
		2256	`if (!call_has_vcallees(cees)) {`
		2257	`if (callee_size >= 0) {`
		2258	`outs(" leal ");`
		2259	`rel_ap(4 + callee_size / 8, 1);`
		2260	`outs(",%eax\n");`
		2261	`}`
		2262	`else {`
		2263	`outs(" movl ");`
		2264	`rel_ap(4, 1);`
		2265	`outs(",%eax\n");`
		2266	`}`
		2267	`}`
		2268
		2269	`restore_callregs(1);`
		2270
		2271	`/* callees, return and proc to call are stacked */`
		2272	`/* size in %ecx if longs<0; callers at %eax unless`
		2273	`* stacked for vcallees */`
		2274	`outs(" pushl %esi\n");`
		2275	`outs(" pushl %edi\n");`
		2276	`if (call_has_vcallees(cees)) {`
		2277	`outs(" movl 16(%esp),%edi\n");`
		2278	`} else {`
		2279	`outs(" movl %eax,%edi\n");`
		2280	`}`
		2281	`if (longs < 0) {`
		2282	`outs(" addl $");`
		2283	`outn((long)(call_has_vcallees(cees) ? 20 : 16));`
		2284	`outs(", %ecx\n");`
		2285	`outs(" leal -4(%esp),%esi\n");`
		2286	`outs(" addl %ecx,%esi\n");`
		2287	`outs(" shrl $2,%ecx\n");`
		2288	`} else {`
		2289	`outs(" movl $");`
		2290	`outn((long)(longs / 32 +`
		2291	`(call_has_vcallees(cees) ? 5 : 4)));`
		2292	`outs(",%ecx\n");`
		2293	`outs(" leal ");`
		2294	`outn((long)(longs / 8 +`
		2295	`(call_has_vcallees(cees) ? 16 : 12)));`
		2296	`outs("(%esp),%esi\n");`
		2297	`}`
		2298	`outs(" subl $4,%edi\n");`
		2299	`outs(" std\n rep\n movsl\n cld\n");`
		2300	`outs(" leal 4(%edi),%esp\n");`
		2301	`outs(" popl %edi\n");`
		2302	`outs(" popl %esi\n");`
		2303	`outs(" ret\n");`
		2304	`}`
		2305
		2306	`cond1_set = 0;`
		2307	`cond2_set = 0;`
		2308	`stack_dec = old_stack_dec;`
		2309	`must_use_bp = prev_use_bp;`
		2310	`return;`
		2311	`};`
		2312	`case alloca_tag: {`
		2313	`where sz_where;`
		2314	`if (name(son(e)) == val_tag)`
		2315	`{`
		2316	`int n = no(son(e));`
		2317	`if (name(sh(son(e)))!= offsethd)`
		2318	`n = 8 * n;`
		2319	`sz_where = mw(zeroe, rounder(n, stack_align) /8);`
		2320	`}`
		2321	`else {`
		2322	`exp temp = getexp(slongsh, nilexp, 0, nilexp, nilexp, 0, 0, val_tag);`
		2323	`if (name(sh(son(e))) == offsethd && al2(sh(son(e))) == 1) {`
		2324	`no(temp) = 31;`
		2325	`bop(add, ulongsh, temp, son(e), reg0, stack);`
		2326	`shiftr(ulongsh, mw(zeroe,3), reg0, reg0);`
		2327	`and(ulongsh, mw(zeroe, -4), reg0, reg0);`
		2328	`sz_where = reg0;`
		2329	`}`
		2330	`else if (al2(sh(son(e))) < 32) {`
		2331	`no(temp) = 3;`
		2332	`bop(add, ulongsh, temp, son(e), reg0, stack);`
		2333	`and(ulongsh, mw(zeroe, -4), reg0, reg0);`
		2334	`sz_where = reg0;`
		2335	`}`
		2336	`else {`
		2337	`sz_where = reg0;`
		2338	`coder(sz_where, stack, son(e));`
		2339	`}`
		2340	`retcell(temp);`
		2341	`};`
		2342	`if (checkalloc(e))`
		2343	`checkalloc_stack(sz_where, 1); /* uses reg1 */`
		2344	`else`
		2345	`sub(ulongsh, sz_where, sp, sp);`
		2346	`if (!eq_where(dest, zero))`
		2347	`move(sh(e), sp, dest);`
		2348	`if (need_preserve_stack)`
		2349	`save_stack();`
		2350	`return;`
		2351	`};`
		2352	`case last_local_tag: {`
		2353	`move(sh(e), sp, dest);`
		2354	`return;`
		2355	`};`
		2356	`case local_free_tag: move(slongsh, mw(son(e),0), sp);`
		2357	`if (name(bro(son(e))) == val_tag)`
		2358	`{`
		2359	`int sz;`
		2360	`int n = no(bro(son(e)));`
		2361	`if (name(sh(bro(son(e))))!= offsethd)`
		2362	`n = 8 * n;`
		2363	`sz = rounder(n, stack_align);`
		2364	`add(slongsh, mw(zeroe, sz/8), sp, sp);`
		2365	`}`
		2366	`else`
		2367	`add(slongsh, mw(bro(son(e)), 0), sp, sp);`
		2368	`add(slongsh, mw(zeroe, 3), sp, sp);`
		2369	`and(slongsh, mw(zeroe, -stack_align/8), sp, sp);`
		2370	`if (need_preserve_stack)`
		2371	`save_stack();`
		2372	`return;`
		2373	`case local_free_all_tag: set_stack_from_bp();`
		2374	`if (need_preserve_stack)`
		2375	`save_stack();`
		2376	`return;`
		2377	`case ignorable_tag: coder(dest, stack, son(e));`
		2378	`return;`
		2379	`case res_tag:`
		2380	`case untidy_return_tag: {`
		2381	`int old_stack_dec = stack_dec;`
		2382	`#ifdef NEWDWARF`
		2383	`long over_lab;`
		2384	`#endif`
		2385	`cond1_set = 0;`
		2386	`cond2_set = 0;`
		2387	`{`
		2388	`/* procedure call not inlined, this res is for a procedure */`
		2389	`if (reg_result (sh (son (e)))) {/* answer to registers */`
		2390	`int with_fl_reg = 0;`
		2391	`/* int simple_res = (name(son(e)) == val_tag); */`
		2392	`int good_fs;`
		2393
		2394	`/* if (!simple_res) */`
		2395	`{`
		2396	`if (name(sh(son(e))) >= shrealhd &&`
		2397	`name(sh(son(e))) <= doublehd) {`
		2398	`coder(flstack, stack, son(e));`
		2399	`with_fl_reg = 1;`
		2400	`}`
		2401	`else {`
		2402	`coder(reg0, stack, son(e));`
		2403	`};`
		2404	`};`
		2405
		2406	`if (name(sh(son(e)))!= bothd) {`
		2407	`good_fs = fstack_pos;`
		2408	`if (with_fl_reg) {/* jumping with a floating value */`
		2409	`/* clear off any unwanted stack registers */`
		2410	`while (fstack_pos > (first_fl_reg + 1))`
		2411	`discard_st1();`
		2412	`fstack_pos = good_fs - 1;`
		2413	`}`
		2414	`else {`
		2415	`/* clear off any unwanted stack registers */`
		2416	`while (fstack_pos > first_fl_reg)`
		2417	`discard_fstack();`
		2418	`fstack_pos = good_fs;`
		2419	`};`
		2420	`reset_fpucon();`
		2421	`if (name(e) ==untidy_return_tag) {`
		2422	`int old_regsinuse = regsinuse;`
		2423	`regsinuse &= ~0x6; /* %ecx, %edx not preserved */`
		2424	`if (shape_size(sh(son(e))) > 32 && !with_fl_reg)`
		2425	`regsinuse \|= 0x2; /* %edx used for return value */`
		2426	`if (stack_dec != 0)`
		2427	`stack_return(- stack_dec);`
		2428	`regsinuse = old_regsinuse;`
		2429	`outs(" pushl ");`
		2430	`rel_ap (0, 1); /* push return address for return after pops */`
		2431	`outnl();`
		2432	`#ifdef NEWDWARF`
		2433	`if (diagnose && dwarf2)`
		2434	`dw2_untidy_return();`
		2435	`#endif`
		2436	`}`
		2437	`#ifdef NEWDWARF`
		2438	`if (diagnose && dwarf2) {`
		2439	`over_lab = next_dwarf_label();`
		2440	`dw2_return_pos(over_lab);`
		2441	`}`
		2442	`#endif`
		2443	`restore_callregs(name(e) ==untidy_return_tag);`
		2444	`#if 0`
		2445	`if (simple_res) { /* now done earlier for dw2_returns consistency */`
		2446	`coder(reg0, stack, son(e));`
		2447	`};`
		2448	`#endif`
		2449
		2450	`if (name(e) ==untidy_return_tag)`
		2451	`ins0(ret);`
		2452	`else`
		2453	`retins();`
		2454	`outnl();`
		2455	`#ifdef NEWDWARF`
		2456	`if (diagnose && dwarf2)`
		2457	`dw2_after_fde_exit(over_lab);`
		2458	`#endif`
		2459	`};`
		2460	`stack_dec = old_stack_dec;`
		2461	`return;`
		2462	`};`
		2463	`failer(STRUCT_RETURN);`
		2464	`return;`
		2465	`};`
		2466	`};`
		2467	`case return_to_label_tag: {`
		2468	`int good_fs = fstack_pos;`
		2469	`/* clear off any unwanted stack registers */`
		2470	`while (fstack_pos > first_fl_reg)`
		2471	`discard_fstack();`
		2472	`fstack_pos = good_fs;`
		2473	`reset_fpucon();`
		2474	`move(slongsh, mw(son(e), 0), reg0);`
		2475	`restore_callregs(0);`
		2476	`ins0("jmp *%eax");`
		2477	`return;`
		2478	`};`
		2479	`case movecont_tag: {`
		2480	`exp frome = son(e);`
		2481	`exp toe = bro(frome);`
		2482	`exp lengthe = bro(toe);`
		2483	`movecont(mw(frome, 0), mw(toe, 0), mw(lengthe, 0),`
		2484	`isnooverlap(e));`
		2485	`return;`
		2486	`};`
		2487	`case solve_tag: {`
		2488	`exp jr = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,`
		2489	`0, 0);`
		2490	`clean_stack();`
		2491	`sonno(jr) = stack_dec;`
		2492	`ptno(jr) = next_lab();`
		2493	`fstack_pos_of(jr) = (prop)fstack_pos;`
		2494	`/* jump record for end */`
		2495	`solve(son(e), son(e), dest, jr, stack);`
		2496	`if (name(sh(e))!= bothd) {`
		2497	`align_label(0, jr);`
		2498	`set_label(jr);`
		2499	`#ifdef NEWDWARF`
		2500	`START_BB();`
		2501	`#endif`
		2502	`};`
		2503	`fpucon = normal_fpucon;`
		2504	`cond1_set = 0;`
		2505	`cond2_set = 0;`
		2506	`return;`
		2507	`};`
		2508	`case case_tag: {`
		2509	`where qw;`
		2510	`exp arg1 = son(e);`
		2511	`exp b = bro(arg1);`
		2512	`exp t = arg1;`
		2513	`while (!last(t))`
		2514	`t = bro(t);`
		2515	`bro(t) = nilexp;`
		2516
		2517	`if (!is_o(name(arg1)) \|\| is_crc(arg1)) {`
		2518	`/* argument is not a possible 80386`
		2519	`operand, precompute it in reg0 */`
		2520	`qw.where_exp = copyexp(reg0.where_exp);`
		2521	`sh(qw.where_exp) = sh(arg1);`
		2522	`qw.where_off = 0;`
		2523	`coder(qw, stack, arg1);`
		2524	`arg1 = qw.where_exp;`
		2525	`bro(arg1) = b;`
		2526	`};`
		2527
		2528	`clean_stack();`
		2529
		2530	`IGNORE caser(arg1, name(sh(e)) == bothd, e);`
		2531
		2532	`return;`
		2533	`};`
		2534	`#ifndef NEWDIAGS`
		2535	`case diagnose_tag: {`
		2536	`diag_info * d = dno(e);`
		2537	`if (d->key == DIAG_INFO_SOURCE) {`
		2538	`crt_lno = natint(d -> data.source.beg.line_no);`
		2539	`crt_charno = natint(d -> data.source.beg.char_off);`
		2540	`crt_flnm = d -> data.source.beg.file->file.ints.chars;`
		2541	`};`
		2542	`output_diag(d, crt_proc_id, e);`
		2543	`coder(dest, stack, son(e));`
		2544	`output_end_scope(d, e);`
		2545	`return;`
		2546	`};`
		2547	`#endif`
		2548	`case trap_tag: {`
		2549	`trap_ins(no(e));`
		2550	`return;`
		2551	`}`
		2552	`case asm_tag: {`
		2553	`if (props(e))`
		2554	`asm_ins(e);`
		2555	`else {`
		2556	`start_asm();`
		2557	`coder(dest, stack, son(e));`
		2558	`end_asm();`
		2559	`}`
		2560	`clear_low_reg_record(crt_reg_record);`
		2561	`return;`
		2562	`}`
		2563	`default:`
		2564	`if (!is_a(name(e))) {`
		2565	`failer(BADOP);`
		2566	`return;`
		2567	`};`
		2568
		2569	`if (name(dest.where_exp)!= val_tag)`
		2570	`codec(dest, stack, e);`
		2571	`else`
		2572	`if (!optop(e)) {`
		2573	`if (name(sh(e)) >= shrealhd && name(sh(e)) <= doublehd) {`
		2574	`codec(flstack, stack, e);`
		2575	`discard_fstack();`
		2576	`}`
		2577	`else`
		2578	`codec(reg0, stack, e);`
		2579	`}`
		2580	`else`
		2581	`if (name(e)!=name_tag && name(e)!=env_offset_tag && son(e)!=nilexp) {`
		2582	`exp l = son(e); /* catch all discards with side-effects */`
		2583	`for (;;) {`
		2584	`coder(dest, stack, l);`
		2585	`if (last(l))break;`
		2586	`l = bro(l);`
		2587	`}`
		2588	`}`
		2589	`return;`
		2590	`};`
		2591	`}`
		2592
		2593	`#ifdef NEWDIAGS`
		2594	`struct coder_args {`
		2595	`where dest;`
		2596	`ash stack;`
		2597	`exp e;`
		2598	`};`
		2599
		2600	`static void`
		2601	`coder2(void *args)`
		2602	`{`
		2603	`struct coder_args * x = (struct coder_args *)args;`
		2604	`coder1(x->dest, x->stack, x->e);`
		2605	`return;`
		2606	`}`
		2607
		2608	`static dg_where`
		2609	`dg_where_dest(exp e)`
		2610	`{`
		2611	`dg_where w;`
		2612	`if (name(e) == name_tag \|\| name(e) == reff_tag) {`
		2613	`w = dg_where_dest(son(e));`
		2614	`w.o += no(e) /8;`
		2615	`return w;`
		2616	`}`
		2617	`if (name(e)!= ident_tag)`
		2618	`failer("bad dg_where");`
		2619	`if (isglob(e)) {`
		2620	`w.k = WH_STR;`
		2621	`w.u.s = (brog(e)) ->dec_u.dec_val.dec_id;`
		2622	`w.o = 0;`
		2623	`return w;`
		2624	`}`
		2625	`if (ptno(e) < 0 \|\| ptno(e) > 10) /* contop case */`
		2626	`return(dg_where_dest(son(e)));`
		2627	`switch (ptno(e)) {`
		2628	`case local_pl: {`
		2629	`w.k = WH_REGOFF;`
		2630	`w.u.l = -2;`
		2631	`w.o = no(e) /8;`
		2632	`break;`
		2633	`}`
		2634	`case par_pl: {`
		2635	`w.k = WH_REGOFF;`
		2636	`w.u.l = -1;`
		2637	`w.o = (no(e) /8) + 4;`
		2638	`break;`
		2639	`}`
		2640	`case reg_pl: {`
		2641	`w.k = WH_REG;`
		2642	`w.u.l = get_reg_no(no(e));`
		2643	`break;`
		2644	`}`
		2645	`default:`
		2646	`failer("bad dg_where");`
		2647	`SET(w);`
		2648	`}`
		2649	`return w;`
		2650	`}`
		2651
		2652	`static dg_where`
		2653	`contop_where(exp id)`
		2654	`{`
		2655	`return(dg_where_dest(bro(son(id))));`
		2656	`}`
		2657
		2658
		2659	`dg_where`
		2660	`find_diag_res(void * args)`
		2661	`{`
		2662	`struct coder_args * x = (struct coder_args *)args;`
		2663	`exp e = x->dest.where_exp;`
		2664	`dg_where w;`
		2665	`switch (name(e)) {`
		2666	`case val_tag: {`
		2667	`w.k = NO_WH;`
		2668	`break;`
		2669	`}`
		2670	`case ident_tag:`
		2671	`case name_tag: {`
		2672	`w = dg_where_dest(e);`
		2673	`break;`
		2674	`}`
		2675	`case ass_tag: {`
		2676	`if (name(son(e)) == ident_tag)`
		2677	`w = contop_where(son(e));`
		2678	`else`
		2679	`w = dg_where_dest(son(e));`
		2680	`break;`
		2681	`}`
		2682	`case apply_tag: {`
		2683	`w.k = WH_REGOFF;`
		2684	`w.u.l = get_reg_no(no(son(sp.where_exp)));`
		2685	`w.o = 0;`
		2686	`break;`
		2687	`}`
		2688	`default:`
		2689	`failer("unexpected diag_res dest");`
		2690	`SET(w);`
		2691	`}`
		2692	`return w;`
		2693	`}`
		2694
		2695	`void`
		2696	`coder(where dest, ash stack, exp e)`
		2697	`{`
		2698	`dg_info d;`
		2699	`dg_info was_current = current_dg_info;`
		2700	`current_dg_info = nildiag;`
		2701	`if (extra_diags) {`
		2702	`switch (name(e)) {`
		2703	`case apply_tag:`
		2704	`case apply_general_tag: {`
		2705	`d = dgf(e);`
		2706	`while (d && d->key != DGA_CALL)`
		2707	`d = d->more;`
		2708	`if (!d) {`
		2709	`d = new_dg_info(DGA_CALL);`
		2710	`d->data.i_call.clnam = (char*)0;`
		2711	`d->data.i_call.pos = no_short_sourcepos;`
		2712	`d->data.i_call.ck = 0;`
		2713	`dgf(e) = combine_diaginfo(dgf(e), d);`
		2714	`}`
		2715	`break;`
		2716	`}`
		2717	`case test_tag: {`
		2718	`d = dgf(e);`
		2719	`if (dw_doing_branch_tests)`
		2720	`break;`
		2721	`while (d && d->key != DGA_TEST)`
		2722	`d = d->more;`
		2723	`if (!d) {`
		2724	`d = new_dg_info(DGA_TEST);`
		2725	`d->data.i_tst.pos = no_short_sourcepos;`
		2726	`d->data.i_tst.inv = 0;`
		2727	`dgf(e) = combine_diaginfo(dgf(e), d);`
		2728	`}`
		2729	`break;`
		2730	`}`
		2731	`case goto_tag: {`
		2732	`short_sourcepos p;`
		2733	`d = dgf(e);`
		2734	`if (dw_doing_branch_tests)`
		2735	`break;`
		2736	`p = no_short_sourcepos;`
		2737	`while (d && d->key != DGA_JUMP) {`
		2738	`if (d->key == DGA_SRC)`
		2739	`p = d->data.i_src.startpos;`
		2740	`d = d->more;`
		2741	`}`
		2742	`if (!d) {`
		2743	`d = new_dg_info(DGA_JUMP);`
		2744	`d->data.i_tst.pos = p;`
		2745	`dgf(e) = combine_diaginfo(dgf(e), d);`
		2746	`}`
		2747	`break;`
		2748	`}`
		2749	`case goto_lv_tag:`
		2750	`case return_to_label_tag:`
		2751	`case long_jump_tag:`
		2752	`case tail_call_tag: {`
		2753	`d = dgf(e);`
		2754	`if (dw_doing_branch_tests)`
		2755	`break;`
		2756	`while (d && d->key != DGA_LJ)`
		2757	`d = d->more;`
		2758	`if (!d) {`
		2759	`d = new_dg_info(DGA_LJ);`
		2760	`d->data.i_tst.pos = no_short_sourcepos;`
		2761	`dgf(e) = combine_diaginfo(dgf(e), d);`
		2762	`}`
		2763	`break;`
		2764	`}`
		2765	`}`
		2766	`}`
		2767	`d = dgf(e);`
		2768	`if (d != nildiag) {`
		2769	`dg_info dpos = nildiag;`
		2770	`struct coder_args args;`
		2771	`args.dest = dest;`
		2772	`args.stack = stack;`
		2773	`current_dg_exp = args.e = e;`
		2774	`while (d != nildiag) {`
		2775	`if (d->key == DGA_SRC && d->data.i_src.startpos.file) {`
		2776	`crt_lno = d->data.i_src.startpos.line;`
		2777	`crt_charno = d->data.i_src.startpos.column;`
		2778	`crt_flnm = d->data.i_src.startpos.file->file_name;`
		2779	`if (d->data.i_src.endpos.file) {`
		2780	`dpos = d;`
		2781	`break;`
		2782	`}`
		2783	`};`
		2784	`d = d->more;`
		2785	`};`
		2786	`#ifdef NEWDWARF`
		2787	`CODE_DIAG_INFO(dgf(e), crt_proc_id, coder2,(void*) &args);`
		2788	`#else`
		2789	`code_diag_info(dgf(e), crt_proc_id, coder2,(void*) &args);`
		2790	`#endif`
		2791	`if (dpos) {`
		2792	`crt_lno = dpos->data.i_src.endpos.line;`
		2793	`crt_charno = dpos->data.i_src.endpos.column;`
		2794	`crt_flnm = dpos->data.i_src.endpos.file->file_name;`
		2795	`};`
		2796	`}`
		2797	`else`
		2798	`coder1(dest, stack, e);`
		2799	`current_dg_info = was_current;`
		2800	`return;`
		2801	`}`
		2802
		2803
		2804
		2805	`static void`
		2806	`done_arg(void * args)`
		2807	`{`
		2808	`UNUSED(args);`
		2809	`return;`
		2810	`}`
		2811
		2812	`void`
		2813	`diag_arg(where dest, ash stack, exp e)`
		2814	`{`
		2815	`if (dgf(e)) {`
		2816	`struct coder_args args;`
		2817	`args.dest = dest;`
		2818	`args.stack = stack;`
		2819	`current_dg_exp = args.e = e;`
		2820	`#ifdef NEWDWARF`
		2821	`CODE_DIAG_INFO(dgf(e), crt_proc_id, done_arg,(void*) &args);`
		2822	`#else`
		2823	`code_diag_info(dgf(e), crt_proc_id, done_arg,(void*) &args);`
		2824	`#endif`
		2825	`}`
		2826	`return;`
		2827	`}`
		2828
		2829
		2830	`#endif`
		2831

Subversion Repositories tendra.SVN

(root)/branches/algol60/src/installers/amd64/common/coder.c – Rev 91