/pliant/language/compiler/argument/argument2.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	function new_argument_immediat t v -> a
20	arg Type t ; arg Universal v ; arg_RW Argument a
21	a :> new Argument
22	a locate t argument_constant
23	a constant := entry_new t
24	t copy_instance addressof:v a:constant
25
26	function new_argument_mapped t v -> a
27	arg Type t ; arg Universal v ; arg_RW Argument a
28	a :> new Argument
29	a locate t argument_constant
30	a constant := addressof:v
31
32	function new_argument_local t -> a
33	arg Type t ; arg_RW Argument a
34	a :> new Argument
35	a locate t argument_local
36
37	function new_argument_indirect t p o -> a
38	arg Type t ; arg Argument p ; arg Int o ; arg_RW Argument a
39	a :> new Argument
40	a locate t argument_indirect
41	a pointer :> p
42	a offset := o
43
44	function new_argument_a_register -> a
45	arg_RW Argument a
46	a :> new Argument
47	a locate Int argument_a_register
48
49	function new_argument_register r -> a
50	arg Int r; arg_RW Argument a
51	a :> new Argument
52	a locate Int argument_register
53	a register := r
54
55
56	public
57
58	meta argument e
59	if e:size=0
60	return
61	if addressof:(entry_type e:0:value)<>addressof:Ident
62	return
63	var Link:Instruction i :> new Instruction
64	var Str id := cast (e:0:value map Ident) Str
65	if id="constant" or id="mapped_constant"
66	if e:size<>3
67	return
68	var Pointer:Type t :> (e:1 constant Type) map Type
69	if addressof:t=null
70	return
71	if not (e:2 cast t)
72	return
73	if id="constant"
74	i function :> the_function new_argument_immediat Type Universal -> Argument
75	eif id="mapped_constant"
76	i function :> the_function new_argument_mapped Type Universal -> Argument
77	else
78	error error_id_unexpected "bug"
79	i 'size :=' 3
80	var Link:Argument a :> new Argument
81	a locate Type argument_constant
82	a constant := addressof t
83	i 0 :> a
84	e suckup e:2
85	i 1 :> e:2:result
86	eif id="local"
87	if e:size<>2 or not (e:1 cast Type)
88	return
89	i function :> the_function new_argument_local Type -> Argument
90	i 'size :=' 2
91	e suckup e:1
92	i 0 :> e:1:result
93	eif id="indirect"
94	if e:size<>4 or not (e:1 cast Type) or not (e:2 cast Argument) or not (e:3 cast Int)
95	return
96	i function :> the_function new_argument_indirect Type Argument Int -> Argument
97	i 'size :=' 4
98	e suckup e:1
99	e suckup e:2
100	e suckup e:3
101	i 0 :> e:1:result
102	i 1 :> e:2:result
103	i 2 :> e:3:result
104	eif id="a_register"
105	if e:size<>1
106	return
107	i function :> the_function new_argument_a_register -> Argument
108	i 'size :=' 1
109	eif id="register"
110	if e:size<>2 or not (e:1 cast Int)
111	return
112	i function :> the_function new_argument_register Int -> Argument
113	i 'size :=' 2
114	e suckup e:1
115	i 0 :> e:1:result
116	else
117	error error_id_unexpected "unknown argument location"
118	return
119	var Link:Argument adr :> new Argument
120	adr locate Address argument_local
121	var Link:Argument a :> new Argument
122	a locate Argument argument_indirect
123	a pointer :> adr ; a offset := 0
124	i i:size-1 :> a
125	e add i
126	e set_result a access_read+access_write