WebSVN – tendra.SVN – Blame – /trunk/src/installers/80x86/common/codec.c

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

Subversion Repositories tendra.SVN

(root)/trunk/src/installers/80x86/common/codec.c – Rev 2