Autor Beitrag
Allesquarks
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 510

Win XP Prof
Delphi 7 E
BeitragVerfasst: Mo 22.01.07 16:19 
Mit den hier vorgestellten Funktionen kann man mit Bigints, großen Zahlen oder wie sie sonst noch heißen rechnen. Hierzu sind die vier Grundoperationen definiert auf einer Klasse TBigint, die praktisch nur ein array aus Speicher darstellt und aus Gründen der besseren Handhabbarkeit aus DWords also 32 Bit Speicherstellen besteht, wofür ich longword benutzt habe.

Die hier vorgestellten Funktionen sind ein Auszug aus meinem Hauptprogramm. Aus diesem Grund sind sie auch nur in meiner speziellen Umgebung getestet. Ich habe versucht den Code weitestgehend von diesen "Meinpprogrammspeziefischen" Stellen zu befreien. Sollte etwas nicht sofort compilieren bitte "sinnvoll" ergänzen oder an mich melden.

Obwohl ich diverse Situationen auf Korrektheit geprüft habe, habe ich natürlich nicht alle kritischen Überläufe/Unterläufe etc getestet. Deshalb wäre ich dankbar, wenn echte Fehlberechnungen auf jeden Fall mir mitgeteilt werden.


So ich hoffe ich habe alles gefunden.
Es gibt für die Bigints 4 Funktionen add,sub,mul,divmod und zur Ausgabe tostring. Dafür verwende ich intern eine TCustomganzzahl. Das ist eigentlich nur ein array of char wo die Ziffern drinstehen und wenn zur Basis 10 eingestellt ist kann man das so ausgeben.

Insbesondere hoffe ich, dass die Ausgabe über tostring funktioniert. Kritik ist erwünscht. Insbesondere zur Division, da ich mir da nicht so sicher bin ob das rumshiften da überhaupt die Effektivität erhöht.

ausblenden volle Höhe Delphi-Quelltext
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:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
type TCustomGanzzahl = class
        Vorzeichen:boolean;
        zahl:array of byte;
        Basis:byte;
end;

type TBigintzahl = class

      zahl:array of longword;
      laenge:integer;
      Vorzeichen:boolean;
end;

implementation

function _min(Zahl1,Zahl2:integer):integer;
asm
    cmp eax,edx;
    jbe @@done;
    xchg eax,edx;
    @@done:
end;

function _max(Zahl1,Zahl2:integer):integer;
asm
    cmp eax,edx;
    jge @@done;
    xchg eax,edx;
    @@done:
end;

constructor TBigintzahl.create(laenge: integer);
begin
      setlength(zahl1.zahl,laenge);
      zahl1.laenge:=laenge;
      zahl1.vorzeichen:=false;
end;

function add(zahl1:TCustomGanzzahl;zahl2: TCustomganzzahl): TCustomganzzahl;
var a,i,remainder,addtemp:integer;
begin
      if length(zahl1.zahl)<length(zahl2.zahl)
      then begin
            result:=zahl1;
            zahl1:=zahl2;
            zahl2:=result;
      end;
      result:=TCustomganzzahl.create;
      setlength(result.zahl,length(zahl1.zahl));
      result.basis:=algebra._max(zahl1.basis,zahl2.basis);
      remainder:=0;
      For i:=0 to length(zahl2.zahl)-1
      do begin
            addtemp:=zahl1.zahl[i]+zahl2.zahl[i]+remainder;
            if addtemp>=result.basis
            then begin
                  result.zahl[i]:=addtemp-result.basis;
                  remainder:=1;
            end else begin
                  result.zahl[i]:=addtemp;
                  remainder:=0;
            end;
      end;
      i:=length(zahl2.zahl);
      while i<length(zahl1.zahl)
      do begin
            addtemp:=zahl1.zahl[i]+remainder;
            if addtemp>=result.basis
            then begin
                  result.zahl[i]:=addtemp-result.basis;
                  remainder:=1;
            end else begin
                  result.zahl[i]:=addtemp;
                  i:=i+1;
                  while i <length(zahl1.zahl)
                  do begin
                        result.zahl[i]:=zahl1.zahl[i];
                        i:=i+1;
                  end;
                  exit;
            end;
            i:=i+1;
      end;
      if remainder=1
      then begin
            setlength(result.zahl,length(result.zahl)+1);
            result.zahl[length(result.zahl)-1]:=1;
      end;
end;


function mul2(zahl1:TCustomganzzahl):TCustomganzzahl;
var multemp,i,remainder:integer;
begin
      result:=TCustomganzzahl.create;
      setlength(result.zahl,length(zahl1.zahl));
      result.Basis:=zahl1.basis;
      remainder:=0;
      For i:=0 to length(zahl1.zahl)-1
      do begin
            multemp:=zahl1.zahl[i]*2+remainder;
            if multemp>=zahl1.Basis
            then begin
                  result.zahl[i]:=multemp-zahl1.Basis;
                  remainder:=1;
            end else begin
                  result.zahl[i]:=multemp;
                  remainder:=0;
            end;
      end;
      if remainder=1
      then begin
            setlength(result.zahl,length(zahl1.zahl)+1);
            result.zahl[length(zahl1.zahl)]:=1;
      end;
end;


function tostring(zahl1:TBigintzahl):string;
var Basiszahl,resultzahl,temp:TCustomganzzahl;i,b:integer;mask:longword;
begin
      Basiszahl:=TCustomganzzahl.create;
      Basiszahl.Basis:=10;
      Basiszahl.Vorzeichen:=false;
      setlength(Basiszahl.zahl,1);
      Basiszahl.zahl[0]:=1;

      resultzahl:=TCustomganzzahl.create;
      setlength(resultzahl.zahl,1);
      resultzahl.zahl[0]:=0;
      resultzahl.Basis:=10;
      resultzahl.Vorzeichen:=false;

      mask:=$80000000;

      For i:=0 to length(zahl1.zahl)-1
      do begin
            For b:=0 to 31
            do begin
                  mask:=rol(mask);
                  if (zahl1.zahl[i] and mask) <> 0
                  then begin
                        temp:=TCustomganzzahl(add(resultzahl,Basiszahl));
                        resultzahl.free;
                        resultzahl:=temp;
                  end;
            temp:=mul2(Basiszahl);
            Basiszahl.free;
            Basiszahl:=temp;
            end;
      end;
      case zahl1.Vorzeichen of
      true:result:='-'+tostring(resultzahl);
      false:result:=tostring(resultzahl);
      end;

end;



function add(zahl1:TBigintzahl;zahl2: TBigintzahl): TBigintzahl;
var ueberlauf:boolean;
begin
  zahl1.laenge:=length(zahl1.zahl);
  zahl2.laenge:=length(zahl2.zahl);
  if zahl1.vorzeichen xor zahl2.vorzeichen then
  begin

  end else begin
    if zahl1.laenge<zahl2.laenge then
    begin
      result:=TBigintzahl.create(zahl2.laenge+1);
      ueberlauf:=_addbigints(zahl2,zahl1,result);
    end else begin
      result:=TBigintzahl.create(zahl1.laenge+1);
      ueberlauf:=_addbigints(zahl1,zahl2,result);
    end;
    if ueberlauf then
    begin
        result.zahl[result.laenge-1]:=1;
    end else begin
        setlength(result.zahl,result.laenge-1);
    end;
  end;
end;

function mul(zahl1:TBigintzahl;zahl2: TBigintzahl): TBigintzahl;
var i:integer;ueberlauf:boolean;
begin
  zahl1.laenge:=length(zahl1.zahl);
  zahl2.laenge:=length(zahl2.zahl);
  if zahl1.vorzeichen xor zahl2.vorzeichen then
  begin

  end else begin
    if zahl1.laenge<zahl2.laenge then
    begin
      result:=TBigintzahl.create(zahl1.laenge+zahl2.laenge);
      ueberlauf:=_mulbigints(zahl2,zahl1,result);
    end else begin
      result:=TBigintzahl.create(zahl1.laenge+zahl2.laenge);
      ueberlauf:=_mulbigints(zahl1,zahl2,result);
    end;
  end;
  i:=-1;
  repeat
    inc(i);
  until (result.zahl[result.laenge-i-1]<>0);
  setlength(result.zahl,result.laenge-i);
  result.laenge:=result.laenge-i;
end;

function sub(zahl1:TBigintzahl;zahl2: TBigintzahl): TBigintzahl;
var i:integer;ueberlauf:boolean;
begin
  zahl1.laenge:=length(zahl1.zahl);
  zahl2.laenge:=length(zahl2.zahl);
  if zahl1.vorzeichen xor zahl2.vorzeichen then
  begin
    if zahl1.laenge<zahl2.laenge then
    begin
      result:=TBigintzahl.create(zahl2.laenge+1);
      ueberlauf:=_addbigints(zahl2,zahl1,result);
    end else begin
      result:=TBigintzahl.create(zahl1.laenge+1);
      ueberlauf:=_addbigints(zahl1,zahl2,result);
    end;
    if ueberlauf then
    begin
        result.zahl[result.laenge-1]:=1;
    end else begin
        setlength(result.zahl,result.laenge-1);
    end;
    result.vorzeichen:=zahl1.vorzeichen;
  end else begin
    if zahl1.laenge<zahl2.laenge then
    begin
      result:=TBigintzahl.create(zahl2.laenge);
      ueberlauf:=_subbigints(zahl2,zahl1,result);
      result.vorzeichen:=not(zahl1.vorzeichen);
    end else begin
      result:=TBigintzahl.create(zahl1.laenge);
      ueberlauf:=_subbigints(zahl1,zahl2,result);
      result.vorzeichen:=zahl1.vorzeichen;
      //wenn überlauf gesetzt ist ist eine negative Zahl herausgekommen
    end;
    if ueberlauf then
    begin
      _Bigint2komplement(result);
    end;
    
    result.vorzeichen:=result.vorzeichen xor ueberlauf;
    //vorzeichen nocheinmal wechseln wenn überlauf
    // sozusagen not if ueberlauf ist offenbar xor
  end;
  For i:=result.laenge-1 downto 0
  do begin
    if result.zahl[i]<>0 then
    begin
      setlength(result.zahl,i+1);
      result.laenge:=i+1;
      break;
    end;
  end;
end;

function _shfl(zahl1:TBigintzahl;int:integer):longword;
asm
  push esi;
  push ebp;
  
  mov ebp,[eax].TBigintzahl.zahl;
  mov ecx,edx;
  mov esi,[eax].TBigintzahl.laenge;
  mov edx,esi;

  dec edx;//
  shl edx,2;//Multiplikation mit 4
  add ebp,edx;

  xor edx,edx;  //edx freimachen für überlauf
  mov eax,[ebp];//höchstes dw holen
  shld edx,eax,cl;//shiften
  push edx; //Überlauf speichern
  mov edx,eax; //für Schleife vorbereiten
 @@loop1:
  sub ebp,$04;
  mov eax,[ebp];
  shld edx,eax,cl;//edx zahl[i+1] eax zahl[i]
  mov [ebp+$04],edx;
  mov edx,eax;
  dec esi;
  cmp esi,$01;
  jne @@loop1;

  shl edx,cl;
  mov [ebp],edx;


  pop eax;//Resultat holen

  pop ebp;
  pop esi;
  //shldw(zahl1,int div 32);

end;

procedure _shfr(zahl1:TBigintzahl;int:integer);
asm
  push esi;
  push ebp;
  push ebx;

  mov ebp,[eax].TBigintzahl.zahl;
  mov ecx,edx;

  mov edx,[ebp];//unterstes dw holen

  mov ebx,[eax].TBigintzahl.laenge;
  sub ebx,$01;//weil ja immer bis length -1 und sub wegen Flags
  jz @@nichtloopen;

  xor esi,esi;

 @@loop1:
  add ebp,$04;
  mov eax,[ebp];
  shrd edx,eax,cl;//edx zahl[i+1] eax zahl[i]
  mov [ebp-$04],edx;
  mov edx,eax;
  inc esi;
  cmp esi,ebx;
  jne @@loop1;

 @@nichtloopen:

  shr edx,cl;
  mov [ebp],edx;

  pop ebx;
  pop ebp;
  pop esi;
end;

procedure shfl(zahl1:TBigintzahl;int:integer);
var ueberlauf:longword;
begin
    if int>0 then
    begin
        shldw(zahl1,int div 32);
        ueberlauf:=_shfl(zahl1,int mod 32);
        if ueberlauf<>0 then
        begin
            setlength(zahl1.zahl,zahl1.laenge+1);
            zahl1.zahl[zahl1.laenge]:=ueberlauf;
            zahl1.laenge:=zahl1.laenge+1;
        end;
    end else
    if int<0 then
    begin
        shfr(zahl1,-int);
    end;
end;

procedure shfr(zahl1:TBigintzahl;int:integer);
begin
    if int>0 then
    begin
        shrdw(zahl1,int div 32);
        _shfr(zahl1,int mod 32);
        if zahl1.zahl[zahl1.laenge-1]=0 then
        begin
            setlength(zahl1.zahl,zahl1.laenge-1);
            zahl1.laenge:=zahl1.laenge-1;
        end;
    end else
    if int<0 then
    begin
        shfl(zahl1,-int);
    end;
end;

procedure shldw(zahl1:TBigintzahl;int:integer);
var i:integer;
begin
    //Null wir einfach nicht behandelt und da procedure ist damit das Ergebnis auch richtig
    if int>0 then
    begin
        setlength(zahl1.zahl,zahl1.laenge+int);
        zahl1.laenge:=zahl1.laenge+int;
        For i:=zahl1.laenge-2 downto int
        do begin
            zahl1.zahl[i+int]:=zahl1.zahl[i];
        end;
        For i:=int-1 downto 0
        do begin
            zahl1.zahl[i+int]:=zahl1.zahl[i];
            zahl1.zahl[i]:=0;
        end;
    end else
    if int<0 then
    begin
          shrdw(zahl1,-int);
    end;
end;

procedure shrdw(zahl1:TBigintzahl;int:integer);
var i:integer;
begin
    if int>0 then
    begin
        For i:=0 to zahl1.laenge-int-1
        do begin
            zahl1.zahl[i]:=zahl1.zahl[i+int];
        end;
        setlength(zahl1.zahl,zahl1.laenge-int);
        zahl1.laenge:=zahl1.laenge-int;
    end else
    if int<0 then
    begin
        shldw(zahl1,-int);
    end;
end;





function _Bigint2komplement(var zahl1:TBigintzahl):boolean;
asm
    push esi;
    mov edx,[eax];
    mov ecx,[edx].TBigintzahl.laenge;
    mov edx,[edx].TBigintzahl.zahl;
    xor esi,esi;
    stc;//carry setzen;
  @@schleife:
    mov eax,[edx+4*esi];
    not eax;
    adc eax,$00;
    mov [edx+4*esi],eax;
    inc esi;
    loop @@schleife;
    setc al;
    pop esi;
end;



function _addBigints(langzahl,kurzzahl:TBigintzahl;var Ergebnis:TBigintzahl):boolean;
asm
    push ebx;
    push esi;
    push ebp;
    mov ecx,[ecx];
    mov ebx,[ecx].TBigintzahl.zahl;//result Data

    mov esi,[eax].TBigintzahl.laenge;//lange Laenge
    mov ecx,[edx].TBigintzahl.laenge;//kurze Länge

    sub esi,ecx;//difflaenge berechnen
    //shl ecx,$04;//mul 4;
    push esi;//difflaenge pushen;
    xor esi,esi;  //zaehler kurze Laenge
    //shl esi,$02;//mul 4

    mov ebp,[eax].TBigintzahl.zahl;//lange Zahl Data
    mov edx,[edx].TBigintzahl.zahl;//kurze Zahl Data
    push ecx;//gemeinsamen Zähler pushen;
@@addboth:
    mov eax, dword ptr [ebp+4*esi];
    adc eax,[edx+4*esi];
    mov [ebx+4*esi],eax;
    inc esi;
    loop @@addboth;
@@weiter1:
    setc al;
    pop ecx;
    shl ecx,$02;//mul 4
    add ebx,ecx;
    add ebp,ecx;

    pop ecx;    //lange Länge poppen
    cmp ecx,$00;
    je @@weiter2;
    xor esi,esi;
    mov edx,esi;//hier ist die Null gespeichert da xor leider das carry beeinflusst
    btr ax,$00;
@@addone:
    mov eax,edx;
    adc eax, dword ptr [ebp+4*esi];
    mov [ebx+4*esi],eax;
    inc esi;
    loop @@addone;
    setc al;//carry auslesen
@@weiter2:

    pop ebp;
    pop esi;
    pop ebx;
end;


function _subBigints(langzahl,kurzzahl:TBigintzahl;var Ergebnis:TBigintzahl):boolean;
asm
    push ebx;
    push esi;
    push ebp;
    mov ecx,[ecx];
    mov ebx,[ecx].TBigintzahl.zahl;//result Data

    mov esi,[eax].TBigintzahl.laenge;//lange Laenge
    mov ecx,[edx].TBigintzahl.laenge;//kurze Länge

    sub esi,ecx;//difflaenge berechnen
    //shl ecx,$04;//mul 4;
    push esi;//difflaenge pushen;
    xor esi,esi;  //zaehler kurze Laenge
    //shl esi,$02;//mul 4

    mov ebp,[eax].TBigintzahl.zahl;//lange Zahl Data
    mov edx,[edx].TBigintzahl.zahl;//kurze Zahl Data
    push ecx;//gemeinsamen Zähler pushen;
@@subboth:
    mov eax, dword ptr [ebp+4*esi];
    sbb eax,[edx+4*esi];
    mov [ebx+4*esi],eax;
    inc esi;
    loop @@subboth;
@@weiter1:
    setc al;
    pop ecx;
    shl ecx,$02;//mul 4
    add ebx,ecx;
    add ebp,ecx;

    pop ecx;    //lange Länge poppen
    cmp ecx,$00;
    je @@weiter2;
    xor esi,esi;
    mov edx,esi;//hier ist die Null gespeichert da xor leider das carry beeinflusst
    btr ax,$00;
@@subone:
    {mov eax,edx;
    sbb eax, dword ptr [ebp+4*esi];}
//gedreht
    mov eax,dword ptr [ebp+4*esi];
    sbb eax,edx;//in edx ist die Null vom hier nicht mehr vorhandenen Subtrahenden zahl2
    mov [ebx+4*esi],eax;
    inc esi;
    loop @@subone;
    setc al;//carry auslesen
@@weiter2:

    pop ebp;
    pop esi;
    pop ebx;
end;

function _mulbigints(langzahl,kurzzahl:TBigintzahl;var Ergebnis:TBigintzahl):boolean;
asm
      // $FFFFFFFF * $FFFFFFFF = edx=$FFFFFFFE und ...
  //ein adc edx,$00 kann hier keinen Überlauf generieren
  
  //eax=multiplikation
  //ebx=in Schleife der feste Multiplikator
  //ecx=Zähler
  //edx=Multiplikation
  //esi=Zähler für Addressierung,
  //edi=langzahl.data
  //esp=stack,
  //ebp=result.data
  
  //STack: jeweils dwords
  
  {
  --------------------------
  derzeitiger Zaehler der äußeren Schleife
  -------------------------
  langzahl laenge
  --------------------------
  kurzzahl laenge
  -------------------------
  Sicherung des höherwertigen dwords der Multiplikation
  ------------------------
  meine beiden Überlaufbits
  ------------------------
  kurzzahl Zeiger
  ------------------------
  die gesicherten Register
  ------------------------}

  
  //Register freimachen
    push ebx;
    push esi;
    push edi;
    push ebp;
      //Register frei
  
  //Stack anlegen
    push edx;
    push $00000000;//Die Überlaufbits sind zu Beginn Null
    push $00000000;//edx mul ergebnis Sicherung zu Beginn auch Null
    
    mov ebp,[edx].TBigintzahl.laenge;//kurzzahl.laenge;
    push ebp;
    
    mov ebp,[eax].TBigintzahl.laenge;//langzahl.laenge
    push ebp;
    
    push $00000000;//äußerer Schleifenzähler nach Initialisieren des ERgebnis ist ja
    //äußere Schleife schon einmal durchgelaufen

    //Stack angelegt
    
    //Register initialisieren:
    mov edx,[edx].TBigintzahl.zahl;//kurzzahl.zahl;
    mov ebx,[edx];//feste Multiplikator setzen
    
    mov edi,[eax].TBigintzahl.zahl;//langzahl.zahl Zeiger
    mov ecx,[ecx];//muss bei var Parametern durchgeführt werden
    mov ebp,[ecx].TBigintzahl.zahl;//result.zahl Zeiger
    xor esi,esi;
    //Register initialisieren ferig

    xor eax,eax;//äußerer Schleifenzähler zu Anfang Null
    
  @@outermultiply:  
    mov edx,[esp+$14];//plus zwanzig kurrzzahl Zeiger
    mov edx,[edx].TBigintzahl.zahl;
    mov ebx,[edx+4*eax];//feste Multiplikator in eax steht hier der äußere Schleifenzähler
    xor esi,esi;
    mov ecx,[esp+$04];//langzahl.laenge innerer Schleifenzähler
    
  @@innermultiply:
    
    mov eax,dword ptr [edi+4*esi];//firstzahl[i]
    mul eax,ebx;
    
    btr word ptr [esp+$10],$00;   //mybitlow
    xchg edx,[esp+$0C];
    adc eax,edx;
    setc byte ptr [esp+$10];  //mybitlow
    
    btr word ptr [esp+$12],$00;  //mybithigh
    adc [ebp+4*esi],eax;
    setc byte ptr [esp+$12]; //mybithigh
    inc esi;
  loop @@innermultiply;
    
    xor edx,edx;
    xchg edx,[esp+$0C];//Multiplikations speicher Null setzen und letzten WErt holen
    
    btr word ptr [esp+$10],$00;//mybit low
    adc edx,$00;//hier kann kein Überlauf geschenhen
    
    btr word ptr [esp+$12],$00;
    adc [ebp+4*esi],edx;
    //hier wieder kein Überlauf, da das entsprechende dword im Ergebnis ja erst durch diese Schleife überhaupt beschrieben wird

    mov [esp+$10],$00000000;//Die beiden Überlauf Bits Null setzen
    
    pop eax;//Zähler äußerer Schleife holen
    inc eax;//inkrementieren
    push eax;//wieder auf STack speichern
    
    add ebp,$04;//result bekommt immer höheren Offset;
    
    mov edx,[esp+$08];//hier kurzzahl.laenge
    cmp eax,edx;//beide Vergleichen raus/oder nicht
  jne @@outermultiply;

    add esp,$18;//addiere  für 24 Bytes höher
    
    pop ebp;
    pop edi;
    pop esi;
    pop ebx;
end;

function stepstonormalize(int:longword):integer;
asm
  xor ecx,ecx;
  @@weiter:
  inc ecx;
  rcl eax,$01;
  jnc @@weiter;
  dec ecx;
  mov eax,ecx;
end;

//rotdoubleprecisionright
function rotdpr(int1,int2:longword;stellen:integer):longword;
asm
  cmp ecx,$00;
  jge @@richtig;
  not ecx;
  inc ecx;
  shl eax,cl;
  jmp @@out;
 @@richtig:
  shrd eax,edx,cl;
 @@out:
end;

function rotdpl(int1,int2:longword;stellen:integer):longword;
asm
  cmp ecx,$00;
  jge @@richtig;
  not ecx;
  inc ecx;
  shr eax,cl;
  jmp @@out;
 @@richtig:
  shld eax,edx,cl;
 @@out:
end;


function _divibigints(divident,divisor:TBigintzahl;var rest:TBigintzahl):TBigintzahl;
var diffdwlaenge,difflaenge,stepsdivident,stepsdivisor:integer;divident1,divisor1:longword;pidaumen,abziehen,restzahl:TBigintzahl;
begin
    pidaumen:=TBigintzahl.create(1);
    abziehen:=TBigintzahl.create(0);
    rest:=TBigintzahl.create(0);
    restzahl:=divident;
    result:=TBigintzahl.create(1);
    if divident.laenge>divisor.laenge
    then begin
        stepsdivident:=stepstonormalize(restzahl.zahl[restzahl.laenge-1]);
        stepsdivisor:=stepstonormalize(divisor.zahl[divisor.laenge-1]);
        divident1:=rotdpl(restzahl.zahl[restzahl.laenge-1],restzahl.zahl[restzahl.laenge-1],stepsdivident);
        //geht da divident immer mindestens 2 lang ist da sonst laenge>laenge nicht erfüllt ist
        if divisor.laenge=1
        then begin

        end else begin
            divisor1:=rotdpl(divisor.zahl[divisor.laenge-1],divisor.zahl[divisor.laenge-1],stepsdivisor-16);
        end;
        diffdwlaenge:=restzahl.laenge-divisor.laenge;
        difflaenge:=stepsdivident-stepsdivisor;
        inc(divisor1);//damit pidaumen immer unterschätzt
        //wird dann könnte man sich hinten das mit nochmal addieren sparen
        pidaumen.zahl[0]:=divident1 div divisor1;
        {if pidaumen.zahl[0]=0
        then begin
            pidaumen.zahl[0]:=restzahl.zahl[restzahl.laenge-1] mod divisor.zahl[divisor.laenge-1];
            dec(difflaenge);//da ich ja jetzt mod benutze liegt das eigetnlich ein dword tiefer
        end;weg da divident jetzt nach Konstruktion immer größer ist}

        shldw(pidaumen,diffdwlaenge);
        shfr(pidaumen,16+difflaenge);

        abziehen:=divisor.mul(pidaumen);

        
        restzahl:=restzahl.sub(abziehen);//hier abziehen
       
        result:=_divibigints(restzahl,divisor,rest);//hier ist die eigentliche Rekursion
        result:=result.add(pidaumen);

    end else begin//falls sie die gleiche laenge haben ende der Rekursion
        pidaumen.zahl[0]:=restzahl.zahl[restzahl.laenge-1div divisor.zahl[divisor.laenge-1];
        if pidaumen.zahl[0]=0
        then begin
            result.zahl[0]:=0;
            rest:=divident;
        end else begin
            abziehen:=divisor.mul(pidaumen);
            rest:=divident.sub(abziehen);
            if rest.vorzeichen=true
            then begin
                result.zahl[0]:=pidaumen.zahl[0]-1;//kann wegen des vorzeichenbits im Integer evt hier nicht reinpassen da cardinal
                rest:=rest.add(divisor));
            end else begin
                result.zahl[0]:=pidaumen.zahl[0];//kann wegen des vorzeichenbits im Integer evt hier nicht reinpassen da cardinal
            end;
        end;
    end;
end;
Logikmensch
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 390

Win XP
Delphi 2007 Prof., XE2, XE5
BeitragVerfasst: Di 23.01.07 07:56 
Also, mich interessiert das Thema 'custom numbers' wirklich sehr! Zu dumm, dass ich momentan grad keine Zeit habe, Deine Routinen auszuprobieren, aber das werde ich definitiv nachholen.

Grade weil die Genauigkeit bei Deinem Zahlentyp offenbar zur Laufzeit festgelegt werden kann!

_________________
Es gibt keine Probleme - nur Lösungen!