![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to multprec_integer_numbers.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Numbers|
Return to multprec_integer_numbers.adb CVS log | Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Numbers |
1.1 maekawa 1: with unchecked_deallocation;
2:
3: package body Multprec_Integer_Numbers is
4:
5: -- NOTES ON THE CHOICE OF REPRESENTATION AND IMPLEMENTATION :
6: -- 0) See also the notes in the body of Multprec_Natural_Numbers.
7: -- This package inherits the operations on natural numbers, with
8: -- additionally the tests on signs.
9: -- Integer numbers are in fact signed natural numbers.
10: -- 1) The construction of tagged records was judged not appropriate to
11: -- extend the natural numbers, as this construction only applies to
12: -- records, it would have changed the privacy of the implementation.
13:
14: -- DATA STRUCTURE :
15:
16: type Integer_Number_Rep is record
17: plus : boolean;
18: numb : Natural_Number;
19: end record;
20:
21: procedure free is
22: new unchecked_deallocation(Integer_Number_Rep,Integer_Number);
23:
24: -- CREATORS :
25:
26: function Natural_Create ( n : natural ) return Integer_Number is
27:
28: res : Integer_Number;
29: res_rep : Integer_Number_Rep;
30:
31: begin
32: res_rep.plus := true;
33: res_rep.numb := Create(n);
34: res := new Integer_Number_Rep'(res_rep);
35: return res;
36: end Natural_Create;
37:
38: function Create ( n : Array_of_Naturals ) return Integer_Number is
39:
40: res : Integer_Number;
41: res_rep : Integer_Number_Rep;
42:
43: begin
44: res_rep.plus := true;
45: res_rep.numb := Create(n);
46: res := new Integer_Number_Rep'(res_rep);
47: return res;
48: end Create;
49:
50: function Create ( n : Natural_Number ) return Integer_Number is
51:
52: res : Integer_Number;
53: res_rep : Integer_Number_Rep;
54:
55: begin
56: res_rep.plus := true;
57: res_rep.numb := +n; --Copy(n,res_rep.numb);
58: res := new Integer_Number_Rep'(res_rep);
59: return res;
60: end Create;
61:
62: function Create ( i : integer ) return Integer_Number is
63:
64: res : Integer_Number;
65: n : natural;
66:
67: begin
68: if i >= 0
69: then n := i;
70: res := Natural_Create(n);
71: res.plus := true;
72: else n := -i;
73: res := Natural_Create(n);
74: res.plus := false;
75: end if;
76: return res;
77: end Create;
78:
79: function Convert ( n : Natural_Number ) return Integer_Number is
80:
81: res : Integer_Number;
82: res_rep : Integer_Number_Rep;
83:
84: begin
85: res_rep.numb := n;
86: res_rep.plus := true;
87: res := new Integer_Number_Rep'(res_rep);
88: return res;
89: end Convert;
90:
91: function Create ( i : Integer_Number ) return integer is
92:
93: res : integer;
94: nres : natural;
95:
96: begin
97: if (Empty(i) or else Empty(i.numb))
98: then res := 0;
99: else nres := Create(i.numb);
100: if i.plus
101: then res := nres;
102: else res := -nres;
103: end if;
104: end if;
105: return res;
106: end Create;
107:
108: -- SELECTORS :
109:
110: function Empty ( i : Integer_Number ) return boolean is
111: begin
112: return (i=null);
113: end Empty;
114:
115: function Size ( i : Integer_Number ) return natural is
116: begin
117: if Empty(i)
118: then return 0;
119: else return Size(i.numb);
120: end if;
121: end Size;
122:
123: function Coefficient ( i : Integer_Number; k : natural ) return natural is
124: begin
125: if (Empty(i) or else (k > Size(i)))
126: then return 0;
127: else return Coefficient(i.numb,k);
128: end if;
129: end Coefficient;
130:
131: function Coefficients ( i : Integer_Number ) return Array_of_Naturals is
132:
133: nullres : Array_of_Naturals(0..0) := (0..0 => 0);
134:
135: begin
136: if not Empty(i)
137: then return Coefficients(i.numb);
138: else return nullres;
139: end if;
140: end Coefficients;
141:
142: function Decimal_Places ( i : Integer_Number ) return natural is
143: begin
144: if Empty(i)
145: then return 0;
146: else return Decimal_Places(i.numb);
147: end if;
148: end Decimal_Places;
149:
150: function Positive ( i : Integer_Number ) return boolean is
151: begin
152: if Empty(i)
153: then return false;
154: elsif Empty(i.numb)
155: then return false;
156: -- elsif Equal(i.numb,0) -- whatever sign you wish to give to 0
157: -- then return false; -- convenient to work with for input
158: else return i.plus;
159: end if;
160: end Positive;
161:
162: function Negative ( i : Integer_Number ) return boolean is
163: begin
164: if Empty(i)
165: then return false;
166: elsif Empty(i.numb)
167: then return false;
168: -- elsif Equal(i.numb,0) -- for input of floating-point numbers
169: -- then return false; -- convenient for reading -0.01
170: else return not i.plus;
171: end if;
172: end Negative;
173:
174: function Sign ( i : Integer_Number ) return integer is
175: begin
176: if Empty(i) or Equal(i,0)
177: then return 0;
178: elsif Positive(i)
179: then return +1;
180: else return -1;
181: end if;
182: end Sign;
183:
184: function Unsigned ( i : Integer_Number ) return Natural_Number is
185:
186: res : Natural_Number;
187:
188: begin
189: if not Empty(i)
190: then res := i.numb;
191: end if;
192: return res;
193: end Unsigned;
194:
195: -- COMPARISON AND COPYING :
196:
197: function Equal ( i1 : Integer_Number; i2 : integer ) return boolean is
198: begin
199: if Empty(i1)
200: then return (i2 = 0);
201: elsif ((i1.plus and i2 < 0) or else (not i1.plus and i2 > 0))
202: then return false;
203: elsif Empty(i1.numb)
204: then if i2 = 0
205: then return true;
206: else return false;
207: end if;
208: elsif i2 >= 0
209: then return Equal(i1.numb,i2);
210: else return Equal(i1.numb,-i2);
211: end if;
212: end Equal;
213:
214: function Equal ( i1,i2 : Integer_Number ) return boolean is
215: begin
216: if Empty(i1)
217: then return Equal(i2,0);
218: elsif Empty(i2)
219: then return Equal(i1,0);
220: else if (Positive(i1) and Negative(i2))
221: or else (Negative(i1) and Positive(i2))
222: then return false;
223: else return Equal(i1.numb,i2.numb);
224: end if;
225: end if;
226: end Equal;
227:
228: function "<" ( i1 : Integer_Number; i2 : integer ) return boolean is
229: begin
230: if Empty(i1)
231: then return (i2 > 0);
232: else if Positive(i1)
233: then if i2 <= 0
234: then return false;
235: else return (i1.numb < i2);
236: end if;
237: elsif Negative(i1)
238: then if i2 >= 0
239: then return true;
240: else return (i1.numb > -i2);
241: end if;
242: else return (i2 > 0);
243: end if;
244: end if;
245: end "<";
246:
247: function "<" ( i1 : integer; i2 : Integer_Number ) return boolean is
248: begin
249: if Empty(i2)
250: then return (i1 < 0);
251: else if Positive(i2)
252: then if i1 <= 0
253: then return true;
254: else return (i1 < i2.numb);
255: end if;
256: elsif Negative(i2)
257: then if i1 >= 0
258: then return false;
259: else return (-i1 > i2.numb);
260: end if;
261: else return (i1 < 0);
262: end if;
263: end if;
264: end "<";
265:
266: function "<" ( i1,i2 : Integer_Number ) return boolean is
267: begin
268: if Empty(i1)
269: then return Positive(i2);
270: elsif Empty(i2)
271: then return Negative(i1);
272: elsif Positive(i1)
273: then if Negative(i2)
274: then return false;
275: else return (i1.numb < i2.numb);
276: end if;
277: elsif Negative(i1)
278: then if Positive(i2)
279: then return true;
280: else return (i1.numb > i2.numb);
281: end if;
282: else return Positive(i2);
283: end if;
284: end "<";
285:
286: function ">" ( i1 : Integer_Number; i2 : integer ) return boolean is
287: begin
288: if Empty(i1)
289: then return (i2 < 0);
290: else if Negative(i1)
291: then if i2 >= 0
292: then return false;
293: else return (i1.numb < -i2);
294: end if;
295: elsif Positive(i1)
296: then if i2 <= 0
297: then return true;
298: else return (i1.numb > i2);
299: end if;
300: else return (i2 < 0);
301: end if;
302: end if;
303: end ">";
304:
305: function ">" ( i1 : integer; i2 : Integer_Number ) return boolean is
306: begin
307: if Empty(i2)
308: then return (i1 > 0);
309: else if Positive(i2)
310: then if i1 <= 0
311: then return false;
312: else return (i1 > i2.numb);
313: end if;
314: elsif Negative(i2)
315: then if i1 >= 0
316: then return true;
317: else return (-i1 < i2.numb);
318: end if;
319: else return (i1 > 0);
320: end if;
321: end if;
322: end ">";
323:
324: function ">" ( i1,i2 : Integer_Number ) return boolean is
325: begin
326: if Empty(i1)
327: then return Negative(i2);
328: elsif Empty(i2)
329: then return Positive(i1);
330: elsif Positive(i1)
331: then if Negative(i2)
332: then return true;
333: else return (i1.numb > i2.numb);
334: end if;
335: elsif Negative(i1)
336: then if Positive(i2)
337: then return false;
338: else return (i1.numb < i2.numb);
339: end if;
340: else return Negative(i2);
341: end if;
342: end ">";
343:
344: procedure Copy ( i1 : in integer; i2 : in out Integer_Number ) is
345: begin
346: Clear(i2);
347: i2 := Create(i1);
348: end Copy;
349:
350: procedure Copy ( i1 : in Integer_Number; i2 : in out Integer_Number ) is
351: begin
352: Clear(i2);
353: if not Empty(i1)
354: then declare
355: i2rep : Integer_Number_Rep;
356: begin
357: i2rep.plus := i1.plus;
358: i2rep.numb := +i1.numb;
359: i2 := new Integer_Number_Rep'(i2rep);
360: end;
361: end if;
362: end Copy;
363:
364: -- ARITHMETIC OPERATIONS as functions :
365:
366: function "+" ( i1 : Integer_Number; i2 : integer ) return Integer_Number is
367:
368: res : Integer_Number;
369: res_rep : Integer_Number_Rep;
370: n : natural;
371:
372: begin
373: if (Empty(i1) or else Empty(i1.numb))
374: then res := Create(i2);
375: else if i1.plus
376: then if i2 >= 0
377: then n := i2;
378: res_rep.plus := true;
379: res_rep.numb := i1.numb + n;
380: res := new Integer_Number_Rep'(res_rep);
381: else n := -i2;
382: if not Equal(i1.numb,n)
383: then if i1.numb > n
384: then res_rep.plus := true;
385: res_rep.numb := i1.numb - n;
386: else res_rep.plus := false;
387: res_rep.numb := n - i1.numb;
388: end if;
389: res := new Integer_Number_Rep'(res_rep);
390: end if;
391: end if;
392: else if i2 <= 0
393: then n := -i2;
394: res_rep.plus := false;
395: res_rep.numb := i1.numb + n;
396: res := new Integer_Number_Rep'(res_rep);
397: else n := i2;
398: if not Equal(i1.numb,n)
399: then if i1.numb < n
400: then res_rep.plus := true;
401: res_rep.numb := n - i1.numb;
402: else res_rep.plus := false;
403: res_rep.numb := i1.numb - n;
404: end if;
405: res := new Integer_Number_Rep'(res_rep);
406: end if;
407: end if;
408: end if;
409: end if;
410: return res;
411: end "+";
412:
413: function "+" ( i1 : integer; i2 : Integer_Number ) return Integer_Number is
414: begin
415: return (i2+i1);
416: end "+";
417:
418: function "+" ( i1,i2 : Integer_Number ) return Integer_Number is
419:
420: res : Integer_Number;
421: res_rep : Integer_Number_Rep;
422:
423: begin
424: if (Empty(i1) or else Empty(i1.numb))
425: then Copy(i2,res);
426: else if (Empty(i2) or else Empty(i2.numb))
427: then Copy(i1,res);
428: else if i1.plus
429: then if i2.plus
430: then res_rep.plus := true;
431: res_rep.numb := i1.numb + i2.numb;
432: res := new Integer_Number_Rep'(res_rep);
433: else if not Equal(i1.numb,i2.numb)
434: then if i1.numb > i2.numb
435: then res_rep.plus := true;
436: res_rep.numb := i1.numb - i2.numb;
437: else res_rep.plus := false;
438: res_rep.numb := i2.numb - i1.numb;
439: end if;
440: res := new Integer_Number_Rep'(res_rep);
441: end if;
442: end if;
443: else if not i2.plus
444: then res_rep.plus := false;
445: res_rep.numb := i1.numb + i2.numb;
446: res := new Integer_Number_Rep'(res_rep);
447: else if not Equal(i1.numb,i2.numb)
448: then if i1.numb < i2.numb
449: then res_rep.plus := true;
450: res_rep.numb := i2.numb - i1.numb;
451: else res_rep.plus := false;
452: res_rep.numb := i1.numb - i2.numb;
453: end if;
454: res := new Integer_Number_Rep'(res_rep);
455: end if;
456: end if;
457: end if;
458: end if;
459: end if;
460: return res;
461: end "+";
462:
463: function "+" ( i : Integer_Number ) return Integer_Number is
464:
465: res : Integer_Number;
466:
467: begin
468: Copy(i,res);
469: return res;
470: end "+";
471:
472: function "-" ( i : Integer_Number ) return Integer_Number is
473:
474: res : Integer_Number;
475: res_rep : Integer_Number_Rep;
476:
477: begin
478: if not Empty(i)
479: then res_rep.plus := not i.plus;
480: res_rep.numb := +i.numb; -- Copy(i.numb,res_rep.numb);
481: res := new Integer_Number_Rep'(res_rep);
482: end if;
483: return res;
484: end "-";
485:
486: function "-" ( i1 : Integer_Number; i2 : integer ) return Integer_Number is
487:
488: mini2 : constant integer := -i2;
489:
490: begin
491: return (i1+mini2);
492: end "-";
493:
494: function "-" ( i1 : integer; i2 : Integer_Number ) return Integer_Number is
495:
496: res : Integer_Number := i2 - i1;
497:
498: begin
499: Min(res);
500: return res;
501: end "-";
502:
503: function "-" ( i1,i2 : Integer_Number ) return Integer_Number is
504:
505: res,mini2 : Integer_Number;
506: mini2rep : Integer_Number_Rep;
507:
508: begin
509: if (Empty(i2) or else Empty(i2.numb))
510: then Copy(i1,res);
511: else mini2rep.numb := i2.numb;
512: mini2rep.plus := not i2.plus;
513: mini2 := new Integer_Number_Rep'(mini2rep);
514: res := i1 + mini2;
515: free(mini2);
516: end if;
517: return res;
518: end "-";
519:
520: function "*" ( i1 : Integer_Number; i2 : integer ) return Integer_Number is
521:
522: res : Integer_Number;
523: res_rep : Integer_Number_Rep;
524: n : natural;
525:
526: begin
527: if not ((i2 = 0) or else Empty(i1) or else Empty(i1.numb))
528: then if i2 > 0
529: then n := i2;
530: res_rep.plus := i1.plus;
531: else n := -i2;
532: res_rep.plus := not i1.plus;
533: end if;
534: res_rep.numb := i1.numb*n;
535: res := new Integer_Number_Rep'(res_rep);
536: end if;
537: return res;
538: end "*";
539:
540: function "*" ( i1 : integer; i2 : Integer_Number ) return Integer_Number is
541: begin
542: return (i2*i1);
543: end "*";
544:
545: function "*" ( i1,i2 : Integer_Number ) return Integer_Number is
546:
547: res : Integer_Number;
548: res_rep : Integer_Number_Rep;
549:
550: begin
551: if (not (Empty(i1) or else Empty(i1.numb)))
552: and then (not (Empty(i2) or else Empty(i2.numb)))
553: then res_rep.numb := i1.numb*i2.numb;
554: res_rep.plus := i1.plus;
555: if not i2.plus
556: then res_rep.plus := not res_rep.plus;
557: end if;
558: res := new Integer_Number_Rep'(res_rep);
559: end if;
560: return res;
561: end "*";
562:
563: function "**" ( i : Integer_Number; n : natural ) return Integer_Number is
564:
565: res : Integer_Number;
566: res_rep : Integer_Number_Rep;
567:
568: begin
569: if n = 0
570: then res := Create(1);
571: else if not (Empty(i) or else Empty(i.numb))
572: then res_rep.numb := i.numb**n;
573: res_rep.plus := i.plus;
574: if ((not i.plus) and then (n mod 2 = 1))
575: then res_rep.plus := not res_rep.plus;
576: end if;
577: res := new Integer_Number_Rep'(res_rep);
578: end if;
579: end if;
580: return res;
581: end "**";
582:
583: function "**" ( i : integer; n : Natural_Number ) return Integer_Number is
584:
585: res : Integer_Number;
586: res_rep : Integer_Number_Rep;
587: ni : natural;
588:
589: begin
590: if (Empty(n) or else Equal(n,0))
591: then res := Create(1);
592: else if i /= 0
593: then if i > 0
594: then ni := i;
595: res_rep.plus := true;
596: else ni := -i;
597: res_rep.plus := false;
598: end if;
599: res_rep.numb := ni**n;
600: if (i < 0 and then (Rmd(n,2) = 0))
601: then res_rep.plus := not res_rep.plus;
602: end if;
603: res := new Integer_Number_Rep'(res_rep);
604: end if;
605: end if;
606: return res;
607: end "**";
608:
609: function "**" ( i : Integer_Number; n : Natural_Number )
610: return Integer_Number is
611:
612: res : Integer_Number;
613: res_rep : Integer_Number_Rep;
614:
615: begin
616: if (Empty(n) or else Equal(n,0))
617: then res := Create(1);
618: else if not (Empty(i) or else Empty(i.numb))
619: then res_rep.numb := i.numb**n;
620: res_rep.plus := i.plus;
621: if ((not i.plus) and then (Rmd(n,2) = 0))
622: then res_rep.plus := not res_rep.plus;
623: end if;
624: res := new Integer_Number_Rep'(res_rep);
625: end if;
626: end if;
627: return res;
628: end "**";
629:
630: function "/" ( i1 : Integer_Number; i2 : integer ) return Integer_Number is
631:
632: res : Integer_Number;
633: i2n : natural;
634: res_rep : Integer_Number_Rep;
635:
636: begin
637: if i2 /= 0
638: then if not (Empty(i1) or else Empty(i1.numb))
639: then if i2 > 0
640: then i2n := i2;
641: else i2n := -i2;
642: end if;
643: res_rep.numb := i1.numb/i2n;
644: if (i1.plus and (i2 > 0)) or ((not i1.plus) and (i2 < 0))
645: then res_rep.plus := true;
646: else res_rep.plus := false;
647: end if;
648: res := new Integer_Number_Rep'(res_rep);
649: end if;
650: else raise NUMERIC_ERROR;
651: end if;
652: return res;
653: end "/";
654:
655: function "/" ( i1 : integer; i2 : Integer_Number ) return integer is
656:
657: res : integer;
658: i1n,nres : natural;
659:
660: begin
661: if (Empty(i2) or else Empty(i2.numb))
662: then raise NUMERIC_ERROR;
663: else if i1 > 0
664: then i1n := i1;
665: else i1n := -i1;
666: end if;
667: nres := i1n/i2.numb;
668: if ((i1 > 0) and i2.plus) or ((i1 < 0) and (not i2.plus))
669: then res := nres;
670: else res := -nres;
671: end if;
672: end if;
673: return res;
674: end "/";
675:
676: function "/" ( i1,i2 : Integer_Number ) return Integer_Number is
677:
678: res : Integer_Number;
679: res_rep : Integer_Number_Rep;
680:
681: begin
682: if not (Empty(i1) or else Empty(i1.numb))
683: then if (Empty(i2) or else Empty(i2.numb))
684: then raise NUMERIC_ERROR;
685: else res_rep.numb := i1.numb/i2.numb;
686: if (i1.plus and i2.plus) or ((not i1.plus) and (not i2.plus))
687: then res_rep.plus := true;
688: else res_rep.plus := false;
689: end if;
690: res := new Integer_Number_Rep'(res_rep);
691: end if;
692: end if;
693: return res;
694: end "/";
695:
696: function Rmd ( i1 : Integer_Number; i2 : integer ) return integer is
697:
698: res : integer;
699: i2n,nres : natural;
700:
701: begin
702: if i2 /= 0
703: then if (Empty(i1) or else Empty(i1.numb))
704: then res := 0;
705: else if i2 > 0
706: then i2n := i2;
707: else i2n := -i2;
708: end if;
709: nres := Rmd(i1.numb,i2n);
710: if i1.plus
711: then res := nres;
712: else res := -nres;
713: end if;
714: end if;
715: else raise NUMERIC_ERROR;
716: end if;
717: return res;
718: end Rmd;
719:
720: function Rmd ( i1 : integer; i2 : Integer_Number ) return integer is
721:
722: res : integer;
723: i1n,nres : natural;
724:
725: begin
726: if i1 = 0
727: then res := 0;
728: else if (Empty(i2) or else Empty(i2.numb))
729: then raise NUMERIC_ERROR;
730: else if i1 > 0
731: then i1n := i1;
732: else i1n := -i1;
733: end if;
734: nres := Rmd(i1n,i2.numb);
735: if i1 > 0
736: then res := nres;
737: else res := -nres;
738: end if;
739: end if;
740: end if;
741: return res;
742: end Rmd;
743:
744: function Rmd ( i1,i2 : Integer_Number ) return Integer_Number is
745:
746: res : Integer_Number;
747: res_rep : Integer_Number_Rep;
748:
749: begin
750: if not (Empty(i1) or else Empty(i1.numb))
751: then if (Empty(i2) or else Empty(i2.numb))
752: then raise NUMERIC_ERROR;
753: else res_rep.numb := Rmd(i1.numb,i2.numb);
754: res_rep.plus := i1.plus;
755: res := new Integer_Number_Rep'(res_rep);
756: end if;
757: end if;
758: return res;
759: end Rmd;
760:
761: -- ARITHMETIC OPERATIONS as procedures for memory management :
762:
763: procedure Add ( i1 : in out Integer_Number; i2 : in integer ) is
764:
765: n : natural;
766: nn : Natural_Number;
767:
768: begin
769: if (Empty(i1) or else Empty(i1.numb))
770: then i1 := Create(i2);
771: else if i1.plus
772: then if i2 >= 0
773: then n := i2;
774: Add(i1.numb,n);
775: else n := -i2;
776: if not Equal(i1.numb,n)
777: then if i1.numb > n
778: then Sub(i1.numb,n);
779: else i1.plus := false;
780: nn := Create(n);
781: Sub(nn,i1.numb);
782: Clear(i1.numb); i1.numb := nn;
783: end if;
784: else Clear(i1);
785: end if;
786: end if;
787: else if i2 <= 0
788: then n := -i2;
789: Add(i1.numb,n);
790: else n := i2;
791: if not Equal(i1.numb,n)
792: then if i1.numb < n
793: then i1.plus := true;
794: nn := Create(n);
795: Sub(nn,i1.numb);
796: Clear(i1.numb); i1.numb := nn;
797: else Sub(i1.numb,n);
798: end if;
799: else Clear(i1);
800: end if;
801: end if;
802: end if;
803: end if;
804: end Add;
805:
806: procedure Add ( i1 : in out Integer_Number; i2 : in Integer_Number ) is
807:
808: nn : Natural_Number;
809:
810: begin
811: if (Empty(i1) or else Empty(i1.numb))
812: then Copy(i2,i1);
813: else if not (Empty(i2) or else Empty(i2.numb))
814: then if i1.plus
815: then if i2.plus
816: then Add(i1.numb,i2.numb);
817: else if not Equal(i1.numb,i2.numb)
818: then if i1.numb > i2.numb
819: then Sub(i1.numb,i2.numb);
820: else Copy(i2.numb,nn);
821: Sub(nn,i1.numb);
822: Clear(i1.numb);
823: i1.plus := false;
824: i1.numb := nn;
825: end if;
826: else Clear(i1);
827: end if;
828: end if;
829: else if not i2.plus
830: then Add(i1.numb,i2.numb);
831: else if not Equal(i1.numb,i2.numb)
832: then if i1.numb < i2.numb
833: then Copy(i2.numb,nn);
834: Sub(nn,i1.numb);
835: Clear(i1.numb);
836: i1.plus := true;
837: i1.numb := nn;
838: else Sub(i1.numb,i2.numb);
839: end if;
840: else Clear(i1);
841: end if;
842: end if;
843: end if;
844: end if;
845: end if;
846: end Add;
847:
848: procedure Min ( i : in out Integer_Number ) is
849: begin
850: if not Empty(i)
851: then i.plus := not i.plus;
852: end if;
853: end Min;
854:
855: procedure Sub ( i1 : in out Integer_Number; i2 : in integer ) is
856: begin
857: Add(i1,-i2);
858: end Sub;
859:
860: procedure Sub ( i1 : in out Integer_Number; i2 : in Integer_Number ) is
861:
862: mini2 : Integer_Number;
863: mini2rep : Integer_Number_Rep;
864:
865: begin
866: if not (Empty(i2) or else Empty(i2.numb))
867: then mini2rep.numb := i2.numb;
868: mini2rep.plus := not i2.plus;
869: mini2 := new Integer_Number_Rep'(mini2rep);
870: Add(i1,mini2);
871: free(mini2);
872: end if;
873: end Sub;
874:
875: procedure Mul ( i1 : in out Integer_Number; i2 : in integer ) is
876:
877: n : natural;
878:
879: begin
880: if not (Empty(i1) or else Empty(i1.numb))
881: then if i2 = 0
882: then Clear(i1);
883: else if i2 > 0
884: then n := i2;
885: else n := -i2;
886: i1.plus := not i1.plus;
887: end if;
888: Mul(i1.numb,n);
889: end if;
890: end if;
891: end Mul;
892:
893: procedure Mul ( i1 : in out Integer_Number; i2 : in Integer_Number ) is
894: begin
895: if (not (Empty(i1) or else Empty(i1.numb)))
896: then if (Empty(i2) or else Empty(i2.numb))
897: then Clear(i1);
898: else Mul(i1.numb,i2.numb);
899: if not i2.plus
900: then i1.plus := not i1.plus;
901: end if;
902: end if;
903: end if;
904: end Mul;
905:
906: procedure Rmd ( i1 : in out Integer_Number; i2 : in integer ) is
907:
908: res : Integer_Number := Create(Rmd(i1,i2));
909:
910: begin
911: Clear(i1); i1 := res;
912: end Rmd;
913:
914: procedure Rmd ( i1 : in out Integer_Number; i2 : in Integer_Number ) is
915:
916: res : Integer_Number := Rmd(i1,i2);
917:
918: begin
919: Clear(i1); i1 := res;
920: end Rmd;
921:
922: procedure Div ( i1 : in out Integer_Number; i2 : in integer ) is
923:
924: r : integer;
925:
926: begin
927: Div(i1,i2,r);
928: end Div;
929:
930: procedure Div ( i1 : in out Integer_Number; i2 : in Integer_Number ) is
931:
932: r : Integer_Number;
933:
934: begin
935: Div(i1,i2,r);
936: Clear(r);
937: end Div;
938:
939: procedure Div ( i1 : in Integer_Number; i2 : in integer;
940: q : out Integer_Number; r : out integer ) is
941:
942: qrep : Integer_Number_Rep;
943: i2n,rn : natural;
944:
945: begin
946: if i2 /= 0
947: then if not (Empty(i1) or else Empty(i1.numb))
948: then if i2 > 0
949: then i2n := i2;
950: else i2n := -i2;
951: end if;
952: Div(i1.numb,i2n,qrep.numb,rn);
953: if (i1.plus and (i2 > 0)) or ((not i1.plus) and (i2 < 0))
954: then qrep.plus := true;
955: else qrep.plus := false;
956: end if;
957: q := new Integer_Number_Rep'(qrep);
958: if i1.plus
959: then r := rn;
960: else r := -rn;
961: end if;
962: end if;
963: else raise NUMERIC_ERROR;
964: end if;
965: end Div;
966:
967: procedure Div ( i1 : in out Integer_Number; i2 : in integer;
968: r : out integer ) is
969:
970: i2n,rn : natural;
971:
972: begin
973: if i2 /= 0
974: then if not (Empty(i1) or else Empty(i1.numb))
975: then if i2 > 0
976: then i2n := i2;
977: else i2n := -i2;
978: end if;
979: Div(i1.numb,i2n,rn);
980: if i1.plus
981: then r := rn;
982: else r := -rn;
983: end if;
984: if (i1.plus and (i2 > 0)) or ((not i1.plus) and (i2 < 0))
985: then i1.plus := true;
986: else i1.plus := false;
987: end if;
988: end if;
989: else raise NUMERIC_ERROR;
990: end if;
991: end Div;
992:
993: procedure Div ( i1,i2 : in Integer_Number; q,r : out Integer_Number ) is
994:
995: qrep,rrep : Integer_Number_Rep;
996:
997: begin
998: if not (Empty(i2) or else Empty(i2.numb))
999: then if not (Empty(i1) or else Empty(i1.numb))
1000: then Div(i1.numb,i2.numb,qrep.numb,rrep.numb);
1001: if (i1.plus and (i2 > 0)) or ((not i1.plus) and (i2 < 0))
1002: then qrep.plus := true;
1003: else qrep.plus := false;
1004: end if;
1005: q := new Integer_Number_Rep'(qrep);
1006: rrep.plus := i1.plus;
1007: r := new Integer_Number_Rep'(rrep);
1008: end if;
1009: else raise NUMERIC_ERROR;
1010: end if;
1011: end Div;
1012:
1013: procedure Div ( i1 : in out Integer_Number; i2 : in Integer_Number;
1014: r : out Integer_Number ) is
1015:
1016: rrep : Integer_Number_Rep;
1017:
1018: begin
1019: if not (Empty(i2) or else Empty(i2.numb))
1020: then if not (Empty(i1) or else Empty(i1.numb))
1021: then Div(i1.numb,i2.numb,rrep.numb);
1022: rrep.plus := i1.plus;
1023: r := new Integer_Number_Rep'(rrep);
1024: if (i1.plus and (i2 > 0)) or ((not i1.plus) and (i2 < 0))
1025: then i1.plus := true;
1026: else i1.plus := false;
1027: end if;
1028: end if;
1029: else raise NUMERIC_ERROR;
1030: end if;
1031: end Div;
1032:
1033: -- DESTRUCTOR :
1034:
1035: procedure Clear ( i : in out Integer_Number ) is
1036: begin
1037: if not Empty(i)
1038: then Clear(i.numb);
1039: free(i);
1040: i := null;
1041: end if;
1042: end Clear;
1043:
1044: end Multprec_Integer_Numbers;