/pliant/language/type/number/intn.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
19
20	constant please_retry 0FFFFFFFFh
21	constant read_locks   1FFFFFFFh
22	constant write_locked 20000000h
23	constant undefinedn   40000000h
24	constant positive     80000000h
25
26
27	type Intn
28	field Address bits
29	field Int size
30	field uInt status
31
32
33
34	#  locking and resizing
35
36
37	method i get_status -> status
38	arg Intn i ; arg uInt status
39	while true
40	status := atomic_read_and_set ((addressof i:status) map uInt) please_retry
41	if status<>please_retry
42	return
43
44	method i read_lock -> i_is_positive
45	arg Intn i ; arg uInt i_is_positive
46	while true
47	var uInt status := i get_status
48	if (status .and. write_locked)=0
49	(addressof i:status) map uInt := status+1
50	i_is_positive := status .and. positive
51	return
52	else
53	(addressof i:status) map uInt := status
54	os_yield
55
56	method i read_unlock
57	arg Intn i
58	(addressof i:status) map uInt := i:get_status-1
59
60	method i write_lock
61	arg_rw Intn i
62	while true
63	var uInt status := i get_status
64	if (status .and. read_locks+write_locked)=0
65	i status := status+write_locked
66	return
67	else
68	i status := status
69	os_yield
70
71	method i write_unlock
72	arg_rw Intn i
73	i status := i:get_status-write_locked
74
75
76	method i extend2 n
77	arg_rw Intn i ; arg Int n
78	if n*uInt:size>(memory_size i:bits)
79	i bits := memory_zresize i:bits n*uInt:size addressof:i
80
81	method i extend n
82	arg Intn i ; arg Int n
83	while n*uInt:size>(memory_size i:bits)
84	i read_unlock
85	(addressof:i map Intn) write_lock
86	(addressof:i map Intn) extend2 n
87	(addressof:i map Intn) write_unlock
88	i read_lock
89
90
91	method i resize n
92	arg_rw Intn i ; arg Int n
93	if n<i:size
94	memory_clear (i:bits translate uInt n) (i:size-n)*uInt:size
95	eif n*uInt:size>(memory_size i:bits)
96	i bits := memory_zresize i:bits n*uInt:size addressof:i
97	i size := n
98
99
100	method i zresize n
101	arg_rw Intn i ; arg Int n
102	memory_clear i:bits i:size*uInt:size
103	if n*uInt:size>(memory_size i:bits)
104	i bits := memory_zresize i:bits n*uInt:size addressof:i
105	i size := n
106
107
108	method i shrink
109	arg_rw Intn i
110	while i:size>0 and ((i:bits translate uInt i:size-1) map uInt)=0
111	i size := i:size-1
112	if i:size=0
113	i status := positive
114
115
116
117	#  basic operations
118
119
120	method i nbbits -> n
121	arg uInt i ; arg Int n
122	if i<2^4
123	n := shunt i=0 0 i<2 1 i<4 2 i<8 3 4
124	eif i<2^8
125	n := 4+(i\2^4 nbbits)
126	eif i<2^16
127	n := 8+(i\2^8 nbbits)
128	else
129	n := 16+(i\2^16 nbbits)
130
131	method i nbbits -> n
132	arg Intn i ; arg Int n
133	if i:size<>0
134	n := (i:size-1)*uInt:bitsize + ((i:bits translate uInt i:size-1) map uInt):nbbits
135	else
136	n := 0
137
138
139	method i set_bit u
140	arg_rw Intn i ; arg Int u
141	check u>=0 and u<i:size*uInt:bitsize
142	var Pointer:uInt bloc :> (i:bits translate uInt u\uInt:bitsize) map uInt
143	bloc := bloc .or. 2^(u%uInt:bitsize)
144
145
146	method i test_bit u -> on
147	arg Intn i ; arg Int u ; arg CBool on
148	check u>=0 and u<i:size*uInt:bitsize
149	var Pointer:uInt bloc :> (i:bits translate uInt u\uInt:bitsize) map uInt
150	on := (bloc .and. 2^(u%uInt:bitsize))<>0
151
152
153	function unsigned_compare a b -> r
154	arg Intn a b ; arg Int r
155	if a:size<>b:size
156	return (shunt a:size>b:size compare_superior compare_inferior)
157	for (var Int i) a:size-1 0 step -1
158	var uInt ai := (a:bits translate uInt i) map uInt
159	var uInt bi := (b:bits translate uInt i) map uInt
160	if ai>bi
161	return compare_superior
162	eif ai<bi
163	return compare_inferior
164	return compare_equal
165
166
167	if uInt:size=4
168	alias Half uInt16 from "/pliant/language/type/number/int_sized.pli"
169	eif uInt:size=8
170	alias Half uInt32 from "/pliant/language/type/number/int_sized.pli"
171
172
173	function add a b r size
174	arg Address a b r ; arg Int size
175	var uInt carry := 0
176	for (var Int i) 0 2*size-1
177	carry := carry + ((a translate Half i) map Half) + ((b translate Half i) map Half)
178	if carry<2^Half:bitsize
179	(r translate Half i) map Half := carry
180	carry := 0
181	else
182	(r translate Half i) map Half := carry - 2^Half:bitsize
183	carry := 1
184	check carry=0
185
186
187	function sub a b r size
188	arg Address a b r ; arg Int size
189	var Int carry := 0
190	for (var Int i) 0 2*size-1
191	carry := carry + ((a translate Half i) map Half) - ((b translate Half i) map Half)
192	if carry>=0
193	(r translate Half i) map Half := carry
194	carry := 0
195	else
196	(r translate Half i) map Half := carry + 2^Half:bitsize
197	carry := -1
198	check carry=0
199
200
201	function add_mul src dest size factor
202	arg Address src dest ; arg Int size ; arg uInt factor
203	var uInt carry := 0
204	for (var Int i) 0 size*2-1
205	carry := carry + ((dest translate Half i) map Half) + ((src translate Half i) map Half) * factor
206	(dest translate Half i) map Half := carry .and. 2^Half:bitsize-1
207	carry := carry \ 2^Half:bitsize
208	var Int i := size*2
209	while carry<>0
210	carry := carry + ((dest translate Half i) map Half)
211	(dest translate Half i) map Half := carry .and. 2^Half:bitsize-1
212	carry := carry \ 2^Half:bitsize
213	i := i+1
214
215
216
217	#  shifted
218
219
220	method i bloc u -> r
221	arg Intn i ; arg Int u ; arg uInt r
222	if u>=0 and u<i:size
223	r := (i:bits translate uInt u) map uInt
224	else
225	r := 0
226
227
228	function do_shift low high shift -> result
229	arg uInt low high result ; arg Int shift
230	check shift>=0 and shift<uInt:bitsize
231	if shift<>0
232	result := (low \ 2^(uInt:bitsize-shift)) .or. (high .*. 2^shift)
233	else
234	result := high
235
236
237	method i size_shifted shift -> r
238	arg Intn i ; arg Int shift ; arg Int r
239	r := i:size+(shift+uInt:bitsize-1)\uInt:bitsize
240
241
242	method i bloc_shifted u shift -> r
243	arg Intn i ; arg Int u shift ; arg uInt r
244	var Int t := u.-.shift\uInt:bitsize
245	var Int s := shift%uInt:bitsize
246	r := do_shift (i bloc t.-.1) (i bloc t) s
247
248
249	function unsigned_compare_shifted1 a b b_shift -> r
250	arg Intn a b ; arg Int b_shift ; arg Int r
251	for (var Int i) (max a:size (b size_shifted b_shift))-1 0 step -1
252	var uInt ai := a bloc i
253	var uInt bi := b bloc_shifted i b_shift
254	if ai>bi
255	return compare_superior
256	eif ai<bi
257	return compare_inferior
258	return compare_equal
259
260
261	constant dl pliant_debugging_level
262	if dl>=4
263
264	function unsigned_compare_shifted2 a b b_shift -> r
265	arg Intn a b ; arg Int b_shift ; arg Int r
266	for (var Int i) (max a:nbbits b:nbbits+b_shift) 0 step -1
267	var CBool ai := shunt i<a:size*uInt:bitsize (a test_bit i) false
268	var CBool bi := shunt i-b_shift>=0 and i-b_shift<b:size*uInt:bitsize (b test_bit i-b_shift) false
269	if ai<>bi
270	return (shunt ai compare_superior compare_inferior)
271	return compare_equal
272
273
274	function unsigned_compare_shifted a b b_shift -> r
275	arg Intn a b ; arg Int b_shift ; arg Int r
276	var Int r1 := unsigned_compare_shifted1 a b b_shift
277	var Int r2 := unsigned_compare_shifted2 a b b_shift
278	check r1=r2
279	r := r1
280
281	else
282
283	alias unsigned_compare_shifted unsigned_compare_shifted1
284
285
286	function sub1 src dest carry
287	arg Half src ; arg_rw Half dest ; arg_rw Int carry
288	carry := carry + (addressof:dest map Half) - (addressof:src map Half)
289	if carry>=0
290	addressof:dest map Half := carry
291	carry := 0
292	else
293	addressof:dest map Half := carry + 2^Half:bitsize
294	carry := -1
295
296
297	function sub2 src dest carry
298	arg uInt src ; arg_rw uInt dest ; arg_rw Int carry
299	sub1 (addressof:src map Half) (addressof:dest map Half) carry
300	sub1 ((addressof:src translate Half 1) map Half) ((addressof:dest translate Half 1) map Half) carry
301
302
303	function sub_shifted src dest size src_shift
304	arg Address src dest ; arg Int size src_shift
305	var Int t := src_shift\uInt:bitsize
306	var Int s := src_shift%uInt:bitsize
307	var Int carry := 0
308	for (var Int i) 0 size
309	var uInt32 shifted := do_shift (shunt i>0 ((src translate uInt i-1) map uInt) 0) ((src translate uInt i) map uInt) s
310	sub2 shifted ((dest translate uInt i+t) map uInt) carry
311	var Int i := t+size*2
312	while carry<>0
313	carry := carry + ((dest translate Half i) map Half)
314	if carry>=0
315	(dest translate Half i) map Half := carry
316	carry := 0
317	else
318	(dest translate Half i) map Half := carry + 2^Half:bitsize
319	carry := -1
320	i := i+1
321
322
323
324	#  generic operations
325
326
327	function build  i
328	arg_w Intn i
329	i bits := null
330	i size := 0
331	i status := positive
332
333
334	function destroy i
335	arg_w Intn i
336	memory_free i:bits
337
338
339	function copy src dest
340	arg Intn src ; arg_w Intn dest
341	src read_lock
342	dest resize src:size
343	memory_copy src:bits dest:bits src:size*uInt:size
344	src read_unlock
345	dest status := src:status .and. (positive .or. undefinedn)
346
347
348	function compare a b -> r
349	arg Intn a b ; arg Int r
350	if (a:status .and. undefinedn)<>0 or (b:status .and. undefinedn)<>0
351	return (shunt (a:status .and. undefinedn)=(b:status .and. undefinedn) compare_equal (a:status .and. undefinedn)<>0 compare_inferior compare_superior)
352	var uInt pa := a read_lock ; var uInt pb := b read_lock
353	if pa<>pb
354	r := shunt pa<>0 compare_superior compare_inferior
355	else
356	r := (unsigned_compare a b) .xor. (shunt pa=positive 0 compare_inferior+compare_superior)
357	a read_unlock ; b read_unlock
358
359
360
361	#  + - *
362
363
364	function '+' a b -> r
365	arg Intn a b r
366	has_no_side_effect
367	var uInt pa := a read_lock ; var uInt pb := b read_lock
368	if pa=pb
369	r status := pa
370	var Int n := (max a:size b:size)+1
371	a extend n ; b extend n ; r resize n
372	add a:bits b:bits r:bits n
373	eif (unsigned_compare a b)<>compare_inferior
374	r status := pa
375	var Int n := a size
376	b extend n ; r resize n
377	sub a:bits b:bits r:bits n
378	else
379	r status := pb
380	var Int n := b size
381	a extend n ; r resize n
382	sub b:bits a:bits r:bits n
383	a read_unlock ; b read_unlock
384	r shrink
385
386
387	function '-' a b -> r
388	arg Intn a b r
389	has_no_side_effect
390	var uInt pa := a read_lock ; var uInt pb := b read_lock
391	if pa<>pb
392	r status := pa
393	var Int n := (max a:size b:size)+1
394	a extend n ; b extend n ; r resize n
395	add a:bits b:bits r:bits n
396	eif (unsigned_compare a b)<>compare_inferior
397	r status := pa
398	var Int n := a size
399	b extend n ; r resize n
400	sub a:bits b:bits r:bits n
401	else
402	r status := positive-pb
403	var Int n := b size
404	a extend n ; r resize n
405	sub b:bits a:bits r:bits n
406	a read_unlock ; b read_unlock
407	r shrink
408
409
410	function '*' a b -> r
411	arg Intn a b r
412	has_no_side_effect
413	var uInt pa := a read_lock ; var uInt pb := b read_lock
414	r zresize a:size+b:size
415	r status := shunt pa=pb positive 0
416	for (var Int i) 0 2*b:size-1
417	add_mul a:bits (r:bits translate Half i) a:size ((b:bits translate Half i) map Half)
418	a read_unlock ; b read_unlock
419	r shrink
420
421
422	function divide a b q r
423	arg Intn a b ; arg_w Intn q r
424	has_no_side_effect
425	check b:size<>0 "Attempted to divide by 0"
426	var uInt pa := a read_lock ; var uInt pb := b read_lock
427	if b:size<>1 or (b:bits map uInt)>=2^Half:bitsize
428	var Int s := a:nbbits-b:nbbits
429	r := a
430	if s>=0
431	b extend b:size+1
432	q zresize s\uInt:bitsize+1 ; q status := shunt pa=pb positive 0
433	r extend2 r:size+1
434	for (var Int i) s 0 step -1
435	if (unsigned_compare_shifted r b i)<>compare_inferior
436	q set_bit i
437	sub_shifted b:bits r:bits b:size i
438	# check (unsigned_compare_shifted r b i)=compare_inferior
439	r shrink
440	else
441	q resize 0
442	q shrink
443	else
444	var uInt d := b:bits map uInt
445	var uInt carry := 0
446	q resize a:size ; q status := shunt pa=pb positive 0
447	for (var Int i) 2*a:size-1 0 step -1
448	carry := carry*2^Half:bitsize + ((a:bits translate Half i) map Half)
449	(q:bits translate Half i) map Half := carry\d
450	carry := carry%d
451	q shrink
452	if carry=0
453	r resize 0 ; r status := positive
454	else
455	r resize 1 ; r:bits map uInt := carry ; r status := pa
456	check (unsigned_compare r b)=compare_inferior
457	a read_unlock ; b read_unlock
458
459
460	function '\' a b -> q
461	arg Intn a b q
462	has_no_side_effect
463	var Intn r t
464	if addressof:q<>addressof:a and addressof:q<>addressof:b
465	divide a b q r
466	else
467	t := a\b
468	q := t
469
470
471	function '%' a b -> r ## section "remain"
472	arg Intn a b r
473	has_no_side_effect
474	var Intn q t
475	if addressof:r<>addressof:a and addressof:r<>addressof:b
476	divide a b q r
477	else
478	t := a%b
479	r := t
480
481
482
483	#  casting
484
485
486	function 'cast Intn' i -> j
487	arg Int i ; arg Intn j
488	extension ; has_no_side_effect
489	if i=undefined
490	j resize 0 ; j status := undefinedn
491	eif i=0
492	j resize 0 ; j status := positive
493	eif i>0
494	j resize 1 ; j:bits map uInt := cast i uInt ; j status := positive
495	else
496	j resize 1 ; j:bits map uInt := cast -i uInt ; j status := 0
497
498
499	function 'cast Int' i -> j
500	arg Intn i ; arg Int j
501	reduction ; has_no_side_effect
502	if i:size=0
503	if (i:status .and. undefinedn)<>0
504	j := undefined
505	else
506	j := 0
507	eif i:size=1 and ((i:bits map uInt) .and. 2^(uInt:bitsize-1))=0
508	var uInt p := i read_lock
509	j := shunt p=positive (i:bits map uInt) -(i:bits map uInt)
510	i read_unlock
511	else
512	error error_id_arithmetic "The value is too large to fit in an integer"
513
514
515	function 'cast Intn' i -> j
516	arg uInt i ; arg Intn j
517	extension ; has_no_side_effect
518	if i=0
519	j resize 0 ; j status := positive
520	else
521	j resize 1 ; j:bits map uInt := i ; j status := positive
522
523
524	function 'cast uInt' i -> j
525	arg Intn i ; arg uInt j
526	reduction ; has_no_side_effect
527	if i:size=0
528	j := 0
529	eif i:size=1
530	var uInt p := i read_lock
531	if p<>positive
532	error error_id_unexpected "The integer is negative"
533	j := i:bits map uInt
534	i read_unlock
535	else
536	error error_id_arithmetic "The value is too large to fit in an integer"
537
538
539	function 'cast Float' n -> f
540	arg Intn n ; arg Float f
541	explicit
542	f := 0
543	var Intn r := n ; var Float d := 1
544	while r<(-(2^30)) or r>2^30
545	f += (cast r%2^15 Int)*d
546	r \= 2^15 ; d *= 2^15
547	f += (cast r Int)*d
548
549
550
551	#  ^
552
553
554	method x apply_modulus m
555	arg_rw Intn x ; arg Intn m
556	check m>0 "Modulus value must be positive"
557	m read_lock
558	var Int s := x:nbbits - m:nbbits
559	if s>=0
560	x extend2 x:size+1
561	m extend m:size+1
562	for (var Int i) s 0 step -1
563	if (unsigned_compare_shifted x m i)<>compare_inferior
564	sub_shifted m:bits x:bits m:size i
565	x shrink
566	# check (unsigned_compare_shifted x m i)=compare_inferior
567	check (unsigned_compare x m)=compare_inferior
568	m read_unlock
569
570
571	function power_modulus a b m -> r
572	arg Intn a b m r
573	has_no_side_effect
574	check addressof:m=null or m>0 "Modulus value must be positive"
575	r := 1 ; var Intn p := a
576	var Int n := b nbbits
577	for (var Int i) 0 n-1
578	if (b test_bit i)
579	r := r*p
580	if addressof:m<>null
581	r apply_modulus m
582	if i=n-1
583	return
584	p := p*p
585	if addressof:m<>null
586	p apply_modulus m
587
588
589	function '^' a b -> r
590	arg Intn a b r
591	has_no_side_effect
592	r := power_modulus a b (null map Intn)
593
594
595	meta '%' e
596	strong_definition
597	if e:size<>2
598	return
599	e:0 compile ?
600	e:1 compile ?
601	var Link:Instruction i :> e:0:instructions:last map Instruction
602	if addressof:i=null or (addressof i:function)<>addressof:(the_function '^' Intn Intn -> Intn)
603	return
604	if (addressof e:0:result)<>(addressof i:2)
605	return
606	if not (e:1 cast Intn)
607	return
608	# console "found x^y%n at "+e:position+"[lf]"
609	i size := 4
610	i 3 :> i 2
611	i 2 :> e:1:result
612	i function :> the_function power_modulus Intn Intn Intn -> Intn
613	e suckup e:1 ; e suckup e:0
614	e set_result e:0:result access_read
615
616
617
618
619
620	function 'cast Status' i -> s
621	arg Intn i ; arg Status s
622	explicit
623	if (i:status .and. undefinedn)<>0
624	s := undefined
625	else
626	s := defined
627
628	function 'cast Intn' s -> i
629	arg Status s ; arg Intn i
630	extension
631	if pliant_debugging_level>=2
632	if s<>undefined
633	error error_id_unexpected "Unexpected Status value"
634	i resize 0
635	i status := undefinedn
636
637
638
639
640
641	function to_string i -> s
642	arg Intn i ; arg Str s
643	has_no_side_effect
644	if i:size=0
645	s := "0"
646	eif i:size=1 and (i:bits map uInt)<2^(Int:bitsize-1)
647	s := 'convert to string' (cast i Int)
648	eif false # faster, but does not worse the extra complexity
649	var Int reserved := i:nbbits\3+2
650	var Address buffer := memory_allocate reserved null
651	var Address cursor := buffer translate Byte reserved
652	var Intn cur := i
653	while cur:size>1 or (cur:bits map uInt)>=2^(Int:bitsize-1)
654	divide cur 10000 (var Intn remain) (var Intn r)
655	var Str temp := right ('convert to string' (cast r Int)) 4 "0"
656	cursor := cursor translate Byte -4
657	memory_copy temp:characters cursor 4
658	cur := remain
659	temp := 'convert to string' (cast cur Int)
660	cursor := cursor translate Byte -(temp:len)
661	memory_copy temp:characters cursor temp:len
662	if p=0
663	cursor := cursor translate uInt8 -1
664	cursor map uInt8 := "-":number
665	var Int length := (cast buffer Int) .+. reserved .-. (cast cursor Int)
666	check length<=reserved
667	var Address final := memory_allocate length addressof:s
668	memory_copy cursor final length
669	s set final length true
670	memory_free buffer
671	else
672	s := ""
673	var Intn cur := i
674	while cur:size>1 or (cur:bits map uInt)>=2^(Int:bitsize-1)
675	divide cur 10000 (var Intn remain) (var Intn r)
676	s := (right ('convert to string' (cast r Int)) 4 "0")+s
677	cur := remain
678	s := ('convert to string' (cast cur Int))+s
679
680
681	method data 'to string' options -> string
682	arg Intn data ; arg Str options ; arg Str string
683	if (data:status .and. undefinedn)<>0
684	return (shunt options="db" or options="raw" "" "?")
685	string := to_string data
686	if options:len<>0 and { var Str sep := options option "separated" Str ; sep:len=1 }
687	var Int newlen := string:len+(string:len-1)\3
688	var Address buf := memory_allocate newlen null
689	var Address stop := string:characters translate Char -1
690	var Address src := stop translate Char string:len
691	var Address dest := buf translate Char newlen-1
692	var Int r := 3
693	while src<>stop
694	if r=0
695	dest map Char := sep 0
696	dest := dest translate Byte -1
697	r := 3
698	dest map Char := src map Char
699	src := src translate Byte -1
700	dest := dest translate Byte -1
701	r := r-1
702	string set buf newlen true
703
704	method data 'from string' string options may_skip skiped offset -> status
705	arg_w Intn data ; arg Str string options ; arg CBool may_skip ; arg_w Int skiped offset ; arg Status status
706	var Int stop := string:len-1
707	if not may_skip and stop<>(-1)
708	stop := 0
709	for (var Int i) 0 stop
710	var Int c0 := string:i number
711	if c0>="0":0:number and c0<="9":0:number or c0="?":0:number or (c0="-":0:number and i+1<>string:len and string:(i+1):number>="0":0:number and string:(i+1):number<="9":0:number)
712	skiped := i
713	if c0="?":0:number
714	data := undefined
715	offset := i+1
716	return success
717	data := 0 ; var Int sign := 1
718	if c0="-":0:number
719	sign := -1
720	i := i+1
721	while i<string:len and string:i:number>="0":0:number and string:i:number<="9":0:number
722	data := data*10 + string:i:number-"0":0:number
723	i := i+1
724	data := data * sign
725	offset := i
726	return success
727	eif c0="?":0:number
728	data := undefined
729	skiped := i
730	offset := i+1
731	return success
732	data := undefined
733	status := shunt string="" and (options="db" or options="raw") success failure
734
735
736	function parse_intn context line parameter
737	arg_rw ParserContext context ; arg Str line ; arg Address parameter
738	if (from_string addressof:(var Intn data) Intn line "" false (var Int skip) (var Int offset))=failure
739	return
740	if line:0:number="-":0:number or line:0:number="?":0:number
741	return
742	if offset=line:len or line:offset:number<>"n":0:number
743	return
744	if offset+1<>line:len and line:(offset+1):isidentcharacter
745	return
746	var Link:Intn i :> new Intn
747	i := data
748	context add_token addressof:i
749	context forward offset+1
750
751	gvar ParserFilter intn_filter
752	intn_filter function :> the_function parse_intn ParserContext Str Address
753	constant 'pliant parser basic types' intn_filter
754	export 'pliant parser basic types'
755
756
757
758
759
760	method i binary_encode -> s
761	arg Intn i ; arg Str s
762	var Int sign := shunt i:read_lock=positive 0 1
763	var Int l := (i:nbbits+7)\8
764	s set (memory_allocate l+sign addressof:s) l+sign true
765	memory_copy i:bits s:characters l
766	if sign<>0
767	s l := character 0
768	i read_unlock
769
770	method i binary_decode s always_positive
771	arg_w Intn i ; arg Str s ; arg CBool always_positive
772	var Int l := s len ; var uInt stat := positive
773	if not always_positive and l>0 and (s l-1):number=0
774	stat := 0 ; l -= 1
775	i resize (l+uInt:size-1)\uInt:size ; i status := stat
776	if i:size>0
777	(i:bits translate uInt i:size-1) map uInt := 0
778	memory_copy s:characters i:bits s:len
779	i shrink
780
781
782
783
784
785	export Intn '. nbbits' '+' '-' '*' '\' '%' '^'
786	export 'cast Intn' 'cast Int' 'cast uInt' 'cast Float' compare
787	export '. apply_modulus' '. binary_encode' '. binary_decode'
788
789	alias '. please read_lock' '. read_lock'
790	export '. please read_lock'
791
792	alias '. please read_unlock' '. read_unlock'
793	export '. please read_unlock'
794
795	alias '. please resize' '. resize'
796	export '. please resize'
797
798	alias '. please shrink' '. shrink'
799	export '. please shrink'
800
801	alias '. please bits' '. bits'
802	export '. please bits'
803
804	alias '. please size' '. size'
805	export '. please size'
806
807	alias '. please status' '. status'
808	export '. please status'
809
810	alias 'please positive' positive
811	export 'please positive'