/pliant/language/compiler/instruction/instruction2.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	function duplicate i -> i2
21	arg Instruction i ; arg_RW Instruction i2
22	i2 :> new Instruction
23	i2 function :> i function
24	i2 'size :=' i:size
25	for (var Int u) 0 i2:size-1
26	i2 u :> i u
27	i2 jump :> i jump
28
29
30	function new_instruction f n -> i
31	arg Function f ; arg Int n; arg_RW Instruction i
32	if f:nb_args_with_result<>n
33	error error_id_unexpected "Expected "+('convert to string' f:nb_args_with_result)+" argument(s) for function at "+f:position
34	i :> new Instruction
35	i function :> f
36	i 'size :=' n
37	return i
38
39	function instruction_set_argument i u a
40	arg_rw Instruction i ; arg Int u ; arg Argument a
41	if addressof:a=null
42	error error_id_unexpected "Attempted to build an Instruction with a null argument ("+i:function:name+")"
43	i u :> a
44
45	function instruction_set_jump i j
46	arg_rw Instruction i ; arg Instruction j
47	i jump :> j
48
49	function instruction_set_nested_with i j
50	arg_rw Instruction i ; arg Instruction j
51	i nested_with :> j
52
53
54	meta instruction e
55	if e:size<1 or not (e:0 cast Function)
56	return
57	var Int stop := e:size
58	if stop>=3 and addressof:(entry_type e:(stop-2):value)=addressof:Ident and (e:(stop-2):value map Ident)=(cast "nested_with" Ident)
59	if not (e:(stop-1) cast Instruction)
60	return
61	stop := stop-2
62	if stop>=3 and addressof:(entry_type e:(stop-2):value)=addressof:Ident and (e:(stop-2):value map Ident)=(cast "jump" Ident)
63	if not (e:(stop-1) cast Instruction)
64	return
65	stop := stop-2
66	for (var Int i) 1 stop-1
67	if not (e:i cast Argument)
68	return
69	var Link:Argument adr :> argument local Address
70	var Link:Argument instr :> argument indirect Instruction adr 0
71	var Link:Instruction i1 :> new Instruction
72	i1 function :> the_function new_instruction Function Int -> Instruction
73	i1 'size :=' 3
74	e:0 cast Function
75	e suckup e:0
76	i1 0 :> e:0:result
77	i1 1 :> argument constant Int stop-1
78	i1 2 :> instr
79	e add i1
80	for (var Int i) 1 stop-1
81	var Link:Instruction ii :> new Instruction
82	ii function :> the_function instruction_set_argument Instruction Int Argument
83	ii:arguments 'size :=' 3
84	ii 0 :> instr
85	ii 1 :> argument constant Int i-1
86	e suckup e:i
87	ii 2 :> e:i:result
88	e add ii
89	while stop<>e:size
90	var Link:Instruction ij :> new Instruction
91	if (e:stop:value map Ident)=(cast "jump" Ident)
92	ij function :> the_function instruction_set_jump Instruction Instruction
93	eif (e:stop:value map Ident)=(cast "nested_with" Ident)
94	ij function :> the_function instruction_set_nested_with Instruction Instruction
95	ij:arguments 'size :=' 2
96	ij 0 :> instr
97	e suckup (e stop+1)
98	ij 1 :> (e stop+1):result
99	e add ij
100	stop := stop+2
101	e set_result instr access_read+access_write
102
103
104	export duplicate instruction
105