/pliant/language/type/number/int64.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/ring3.pli"
18	module "intn.pli"
19
20
21	if Int:size=4
22
23	type uInt64
24	field uInt low
25	field uInt high
26
27	function compare a b -> c
28	arg uInt64 a b ; arg Int c
29	c := compare a:high b:high
30	if c=compare_equal
31	c := compare a:low b:low
32
33	function 'cast uInt64' i -> j
34	arg uInt i ; arg uInt64 j
35	extension ; has_no_side_effect
36	j low := i
37	j high := 0
38
39	function 'cast uInt' i -> j
40	arg uInt64 i ; arg uInt j
41	reduction ; has_no_side_effect
42	check i:high=0 "The value is too large to fit in an uInt"
43	j := i low
44
45	function 'cast Intn' i -> j
46	arg uInt64 i ; arg Intn j
47	extension ; has_no_side_effect
48	j 'please resize' 2
49	memory_copy addressof:i j:'please bits' uInt64:size
50	j 'please status' := 'please positive'
51	j 'please shrink'
52
53	function 'cast uInt64' i -> j
54	arg Intn i ; arg uInt64 j
55	reduction ; has_no_side_effect
56	var uInt p := i 'please read_lock'
57	if p<>'please positive'
58	error error_id_unexpected "The integer is negative"
59	if i:'please size'>0
60	j low := i:'please bits' map uInt
61	else
62	j low := 0
63	if i:'please size'>1
64	j high := (i:'please bits' translate uInt 1) map uInt
65	else
66	j high := 0
67	if i:'please size'>2
68	error error_id_arithmetic "The value is too large to fit in an uInt64"
69	i 'please read_unlock'
70
71	export uInt64 compare 'cast uInt64' 'cast uInt' 'cast Intn' 'cast uInt64'
72
73
74	if Int:size=4
75
76	type Int64
77	field uInt low
78	field Int high
79
80	function compare a b -> c
81	arg Int64 a b ; arg Int c
82	c := compare a:high b:high
83	if c=compare_equal
84	if a:high>=0
85	c := compare a:low b:low
86	else
87	c := compare 0FFFFFFFFh-a:low 0FFFFFFFFh-b:low
88
89	function 'cast Int64' i -> j
90	arg Int i ; arg Int64 j
91	extension ; has_no_side_effect
92	j low := i
93	if i>=0
94	j high := 0
95	else
96	j high := -1
97
98	function 'cast Int' i -> j
99	arg Int64 i ; arg Int j
100	reduction ; has_no_side_effect
101	check (i:high=0 and i:low<80000000h) or (i:high=(-1) and i:low>=80000000h) "The value is too large to fit in an Int"
102	j := i low
103
104	function 'cast Intn' i -> j
105	arg Int64 i ; arg Intn j
106	extension ; has_no_side_effect
107	j 'please resize' 2
108	memory_copy addressof:i j:'please bits' uInt64:size
109	j 'please status' := 'please positive'
110	j 'please shrink'
111	if i:high<0
112	j := j - 2n^64
113
114	function raw_convert i j
115	arg Intn i ; arg_w Int64 j
116	var uInt p := i 'please read_lock'
117	if i:'please size'>0
118	j low := i:'please bits' map uInt
119	else
120	j low := 0
121	if i:'please size'>1
122	j high := (i:'please bits' translate uInt 1) map Int
123	else
124	j high := 0
125
126	function 'cast Int64' i -> j
127	arg Intn i ; arg Int64 j
128	reduction ; has_no_side_effect
129	var uInt p := i 'please read_lock'
130	if p='please positive'
131	raw_convert i j
132	if i:'please size'>2 or j:high<0
133	error error_id_arithmetic "The value is too large to fit in an Int64"
134	else
135	raw_convert i+2n^64 j
136	if i:'please size'>2 or j:high>=0
137	error error_id_arithmetic "The value is too large to fit in an Int64"
138	i 'please read_unlock'
139
140	export Int64 compare 'cast Int64' 'cast Int' 'cast Intn' 'cast Int64'