/pliant/language/optimizer/extend.pli
1	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
2	#
3	# This program is free software; you can redistribute it and/or
4	# modify it under the terms of the GNU General Public License version 2
5	# as published by the Free Software Foundation.
6	#
7	# This program is distributed in the hope that it will be useful,
8	# but WITHOUT ANY WARRANTY; without even the implied warranty of
9	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10	# GNU General Public License for more details.
11	#
12	# You should have received a copy of the GNU General Public License
13	# version 2 along with this program; if not, write to the Free Software
14	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
15
16	scope "/pliant/language/" "/pliant/install/"
17	module "/pliant/install/ring2.pli"
18
19
20	method a access i -> m
21	arg Argument a ; arg Instruction i ; arg Int m
22	m := 0
23	for (var Int u) 0 i:size-1
24	var Pointer:Argument au :> i u
25	if au=a
26	m := '.or.' m (i:function arg u):access
27	while au:where=argument_indirect
28	au :> au pointer
29	if au=a
30	m := '.or.' m access_read
31	m := '.and.' m access_read+access_write
32
33
34	method a is_stable first last -> stable
35	arg Argument a ; arg Instruction first last ; arg CBool stable
36	if a:where=argument_indirect
37	if not (a:pointer is_stable first last)
38	return false
39	if a:is_mapped
40	return false
41	var Pointer:Instruction i :> first
42	while true
43	if i:backward_jumps:first<>null
44	if i<>first
45	return false
46	if (addressof i:jump)<>null
47	if i<>last
48	return false
49	var Int count := 0
50	for (var Int u) 0 i:size-1
51	var Pointer:Argument au :> i u
52	if au=a
53	count := count+1
54	while au:where=argument_indirect
55	au :> au pointer
56	if au=a
57	count := count+1
58	if i=first or i=last
59	count := count-1
60	if count>0
61	return false
62	if i=last
63	return true
64	i :> i next_instruction
65
66	method a is_temporary -> temp
67	arg Argument a ; arg CBool temp
68	if a:where<>argument_local
69	return false
70	if (addressof a:first_instruction)=null or a:first_instruction=a:last_instruction
71	return
72	var Pointer:Instruction i :> a first_instruction
73	if i:size=0 or (i i:size-1)<>a
74	return false
75	if (a access a:first_instruction)<>access_write
76	return false
77	if (a access a:last_instruction)<>access_read
78	return false
79	return (a is_stable a:first_instruction a:last_instruction)
80
81
82
83
84
85	function keep_object a
86	arg Universal a
87	function keep_object_generate_binary instr function
88	arg Instruction instr ; arg_rw Function function
89	(the_function keep_object Universal) set_generate_binary (the_function keep_object_generate_binary Instruction Function)
90
91	method gc keep_object a
92	arg_rw GeneratorContext gc ; arg_rw Argument a
93	if a:requires:first<>null and a:first_instruction=a:last_instruction
94	gc insert_after_instruction a:first_instruction (instruction (the_function keep_object Universal) a)
95
96
97
98
99
100	function record_optimizer_function2 f section
101	arg Function f ; arg Str section
102	pliant_general_dictionary insert2 section false addressof:f the_module:"/pliant/language/optimizer/basic.pli"
103
104	meta record_optimizer_function e
105	if e:size=2 and e:0:is_pure_ident and (e:1 cast Str)
106	e compile_as (expression immediat (record_optimizer_function2 (the_function fun GeneratorContext) section) substitute fun e:0 substitute section e:1)
107
108
109	function optimizer_section name -> ptr
110	arg Str name ; arg Pointer:Arrow ptr
111	ptr :> 'pliant optimizer sections' first
112	while ptr<>null and (ptr map Str)<>name
113	ptr :> 'pliant optimizer sections' next ptr
114	if ptr=null
115	error "The optimizing section "+name+" does not exist"
116
117	function set_new_optimizing_sections
118	var Link:Str section0 :> new Str
119	section0 := "pliant optimizer rewrite instructions0"
120	'pliant optimizer sections' insert_before optimizer_section:"pliant optimizer rewrite instructions" addressof:section0
121	var Link:Str section2 :> new Str
122	section2 := "pliant optimizer rewrite instructions2"
123	'pliant optimizer sections' insert_after optimizer_section:"pliant optimizer rewrite instructions" addressof:section2
124	set_new_optimizing_sections
125
126
127	export '. is_stable' '. is_temporary'
128	export '. keep_object'
129	export record_optimizer_function record_optimizer_function2