1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
|
(* file kernel/pascal/p/xlong.p: Pascal extensible integer definitions
+-----------------------------------------------------------------------+
| Copyright 2005-2006, Michel Quercia (michel.quercia@prepas.org) |
| |
| This file is part of Numerix. Numerix is free software; you can |
| redistribute it and/or modify it under the terms of the GNU Lesser |
| General Public License as published by the Free Software Foundation; |
| either version 2.1 of the License, or (at your option) any later |
| version. |
| |
| The Numerix Library is distributed in the hope that it will be |
| useful, but WITHOUT ANY WARRANTY; without even the implied warranty |
| of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| Lesser General Public License for more details. |
| |
| You should have received a copy of the GNU Lesser General Public |
| License along with the GNU MP Library; see the file COPYING. If not, |
| write to the Free Software Foundation, Inc., 59 Temple Place - |
| Suite 330, Boston, MA 02111-1307, USA. |
+-----------------------------------------------------------------------+
| |
| Dfinitions pour l'interface Pascal |
| |
+-----------------------------------------------------------------------*)
unit _name_;
interface
(* compiler dependant code *)
{$ifdef __GPC__}
{$W no-underscore}{$X+}
type int = integer;
{$else}
type int = longint;
{$endif}
(* Numerix Pascal-library, public interface
Pascal extensible integers are defined as pointers to structures containing
two fields of long type ...
THIS IS NOT THE REALITY
... but it will be enough to make the Pascal compiler happy without having
to include all the low-level Numerix headers.
Please,
1. never make an xint of your own by directing some pointer towards
a double-long structure. Use only the functions described below
to build xint values.
2. never use an xint created for one mode (clong/dlong/slong) with
functions dealing with another mode.
3. never use pointer arithmetic on xints.
*)
type _xint = record lmax : int; hd : int; end; (* white lie *)
type xint = ^_xint;
type tristate = (t_false, t_unknown, t_true);
(* creation/destruction *)
function xnew : xint;
procedure xfree(var x : xint);
(* addition/soustraction *)
procedure add (var c:xint; a:xint; b:xint);
procedure sub (var c:xint; a:xint; b:xint);
procedure add_1(var c:xint; a:xint; b:int);
procedure sub_1(var c:xint; a:xint; b:int);
function f_add (a:xint; b:xint ):xint;
function f_sub (a:xint; b:xint ):xint;
function f_add_1(a:xint; b:int):xint;
function f_sub_1(a:xint; b:int):xint;
(* comparaison *)
function cmp (a:xint; b:xint):int; _cdecl_ external name 'xx(cmp)';
function cmp_1 (a:xint; b:int ):int; _cdecl_ external name 'xx(cmp_1)';
function sgn (a:xint ):int;
function eq (a:xint; b:xint):boolean;
function neq (a:xint; b:xint):boolean;
function inf (a:xint; b:xint):boolean;
function infeq (a:xint; b:xint):boolean;
function sup (a:xint; b:xint):boolean;
function supeq (a:xint; b:xint):boolean;
function eq_1 (a:xint; b:int ):boolean;
function neq_1 (a:xint; b:int ):boolean;
function inf_1 (a:xint; b:int ):boolean;
function infeq_1(a:xint; b:int ):boolean;
function sup_1 (a:xint; b:int ):boolean;
function supeq_1(a:xint; b:int ):boolean;
(* conversions *)
procedure copy_int(var b:xint; a:int); _cdecl_ external name 'xx(copy_int)';
function of_int(a:int):xint;
function int_of (a:xint ):int; _cdecl_ external name 'xx(int_of)';
function nbits (a:xint ):int; _cdecl_ external name 'xx(nbits)';
function lowbits (a:xint ):int; _cdecl_ external name 'xx(lowbits)';
function highbits(a:xint ):int; _cdecl_ external name 'xx(highbits)';
function nth_word(a:xint; n:int):int; _cdecl_ external name 'xx(nth_word)';
function nth_bit (a:xint; n:int):boolean; _cdecl_ external name 'xx(nth_bit)';
(* copie *)
procedure copy (var b:xint; a:xint);
procedure abs (var b:xint; a:xint);
procedure neg (var b:xint; a:xint);
function f_copy(a:xint):xint;
function f_abs (a:xint):xint;
function f_neg (a:xint):xint;
(* division *)
procedure quomod (var c,d:xint; a:xint; b:xint);
procedure quo (var c :xint; a:xint; b:xint);
procedure modulo (var d :xint; a:xint; b:xint);
procedure quomod_1 (var c :xint; a:xint; b:int );
procedure quo_1 (var c :xint; a:xint; b:int );
function mod_1 (a:xint; b:int ):int;
procedure gquomod (var c,d:xint; a:xint; b:xint; mode:int);
procedure gquo (var c :xint; a:xint; b:xint; mode:int);
procedure gmod (var d :xint; a:xint; b:xint; mode:int);
function gquomod_1(var c :xint; a:xint; b:int; mode:int):int;
procedure gquo_1 (var c :xint; a:xint; b:int; mode:int);
function gmod_1 (a:xint; b:int; mode:int):int;
function f_quo (a:xint; b:xint):xint;
function f_mod (a:xint; b:xint):xint;
function f_quo_1 (a:xint; b:int ):xint;
function f_mod_1 (a:xint; b:int ):int;
function f_gquo (a:xint; b:xint; mode:int):xint;
function f_gmod (a:xint; b:xint; mode:int):xint;
function f_gquo_1 (a:xint; b:int; mode:int):xint;
function f_gmod_1 (a:xint; b:int; mode:int):int;
(* affichage hexadcimal *)
procedure dump(a:xint); _cdecl_ external name 'xx(dump)';
(* factorielle *)
procedure fact(var a:xint; n:int); _cdecl_ external name 'xx(fact)';
function f_fact(n:int):xint;
(* pgcd *)
procedure gcd (var d:xint; a,b:xint);
procedure gcd_ex(var d,u,v:xint; a,b:xint);
procedure cfrac (var d,u,v,p,q:xint; a,b:xint);
function f_gcd(a,b:xint):xint;
(* primalit *)
function isprime (a:xint):tristate; _cdecl_ external name 'xx(isprime)';
function isprime_1(a:int ):tristate; _cdecl_ external name 'xx(isprime_1)';
(* multiplication *)
procedure mul (var c:xint; a:xint; b:xint ); _cdecl_ external name 'xx(mul)';
procedure mul_1(var c:xint; a:xint; b:int); _cdecl_ external name 'xx(mul_1)';
procedure sqr (var b:xint; a:xint); _cdecl_ external name 'xx(sqr)';
function f_mul (a:xint; b:xint):xint;
function f_mul_1(a:xint; b:int ):xint;
function f_sqr (a:xint):xint;
(* exponentiation *)
procedure power (var b:xint; a:xint; p:int); _cdecl_ external name 'xx(pow)';
procedure pow_1 (var b:xint; a:int; p:int); _cdecl_ external name 'xx(pow_1)';
procedure powmod (var d:xint; a:xint; b:xint; c:xint);
procedure gpowmod(var d:xint; a:xint; b:xint; c:xint; mode:int);
function f_pow (a:xint; p:int):xint;
function f_pow_1 (a:int; p:int):xint;
function f_powmod (a:xint; b:xint; c:xint):xint;
function f_gpowmod(a:xint; b:xint; c:xint; mode:int):xint;
(* nombres alatoires *)
procedure random_init(n:int); _cdecl_ external name 'xx(random_init)';
procedure nrandom (var a:xint; n:int);
procedure zrandom (var a:xint; n:int);
procedure nrandom1(var a:xint; n:int);
procedure zrandom1(var a:xint; n:int);
function f_nrandom (n:int):xint;
function f_zrandom (n:int):xint;
function f_nrandom1(n:int):xint;
function f_zrandom1(n:int):xint;
(* racines *)
procedure sqrt (var b:xint; a:xint);
procedure gsqrt(var b:xint; a:xint; mode:int);
procedure root (var b:xint; a:xint; p:int);
procedure groot(var b:xint; a:xint; p:int; mode:int);
function f_sqrt (a:xint ):xint;
function f_gsqrt(a:xint; mode: int):xint;
function f_root (a:xint; p: int):xint;
function f_groot(a:xint; p,mode:int):xint;
(* dcalages *)
procedure shiftl(var b:xint; a:xint; n:int);
procedure shiftr(var b:xint; a:xint; n:int);
function f_shl(a:xint; n:int):xint;
function f_shr(a:xint; n:int):xint;
procedure split(var b,c:xint; a:xint; n:int); _cdecl_ external name 'xx(split)';
procedure join(var c:xint; a:xint; b:xint; n:int); _cdecl_ external name 'xx(join)';
function f_join(a:xint; b:xint; n:int):xint;
(* conversion en chaine *)
procedure copy_string (var a:xint; s:pchar); _cdecl_ external name 'xx(copy_string)';
procedure copy_pstring(var a:xint; s:string);
function of_string (s:pchar ):xint;
function of_pstring(s:string):xint;
function string_of (a:xint):pchar; _cdecl_ external name 'xx(string_of)';
function hstring_of(a:xint):pchar; _cdecl_ external name 'xx(hstring_of)';
function ostring_of(a:xint):pchar; _cdecl_ external name 'xx(ostring_of)';
function bstring_of(a:xint):pchar; _cdecl_ external name 'xx(bstring_of)';
(* interface avec les fonctions de manipulation de chanes de la libc *)
function strlen (s:pchar):int; _cdecl_ external name 'strlen';
function strcpy (dest,source:pchar ):pchar; _cdecl_ external name 'strcpy';
function strncpy(dest,source:pchar; l:int):pchar; _cdecl_ external name 'strncpy';
function strcat (dest,source:pchar ):pchar; _cdecl_ external name 'strcat';
function strncat(dest,source:pchar; l:int):pchar; _cdecl_ external name 'strncat';
function strdup (s:pchar ):pchar; _cdecl_ external name 'strdup';
function strndup(s:pchar; l:int):pchar; _cdecl_ external name 'strndup';
function strcmp (s1,s2:pchar ):int; _cdecl_ external name 'strcmp';
function strncmp(s1,s2:pchar; l:int):int; _cdecl_ external name 'strncmp';
function stralloc(l:int):pchar; _cdecl_ external name 'malloc';
procedure strfree(s:pchar); _cdecl_ external name 'free';
(* chronomtrage *)
procedure chrono(msg:pchar); _cdecl_ external name 'chrono';
(*----------------------------- end of interface ---------------------------- *)
implementation
_links_
type pxint = ^xint;
(* creation/destruction *)
function xnew : xint; begin xnew := NIL; end;
procedure free(x : pointer); _cdecl_ external name 'free';
procedure xfree(var x: xint);
begin
if x <> NIL then begin free(x); x := NIL; end;
end;
(* addition/soustraction *)
procedure private_add (var x:xint; a,b:xint; s:int); _cdecl_ external name 'xx(private_add)';
procedure private_add_1(var x:xint; a:xint; b,s:int); _cdecl_ external name 'xx(private_add_1)';
procedure add (var c:xint; a:xint; b:xint); begin private_add (c,a,b,0); end;
procedure sub (var c:xint; a:xint; b:xint); begin private_add (c,a,b,1); end;
procedure add_1(var c:xint; a:xint; b:int ); begin private_add_1(c,a,b,0); end;
procedure sub_1(var c:xint; a:xint; b:int ); begin private_add_1(c,a,b,1); end;
function f_add (a:xint; b:xint):xint; var c:xint; begin c:=xnew; private_add (c,a,b,0); f_add :=c; end;
function f_sub (a:xint; b:xint):xint; var c:xint; begin c:=xnew; private_add (c,a,b,1); f_sub :=c; end;
function f_add_1(a:xint; b:int ):xint; var c:xint; begin c:=xnew; private_add_1(c,a,b,0); f_add_1:=c; end;
function f_sub_1(a:xint; b:int ):xint; var c:xint; begin c:=xnew; private_add_1(c,a,b,1); f_sub_1:=c; end;
(* comparaison *)
function sgn (a:xint ):int; begin sgn := cmp_1(a,0); end;
function eq (a:xint; b:xint):boolean; begin eq := cmp (a,b) = 0; end;
function neq (a:xint; b:xint):boolean; begin neq := cmp (a,b) <> 0; end;
function inf (a:xint; b:xint):boolean; begin inf := cmp (a,b) < 0; end;
function infeq (a:xint; b:xint):boolean; begin infeq := cmp (a,b) <= 0; end;
function sup (a:xint; b:xint):boolean; begin sup := cmp (a,b) > 0; end;
function supeq (a:xint; b:xint):boolean; begin supeq := cmp (a,b) >= 0; end;
function eq_1 (a:xint; b:int ):boolean; begin eq_1 := cmp_1(a,b) = 0; end;
function neq_1 (a:xint; b:int ):boolean; begin neq_1 := cmp_1(a,b) <> 0; end;
function inf_1 (a:xint; b:int ):boolean; begin inf_1 := cmp_1(a,b) < 0; end;
function infeq_1(a:xint; b:int ):boolean; begin infeq_1 := cmp_1(a,b) <= 0; end;
function sup_1 (a:xint; b:int ):boolean; begin sup_1 := cmp_1(a,b) > 0; end;
function supeq_1(a:xint; b:int ):boolean; begin supeq_1 := cmp_1(a,b) >= 0; end;
(* conversions *)
function of_int(a:int):xint; var b:xint; begin b:=xnew; copy_int(b,a); of_int:=b; end;
(* copie *)
procedure private_copy(var b:xint; a:xint; s:int); _cdecl_ external name 'xx(private_copy)';
procedure copy (var b:xint; a:xint); begin private_copy(b,a,0); end;
procedure abs (var b:xint; a:xint); begin private_copy(b,a,1); end;
procedure neg (var b:xint; a:xint); begin private_copy(b,a,2); end;
function f_copy(a:xint):xint; var b:xint; begin b:=xnew; private_copy(b,a,0); f_copy:=b; end;
function f_abs (a:xint):xint; var b:xint; begin b:=xnew; private_copy(b,a,1); f_abs :=b; end;
function f_neg (a:xint):xint; var b:xint; begin b:=xnew; private_copy(b,a,2); f_neg :=b; end;
(* division *)
procedure private_quomod (c,d:pxint; a,b:xint; mode:int); _cdecl_ external name 'xx(private_quomod)';
function private_quomod_1(c: pxint; a:xint; b,mode:int):int; _cdecl_ external name 'xx(private_quomod_1)';
procedure quomod (var c,d:xint; a:xint; b:xint); begin private_quomod (@c, @d, a,b, 0 or 0); end;
procedure quo (var c :xint; a:xint; b:xint); begin private_quomod (@c,NIL, a,b, 4 or 0); end;
procedure modulo (var d :xint; a:xint; b:xint); begin private_quomod (NIL,@d, a,b, 8 or 0); end;
procedure quomod_1 (var c :xint; a:xint; b:int ); begin private_quomod_1(@c, a,b, 8 or 0); end;
procedure quo_1 (var c :xint; a:xint; b:int ); begin private_quomod_1(@c, a,b, 4 or 0); end;
function mod_1 (a:xint; b:int ):int; begin mod_1 :=private_quomod_1(NIL, a,b, 8 or 0); end;
procedure gquomod (var c,d:xint; a:xint; b:xint; mode:int); begin private_quomod (@c,@d, a,b, 0 or (mode and 3)); end;
procedure gquo (var c:xint; a:xint; b:xint; mode:int); begin private_quomod (@c, NIL,a,b, 4 or (mode and 3)); end;
procedure gmod (var d:xint; a:xint; b:xint; mode:int); begin private_quomod (NIL,@d, a,b, 8 or (mode and 3)); end;
function gquomod_1(var c:xint; a:xint; b:int; mode:int):int; begin gquomod_1:=private_quomod_1(@c, a,b, 8 or (mode and 3)); end;
procedure gquo_1 (var c:xint; a:xint; b:int; mode:int); begin private_quomod_1(@c, a,b, 4 or (mode and 3)); end;
function gmod_1 (a:xint; b:int; mode:int):int; begin gmod_1 :=private_quomod_1(NIL, a,b, 8 or (mode and 3)); end;
function f_quo (a:xint; b:xint ):xint; var c:xint; begin c:=xnew; private_quomod (@c,NIL,a,b, 4 or 0); f_quo :=c; end;
function f_mod (a:xint; b:xint ):xint; var d:xint; begin d:=xnew; private_quomod (NIL,@d,a,b, 8 or 0); f_mod :=d; end;
function f_quo_1 (a:xint; b:int ):xint; var c:xint; begin c:=xnew; private_quomod_1(@c, a,b, 4 or 0); f_quo_1 :=c; end;
function f_mod_1 (a:xint; b:int ):int; begin f_mod_1:=private_quomod_1(NIL, a,b, 8 or 0); end;
function f_gquo (a:xint; b:xint; mode:int):xint; var c:xint; begin c:=xnew; private_quomod (@c,NIL,a,b, 4 or (mode and 3)); f_gquo :=c; end;
function f_gmod (a:xint; b:xint; mode:int):xint; var d:xint; begin d:=xnew; private_quomod (NIL,@d,a,b, 8 or (mode and 3)); f_gmod :=d; end;
function f_gquo_1(a:xint; b:int; mode:int):xint; var c:xint; begin c:=xnew; private_quomod_1(@c, a,b, 4 or (mode and 3)); f_gquo_1:=c; end;
function f_gmod_1(a:xint; b:int; mode:int):int; begin f_gmod_1:= private_quomod_1(NIL, a,b, 8 or (mode and 3)); end;
(* factorielle *)
function f_fact(n:int):xint; var a:xint; begin a:=xnew; fact(a,n); f_fact:=a; end;
(* pgcd *)
procedure private_cfrac(d,u,v,p,q:pxint; a,b:xint; mode:int); _cdecl_ external name 'xx(private_cfrac)';
procedure gcd (var d:xint; a,b:xint); begin private_cfrac(@d,NIL,NIL,NIL,NIL,a,b,1); end;
procedure gcd_ex(var d,u,v:xint; a,b:xint); begin private_cfrac(@d,@u, @v, NIL,NIL,a,b,0); end;
procedure cfrac (var d,u,v,p,q:xint; a,b:xint); begin private_cfrac(@d,@u, @v, @p, @q, a,b,0); end;
function f_gcd(a,b:xint):xint; var d:xint; begin d:=xnew; private_cfrac(@d,NIL,NIL,NIL,NIL,a,b,1); f_gcd:=d; end;
(* multiplication *)
function f_mul (a:xint; b:xint):xint; var c:xint; begin c:=xnew; mul (c,a,b); f_mul :=c; end;
function f_mul_1(a:xint; b:int ):xint; var c:xint; begin c:=xnew; mul_1(c,a,b); f_mul_1:=c; end;
function f_sqr (a:xint):xint; var c:xint; begin c:=xnew; sqr (c,a); f_sqr :=c; end;
(* exponentiation *)
function f_pow (a:xint;p:int):xint; var b:xint; begin b:=xnew; power(b,a,p); f_pow :=b; end;
function f_pow_1(a:int; p:int):xint; var b:xint; begin b:=xnew; pow_1(b,a,p); f_pow_1:=b; end;
procedure private_powmod(var d:xint; a:xint; b:xint; c:xint; mode:int); _cdecl_ external name 'xx(private_powmod)';
procedure powmod (var d:xint; a:xint; b:xint; c:xint); begin private_powmod(d,a,b,c,0); end;
procedure gpowmod(var d:xint; a:xint; b:xint; c:xint; mode:int); begin private_powmod(d,a,b,c,mode); end;
function f_powmod (a:xint; b:xint; c:xint):xint; var d:xint; begin d:=xnew; private_powmod(d,a,b,c,0); f_powmod :=d; end;
function f_gpowmod(a:xint; b:xint; c:xint; mode:int):xint; var d:xint; begin d:=xnew; private_powmod(d,a,b,c,mode); f_gpowmod:=d; end;
(* nombres alatoires *)
procedure private_random(var a:xint; n:int; mode:int); _cdecl_ external name 'xx(private_random)';
procedure nrandom (var a:xint; n:int); begin private_random(a,n,0); end;
procedure zrandom (var a:xint; n:int); begin private_random(a,n,1); end;
procedure nrandom1(var a:xint; n:int); begin private_random(a,n,2); end;
procedure zrandom1(var a:xint; n:int); begin private_random(a,n,3); end;
function f_nrandom (n:int):xint; var a:xint; begin a:=xnew; private_random(a,n,0); f_nrandom :=a; end;
function f_zrandom (n:int):xint; var a:xint; begin a:=xnew; private_random(a,n,1); f_zrandom :=a; end;
function f_nrandom1(n:int):xint; var a:xint; begin a:=xnew; private_random(a,n,2); f_nrandom1:=a; end;
function f_zrandom1(n:int):xint; var a:xint; begin a:=xnew; private_random(a,n,3); f_zrandom1:=a; end;
(* racines *)
procedure private_sqrt(var b:xint; a:xint; mode:int); _cdecl_ external name 'xx(private_sqrt)';
procedure private_root(var b:xint; a:xint; p:int; mode:int); _cdecl_ external name 'xx(private_root)';
procedure sqrt (var b:xint; a:xint); begin private_sqrt(b, a,0); end;
procedure gsqrt(var b:xint; a:xint; mode:int); begin private_sqrt(b, a,mode); end;
procedure root (var b:xint; a:xint; p:int); begin private_root(b, a,p,0); end;
procedure groot(var b:xint; a:xint; p:int; mode:int); begin private_root(b, a,p,mode); end;
function f_sqrt (a:xint ):xint; var b:xint; begin b:=xnew; private_sqrt(b,a,0); f_sqrt :=b; end;
function f_gsqrt(a:xint; mode: int):xint; var b:xint; begin b:=xnew; private_sqrt(b,a,mode); f_gsqrt:=b; end;
function f_root (a:xint; p: int):xint; var b:xint; begin b:=xnew; private_root(b,a,p,0); f_root :=b; end;
function f_groot(a:xint; p,mode:int):xint; var b:xint; begin b:=xnew; private_root(b,a,p,mode);f_groot:=b; end;
(* dcalages *)
procedure private_shift(var b:xint; a:xint; n:int; sens:int); _cdecl_ external name 'xx(private_shift)';
procedure shiftl(var b:xint; a:xint; n:int); begin if n >= 0 then private_shift(b,a, n,1) else private_shift(b,a,-n,0); end;
procedure shiftr(var b:xint; a:xint; n:int); begin if n < 0 then private_shift(b,a,-n,1) else private_shift(b,a, n,0); end;
function f_shl(a:xint; n:int):xint; var b:xint; begin b:=xnew; if n >= 0 then private_shift(b,a, n,1) else private_shift(b,a,-n,0); f_shl:=b; end;
function f_shr(a:xint; n:int):xint; var b:xint; begin b:=xnew; if n < 0 then private_shift(b,a,-n,1) else private_shift(b,a, n,0); f_shr:=b; end;
function f_join(a:xint; b:xint; n:int):xint; var c:xint; begin c:=xnew; join(c,a,b,n); f_join:=c; end;
(* conversion en chaine *)
procedure copy_pstring(var a:xint; s:string);
var ss:pchar;
l :int;
begin
l := length(s);
ss := stralloc(l+1);
strncpy(ss,@s[1],l);
ss[l] := #0;
copy_string(a,ss);
strfree(ss);
end;
function of_string(s: pchar):xint; var a:xint; begin a:=xnew; copy_string(a,s); of_string:=a; end;
function of_pstring(s:string):xint;
var a :xint;
ss:pchar;
l :int;
begin
a := xnew;
l := length(s);
ss := stralloc(l+1);
strncpy(ss,@s[1],l);
ss[l] := #0;
copy_string(a,ss);
strfree(ss);
of_pstring := a;
end;
end.
|
