/pliant/language/type/number/int_sized.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 select_low_bytes adr big_type small_type -> part
21	arg Address adr part ; arg Type big_type small_type
22	if processor_is_low_indian
23	part := adr
24	eif processor_is_high_indian
25	part := (adr translate big_type 1) translate small_tye -1
26	else
27	error error_id_runtime "processor "+processor_name+" is unknown indian"
28
29
30	function build_fixed_size_type name signed size
31	arg Str name ; arg CBool signed ; arg Int size
32	var Str ename := shunt signed "Int" "uInt"
33	var Ident reduced_type := cast name Ident
34	var Ident extended_type := cast ename Ident
35	var Ident cast_extension := cast "cast "+ename Ident
36	var Ident cast_reduction := cast "cast "+ename+('convert to string' size*8) Ident
37	var Str ctype
38	if size=1
39	ctype := "char"
40	eif size=2
41	ctype := "short"
42	else
43	ctype := "int"
44	if signed
45	ctype := "signed "+ctype
46	else
47	ctype := "unsigned "+ctype
48	runtime_compile reduced_type reduced_type  extended_type extended_type  signed signed  s size  cast_extension cast_extension  cast_reduction cast_reduction ctype ctype
49
50	type reduced_type
51	field Byte b1
52	if s>=2
53	field Byte b2
54	if s>=4
55	field Byte b3 b4
56
57	function cast_extension i -> j
58	arg reduced_type i ; arg extended_type j
59	extension ; has_no_side_effect ; gcc_inline "$2 = *("+ctype+" *)@1;"
60	if reduced_type:size=extended_type:size
61	j := addressof:i map extended_type
62	eif signed
63	if ((addressof:i map extended_type) .and. 80h*100h^(reduced_type:size-1))=0
64	j := 0
65	else
66	j := -1
67	memory_copy addressof:i (select_low_bytes addressof:j extended_type reduced_type) reduced_type:size
68	else
69	j := 0
70	memory_copy addressof:i (select_low_bytes addressof:j extended_type reduced_type) reduced_type:size
71
72	function cast_reduction i -> j
73	arg extended_type i ; arg reduced_type j
74	reduction ; has_no_side_effect ; gcc_nocheck_inline "*("+ctype+" *)@2 = $1;"
75	if reduced_type:size<extended_type:size
76	if signed
77	check i>=-(256^s\2) and i<256^s\2 "The value is too large to fit in an "+reduced_type:name
78	else
79	check i<256^s "The value is too large to fit in an "+reduced_type:name
80	memory_copy (select_low_bytes addressof:i extended_type reduced_type) addressof:j reduced_type:size
81	else
82	addressof:j map extended_type := i
83
84	# function compare i j -> c
85	#   arg reduced_type i j ; arg Int c
86	#   c := compare (cast i extended_type) (cast j extended_type)
87
88	export reduced_type cast_extension cast_reduction # compare
89
90
91	build_fixed_size_type "Int8" true 1
92	build_fixed_size_type "Int16" true 2
93	build_fixed_size_type "Int32" true 4
94
95	build_fixed_size_type "uInt8" false 1
96	build_fixed_size_type "uInt16" false 2
97	build_fixed_size_type "uInt32" false 4
98	if Int:size=8
99	build_fixed_size_type "Int64" true 8
100	build_fixed_size_type "uInt64" false 8
101
102
103
104
105	if processor_name="i386" and pliant_debugging_level<2
106
107	function generate_extend_Int8_assembly instr gc
108	arg_rw Instruction instr ; arg_rw GeneratorContext gc
109	var Pointer:Instruction cur :> instr
110	var Link:Argument arg :> argument a_register
111	cur :> gc insert_after_instruction cur (instruction (the_function i386_movsx8 Int -> Int) instr:0 arg)
112	cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) arg instr:1)
113	gc remove instr
114	(the_function 'cast Int' Int8 -> Int) set_generate_assembly (the_function generate_extend_Int8_assembly Instruction GeneratorContext)
115
116	function generate_extend_Int16_assembly instr gc
117	arg_rw Instruction instr ; arg_rw GeneratorContext gc
118	var Pointer:Instruction cur :> instr
119	var Link:Argument arg :> argument a_register
120	cur :> gc insert_after_instruction cur (instruction (the_function i386_movsx16 Int -> Int) instr:0 arg)
121	cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) arg instr:1)
122	gc remove instr
123	(the_function 'cast Int' Int16 -> Int) set_generate_assembly (the_function generate_extend_Int16_assembly Instruction GeneratorContext)
124
125	function generate_extend_uInt8_assembly instr gc
126	arg_rw Instruction instr ; arg_rw GeneratorContext gc
127	var Pointer:Instruction cur :> instr
128	var Link:Argument arg :> argument a_register
129	cur :> gc insert_after_instruction cur (instruction (the_function i386_movzx8 Int -> Int) instr:0 arg)
130	cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) arg instr:1)
131	gc remove instr
132	(the_function 'cast uInt' uInt8 -> uInt) set_generate_assembly (the_function generate_extend_uInt8_assembly Instruction GeneratorContext)
133
134	function generate_extend_uInt16_assembly instr gc
135	arg_rw Instruction instr ; arg_rw GeneratorContext gc
136	var Pointer:Instruction cur :> instr
137	var Link:Argument arg :> argument a_register
138	cur :> gc insert_after_instruction cur (instruction (the_function i386_movzx16 Int -> Int) instr:0 arg)
139	cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) arg instr:1)
140	gc remove instr
141	(the_function 'cast uInt' uInt16 -> uInt) set_generate_assembly (the_function generate_extend_uInt16_assembly Instruction GeneratorContext)
142
143	function generate_reduce_Int8_assembly instr gc
144	arg_rw Instruction instr ; arg_rw GeneratorContext gc
145	var Pointer:Instruction cur :> instr
146	var Link:Argument arg :> argument a_register
147	cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) instr:0 arg)
148	cur :> gc insert_after_instruction cur (instruction (the_function i386_mov8 Int -> Int) arg instr:1)
149	gc remove instr
150	(the_function 'cast Int8' Int -> Int8) set_generate_assembly (the_function generate_reduce_Int8_assembly Instruction GeneratorContext)
151	(the_function 'cast uInt8' uInt -> uInt8) set_generate_assembly (the_function generate_reduce_Int8_assembly Instruction GeneratorContext)
152
153	function generate_reduce_Int16_assembly instr gc
154	arg_rw Instruction instr ; arg_rw GeneratorContext gc
155	var Pointer:Instruction cur :> instr
156	var Link:Argument arg :> argument a_register
157	cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) instr:0 arg)
158	cur :> gc insert_after_instruction cur (instruction (the_function i386_mov16 Int -> Int) arg instr:1)
159	gc remove instr
160	(the_function 'cast Int16' Int -> Int16) set_generate_assembly (the_function generate_reduce_Int16_assembly Instruction GeneratorContext)
161	(the_function 'cast uInt16' uInt -> uInt16) set_generate_assembly (the_function generate_reduce_Int16_assembly Instruction GeneratorContext)