PageRenderTime 98ms CodeModel.GetById 40ms app.highlight 37ms RepoModel.GetById 14ms app.codeStats 0ms

/vm/quotations.c

https://github.com/Keyholder/factor
C | 544 lines | 409 code | 88 blank | 47 comment | 109 complexity | b4f56cb4c6285e3df45c1771de301684 MD5 | raw file
  1#include "master.h"
  2
  3/* Simple non-optimizing compiler.
  4
  5This is one of the two compilers implementing Factor; the second one is written
  6in Factor and performs advanced optimizations. See core/compiler/compiler.factor.
  7
  8The non-optimizing compiler compiles a quotation at a time by concatenating
  9machine code chunks; prolog, epilog, call word, jump to word, etc. These machine
 10code chunks are generated from Factor code in core/cpu/.../bootstrap.factor.
 11
 12Calls to words and constant quotations (referenced by conditionals and dips)
 13are direct jumps to machine code blocks. Literals are also referenced directly
 14without going through the literal table.
 15
 16It actually does do a little bit of very simple optimization:
 17
 181) Tail call optimization.
 19
 202) If a quotation is determined to not call any other words (except for a few
 21special words which are open-coded, see below), then no prolog/epilog is
 22generated.
 23
 243) When in tail position and immediately preceded by literal arguments, the
 25'if' and 'dispatch' conditionals are generated inline, instead of as a call to
 26the 'if' word.
 27
 284) When preceded by a quotation, calls to 'dip', '2dip' and '3dip' are
 29open-coded as retain stack manipulation surrounding a subroutine call.
 30
 315) When preceded by an array, calls to the 'declare' word are optimized out
 32entirely. This word is only used by the optimizing compiler, and with the
 33non-optimizing compiler it would otherwise just decrease performance to have to
 34push the array and immediately drop it after.
 35
 366) Sub-primitives are primitive words which are implemented in assembly and not
 37in the VM. They are open-coded and no subroutine call is generated. This
 38includes stack shufflers, some fixnum arithmetic words, and words such as tag,
 39slot and eq?. A primitive call is relatively expensive (two subroutine calls)
 40so this results in a big speedup for relatively little effort. */
 41
 42bool jit_primitive_call_p(F_ARRAY *array, CELL i)
 43{
 44	return (i + 2) == array_capacity(array)
 45		&& type_of(array_nth(array,i)) == FIXNUM_TYPE
 46		&& array_nth(array,i + 1) == userenv[JIT_PRIMITIVE_WORD];
 47}
 48
 49bool jit_fast_if_p(F_ARRAY *array, CELL i)
 50{
 51	return (i + 3) == array_capacity(array)
 52		&& type_of(array_nth(array,i)) == QUOTATION_TYPE
 53		&& type_of(array_nth(array,i + 1)) == QUOTATION_TYPE
 54		&& array_nth(array,i + 2) == userenv[JIT_IF_WORD];
 55}
 56
 57bool jit_fast_dispatch_p(F_ARRAY *array, CELL i)
 58{
 59	return (i + 2) == array_capacity(array)
 60		&& type_of(array_nth(array,i)) == ARRAY_TYPE
 61		&& array_nth(array,i + 1) == userenv[JIT_DISPATCH_WORD];
 62}
 63
 64bool jit_fast_dip_p(F_ARRAY *array, CELL i)
 65{
 66	return (i + 2) <= array_capacity(array)
 67		&& type_of(array_nth(array,i)) == QUOTATION_TYPE
 68		&& array_nth(array,i + 1) == userenv[JIT_DIP_WORD];
 69}
 70
 71bool jit_fast_2dip_p(F_ARRAY *array, CELL i)
 72{
 73	return (i + 2) <= array_capacity(array)
 74		&& type_of(array_nth(array,i)) == QUOTATION_TYPE
 75		&& array_nth(array,i + 1) == userenv[JIT_2DIP_WORD];
 76}
 77
 78bool jit_fast_3dip_p(F_ARRAY *array, CELL i)
 79{
 80	return (i + 2) <= array_capacity(array)
 81		&& type_of(array_nth(array,i)) == QUOTATION_TYPE
 82		&& array_nth(array,i + 1) == userenv[JIT_3DIP_WORD];
 83}
 84
 85bool jit_ignore_declare_p(F_ARRAY *array, CELL i)
 86{
 87	return (i + 1) < array_capacity(array)
 88		&& type_of(array_nth(array,i)) == ARRAY_TYPE
 89		&& array_nth(array,i + 1) == userenv[JIT_DECLARE_WORD];
 90}
 91
 92F_ARRAY *code_to_emit(CELL code)
 93{
 94	return untag_object(array_nth(untag_object(code),0));
 95}
 96
 97F_REL rel_to_emit(CELL code, CELL code_format, CELL code_length, bool *rel_p)
 98{
 99	F_ARRAY *quadruple = untag_object(code);
100	CELL rel_class = array_nth(quadruple,1);
101	CELL rel_type = array_nth(quadruple,2);
102	CELL offset = array_nth(quadruple,3);
103
104	if(rel_class == F)
105	{
106		*rel_p = false;
107		return 0;
108	}
109	else
110	{
111		*rel_p = true;
112		return (to_fixnum(rel_type) << 28)
113			| (to_fixnum(rel_class) << 24)
114			| ((code_length + to_fixnum(offset)) * code_format);
115	}
116}
117
118#define EMIT(name) { \
119		bool rel_p; \
120		F_REL rel = rel_to_emit(name,code_format,code_count,&rel_p); \
121		if(rel_p) GROWABLE_BYTE_ARRAY_APPEND(relocation,&rel,sizeof(F_REL)); \
122		GROWABLE_ARRAY_APPEND(code,code_to_emit(name)); \
123	}
124
125bool jit_stack_frame_p(F_ARRAY *array)
126{
127	F_FIXNUM length = array_capacity(array);
128	F_FIXNUM i;
129
130	for(i = 0; i < length - 1; i++)
131	{
132		CELL obj = array_nth(array,i);
133		if(type_of(obj) == WORD_TYPE)
134		{
135			F_WORD *word = untag_object(obj);
136			if(word->subprimitive == F && obj != userenv[JIT_DECLARE_WORD])
137				return true;
138		}
139		else if(type_of(obj) == QUOTATION_TYPE)
140		{
141			if(jit_fast_dip_p(array,i)
142				|| jit_fast_2dip_p(array,i)
143				|| jit_fast_3dip_p(array,i))
144				return true;
145		}
146	}
147
148	return false;
149}
150
151void set_quot_xt(F_QUOTATION *quot, F_CODE_BLOCK *code)
152{
153	if(code->block.type != QUOTATION_TYPE)
154		critical_error("Bad param to set_quot_xt",(CELL)code);
155
156	quot->code = code;
157	quot->xt = (XT)(code + 1);
158	quot->compiledp = T;
159}
160
161/* Might GC */
162void jit_compile(CELL quot, bool relocate)
163{
164	if(untag_quotation(quot)->compiledp != F)
165		return;
166
167	CELL code_format = compiled_code_format();
168
169	REGISTER_ROOT(quot);
170
171	CELL array = untag_quotation(quot)->array;
172	REGISTER_ROOT(array);
173
174	GROWABLE_ARRAY(code);
175	REGISTER_ROOT(code);
176
177	GROWABLE_BYTE_ARRAY(relocation);
178	REGISTER_ROOT(relocation);
179
180	GROWABLE_ARRAY(literals);
181	REGISTER_ROOT(literals);
182
183	if(stack_traces_p())
184		GROWABLE_ARRAY_ADD(literals,quot);
185
186	bool stack_frame = jit_stack_frame_p(untag_object(array));
187
188	if(stack_frame)
189		EMIT(userenv[JIT_PROLOG]);
190
191	CELL i;
192	CELL length = array_capacity(untag_object(array));
193	bool tail_call = false;
194
195	for(i = 0; i < length; i++)
196	{
197		CELL obj = array_nth(untag_object(array),i);
198		F_WORD *word;
199		F_WRAPPER *wrapper;
200
201		switch(type_of(obj))
202		{
203		case WORD_TYPE:
204			word = untag_object(obj);
205
206			/* Intrinsics */
207			if(word->subprimitive != F)
208			{
209				if(array_nth(untag_object(word->subprimitive),1) != F)
210				{
211					GROWABLE_ARRAY_ADD(literals,T);
212				}
213
214				EMIT(word->subprimitive);
215			}
216			else
217			{
218				GROWABLE_ARRAY_ADD(literals,obj);
219
220				if(i == length - 1)
221				{
222					if(stack_frame)
223						EMIT(userenv[JIT_EPILOG]);
224
225					EMIT(userenv[JIT_WORD_JUMP]);
226
227					tail_call = true;
228				}
229				else
230					EMIT(userenv[JIT_WORD_CALL]);
231			}
232			break;
233		case WRAPPER_TYPE:
234			wrapper = untag_object(obj);
235			GROWABLE_ARRAY_ADD(literals,wrapper->object);
236			EMIT(userenv[JIT_PUSH_IMMEDIATE]);
237			break;
238		case FIXNUM_TYPE:
239			if(jit_primitive_call_p(untag_object(array),i))
240			{
241				EMIT(userenv[JIT_SAVE_STACK]);
242				GROWABLE_ARRAY_ADD(literals,obj);
243				EMIT(userenv[JIT_PRIMITIVE]);
244
245				i++;
246
247				tail_call = true;
248				break;
249			}
250		case QUOTATION_TYPE:
251			if(jit_fast_if_p(untag_object(array),i))
252			{
253				if(stack_frame)
254					EMIT(userenv[JIT_EPILOG]);
255
256				jit_compile(array_nth(untag_object(array),i),relocate);
257				jit_compile(array_nth(untag_object(array),i + 1),relocate);
258
259				GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
260				EMIT(userenv[JIT_IF_1]);
261				GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i + 1));
262				EMIT(userenv[JIT_IF_2]);
263
264				i += 2;
265
266				tail_call = true;
267				break;
268			}
269			else if(jit_fast_dip_p(untag_object(array),i))
270			{
271				jit_compile(obj,relocate);
272
273				GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
274				EMIT(userenv[JIT_DIP]);
275
276				i++;
277				break;
278			}
279			else if(jit_fast_2dip_p(untag_object(array),i))
280			{
281				jit_compile(obj,relocate);
282
283				GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
284				EMIT(userenv[JIT_2DIP]);
285
286				i++;
287				break;
288			}
289			else if(jit_fast_3dip_p(untag_object(array),i))
290			{
291				jit_compile(obj,relocate);
292
293				GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
294				EMIT(userenv[JIT_3DIP]);
295
296				i++;
297				break;
298			}
299		case ARRAY_TYPE:
300			if(jit_fast_dispatch_p(untag_object(array),i))
301			{
302				if(stack_frame)
303					EMIT(userenv[JIT_EPILOG]);
304
305				GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
306				EMIT(userenv[JIT_DISPATCH]);
307
308				i++;
309
310				tail_call = true;
311				break;
312			}
313			else if(jit_ignore_declare_p(untag_object(array),i))
314			{
315				i++;
316				break;
317			}
318		default:
319			GROWABLE_ARRAY_ADD(literals,obj);
320			EMIT(userenv[JIT_PUSH_IMMEDIATE]);
321			break;
322		}
323	}
324
325	if(!tail_call)
326	{
327		if(stack_frame)
328			EMIT(userenv[JIT_EPILOG]);
329
330		EMIT(userenv[JIT_RETURN]);
331	}
332
333	GROWABLE_ARRAY_TRIM(code);
334	GROWABLE_ARRAY_TRIM(literals);
335	GROWABLE_BYTE_ARRAY_TRIM(relocation);
336
337	F_CODE_BLOCK *compiled = add_code_block(
338		QUOTATION_TYPE,
339		untag_object(code),
340		NULL,
341		relocation,
342		literals);
343
344	set_quot_xt(untag_object(quot),compiled);
345
346	if(relocate)
347		relocate_code_block(compiled);
348
349	UNREGISTER_ROOT(literals);
350	UNREGISTER_ROOT(relocation);
351	UNREGISTER_ROOT(code);
352	UNREGISTER_ROOT(array);
353	UNREGISTER_ROOT(quot);
354}
355
356/* Crappy code duplication. If C had closures (not just function pointers)
357it would be easy to get rid of, but I can't think of a good way to deal
358with it right now that doesn't involve lots of boilerplate that would be
359worse than the duplication itself (eg, putting all state in some global
360struct.) */
361#define COUNT(name,scan) \
362	{ \
363		CELL size = array_capacity(code_to_emit(name)) * code_format; \
364		if(offset == 0) return scan - 1; \
365		if(offset < size) return scan + 1; \
366		offset -= size; \
367	}
368
369F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
370{
371	CELL code_format = compiled_code_format();
372
373	CELL array = untag_quotation(quot)->array;
374
375	bool stack_frame = jit_stack_frame_p(untag_object(array));
376
377	if(stack_frame)
378		COUNT(userenv[JIT_PROLOG],0)
379
380	CELL i;
381	CELL length = array_capacity(untag_object(array));
382	bool tail_call = false;
383
384	for(i = 0; i < length; i++)
385	{
386		CELL obj = array_nth(untag_object(array),i);
387		F_WORD *word;
388
389		switch(type_of(obj))
390		{
391		case WORD_TYPE:
392			/* Intrinsics */
393			word = untag_object(obj);
394			if(word->subprimitive != F)
395				COUNT(word->subprimitive,i)
396			else if(i == length - 1)
397			{
398				if(stack_frame)
399					COUNT(userenv[JIT_EPILOG],i);
400
401				COUNT(userenv[JIT_WORD_JUMP],i)
402
403				tail_call = true;
404			}
405			else
406				COUNT(userenv[JIT_WORD_CALL],i)
407			break;
408		case WRAPPER_TYPE:
409			COUNT(userenv[JIT_PUSH_IMMEDIATE],i)
410			break;
411		case FIXNUM_TYPE:
412			if(jit_primitive_call_p(untag_object(array),i))
413			{
414				COUNT(userenv[JIT_SAVE_STACK],i);
415				COUNT(userenv[JIT_PRIMITIVE],i);
416
417				i++;
418
419				tail_call = true;
420				break;
421			}
422		case QUOTATION_TYPE:
423			if(jit_fast_if_p(untag_object(array),i))
424			{
425				if(stack_frame)
426					COUNT(userenv[JIT_EPILOG],i)
427
428				COUNT(userenv[JIT_IF_1],i)
429				COUNT(userenv[JIT_IF_2],i)
430				i += 2;
431
432				tail_call = true;
433				break;
434			}
435			else if(jit_fast_dip_p(untag_object(array),i))
436			{
437				COUNT(userenv[JIT_DIP],i)
438				i++;
439				break;
440			}
441			else if(jit_fast_2dip_p(untag_object(array),i))
442			{
443				COUNT(userenv[JIT_2DIP],i)
444				i++;
445				break;
446			}
447			else if(jit_fast_3dip_p(untag_object(array),i))
448			{
449				COUNT(userenv[JIT_3DIP],i)
450				i++;
451				break;
452			}
453		case ARRAY_TYPE:
454			if(jit_fast_dispatch_p(untag_object(array),i))
455			{
456				if(stack_frame)
457					COUNT(userenv[JIT_EPILOG],i)
458
459				i++;
460
461				COUNT(userenv[JIT_DISPATCH],i)
462
463				tail_call = true;
464				break;
465			}
466			if(jit_ignore_declare_p(untag_object(array),i))
467			{
468				if(offset == 0) return i;
469
470				i++;
471
472				break;
473			}
474		default:
475			COUNT(userenv[JIT_PUSH_IMMEDIATE],i)
476			break;
477		}
478	}
479
480	if(!tail_call)
481	{
482		if(stack_frame)
483			COUNT(userenv[JIT_EPILOG],length)
484
485		COUNT(userenv[JIT_RETURN],length)
486	}
487
488	return -1;
489}
490
491F_FASTCALL CELL lazy_jit_compile_impl(CELL quot, F_STACK_FRAME *stack)
492{
493	stack_chain->callstack_top = stack;
494	REGISTER_ROOT(quot);
495	jit_compile(quot,true);
496	UNREGISTER_ROOT(quot);
497	return quot;
498}
499
500void primitive_jit_compile(void)
501{
502	jit_compile(dpop(),true);
503}
504
505/* push a new quotation on the stack */
506void primitive_array_to_quotation(void)
507{
508	F_QUOTATION *quot = allot_object(QUOTATION_TYPE,sizeof(F_QUOTATION));
509	quot->array = dpeek();
510	quot->xt = lazy_jit_compile;
511	quot->compiledp = F;
512	quot->cached_effect = F;
513	quot->cache_counter = F;
514	drepl(tag_object(quot));
515}
516
517void primitive_quotation_xt(void)
518{
519	F_QUOTATION *quot = untag_quotation(dpeek());
520	drepl(allot_cell((CELL)quot->xt));
521}
522
523void compile_all_words(void)
524{
525	CELL words = find_all_words();
526
527	REGISTER_ROOT(words);
528
529	CELL i;
530	CELL length = array_capacity(untag_object(words));
531	for(i = 0; i < length; i++)
532	{
533		F_WORD *word = untag_word(array_nth(untag_array(words),i));
534		REGISTER_UNTAGGED(word);
535		if(word->optimizedp == F)
536			jit_compile_word(word,word->def,false);
537		UNREGISTER_UNTAGGED(word);
538		update_word_xt(word);
539	}
540
541	UNREGISTER_ROOT(words);
542
543	iterate_code_heap(relocate_code_block);
544}