WebSVN – tendra.SVN – Blame – /trunk/src/installers/680x0/common/ops_int.c

Rev	Author	Line No.	Line
2	7u83	1	`/*`
		2	`Crown Copyright (c) 1996`
		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	`VERSION INFORMATION`
		31	`===================`
		32
		33	`--------------------------------------------------------------------------`
		34	$Header: /u/g/release/CVSROOT/Source/src/installers/680x0/common/ops_int.c,v 1.1.1.1 1998/01/17 15:55:49 release Exp $
		35	`--------------------------------------------------------------------------`
		36	$Log: ops_int.c,v $
		37	`* Revision 1.1.1.1 1998/01/17 15:55:49 release`
		38	`* First version to be checked into rolling release.`
		39	`*`
		40	`Revision 1.5 1997/11/13 08:27:15 ma`
		41	`All avs test passed (except add_to_ptr).`
		42
		43	`Revision 1.4 1997/11/10 15:38:07 ma`
		44	`.`
		45
		46	`Revision 1.3 1997/11/09 14:12:27 ma`
		47	`Fixed max_min & splitted add_const into add_const and sub_const to make`
		48	`error handling work.`
		49
		50	`Revision 1.2 1997/10/29 10:22:26 ma`
		51	`Replaced use_alloca with has_alloca.`
		52
		53	`Revision 1.1.1.1 1997/10/13 12:42:56 ma`
		54	`First version.`
		55
		56	`Revision 1.6 1997/10/13 08:49:47 ma`
		57	`Made all pl_tests for general proc & exception handling pass.`
		58
		59	`Revision 1.5 1997/09/25 06:45:24 ma`
		60	`All general_proc tests passed`
		61
		62	`Revision 1.4 1997/06/24 10:56:06 ma`
		63	`Added changes for "Plumhall Patch"`
		64
		65	`Revision 1.3 1997/06/18 10:09:42 ma`
		66	`Checking in before merging with Input Baseline changes.`
		67
		68	`Revision 1.2 1997/04/20 11:30:34 ma`
		69	`Introduced gcproc.c & general_proc.[ch].`
		70	`Added cases for apply_general_proc next to apply_proc in all files.`
		71
		72	`Revision 1.1.1.1 1997/03/14 07:50:16 ma`
		73	`Imported from DRA`
		74
		75	`* Revision 1.1.1.1 1996/09/20 10:56:57 john`
		76	`*`
		77	`* Revision 1.3 1996/07/30 16:31:23 john`
		78	`* Removed offset conversion`
		79	`*`
		80	`* Revision 1.2 1996/07/05 14:24:16 john`
		81	`* Changes for spec 3.1`
		82	`*`
		83	`* Revision 1.1.1.1 1996/03/26 15:45:15 john`
		84	`*`
		85	`* Revision 1.7 94/11/16 10:37:25 10:37:25 ra (Robert Andrews)`
		86	`* Added support for integer absolute.`
		87	`*`
		88	`* Revision 1.6 94/11/08 11:23:45 11:23:45 ra (Robert Andrews)`
		89	`* The operations addq and subq on A-registers do not set the condition`
		90	`* flags.`
		91	`*`
		92	`* Revision 1.5 94/06/29 14:23:27 14:23:27 ra (Robert Andrews)`
		93	`* Added maximum and minimum operations.`
		94	`*`
		95	`* Revision 1.4 94/02/21 16:01:29 16:01:29 ra (Robert Andrews)`
		96	`* Made a couple of integer literals into longs.`
		97	`*`
		98	`* Revision 1.3 93/04/19 13:35:28 13:35:28 ra (Robert Andrews)`
		99	`* Change_varieties in division routines were the wrong way round.`
		100	`*`
		101	`* Revision 1.2 93/03/03 14:49:05 14:49:05 ra (Robert Andrews)`
		102	`* Started adding support for error treatments.`
		103	`*`
		104	`* Revision 1.1 93/02/22 17:16:20 17:16:20 ra (Robert Andrews)`
		105	`* Initial revision`
		106	`*`
		107	`--------------------------------------------------------------------------`
		108	`*/`
		109
		110
		111	`#include "config.h"`
		112	`#include "common_types.h"`
		113	`#include "assembler.h"`
		114	`#include "basicread.h"`
		115	`#include "check.h"`
		116	`#include "exp.h"`
		117	`#include "expmacs.h"`
		118	`#include "externs.h"`
		119	`#include "install_fns.h"`
		120	`#include "shapemacs.h"`
		121	`#include "tags.h"`
		122	`#include "mach.h"`
		123	`#include "mach_ins.h"`
		124	`#include "where.h"`
		125	`#include "mach_op.h"`
		126	`#include "instr.h"`
		127	`#include "codex.h"`
		128	`#include "instrs.h"`
		129	`#include "coder.h"`
		130	`#include "tests.h"`
		131	`#include "operations.h"`
		132	`#include "evaluate.h"`
		133	`#include "utility.h"`
		134	`#include "translate.h"`
		135	`#include "ops_shared.h"`
		136	`extern void add_const PROTO_S ( ( shape, long, where ) ) ;`
		137
		138	`/*`
		139	`DO AN ADD BY A LOAD EFFECTIVE ADDRESS`
		140
		141	`The m_lea instruction is used to add the constant offset to the value`
		142	`a and put the result into dest. The flag psh is true to indicate`
		143	`that the result should be pushed onto the stack.`
		144	`*/`
		145
		146	`void load_ea`
		147	`PROTO_N ( ( sha, offset, a, dest, psh ) )`
		148	`PROTO_T ( shape sha X long offset X where a X where dest X bool psh )`
		149	`{`
		150	`if ( have_overflow () ) {`
		151	`move ( sha, a, D0 ) ;`
		152	`add_const ( sha, offset, D0 ) ;`
		153	`move ( sha, D0, dest ) ;`
		154	`have_cond = 0 ;`
		155	`} else {`
		156	`exp ra = simple_exp ( dummy_tag ) ;`
		157	`son ( ra ) = a.wh_exp ;`
		158	`no ( ra ) = 8 * offset ;`
		159	`if ( psh ) {`
		160	`ins1 ( m_pea, L32, zw ( ra ), 0 ) ;`
		161	`stack_size -= 32 ;`
		162	`} else {`
		163	`ins2 ( m_lea, L32, L32, zw ( ra ), dest, 1 ) ;`
		164	`}`
		165	`retcell ( ra ) ;`
		166	`have_cond = 0 ;`
		167	`}`
		168	`return ;`
		169	`}`
		170
		171
		172	`/*`
		173	`INCREASE BY A CONSTANT`
		174
		175	`The value dest is increased or decreased by the constant n.`
		176	`*/`
		177
		178	`void addsub_const`
		179	`PROTO_N ( ( sha, n, dest, use_sub ) )`
		180	`PROTO_T ( shape sha X long n X where dest X bool use_sub )`
		181	`{`
		182	`int instr ;`
		183	`bool negate = 0, use_quick = 0 ;`
		184
		185	`long sz = shape_size ( sha ) ;`
		186	`if ( n == 0 ) return ;`
		187
		188	`/* If destination is a value we just have to test for overflow */`
		189
		190	`if ( whereis ( dest ) == Value ) {`
		191	`long v = nw ( dest ) ;`
		192	`if ( is_signed(sha) ) {`
		193	`if ( use_sub )`
		194	`n = -n ;`
		195	`if (v>0 && n>0) {`
		196	`if (v > range_max(sha) - n)`
		197	`test_overflow(UNCONDITIONAL) ;`
		198	`}`
		199	`else if (v<0 && n<0) {`
		200	`if (v < range_min(sha) - n)`
		201	`test_overflow(UNCONDITIONAL) ;`
		202	`}`
		203	`}`
		204	`else { /* unsigned addition */`
		205	`if (use_sub) {`
		206	`/* will v - n underflow ? */`
		207	`if ((unsigned)v < (unsigned) range_min(sha) - (unsigned) n)`
		208	`test_overflow(UNCONDITIONAL) ;`
		209	`}`
		210	`else {`
		211	`if ((unsigned)v > (unsigned) range_max(sha) - (unsigned) n)`
		212	`test_overflow(UNCONDITIONAL) ;`
		213	`}`
		214	`}`
		215	`return ;`
		216	`}`
		217
		218
		219	`/* Destination is not just a value */`
		220
		221	`/* If we don't have to test for overflow, we can chose wheter to add/sub */`
		222	`/* Changeing add and sub might allow us to use quick add or sub */`
		223	`if ( ! have_overflow() ) {`
		224	`/* But -(INT_MIN) can't be represented in signed shape */`
		225	`if (n != INT_MIN) {`
		226	`if (n < 0)`
		227	`negate = 1 ;`
		228	`if ((n < 8) && (n > -8))`
		229	`use_quick = 1 ;`
		230	`}`
		231	`}`
		232	`else {`
		233	`if ((unsigned long)n < 8)`
		234	`use_quick = 1 ;`
		235	`}`
		236
		237	`/* Special handling for address regs. */`
		238	`if ( whereis ( dest ) == Areg ) {`
		239	`if (use_quick) {`
		240	`have_cond = 0 ;`
		241	`}`
		242	`else {`
		243	`if (use_sub)`
		244	`n = -n ;`
		245	`load_ea ( sha, n, dest, dest, 0 ) ;`
		246	`return ;`
		247	`}`
		248	`}`
		249
		250	`/* Find appropriate ADD/SUB */`
		251	`if (negate) {`
		252	`n = -n ;`
		253	`use_sub = ! use_sub ;`
		254	`}`
		255
		256	`if (use_sub) {`
		257	`if (use_quick)`
		258	`instr = ins ( sz, ml_subq ) ;`
		259	`else`
		260	`instr = ins ( sz, ml_sub ) ;`
		261	`}`
		262	`else {`
		263	`if (use_quick)`
		264	`instr = ins ( sz, ml_addq ) ;`
		265	`else`
		266	`instr = ins ( sz, ml_add ) ;`
		267	`}`
		268
		269	`ins2n ( instr, n, sz, dest, 1 ) ;`
		270	`set_cond ( dest, sz ) ;`
		271	`test_overflow(ON_SHAPE ( sha )) ;`
		272	`}`
		273
		274	`void add_const`
		275	`PROTO_N ( ( sha, n, dest) )`
		276	`PROTO_T ( shape sha X long n X where dest )`
		277	`{`
		278	`addsub_const ( sha, n, dest, 0);`
		279	`}`
		280
		281	`void sub_const`
		282	`PROTO_N ( ( sha, n, dest) )`
		283	`PROTO_T ( shape sha X long n X where dest )`
		284	`{`
		285	`addsub_const ( sha, n, dest, 1);`
		286	`}`
		287
		288	`/*`
		289	`AUXILIARY ADD ROUTINE`
		290
		291	`The value inc (of shape sha and size sz) is added to dest.`
		292	`*/`
		293
		294	`static void add_aux`
		295	`PROTO_N ( ( sha, sz, inc, dest ) )`
		296	`PROTO_T ( shape sha X long sz X where inc X where dest )`
		297	`{`
		298	`int instr ;`
		299	`long whi = whereis ( inc ) ;`
		300	`long whd = whereis ( dest ) ;`
		301	`if ( whd == Freg ) {`
		302	`move ( sha, dest, D0 ) ;`
		303	`add_aux ( sha, sz, inc, D0 ) ;`
		304	`move ( sha, D0, dest ) ;`
		305	`return ;`
		306	`}`
		307	`if ( whi == Value ) {`
		308	`long v = nw ( inc ) ;`
		309	`if ( is_offset ( inc.wh_exp ) ) v /= 8 ;`
		310	`add_const ( sha, v, dest) ;`
		311	`return ;`
		312	`}`
		313	`if ( whi == Freg ) {`
		314	`move ( sha, inc, D0 ) ;`
		315	`add_aux ( sha, sz, D0, dest ) ;`
		316	`return ;`
		317	`}`
		318
		319	`if ( have_overflow () && whd == Areg ) {`
		320	`/* Skip to end */`
		321	`} else if ( whi == Dreg \|\| whd == Dreg \|\| whd == Areg ) {`
		322	`instr = ins ( sz, ml_add ) ;`
		323	`ins2 ( instr, sz, sz, inc, dest, 1 ) ;`
		324	`if ( whd == Areg ) {`
		325	`have_cond = 0 ;`
		326	`} else {`
		327	`set_cond ( dest, sz ) ;`
		328	`}`
		329	`test_overflow(ON_SHAPE ( sha )) ;`
		330	`return ;`
		331	`}`
		332	`move ( sha, inc, D0 ) ;`
		333	`add_aux ( sha, sz, D0, dest ) ;`
		334	`return ;`
		335	`}`
		336
		337
		338	`/*`
		339	`ADD CONSTANT ROUTINE`
		340
		341	`The constant c is added to the value inc, and the result is stored`
		342	`in dest.`
		343	`*/`
		344
		345	`static void addsub_const_3_args`
		346	`PROTO_N ( ( sha, sz, c, inc, dest, use_sub ) )`
		347	`PROTO_T ( shape sha X long sz X long c X where inc X where dest X bool use_sub )`
		348	`{`
		349	`if ( c == 0 ) {`
		350	`move ( sha, inc, dest ) ;`
		351	`return ;`
		352	`}`
		353	`switch ( whereis ( dest ) ) {`
		354	`case Dreg : {`
		355	`move ( sha, inc, dest ) ;`
		356	`addsub_const ( sha, c, dest, use_sub ) ;`
		357	`return ;`
		358	`}`
		359	`case Areg : {`
		360	`if ( whereis ( inc ) == Areg ) {`
		361	`load_ea ( sha, c, inc, dest, 0 ) ;`
		362	`return ;`
		363	`}`
		364	`move ( sha, inc, dest ) ;`
		365	`addsub_const ( sha, c, dest, use_sub ) ;`
		366	`return ;`
		367	`}`
		368	`default : {`
		369	`long whi = whereis ( inc ) ;`
		370	`if ( whi == Dreg && last_use ( inc ) ) {`
		371	`addsub_const ( sha, c, inc, use_sub ) ;`
		372	`move ( sha, inc, dest ) ;`
		373	`set_cond ( dest, sz ) ;`
		374	`return ;`
		375	`}`
		376	`if ( whi == Areg && ( name ( dest.wh_exp ) == apply_tag`
		377	`\|\| name ( dest.wh_exp ) == apply_general_tag`
		378	`\|\| name ( dest.wh_exp ) == tail_call_tag )) {`
		379	`load_ea ( sha, c, inc, dest, 1 ) ;`
		380	`return ;`
		381	`}`
		382	`addsub_const_3_args ( sha, sz, c, inc, D0, use_sub ) ;`
		383	`move ( sha, D0, dest ) ;`
		384	`set_cond ( dest, sz ) ;`
		385	`return ;`
		386	`}`
		387	`}`
		388	`}`
		389
		390
		391	`/*`
		392	`MAIN ADD ROUTINE`
		393
		394	`The values a1 and a2 of shape sha are added and the result stored in`
		395	`dest.`
		396	`*/`
		397
		398	`void add`
		399	`PROTO_N ( ( sha, a1, a2, dest ) )`
		400	`PROTO_T ( shape sha X where a1 X where a2 X where dest )`
		401	`{`
		402	`long sz = shape_size ( sha ) ;`
		403	`long rt = shtype ( sha ) ;`
		404	`long wh1, wh2, whd ;`
		405
		406	`if ( rt == Freg ) {`
		407	`fl_binop ( fplus_tag, sha, a1, a2, dest ) ;`
		408	`return ;`
		409	`}`
		410
		411	`if ( eq_where ( a1, dest ) ) {`
		412	`add_aux ( sha, sz, a2, dest ) ;`
		413	`return ;`
		414	`}`
		415
		416	`if ( eq_where ( a2, dest ) ) {`
		417	`add_aux ( sha, sz, a1, dest ) ;`
		418	`return ;`
		419	`}`
		420
		421	`wh1 = whereis ( a1 ) ;`
		422	`wh2 = whereis ( a2 ) ;`
		423	`whd = whereis ( dest ) ;`
		424
		425	`if ( wh1 == Value ) {`
		426	`long v1 = nw ( a1 ) ;`
		427	`if ( is_offset ( a1.wh_exp ) ) v1 /= 8 ;`
		428	`if ( wh2 == Value && !have_overflow () ) {`
		429	`long v2 = nw ( a2 ) ;`
		430	`if ( is_offset ( a2.wh_exp ) ) v2 /= 8 ;`
		431	`move ( sha, mnw ( v1 + v2 ), dest ) ;`
		432	`return ;`
		433	`}`
		434	`addsub_const_3_args ( sha, sz, v1, a2, dest, 0 ) ;`
		435	`return ;`
		436	`}`
		437
		438	`if ( wh2 == Value ) {`
		439	`long v2 = nw ( a2 ) ;`
		440	`if ( is_offset ( a2.wh_exp ) ) v2 /= 8 ;`
		441	`addsub_const_3_args ( sha, sz, v2, a1, dest, 0 ) ;`
		442	`return ;`
		443	`}`
		444
		445	`if ( whd == Dreg ) {`
		446	`if ( !interfere ( a2, dest ) ) {`
		447	`move ( sha, a1, dest ) ;`
		448	`add_aux ( sha, sz, a2, dest ) ;`
		449	`return ;`
		450	`}`
		451	`if ( !interfere ( a1, dest ) ) {`
		452	`move ( sha, a2, dest ) ;`
		453	`add_aux ( sha, sz, a1, dest ) ;`
		454	`return ;`
		455	`}`
		456	`}`
		457
		458	`if ( wh1 == Dreg && last_use ( a1 ) ) {`
		459	`add_aux ( sha, sz, a2, a1 ) ;`
		460	`move ( sha, a1, dest ) ;`
		461	`set_cond ( dest, sz ) ;`
		462	`return ;`
		463	`}`
		464
		465	`if ( wh2 == Dreg && last_use ( a2 ) ) {`
		466	`add_aux ( sha, sz, a1, a2 ) ;`
		467	`move ( sha, a2, dest ) ;`
		468	`set_cond ( dest, sz ) ;`
		469	`return ;`
		470	`}`
		471
		472	`if ( wh1 == Dreg ) {`
		473	`move ( sha, a2, D0 ) ;`
		474	`add_aux ( sha, sz, a1, D0 ) ;`
		475	`} else {`
		476	`move ( sha, a1, D0 ) ;`
		477	`add_aux ( sha, sz, a2, D0 ) ;`
		478	`}`
		479	`move ( sha, D0, dest ) ;`
		480	`set_cond ( dest, sz ) ;`
		481	`return ;`
		482	`}`
		483
		484
		485	`/*`
		486	`AUXILIARY SUBTRACT ROUTINE`
		487
		488	`The value a is subtracted from dest.`
		489	`*/`
		490
		491	`static void sub_aux`
		492	`PROTO_N ( ( sha, sz, a, dest ) )`
		493	`PROTO_T ( shape sha X long sz X where a X where dest )`
		494	`{`
		495	`long wha = whereis ( a ) ;`
		496	`long whd = whereis ( dest ) ;`
		497	`if ( whd == Freg ) {`
		498	`move ( sha, dest, D0 ) ;`
		499	`sub_aux ( sha, sz, a, D0 ) ;`
		500	`move ( sha, D0, dest ) ;`
		501	`return ;`
		502	`}`
		503
		504	`if ( wha == Value ) {`
		505	`long v = nw ( a ) ;`
		506	`if ( is_offset ( a.wh_exp ) ) v /= 8 ;`
		507	`sub_const ( sha, v, dest ) ;`
		508	`return ;`
		509	`}`
		510
		511	`if ( wha != Freg ) {`
		512	`if ( have_overflow () && whd == Areg ) {`
		513	`/* Skip to end */`
		514	`} else if ( whd == Dreg \|\| whd == Areg \|\| wha == Dreg ) {`
		515	`int instr = ins ( sz, ml_sub ) ;`
		516	`ins2 ( instr, sz, sz, a, dest, 1 ) ;`
		517	`if ( whd == Areg ) {`
		518	`have_cond = 0 ;`
		519	`} else {`
		520	`set_cond ( dest, sz ) ;`
		521	`}`
		522	`test_overflow(ON_SHAPE ( sha )) ;`
		523	`return ;`
		524	`}`
		525	`}`
		526	`move ( sha, a, D0 ) ;`
		527	`sub_aux ( sha, sz, D0, dest ) ;`
		528	`set_cond ( dest, sz ) ;`
		529	`return ;`
		530	`}`
		531
		532
		533	`/*`
		534	`MAIN SUBTRACT ROUTINE`
		535
		536	`The value a2 of shape sha is subtracted from a1 and the result is`
		537	`stored in dest.`
		538	`*/`
		539
		540	`void sub`
		541	`PROTO_N ( ( sha, a1, a2, dest ) )`
		542	`PROTO_T ( shape sha X where a1 X where a2 X where dest )`
		543	`{`
		544	`long sz = shape_size ( sha ) ;`
		545	`long wh1, wh2, whd ;`
		546
		547	`if ( eq_where ( a1, a2 ) ) {`
		548	`move ( sha, zero, dest ) ;`
		549	`return ;`
		550	`}`
		551
		552	`if ( eq_where ( a2, dest ) && !eq_where(dest,zero)) {`
		553	`sub_aux ( sha, sz, a1, dest ) ;`
		554	`return ;`
		555	`}`
		556
		557	`wh1 = whereis ( a1 ) ;`
		558	`wh2 = whereis ( a2 ) ;`
		559	`whd = whereis ( dest ) ;`
		560
		561	`if ( wh1 == Value ) {`
		562	`long v1 = nw ( a1 ) ;`
		563	`if ( is_offset ( a1.wh_exp ) ) v1 /= 8 ;`
		564	`if ( wh2 == Value ) {`
		565	`long v2 = nw ( a2 ) ;`
		566	`if ( is_offset ( a2.wh_exp ) ) v2 /= 8 ;`
		567
		568	`if ( is_signed(sha) ) {`
		569	`if (v2>0 && v1<0) {`
		570	`if (-v1 > range_max(sha) - v2)`
		571	`test_overflow(UNCONDITIONAL) ;`
		572	`}`
		573	`else if (v2<0 && v1>0) {`
		574	`if (v2 < range_min(sha) + v1 )`
		575	`test_overflow(UNCONDITIONAL) ;`
		576	`}`
		577	`}`
		578	`else {`
		579	`if ((unsigned)v1>(unsigned)v2)`
		580	`test_overflow(UNCONDITIONAL) ;`
		581	`}`
		582
		583	`move ( sha, mnw ( v2 - v1 ), dest ) ;`
		584	`return ;`
		585	`}`
		586	`addsub_const_3_args ( sha, sz, v1, a2, dest, 1 ) ;`
		587	`return ;`
		588	`}`
		589
		590	`if ( wh2 == Value && nw ( a2 ) == 0 ) {`
		591	`negate ( sha, a1, dest ) ;`
		592	`return ;`
		593	`}`
		594
		595	`if ( ( whd == Dreg \|\| whd == Areg ) && !interfere ( a1, dest ) ) {`
		596	`move ( sha, a2, dest ) ;`
		597	`sub_aux ( sha, sz, a1, dest ) ;`
		598	`return ;`
		599	`}`
		600
		601	`move ( sha, a2, D0 ) ;`
		602	`sub_aux ( sha, sz, a1, D0 ) ;`
		603	`move ( sha, D0, dest ) ;`
		604	`set_cond ( dest, sz ) ;`
		605	`return ;`
		606	`}`
		607
		608
		609	`/*`
		610	`NEGATE ROUTINE`
		611
		612	`The value a of shape sha is negated and the result is stored in dest.`
		613	`*/`
		614
		615	`void negate`
		616	`PROTO_N ( ( sha, a, dest ) )`
		617	`PROTO_T ( shape sha X where a X where dest )`
		618	`{`
		619	`int instr ;`
		620	`long sz = shape_size ( sha ) ;`
		621	`long rt = shtype ( sha ) ;`
		622	`long wha = whereis ( a ) ;`
		623	`long whd = whereis ( dest ) ;`
		624
		625	`if ( rt == Freg ) {`
		626	`negate_float ( sha, a, dest ) ;`
		627	`return ;`
		628	`}`
		629
		630	`if ( wha == Value ) {`
		631	`long c = nw ( a ) ;`
		632	`bool overflow = 0 ;`
		633
		634	`if ( is_offset ( a.wh_exp ) ) c /= 8 ;`
		635
		636	`if ( is_signed(sha) ) {`
		637	`if (c < - range_max(sha))`
		638	`overflow = 1 ;`
		639	`}`
		640	`else {`
		641	`if ( c != 0 ) {`
		642	`make_comment("negation of unsigned shape");`
		643	`overflow = 1 ;`
		644	`}`
		645	`}`
		646
		647	`/* If there is overflow and we have an error treatment, do it */`
		648	`if ( overflow && have_overflow () ) {`
		649	`test_overflow( UNCONDITIONAL ) ;`
		650	`}`
		651	`/* No, so move the value in place */`
		652	`else {`
		653	`move ( sha, mnw ( -c ), dest ) ;`
		654	`}`
		655
		656	`return ;`
		657	`}`
		658
		659	`if ( eq_where ( a, dest ) && whd != Areg ) {`
		660	`instr = ins ( sz, ml_neg ) ;`
		661	`ins1 ( instr, sz, dest, 1 ) ;`
		662	`set_cond ( dest, sz ) ;`
		663	`test_overflow(ON_SHAPE ( sha )) ;`
		664
		665	`return ;`
		666	`}`
		667
		668	`if ( whd == Dreg ) {`
		669	`move ( sha, a, dest ) ;`
		670	`negate ( sha, dest, dest ) ;`
		671	`return ;`
		672	`}`
		673
		674	`if ( wha == Dreg && last_use ( a ) ) {`
		675	`negate ( sha, a, a ) ;`
		676	`move ( sha, a, dest ) ;`
		677	`return ;`
		678	`}`
		679
		680	`move ( sha, a, D0 ) ;`
		681	`negate ( sha, D0, D0 ) ;`
		682	`move ( sha, D0, dest ) ;`
		683	`return ;`
		684	`}`
		685
		686
		687	`/*`
		688	`AUXILIARY MULTIPLY ROUTINE`
		689
		690	`The value dest of shape sha is multiplied by a.`
		691	`*/`
		692
		693	`static void mult_aux`
		694	`PROTO_N ( ( sha, a, dest ) )`
		695	`PROTO_T ( shape sha X where a X where dest )`
		696	`{`
		697	`bool sg = is_signed ( sha ) ;`
		698	`long sz = shape_size ( sha ) ;`
		699	`int instr = ( sg ? m_mulsl : m_mulul ) ;`
		700	`shape lsha = ( sg ? slongsh : ulongsh ) ;`
		701
		702	`if ( whereis ( a ) == Freg ) {`
		703	`move ( sha, a, D0 ) ;`
		704	`mult_aux ( sha, D0, dest ) ;`
		705	`return ;`
		706	`}`
		707
		708	`if ( sz == 8 \|\| (have_overflow() && (sz == 16))) {`
		709	`change_var_sh ( lsha, sha, dest, dest ) ;`
		710	`change_var_sh ( lsha, sha, a, D0 ) ;`
		711	`ins2 ( instr, L32, L32, dest, D0, 1 ) ;`
		712	`test_overflow( ON_OVERFLOW ) ;`
		713	`change_var_sh ( sha, lsha, D0, dest ) ;`
		714	`set_cond ( dest, sz ) ;`
		715	`return ;`
		716	`}`
		717
		718	`if ( sz == 16 ) instr = ( sg ? m_mulsw : m_muluw ) ;`
		719
		720	`if ( whereis ( dest ) == Dreg ) {`
		721	`if ( whereis ( a ) == Areg ) {`
		722	`if ( eq_where ( dest, D0 ) ) {`
		723	`move ( sha, a, D1 ) ;`
		724	`regsinproc \|= regmsk ( REG_D1 ) ;`
		725	`ins2 ( instr, sz, sz, D1, dest, 1 ) ;`
		726	`} else {`
		727	`move ( sha, a, D0 ) ;`
		728	`ins2 ( instr, sz, sz, D0, dest, 1 ) ;`
		729	`}`
		730	`} else {`
		731	`ins2 ( instr, sz, sz, a, dest, 1 ) ;`
		732	`}`
		733	`test_overflow( ON_OVERFLOW ) ;`
		734	`set_cond ( dest, sz ) ;`
		735	`return ;`
		736	`}`
		737
		738	`move ( sha, dest, D0 ) ;`
		739	`if ( whereis ( a ) == Areg ) {`
		740	`move ( sha, a, D1 ) ;`
		741	`regsinproc \|= regmsk ( REG_D1 ) ;`
		742	`ins2 ( instr, sz, sz, D1, D0, 1 ) ;`
		743	`} else {`
		744	`ins2 ( instr, sz, sz, a, D0, 1 ) ;`
		745	`}`
		746	`test_overflow( ON_OVERFLOW ) ;`
		747	`move ( sha, D0, dest ) ;`
		748	`set_cond ( dest, sz ) ;`
		749	`return ;`
		750	`}`
		751
		752
		753	`/*`
		754	`MULTIPLY USING LOAD EFFECTIVE ADDRESS`
		755
		756	`The m_lea instruction is used to multiply a by the constant sf + 1`
		757	`where sf is 1, 2, 4 or 8. If d is true then a further add instruction`
		758	`is used to multiply further by 2. The result is stored in dest.`
		759	`This routine only applies to values of size 32.`
		760	`*/`
		761
		762	`static void mult_clever`
		763	`PROTO_N ( ( a, dest, sf, d ) )`
		764	`PROTO_T ( where a X where dest X long sf X bool d )`
		765	`{`
		766	`int r ;`
		767	`where ar ;`
		768	`mach_op op1, op2 ;`
		769	`if ( whereis ( dest ) == Areg ) {`
		770	`ar = dest ;`
		771	`r = reg ( dest.wh_regs ) ;`
		772	`} else {`
		773	`r = next_tmp_reg () ;`
		774	`regsinproc \|= regmsk ( r ) ;`
		775	`ar = register ( r ) ;`
		776	`}`
		777	`move ( slongsh, a, ar ) ;`
		778	`op1 = make_reg_index ( r, r, 0, sf ) ;`
		779	`op2 = make_register ( r ) ;`
		780	`make_instr ( m_lea, op1, op2, regmsk ( r ) ) ;`
		781	`have_cond = 0 ;`
		782	`if ( d ) {`
		783	`op1 = make_register ( r ) ;`
		784	`op2 = make_register ( r ) ;`
		785	`make_instr ( m_addl, op1, op2, regmsk ( r ) ) ;`
		786	`}`
		787	`tmp_reg_status = 1 ;`
		788	`move ( slongsh, ar, dest ) ;`
		789	`return ;`
		790	`}`
		791
		792
		793	`/*`
		794	`MULTIPLY A REGISTER BY A POWER OF 2`
		795
		796	`The register r is multiplied by 2 to the power of p. The flag`
		797	`D1_used is passed on to shift_aux if necessary.`
		798	`*/`
		799
		800	`static void mult_power2`
		801	`PROTO_N ( ( p, r, D1_used ) )`
		802	`PROTO_T ( long p X where r X bool D1_used )`
		803	`{`
		804	`switch ( p ) {`
		805	`case 0 : return ;`
		806	`case 1 : ins2 ( m_addl, L32, L32, r, r, 1 ) ; return ;`
		807	`default : {`
		808	`shift_aux ( slongsh, mnw ( p ), r, r, 0, D1_used ) ;`
		809	`return ;`
		810	`}`
		811	`}`
		812	`}`
		813
		814
		815	`/*`
		816	`MULTIPLICATION UTILITY ROUTINE`
		817
		818	`This routine is used by mult_const. The values r1 and r2 represent`
		819	`registers. If P denotes 2 to the power of p and Q denotes 2 to the`
		820	`power of q then :`
		821
		822	`(a) If first_time is true, then q will be zero and r2 will hold`
		823	`the same value as r1. r1 is multiplied by P - 1.`
		824
		825	`(b) Otherwise, r1 is set equal to ( P * Q * r1 + ( P - 1 ) * r2 ).`
		826
		827	`The flag D1_used is passed onto mult_power2 if necessary.`
		828	`*/`
		829
		830	`static void mult_utility`
		831	`PROTO_N ( ( p, q, r1, r2, D1_used, first_time ) )`
		832	`PROTO_T ( long p X long q X where r1 X where r2 X bool D1_used X bool first_time )`
		833	`{`
		834	`if ( first_time ) {`
		835	`switch ( p ) {`
		836
		837	`case 0 : return ; /* Doesn't occur */`
		838	`case 1 : return ; /* Multiply by one */`
		839
		840	`case 2 : {`
		841	`/* Multiply by 3 */`
		842	`ins2 ( m_addl, L32, L32, r1, r1, 1 ) ;`
		843	`ins2 ( m_addl, L32, L32, r2, r1, 1 ) ;`
		844	`return ;`
		845	`}`
		846
		847	`default : {`
		848	`mult_power2 ( p, r1, D1_used ) ;`
		849	`ins2 ( m_subl, L32, L32, r2, r1, 1 ) ;`
		850	`return ;`
		851	`}`
		852	`}`
		853	`} else {`
		854	`switch ( p ) {`
		855
		856	`case 0 : {`
		857	`/* P = 1 => r1 = ( Q * r1 ) */`
		858	`mult_power2 ( q, r1, D1_used ) ;`
		859	`return ;`
		860	`}`
		861
		862	`case 1 : {`
		863	`/* P = 2 => r1 = ( 2 * Q * r1 + r2 ) */`
		864	`mult_power2 ( q + 1, r1, D1_used ) ;`
		865	`ins2 ( m_addl, L32, L32, r2, r1, 1 ) ;`
		866	`return ;`
		867	`}`
		868
		869	`case 2 : {`
		870	`/* P = 4 => r1 = ( 4 * Q * r1 + 3 * r2 ) */`
		871	`mult_power2 ( q + 1, r1, D1_used ) ;`
		872	`ins2 ( m_addl, L32, L32, r2, r1, 1 ) ;`
		873	`ins2 ( m_addl, L32, L32, r1, r1, 1 ) ;`
		874	`ins2 ( m_addl, L32, L32, r2, r1, 1 ) ;`
		875	`return ;`
		876	`}`
		877
		878	`default : {`
		879	`mult_power2 ( q, r1, D1_used ) ;`
		880	`ins2 ( m_addl, L32, L32, r2, r1, 1 ) ;`
		881	`mult_power2 ( p, r1, D1_used ) ;`
		882	`ins2 ( m_subl, L32, L32, r2, r1, 1 ) ;`
		883	`return ;`
		884	`}`
		885	`}`
		886	`}`
		887	`}`
		888
		889
		890	`/*`
		891	`MULTIPLY BY A CONSTANT`
		892
		893	`The value a1 of shape sha is multiplied by the constant value a2`
		894	`and the result is stored in dest. All constant multiplications`
		895	`are done by means of shifts, adds and subtracts. Certain small`
		896	`cases and powers of 2 are dealt with separately. The main algorithm`
		897	`is to split the constant into sections of the form 00...0011...11.`
		898	`*/`
		899
		900	`static void mult_const`
		901	`PROTO_N ( ( sha, a1, a2, dest ) )`
		902	`PROTO_T ( shape sha X where a1 X where a2 X where dest )`
		903	`{`
		904	`long n = nw ( a2 ), m, p, q, n0 ;`
		905	`where reg1, reg2 ;`
		906	`bool D1_used, dont_move = 0 ;`
		907	`bool started = 0, first_time = 1 ;`
		908
		909	`long sz = shape_size ( sha ) ;`
		910
		911	`long wh1 = whereis ( a1 ) ;`
		912	`long whd = whereis ( dest ) ;`
		913
		914	`if ( is_offset ( a2.wh_exp ) ) n /= 8 ;`
		915	`switch ( n ) {`
		916
		917	`case 0 : {`
		918	`/* Multiply by zero = Load zero */`
		919	`move ( sha, zero, dest ) ;`
		920	`return ;`
		921	`}`
		922
		923	`case 1 : {`
		924	`/* Multiply by one = Move */`
		925	`move ( sha, a1, dest ) ;`
		926	`return ;`
		927	`}`
		928
		929	`case -1 : {`
		930	`/* Multiply by minus one = Negate */`
		931	`negate ( sha, a1, dest ) ;`
		932	`return ;`
		933	`}`
		934
		935	`case 2 : {`
		936	`/* Multiply by two = Add */`
		937	`add ( sha, a1, a1, dest ) ;`
		938	`return ;`
		939	`}`
		940
		941	`case 5 : {`
		942	`if ( sz == 32 ) {`
		943	`mult_clever ( a1, dest, L4, 0 ) ;`
		944	`return ;`
		945	`}`
		946	`break ;`
		947	`}`
		948
		949	`case 9 : {`
		950	`if ( sz == 32 ) {`
		951	`mult_clever ( a1, dest, L8, 0 ) ;`
		952	`return ;`
		953	`}`
		954	`break ;`
		955	`}`
		956
		957	`case 10 : {`
		958	`if ( sz == 32 ) {`
		959	`mult_clever ( a1, dest, L4, 1 ) ;`
		960	`return ;`
		961	`}`
		962	`break ;`
		963	`}`
		964
		965	`case 18 : {`
		966	`if ( sz == 32 ) {`
		967	`mult_clever ( a1, dest, L8, 1 ) ;`
		968	`return ;`
		969	`}`
		970	`break ;`
		971	`}`
		972	`}`
		973
		974	`/* Find two registers */`
		975	`if ( whd == Dreg && !eq_where ( dest, D0 ) ) {`
		976	`reg1 = dest ;`
		977	`reg2 = D0 ;`
		978	`D1_used = 0 ;`
		979	`} else {`
		980	`reg1 = D0 ;`
		981	`reg2 = D1 ;`
		982	`D1_used = 1 ;`
		983	`}`
		984	`if ( wh1 == Dreg && !eq_where ( a1, reg1 ) ) {`
		985	`reg2 = a1 ;`
		986	`D1_used = 0 ;`
		987	`dont_move = 1 ;`
		988	`}`
		989
		990	`/* Deal with multiplications of less than 32 bits */`
		991	`if ( sz < 32 ) {`
		992	`shape lsha = ( is_signed ( sha ) ? slongsh : ulongsh ) ;`
		993	`change_var_sh ( lsha, sha, a1, reg1 ) ;`
		994	`mult_const ( lsha, reg1, a2, reg1 ) ;`
		995	`change_var_sh ( sha, lsha, reg1, dest ) ;`
		996	`return ;`
		997	`}`
		998
		999	`/* Now prepare to multiply by \|n\| */`
		1000	`n0 = n ;`
		1001	`if ( n < 0 ) n = -n ;`
		1002
		1003	`if ( is_pow2 ( n ) ) {`
		1004	`/* Powers of two are easy */`
		1005	`p = log2 ( n ) ;`
		1006	`if ( wh1 == Dreg && last_use ( a1 ) ) {`
		1007	`reg1 = a1 ;`
		1008	`D1_used = 0 ;`
		1009	`} else {`
		1010	`move ( sha, a1, reg1 ) ;`
		1011	`}`
		1012	`mult_power2 ( p, reg1, D1_used ) ;`
		1013	`} else {`
		1014	`/* The thing we are multiplying goes in reg1 */`
		1015	`move ( sha, a1, reg1 ) ;`
		1016	`/* Copy reg1 into reg2 if necessary */`
		1017	`if ( !dont_move ) move ( slongsh, reg1, reg2 ) ;`
		1018	`if ( D1_used ) regsinproc \|= regmsk ( REG_D1 ) ;`
		1019	`/* p will count consecutive ones and q consecutive zeros */`
		1020	`p = 0 ;`
		1021	`q = 0 ;`
		1022	`/* Scan through the 31 bits of n (the sign bit is zero), MSB first */`
		1023	`for ( m = pow2 ( 30 ) ; m ; m >>= 1 ) {`
		1024	`if ( m & n ) {`
		1025	`/* Set bit - record this */`
		1026	`started = 1 ;`
		1027	`p++ ;`
		1028	`} else {`
		1029	`/* Reset bit - record this */`
		1030	`if ( p ) {`
		1031	`/* We have read q 0's, then p 1's, before this 0 */`
		1032	`mult_utility ( p, q, reg1, reg2, 1, first_time ) ;`
		1033	`first_time = 0 ;`
		1034	`/* Restart counts */`
		1035	`p = 0 ;`
		1036	`q = 0 ;`
		1037	`}`
		1038	`/* Record reset bit, ignoring initial zeros */`
		1039	`if ( started ) q++ ;`
		1040	`}`
		1041	`}`
		1042	`/* Deal with last batch of digits */`
		1043	`if ( p \|\| q ) mult_utility ( p, q, reg1, reg2, 1, first_time ) ;`
		1044	`}`
		1045	`/* Now put the result into dest - take care of sign of n now */`
		1046	`if ( n0 < 0 ) {`
		1047	`negate ( slongsh, reg1, dest ) ;`
		1048	`} else {`
		1049	`move ( slongsh, reg1, dest ) ;`
		1050	`}`
		1051	`set_cond ( dest, L32 ) ;`
		1052	`return ;`
		1053	`}`
		1054
		1055
		1056	`/*`
		1057	`MAIN MULTIPLICATION ROUTINE`
		1058
		1059	`The values a1 and a2 of shape sha are multiplied and the result is`
		1060	`stored in dest.`
		1061	`*/`
		1062
		1063	`void mult`
		1064	`PROTO_N ( ( sha, a1, a2, dest ) )`
		1065	`PROTO_T ( shape sha X where a1 X where a2 X where dest )`
		1066	`{`
		1067	`where w ;`
		1068	`long wh1 = whereis ( a1 ) ;`
		1069	`long wh2 = whereis ( a2 ) ;`
		1070	`long whd = whereis ( dest ) ;`
		1071
		1072	`if ( !have_overflow () ) {`
		1073	`/* Constant multiplication */`
		1074	`if ( wh1 == Value ) {`
		1075	`if ( wh2 == Value ) {`
		1076	`long v1 = nw ( a1 ) ;`
		1077	`long v2 = nw ( a2 ) ;`
		1078	`if ( is_offset ( a1.wh_exp ) ) v1 /= 8 ;`
		1079	`if ( is_offset ( a2.wh_exp ) ) v2 /= 8 ;`
		1080	`move ( sha, mnw ( v1 * v2 ), dest ) ;`
		1081	`return ;`
		1082	`}`
		1083	`mult_const ( sha, a2, a1, dest ) ;`
		1084	`return ;`
		1085	`}`
		1086
		1087	`if ( wh2 == Value ) {`
		1088	`mult_const ( sha, a1, a2, dest ) ;`
		1089	`return ;`
		1090	`}`
		1091	`}`
		1092
		1093	`if ( eq_where ( a1, a2 ) ) {`
		1094	`if ( whd == Dreg ) {`
		1095	`move ( sha, a1, dest ) ;`
		1096	`mult_aux ( sha, dest, dest ) ;`
		1097	`return ;`
		1098	`} else {`
		1099	`move ( sha, a1, D0 ) ;`
		1100	`mult_aux ( sha, D0, D0 ) ;`
		1101	`move ( sha, D0, dest ) ;`
		1102	`return ;`
		1103	`}`
		1104	`}`
		1105
		1106	`if ( eq_where ( a1, dest ) ) {`
		1107	`mult_aux ( sha, a2, dest ) ;`
		1108	`return ;`
		1109	`}`
		1110
		1111	`if ( eq_where ( a2, dest ) ) {`
		1112	`mult_aux ( sha, a1, dest ) ;`
		1113	`return ;`
		1114	`}`
		1115
		1116	`if ( whd == Dreg ) {`
		1117	`if ( !interfere ( a2, dest ) ) {`
		1118	`move ( sha, a1, dest ) ;`
		1119	`mult_aux ( sha, a2, dest ) ;`
		1120	`return ;`
		1121	`}`
		1122	`if ( !interfere ( a1, dest ) ) {`
		1123	`move ( sha, a2, dest ) ;`
		1124	`mult_aux ( sha, a1, dest ) ;`
		1125	`return ;`
		1126	`}`
		1127	`}`
		1128
		1129	`if ( shape_size ( sha ) == 8 \|\|`
		1130	`((shape_size(sha)==16) && (have_overflow()))) {`
		1131	`w = D1 ;`
		1132	`regsinproc \|= regmsk ( REG_D1 ) ;`
		1133	`} else {`
		1134	`w = D0 ;`
		1135	`}`
		1136	`if ( whereis ( a2 ) == Areg ) {`
		1137	`move ( sha, a2, w ) ;`
		1138	`mult_aux ( sha, a1, w ) ;`
		1139	`move ( sha, w, dest ) ;`
		1140	`} else {`
		1141	`move ( sha, a1, w ) ;`
		1142	`mult_aux ( sha, a2, w ) ;`
		1143	`move ( sha, w, dest ) ;`
		1144	`}`
		1145	`return ;`
		1146	`}`
		1147
		1148
		1149	`/*`
		1150	`DIVISION BY A POWER OF 2`
		1151
		1152	`The value top of shape sha is divided by the constant v which is a`
		1153	`power of 2. The result is stored in dest.`
		1154	`*/`
		1155
		1156	`static void div_power2`
		1157	`PROTO_N ( ( sha, v, top, dest ) )`
		1158	`PROTO_T ( shape sha X long v X where top X where dest )`
		1159	`{`
		1160	`long n = log2 ( v ) ;`
		1161	`if ( is_signed ( sha ) ) {`
		1162	`bool sw ;`
		1163	`where w ;`
		1164	`int instr ;`
		1165	`long sz = shape_size ( sha ) ;`
		1166	`long lab = next_lab () ;`
		1167	`exp jt = simple_exp ( 0 ) ;`
		1168	`ptno ( jt ) = lab ;`
		1169
		1170	`if ( whereis ( dest ) == Dreg ) {`
		1171	`w = dest ;`
		1172	`} else if ( whereis ( top ) == Dreg && last_use ( top ) ) {`
		1173	`w = top ;`
		1174	`} else {`
		1175	`w = D0 ;`
		1176	`}`
		1177	`move ( sha, top, w ) ;`
		1178	`sw = cmp ( sha, w, zero, tst_ge ) ;`
		1179	`branch ( tst_ge, jt, 1, sw, 0 ) ;`
		1180	`add ( sha, w, mnw ( v - 1 ), w ) ;`
		1181	`make_label ( lab ) ;`
		1182	`instr = ins ( sz, ml_asr ) ;`
		1183	`while ( n ) {`
		1184	`long m = ( n > 8 ? 7 : n ) ;`
		1185	`ins2n ( instr, m, sz, w, 1 ) ;`
		1186	`n -= m ;`
		1187	`}`
		1188	`move ( sha, w, dest ) ;`
		1189	`set_cond ( dest, sz ) ;`
		1190	`} else {`
		1191	`shift_aux ( sha, mnw ( n ), top, dest, 1, 0 ) ;`
		1192	`}`
		1193	`return ;`
		1194	`}`
		1195
		1196
		1197	`/*`
		1198	`REMAINDER MODULO A POWER OF 2`
		1199
		1200	`The remainder of the value top of shape sha when divided by the`
		1201	`constant v (which is a power of 2) is stored in dest.`
		1202	`*/`
		1203
		1204	`static void rem_power2`
		1205	`PROTO_N ( ( sha, v, top, dest ) )`
		1206	`PROTO_T ( shape sha X long v X where top X where dest )`
		1207	`{`
		1208	`if ( is_signed ( sha ) ) {`
		1209	`bool sw ;`
		1210	`where w ;`
		1211	`long lab = next_lab () ;`
		1212	`long end = next_lab () ;`
		1213	`exp jt = simple_exp ( 0 ) ;`
		1214	`exp je = simple_exp ( 0 ) ;`
		1215	`ptno ( jt ) = lab ;`
		1216	`ptno ( je ) = end ;`
		1217
		1218	`if ( whereis ( dest ) == Dreg ) {`
		1219	`w = dest ;`
		1220	`} else if ( whereis ( top ) == Dreg && last_use ( top ) ) {`
		1221	`w = top ;`
		1222	`} else {`
		1223	`w = D0 ;`
		1224	`}`
		1225	`move ( sha, top, w ) ;`
		1226	`sw = cmp ( sha, w, zero, tst_ge ) ;`
		1227	`branch ( tst_ge, jt, 1, sw, 0 ) ;`
		1228	`negate ( sha, w, w ) ;`
		1229	`and ( sha, mnw ( v - 1 ), w, w ) ;`
		1230	`negate ( sha, w, w ) ;`
		1231	`make_jump ( m_bra, end ) ;`
		1232	`make_label ( lab ) ;`
		1233	`and ( sha, mnw ( v - 1 ), w, w ) ;`
		1234	`make_label ( end ) ;`
		1235	`move ( sha, w, dest ) ;`
		1236	`set_cond ( dest, shape_size ( sha ) ) ;`
		1237	`} else {`
		1238	`and ( sha, mnw ( v - 1 ), top, dest ) ;`
		1239	`}`
		1240	`return ;`
		1241	`}`
		1242
		1243
		1244	`/*`
		1245	`REMAINDER MODULO A POWER OF 2 MINUS 1`
		1246
		1247	`The remainder of the value top of shape sha when divided by the`
		1248	`constant v (which is a power of 2 minus 1) is stored in dest. The`
		1249	`algorithm used is a modification of "casting out the nines".`
		1250	`*/`
		1251
		1252	`static bool rem_power2_1`
		1253	`PROTO_N ( ( sha, v, top, dest ) )`
		1254	`PROTO_T ( shape sha X long v X where top X where dest )`
		1255	`{`
		1256	`bool sw ;`
		1257	`where d0, d1 ;`
		1258	`long loop, end, tst ;`
		1259	`exp jloop, jend, jtst ;`
		1260	`bool s = is_signed ( sha ) ;`
		1261
		1262	`if ( s && ( eq_where ( top, D0 ) \|\| eq_where ( top, D1 ) ) ) return ( 0 ) ;`
		1263
		1264	`if ( whereis ( dest ) == Dreg ) {`
		1265	`d1 = dest ;`
		1266	`} else {`
		1267	`d1 = D1 ;`
		1268	`regsinproc \|= regmsk ( REG_D1 ) ;`
		1269	`}`
		1270
		1271	`if ( eq_where ( d1, D0 ) ) {`
		1272	`d0 = D1 ;`
		1273	`regsinproc \|= regmsk ( REG_D1 ) ;`
		1274	`} else {`
		1275	`d0 = D0 ;`
		1276	`}`
		1277
		1278	`loop = next_lab () ;`
		1279	`jloop = simple_exp ( 0 ) ;`
		1280	`ptno ( jloop ) = loop ;`
		1281	`end = next_lab () ;`
		1282	`jend = simple_exp ( 0 ) ;`
		1283	`ptno ( jend ) = end ;`
		1284	`tst = next_lab () ;`
		1285	`jtst = simple_exp ( 0 ) ;`
		1286	`ptno ( jtst ) = tst ;`
		1287
		1288	`move ( sha, top, d1 ) ;`
		1289	`if ( s ) {`
		1290	`sw = cmp ( sha, d1, zero, tst_ge ) ;`
		1291	`branch ( tst_ge, jloop, s, sw, 0 ) ;`
		1292	`negate ( sha, d1, d1 ) ;`
		1293	`}`
		1294	`make_label ( loop ) ;`
		1295	`move ( sha, mnw ( v ), d0 ) ;`
		1296	`sw = cmp ( ulongsh, d1, d0, tst_le ) ;`
		1297	`branch ( tst_le, jend, s, sw, 0 ) ;`
		1298	`and ( ulongsh, d1, d0, d0 ) ;`
		1299	`rshift ( ulongsh, mnw ( log2 ( v + 1 ) ), d1, d1 ) ;`
		1300	`add ( ulongsh, d0, d1, d1 ) ;`
		1301	`make_jump ( m_bra, loop ) ;`
		1302	`make_label ( end ) ;`
		1303	`branch ( tst_neq, jtst, s, sw, 0 ) ;`
		1304	`move ( sha, zero, d1 ) ;`
		1305	`make_label ( tst ) ;`
		1306	`if ( s ) {`
		1307	`long ntst = next_lab () ;`
		1308	`exp jntst = simple_exp ( 0 ) ;`
		1309	`ptno ( jntst ) = ntst ;`
		1310	`sw = cmp ( sha, top, zero, tst_ge ) ;`
		1311	`branch ( tst_ge, jntst, 1, sw, 0 ) ;`
		1312	`negate ( sha, d1, d1 ) ;`
		1313	`make_label ( ntst ) ;`
		1314	`}`
		1315	`have_cond = 0 ;`
		1316	`move ( sha, d1, dest ) ;`
		1317	`return ( 1 ) ;`
		1318	`}`
		1319
		1320
		1321	`/*`
		1322	`MARKERS FOR DIVISION AND REMAINDER`
		1323
		1324	`Division, remainder and combined division-remainder operations are`
		1325	`all handled by a single routine. The following values are used to`
		1326	`indicate to the routine the operation type.`
		1327	`*/`
		1328
		1329	`#define DIV 0`
		1330	`#define REM 1`
		1331	`#define BOTH 2`
		1332
		1333
		1334	`/*`
		1335	`MAIN DIVISION AND REMAINDER ROUTINE`
		1336
		1337	`The value top of shape sha is divided by bottom and, depending on`
		1338	`the value of type, the quotient is stored in quot and the remainder`
		1339	`in rem. Which of the two possible division types used is determined`
		1340	`by form : for example, if form is 1 then :`
		1341
		1342	`5 = ( -2 ) * ( -3 ) - 1`
		1343
		1344	`whereas if form is 2 :`
		1345
		1346	`5 = ( -1 ) * ( -3 ) + 2`
		1347
		1348	`The second form is the standard one.`
		1349	`*/`
		1350
		1351	`static void euclid`
		1352	`PROTO_N ( ( sha, bottom, top, quot, rem, type, form ) )`
		1353	`PROTO_T ( shape sha X where bottom X where top X where quot X where rem X int type X int form )`
		1354	`{`
		1355	`long v ;`
		1356	`bool b_const = 0 ;`
		1357	`bool save_d1 = 0 ;`
		1358	`bool d1_pending = 0 ;`
		1359	`where qreg, rreg, breg ;`
		1360	`long sz = shape_size ( sha ) ;`
		1361	`bool sg = is_signed ( sha ) ;`
		1362	`shape lsha = ( sg ? slongsh : ulongsh ) ;`
		1363
		1364	`/* The two forms are the same for unsigned division */`
		1365	`if ( !sg ) form = 2 ;`
		1366
		1367	`/* Deal with division by constants */`
		1368	`if ( name ( bottom.wh_exp ) == val_tag ) {`
		1369	`b_const = 1 ;`
		1370	`v = nw ( bottom ) ;`
		1371	`if ( is_offset ( bottom.wh_exp ) ) v /= 8 ;`
		1372	`switch ( v ) {`
		1373
		1374	`case 0 : {`
		1375	`warning ( "Division by zero" ) ;`
		1376	`if ( have_overflow () ) {`
		1377	`test_overflow( UNCONDITIONAL ) ;`
		1378	`}`
		1379	`else {`
		1380	`if ( type != REM ) move ( sha, zero, quot ) ;`
		1381	`if ( type != DIV ) move ( sha, zero, rem ) ;`
		1382	`}`
		1383	`return ;`
		1384	`}`
		1385
		1386	`case 1 : {`
		1387	`if ( type != REM ) move ( sha, top, quot ) ;`
		1388	`if ( type != DIV ) move ( sha, zero, rem ) ;`
		1389	`return ;`
		1390	`}`
		1391
		1392	`case -1 : {`
		1393	`if (is_signed(sha)) { /* is it really negative */`
		1394	`if ( type != REM \|\| have_overflow() ) negate ( sha, top, quot ) ;`
		1395	`if ( type != DIV ) move ( sha, zero, rem ) ;`
		1396	`return ;`
		1397	`}`
		1398	`/* fall through */`
		1399	`}`
		1400
		1401	`default : {`
		1402	`if ( form != 1 ) {`
		1403	`if ( (!is_signed(sha) \|\| v > 0) && is_pow2 ( v ) && sz == 32 ) {`
		1404	`if ( type == DIV ) {`
		1405	`div_power2 ( sha, v, top, quot ) ;`
		1406	`return ;`
		1407	`}`
		1408	`if ( type == REM ) {`
		1409	`rem_power2 ( sha, v, top, rem ) ;`
		1410	`return ;`
		1411	`}`
		1412	`}`
		1413	`if ( v > 7 && is_pow2 ( v + 1 ) && sz == 32 ) {`
		1414	`if ( type == REM &&`
		1415	`rem_power2_1 ( sha, v, top, rem ) ) {`
		1416	`return ;`
		1417	`}`
		1418	`}`
		1419	`}`
		1420	`break ;`
		1421	`}`
		1422	`}`
		1423	`}`
		1424
		1425	`/* Check on pointless divisions */`
		1426	`if ( eq_where ( top, bottom ) ) {`
		1427	`if ( type != REM ) move ( sha, mnw ( 1 ), quot ) ;`
		1428	`if ( type != DIV ) move ( sha, zero, rem ) ;`
		1429	`return ;`
		1430	`}`
		1431
		1432	`/* Now find two registers */`
		1433	`if ( type == BOTH && interfere ( quot, rem ) ) {`
		1434	`qreg = D0 ;`
		1435	`rreg = D1 ;`
		1436	`regsinproc \|= regmsk ( REG_D1 ) ;`
		1437	`if ( D1_is_special ) save_d1 = 1 ;`
		1438	`} else {`
		1439	`if ( type != REM && whereis ( quot ) == Dreg &&`
		1440	`!interfere ( quot, bottom ) ) {`
		1441	`qreg = quot ;`
		1442	`} else {`
		1443	`qreg = D0 ;`
		1444	`}`
		1445	`if ( type != DIV && whereis ( rem ) == Dreg ) {`
		1446	`if ( eq_where ( rem, D0 ) ) {`
		1447	`qreg = D1 ;`
		1448	`rreg = D0 ;`
		1449	`regsinproc \|= regmsk ( REG_D1 ) ;`
		1450	`if ( D1_is_special ) save_d1 = 1 ;`
		1451	`} else {`
		1452	`rreg = rem ;`
		1453	`}`
		1454	`} else {`
		1455	`if ( eq_where ( qreg, D0 ) ) {`
		1456	`rreg = D1 ;`
		1457	`if ( type == DIV ) {`
		1458	`d1_pending = 1 ;`
		1459	`} else {`
		1460	`regsinproc \|= regmsk ( REG_D1 ) ;`
		1461	`if ( D1_is_special ) save_d1 = 1 ;`
		1462	`}`
		1463	`} else {`
		1464	`rreg = D0 ;`
		1465	`}`
		1466	`}`
		1467	`}`
		1468
		1469	`/* Save D1 if necessary */`
		1470	`if ( save_d1 ) push ( slongsh, L32, D1 ) ;`
		1471	`#if 0`
		1472	`/* Keep the denominator in form 1 */`
		1473	`if ( form == 1 && !b_const ) push ( slongsh, L32, bottom ) ;`
		1474	`#endif`
		1475	`/* Get the arguments into the correct positions */`
		1476	`if ( sz != 32 ) {`
		1477	`bool d0_pushed = 0 ;`
		1478
		1479	`make_comment("change variety top -> qreg") ;`
		1480	`change_var_sh ( lsha, sha, top, qreg ) ;`
		1481
		1482	`if ( eq_where ( qreg, D0 ) ) {`
		1483	`push ( slongsh, L32, D0 ) ;`
		1484	`d0_pushed = 1 ;`
		1485	`}`
		1486
		1487	`make_comment("change variety bottom -> rreg") ;`
		1488	`change_var_sh ( lsha, sha, bottom, rreg ) ;`
		1489
		1490	`if ( d0_pushed )`
		1491	`pop(slongsh,L32,D0);`
		1492
		1493	`breg = rreg ;`
		1494	`} else {`
		1495	`move ( sha, top, qreg ) ;`
		1496	`if ( whereis ( bottom ) == Areg \|\| whereis ( bottom ) == Freg ) {`
		1497	`if ( d1_pending ) {`
		1498	`regsinproc \|= regmsk ( REG_D1 ) ;`
		1499	`if ( D1_is_special ) {`
		1500	`save_d1 = 1 ;`
		1501	`push ( slongsh, L32, D1 ) ;`
		1502	`}`
		1503	`}`
		1504	`move ( sha, bottom, rreg ) ;`
		1505	`breg = rreg ;`
		1506	`} else {`
		1507	`breg = bottom ;`
		1508	`}`
		1509	`}`
		1510
		1511	`if (have_overflow()) {`
		1512	`if(save_d1) {`
		1513	`pop(slongsh,L32,D1);`
		1514	`}`
		1515	`cmp_zero ( sha, sz, breg );`
		1516	`test_overflow2( m_beq ) ;`
		1517	`if(save_d1) {`
		1518	`push(slongsh,L32,D1);`
		1519	`}`
		1520	`}`
		1521
		1522	`/* Keep the denominator in form 1 */`
		1523	`if ( form == 1 && !b_const ) push ( slongsh, L32, breg ) ;`
		1524
		1525	`/* Create the actual division instruction */`
		1526	`if ( type == DIV && form != 1 ) {`
		1527	`long qn = reg ( qreg.wh_regs ) ;`
		1528	`int instr = ( sg ? m_divsl : m_divul ) ;`
		1529	`mach_op *op1 = operand ( L32, breg ) ;`
		1530	`mach_op *op2 = make_register ( qn ) ;`
		1531	`make_instr ( instr, op1, op2, regmsk ( qn ) ) ;`
		1532	`} else {`
		1533	`long qn = reg ( qreg.wh_regs ) ;`
		1534	`long rn = reg ( rreg.wh_regs ) ;`
		1535	`int instr = ( sg ? m_divsll : m_divull ) ;`
		1536	`mach_op *op1 = operand ( L32, breg ) ;`
		1537	`mach_op *op2 = make_reg_pair ( rn, qn ) ;`
		1538	`make_instr ( instr, op1, op2, ( regmsk ( qn ) \| regmsk ( rn ) ) ) ;`
		1539	`}`
		1540	`if(have_overflow()) {`
		1541	`if(save_d1) {`
		1542	`pop(slongsh,L32,D1);`
		1543	`}`
		1544	`if( form == 1 && !b_const ) {`
		1545	`dec_stack(-32);`
		1546	`}`
		1547	`test_overflow( ON_SHAPE(sha) ) ;`
		1548	`if( form == 1 && !b_const ) {`
		1549	`dec_stack(32);`
		1550	`}`
		1551
		1552
		1553	`}`
		1554
		1555
		1556	`/* Apply hacks for form 1 */`
		1557	`if ( form == 1 && is_signed(sha) ) {`
		1558	`mach_op op1, op2 ;`
		1559	`long lab1 = next_lab () ;`
		1560	`long lab2 = next_lab () ;`
		1561	`long qn = reg ( qreg.wh_regs ) ;`
		1562	`long rn = reg ( rreg.wh_regs ) ;`
		1563	`if ( !b_const ) {`
		1564	`op1 = make_indirect ( REG_SP, 0 ) ;`
		1565	`make_instr ( m_tstl, op1, null, 0 ) ;`
		1566	`make_jump ( m_bge, lab1 ) ;`
		1567	`}`
		1568
		1569	`/* Denominator is negative ? */`
		1570	`if ( !( b_const && v >= 0 ) ) {`
		1571	`op1 = make_register ( rn ) ;`
		1572	`make_instr ( m_tstl, op1, null, 0 ) ;`
		1573	`make_jump ( m_ble, lab2 ) ;`
		1574	`if ( type != REM ) {`
		1575	`op1 = make_value ( 1 ) ;`
		1576	`op2 = make_register ( qn ) ;`
		1577	`make_instr ( m_subql, op1, op2, regmsk ( qn ) ) ;`
		1578	`}`
		1579	`if ( type != DIV ) {`
		1580	`if ( b_const ) {`
		1581	`op1 = make_value ( v ) ;`
		1582	`} else {`
		1583	`op1 = make_indirect ( REG_SP, 0 ) ;`
		1584	`}`
		1585	`op2 = make_register ( rn ) ;`
		1586	`make_instr ( m_addl, op1, op2, regmsk ( rn ) ) ;`
		1587	`}`
		1588	`if ( !b_const ) make_jump ( m_bra, lab2 ) ;`
		1589	`}`
		1590
		1591	`/* Denominator is positive ? */`
		1592	`if ( !( b_const && v < 0 ) ) {`
		1593	`if ( !b_const ) make_label ( lab1 ) ;`
		1594	`op1 = make_register ( rn ) ;`
		1595	`make_instr ( m_tstl, op1, null, 0 ) ;`
		1596	`make_jump ( m_bge, lab2 ) ;`
		1597	`if ( type != REM ) {`
		1598	`op1 = make_value ( 1 ) ;`
		1599	`op2 = make_register ( qn ) ;`
		1600	`make_instr ( m_subql, op1, op2, regmsk ( qn ) ) ;`
		1601	`}`
		1602	`if ( type != DIV ) {`
		1603	`if ( b_const ) {`
		1604	`op1 = make_value ( v ) ;`
		1605	`} else {`
		1606	`op1 = make_indirect ( REG_SP, 0 ) ;`
		1607	`}`
		1608	`op2 = make_register ( rn ) ;`
		1609	`make_instr ( m_addl, op1, op2, regmsk ( rn ) ) ;`
		1610	`}`
		1611	`}`
		1612
		1613	`make_label ( lab2 ) ;`
		1614	`if ( !b_const ) dec_stack ( -32 ) ;`
		1615	`}`
		1616
		1617	`/* Move results into place */`
		1618	`if ( sz == 32 ) {`
		1619	`if ( type != REM ) move ( sha, qreg, quot ) ;`
		1620	`if ( type != DIV ) move ( sha, rreg, rem ) ;`
		1621	`} else {`
		1622	`if ( type != REM ) change_var_sh ( sha, lsha, qreg, quot ) ;`
		1623	`if ( type != DIV ) change_var_sh ( sha, lsha, rreg, rem ) ;`
		1624	`}`
		1625
		1626	`/* Restore D1 */`
		1627	`if ( save_d1 ) {`
		1628	`pop ( slongsh, L32, D1 ) ;`
		1629	`debug_warning ( "D1 saved on stack during division" ) ;`
		1630	`}`
		1631	`have_cond = 0 ;`
		1632	`return ;`
		1633	`}`
		1634
		1635
		1636	`/*`
		1637	`DIVISION INSTRUCTION - FORM ONE`
		1638
		1639	`The value top of shape sha is divided by bottom and the result is`
		1640	`stored in dest. This is the alternative division operation.`
		1641	`*/`
		1642
		1643	`void div1`
		1644	`PROTO_N ( ( sha, bottom, top, dest ) )`
		1645	`PROTO_T ( shape sha X where bottom X where top X where dest )`
		1646	`{`
		1647	`euclid ( sha, bottom, top, dest, zero, DIV, 1 ) ;`
		1648	`return ;`
		1649	`}`
		1650
		1651
		1652	`/*`
		1653	`DIVISION INSTRUCTION - FORM TWO`
		1654
		1655	`The value top of shape sha is divided by bottom and the result is`
		1656	`stored in dest. This is the standard division operation.`
		1657	`*/`
		1658
		1659	`void div2`
		1660	`PROTO_N ( ( sha, bottom, top, dest ) )`
		1661	`PROTO_T ( shape sha X where bottom X where top X where dest )`
		1662	`{`
		1663	`euclid ( sha, bottom, top, dest, zero, DIV, 2 ) ;`
		1664	`return ;`
		1665	`}`
		1666
		1667
		1668	`/*`
		1669	`REMAINDER INSTRUCTION - FORM ONE`
		1670
		1671	`The value top of shape sha is divided by bottom and the remainder is`
		1672	`stored in dest. This is the alternative remainder operation.`
		1673	`*/`
		1674
		1675	`void rem1`
		1676	`PROTO_N ( ( sha, bottom, top, dest ) )`
		1677	`PROTO_T ( shape sha X where bottom X where top X where dest )`
		1678	`{`
		1679	`euclid ( sha, bottom, top, zero, dest, REM, 1 ) ;`
		1680	`return ;`
		1681	`}`
		1682
		1683
		1684	`/*`
		1685	`REMAINDER INSTRUCTION - FORM TWO`
		1686
		1687	`The value top of shape sha is divided by bottom and the remainder is`
		1688	`stored in dest. This is the standard remainder operation.`
		1689	`*/`
		1690
		1691	`void rem2`
		1692	`PROTO_N ( ( sha, bottom, top, dest ) )`
		1693	`PROTO_T ( shape sha X where bottom X where top X where dest )`
		1694	`{`
		1695	`euclid ( sha, bottom, top, zero, dest, REM, 2 ) ;`
		1696	`return ;`
		1697	`}`
		1698
		1699
		1700	`/*`
		1701	`DO AN EXACT DIVISION`
		1702
		1703	`The value top is divided by bottom and the result is stored in dest.`
		1704	`*/`
		1705
		1706	`void exactdiv`
		1707	`PROTO_N ( ( sha, bottom, top, dest ) )`
		1708	`PROTO_T ( shape sha X where bottom X where top X where dest )`
		1709	`{`
		1710	`euclid ( slongsh, bottom, top, dest, zero, DIV, 2 ) ;`
		1711	`return ;`
		1712	`}`
		1713
		1714
		1715	`/*`
		1716	`DO A MAXIMUM OR MINIMUM INSTRUCTION`
		1717	`*/`
		1718
		1719	`static void maxmin`
		1720	`PROTO_N ( ( sha, a1, a2, dest, tst ) )`
		1721	`PROTO_T ( shape sha X where a1 X where a2 X where dest X int tst )`
		1722	`{`
		1723	`where d ;`
		1724	`bool sw ;`
		1725	`long sz = shape_size ( sha ) ;`
		1726	`long lab = next_lab () ;`
		1727	`exp jt = simple_exp ( 0 ) ;`
		1728	`ptno ( jt ) = lab ;`
		1729	`if ( whereis ( dest ) == Dreg && !interfere ( a1, dest ) &&`
		1730	`!interfere ( a2, dest ) ) {`
		1731	`d = dest ;`
		1732	`} else {`
		1733	`d = D0 ;`
		1734	`}`
		1735	`make_comment("maxmin ...");`
		1736	`move ( sha, a1, d ) ;`
		1737	`sw = cmp ( sha, d, a2, tst ) ;`
		1738	`branch ( tst, jt, is_signed(sha), sw, 0 ) ;`
		1739	`move ( sha, a2, d ) ;`
		1740	`make_label ( lab ) ;`
		1741	`move ( sha, d, dest ) ;`
		1742	`make_comment("maxmin done");`
		1743	`return ;`
		1744	`}`
		1745
		1746
		1747	`/*`
		1748	`DO A MAXIMUM INSTRUCTION`
		1749	`*/`
		1750
		1751	`void maxop`
		1752	`PROTO_N ( ( sha, a1, a2, dest ) )`
		1753	`PROTO_T ( shape sha X where a1 X where a2 X where dest )`
		1754	`{`
		1755	`maxmin ( sha, a1, a2, dest, tst_ge ) ;`
		1756	`return ;`
		1757	`}`
		1758
		1759
		1760	`/*`
		1761	`DO A MINIMUM INSTRUCTION`
		1762	`*/`
		1763
		1764	`void minop`
		1765	`PROTO_N ( ( sha, a1, a2, dest ) )`
		1766	`PROTO_T ( shape sha X where a1 X where a2 X where dest )`
		1767	`{`
		1768	`maxmin ( sha, a1, a2, dest, tst_le ) ;`
		1769	`return ;`
		1770	`}`
		1771
		1772
		1773	`/*`
		1774	`DO AN ABSOLUTE OPERATION`
		1775	`*/`
		1776
		1777	`void absop`
		1778	`PROTO_N ( ( sha, a, dest ) )`
		1779	`PROTO_T ( shape sha X where a X where dest )`
		1780	`{`
		1781	`if ( is_signed ( sha ) ) {`
		1782	`where d ;`
		1783	`bool sw ;`
		1784	`long lab = next_lab () ;`
		1785	`exp jt = simple_exp ( 0 ) ;`
		1786	`ptno ( jt ) = lab ;`
		1787	`if ( whereis ( dest ) == Dreg ) {`
		1788	`d = dest ;`
		1789	`} else {`
		1790	`d = D0 ;`
		1791	`}`
		1792	`move ( sha, a, d ) ;`
		1793	`sw = cmp ( sha, d, zero, tst_ge ) ;`
		1794	`branch ( tst_ge, jt, 1, sw, 0 ) ;`
		1795	`negate ( sha, d, d ) ;`
		1796	`make_label ( lab ) ;`
		1797	`move ( sha, d, dest ) ;`
		1798	`} else {`
		1799	`move ( sha, a, dest ) ;`
		1800	`}`
		1801	`return ;`
		1802	`}`
		1803

Subversion Repositories tendra.SVN

(root)/trunk/src/installers/680x0/common/ops_int.c – Rev 2