/pliant/language/optimizer/consteval.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/ring1.pli"
18
19
20	function remove_dead_code e
21	arg_rw Expression e
22	var Pointer:Arrow c :> e:instructions first ; var Int counter := 0
23	while c<>null
24	var Pointer:Instruction i :> c map Instruction
25	i order := counter
26	if (addressof i:function)=addressof:(the_function 'jump if' CBool) and i:0:where=argument_constant
27	if (i:0:constant map CBool)
28	i function :> the_function 'jump anyway'
29	else
30	i function :> the_function 'do nothing'
31	i jump :> null map Instruction
32	i 'size :=' 0
33	eif (addressof i:function)=addressof:(the_function 'jump if not' CBool) and i:0:where=argument_constant
34	if (i:0:constant map CBool)
35	i function :> the_function 'do nothing'
36	i jump :> null map Instruction
37	else
38	i function :> the_function 'jump anyway'
39	i 'size :=' 0
40	c :> e:instructions next c ; counter := counter+1
41	var Pointer:Arrow c :> e:instructions first
42	while c<>null
43	var Pointer:Arrow c2 :> e:instructions next c
44	var Pointer:Instruction i :> c map Instruction
45	if (addressof i:function)=(addressof the_function:'jump anyway') and (addressof i:jump)<>(cast -1 Address) and i:jump:order>i:order
46	var Pointer:Arrow c3 :> e:instructions first
47	while c3<>null and { var Pointer:Instruction j :> c3 map Instruction ; ( (addressof j:jump)=null or (addressof j:jump)=(cast -1 Address) or (j:order>i:order and j:order<i:jump:order) or j:jump:order<=i:order or j:jump:order>=i:jump:order ) }
48	c3 :> e:instructions next c3
49	if c3=null
50	var Pointer:Instruction i2 :> i jump
51	while c<>addressof:i2
52	c :> e:instructions remove c
53	c2 :> c
54	c :> c2
55
56
57	function evaluate_constant_expression e
58	arg_rw Expression e
59	# console "constant expression at "+e:position+"[lf]"
60	var Address cst := e evaluate
61	if error_notified
62	return
63	if cst<>null
64	e set_constant_result cst
65	else
66	error error_id_unexpected "Failed to evaluate expression at "+e:position
67	e set_void_result
68
69
70	method f may_map arg_num -> c
71	arg Function f ; arg Int arg_num ; arg CBool c
72	var Pointer:FunctionPrototype fp :> f arg arg_num
73	if ('.and.' fp:access access_byvalue)<>0
74	return false
75	for (var Int i) 0 f:nb_args_with_result-1
76	var Pointer:FunctionPrototype fp :> f arg i
77	if ('.and.' fp:access access_write)<>0
78	var Int b
79	if arg_num<30
80	b := arg_num
81	else
82	b := 30
83	if fp:maps<0 # bit 31 is set
84	if ('.and.' fp:type:flags type_flag_mapper)<>0
85	return true
86	else
87	if ('.and.' fp:maps 2^b)<>0 or ( ('.and.' fp:access access_mapped)<>0 and i<>arg_num )
88	return true
89	return false
90
91	function look_for_constant_expression e
92	arg_rw Expression e
93	if (addressof e:result)=null
94	return
95	if ('.and.' e:access access_read+access_write)<>access_read
96	return
97	if e:result:where<>argument_local and (e:result:where<>argument_indirect or e:result:pointer:where<>argument_local)
98	return
99	if e:instructions:first=null
100	return
101	var List temporaries
102	var List requires
103	var Pointer:Arrow c :> e:instructions first
104	while c<>null
105	if entry_type:c<>Instruction
106	error error_id_unexpected "Expression instructions list should contain only instructions"
107	return
108	var Pointer:Instruction instr :> c map Instruction
109	if (instr:function nb_args_with_result)<>instr:size
110	error_notify error_id_unexpected null "The number of parameter in the instruction is not consistent with the function it calls"
111	return
112	if (addressof instr:jump)<>null
113	return
114	if ('.and.' instr:function:flags function_flag_has_side_effects+function_flag_later+function_flag_under_construction)<>0
115	return
116	for (var Int i) 0 instr:size-1
117	var Int arw := '.and.' (instr:function arg i):access access_read+access_write
118	if (instr:function may_map i)
119	return
120	if instr:i:where=argument_constant
121	requires append instr:i:constant
122	eif (addressof instr:i)=(addressof e:result)
123	if arw<>access_write # access is not write only
124	return
125	eif instr:i:where<>argument_local and instr:i:where<>argument_a_register
126	return
127	eif arw=access_write # access is write only
128	temporaries append (addressof instr:i)
129	eif arw<>access_read # access is not read only
130	return
131	else
132	var Pointer:Arrow c2
133	c2 :> temporaries first
134	while c2<>null and c2<>(addressof instr:i)
135	c2 :> temporaries next c2
136	if c2=null
137	return
138	temporaries remove c2
139	c :> e:instructions next c
140	if temporaries:first<>null
141	return
142	evaluate_constant_expression e
143	if error_notified
144	return
145	e:result requires := requires
146
147
148	alias 'pliant postcompile rewrite' remove_dead_code in "/pliant/language/optimizer/basic.pli"
149	alias 'pliant postcompile rewrite' look_for_constant_expression in "/pliant/language/optimizer/basic.pli"
150
151
152	meta constant e
153	if e:size=1
154	evaluate_constant_expression e:0
155	e suckup e:0
156	e set_result e:0:result e:0:access
157
158	export constant '. may_map'