home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / src / intprint.d < prev    next >
Encoding:
Text File  |  1996-04-15  |  10.9 KB  |  250 lines
  1. # Hilfsfunktion zur Ausgabe von Integers
  2.  
  3. # Tabelle: enthält zu jeder Basis b (2 <= b <= 36)
  4. # - eine Kettenbruchapproximation num/den von intDsize*log(2)/log(b)
  5. #   (num/den >= intDsize*log(2)/log(b), mit num <= 2^10)
  6. # - k-1 und b^k mit b^k < 2^intDsize, k maximal.
  7.   typedef struct { /* uintW num,den; */ uintC k_1; uintD b_hoch_k; } power_table_entry;
  8.   local power_table_entry table [36-2+1] = {
  9.     #if (intDsize==8)
  10.       { /*    8,  1, */ 7-1, 2*2*2*2*2*2*2},
  11.       { /*  106, 21, */ 5-1, 3*3*3*3*3},
  12.       { /*    4,  1, */ 3-1, 4*4*4},
  13.       { /*  789,229, */ 3-1, 5*5*5},
  14.       { /*  359,116, */ 3-1, 6*6*6},
  15.       { /*  436,153, */ 2-1, 7*7},
  16.       { /* 1019,382, */ 2-1, 8*8},
  17.       { /*   53, 21, */ 2-1, 9*9},
  18.       { /*  525,218, */ 2-1, 10*10},
  19.       { /* 1006,435, */ 2-1, 11*11},
  20.       { /*  665,298, */ 2-1, 12*12},
  21.       { /*  988,457, */ 2-1, 13*13},
  22.       { /*  872,415, */ 2-1, 14*14},
  23.       { /*  987,482, */ 2-1, 15*15},
  24.       { /*    2,  1, */ 1-1, 16},
  25.       { /*  869,444, */ 1-1, 17},
  26.       { /*  871,454, */ 1-1, 18},
  27.       { /*  597,317, */ 1-1, 19},
  28.       { /*   87, 47, */ 1-1, 20},
  29.       { /*  989,543, */ 1-1, 21},
  30.       { /*  949,529, */ 1-1, 22},
  31.       { /*  191,108, */ 1-1, 23},
  32.       { /*  930,533, */ 1-1, 24},
  33.       { /*  789,458, */ 1-1, 25},
  34.       { /*  691,406, */ 1-1, 26},
  35.       { /*  461,274, */ 1-1, 27},
  36.       { /*  218,131, */ 1-1, 28},
  37.       { /*  690,419, */ 1-1, 29},
  38.       { /*  494,303, */ 1-1, 30},
  39.       { /*  633,392, */ 1-1, 31},
  40.       { /*    8,  5, */ 1-1, 32},
  41.       { /*  766,483, */ 1-1, 33},
  42.       { /*  629,400, */ 1-1, 34},
  43.       { /*  967,620, */ 1-1, 35},
  44.       { /*  359,232, */ 1-1, 36},
  45.     #endif
  46.     #if (intDsize==16)
  47.       { /*   16,  1, */ 15-1, 2*2*2*2*2*2*2*2*2*2*2*2*2*2*2},
  48.       { /*  212, 21, */ 10-1, 3*3*3*3*3*3*3*3*3*3},
  49.       { /*    8,  1, */  7-1, 4*4*4*4*4*4*4},
  50.       { /*  379, 55, */  6-1, 5*5*5*5*5*5},
  51.       { /*  359, 58, */  6-1, 6*6*6*6*6*6},
  52.       { /*  872,153, */  5-1, 7*7*7*7*7},
  53.       { /* 1019,191, */  5-1, 8*8*8*8*8},
  54.       { /*  106, 21, */  5-1, 9*9*9*9*9},
  55.       { /*  525,109, */  4-1, 10*10*10*10},
  56.       { /* 1013,219, */  4-1, 11*11*11*11},
  57.       { /*  665,149, */  4-1, 12*12*12*12},
  58.       { /*  761,176, */  4-1, 13*13*13*13},
  59.       { /*  685,163, */  4-1, 14*14*14*14},
  60.       { /*  987,241, */  4-1, 15*15*15*15},
  61.       { /*    4,  1, */  3-1, 16*16*16},
  62.       { /*  869,222, */  3-1, 17*17*17},
  63.       { /*  871,227, */  3-1, 18*18*18},
  64.       { /*  113, 30, */  3-1, 19*19*19},
  65.       { /*  174, 47, */  3-1, 20*20*20},
  66.       { /*   51, 14, */  3-1, 21*21*21},
  67.       { /*  653,182, */  3-1, 22*22*22},
  68.       { /*  191, 54, */  3-1, 23*23*23},
  69.       { /*  677,194, */  3-1, 24*24*24},
  70.       { /*  789,229, */  3-1, 25*25*25},
  71.       { /*  691,203, */  3-1, 26*26*26},
  72.       { /*  461,137, */  3-1, 27*27*27},
  73.       { /*  436,131, */  3-1, 28*28*28},
  74.       { /*  359,109, */  3-1, 29*29*29},
  75.       { /*  988,303, */  3-1, 30*30*30},
  76.       { /*  633,196, */  3-1, 31*31*31},
  77.       { /*   16,  5, */  3-1, 32*32*32},
  78.       { /*  203, 64, */  3-1, 33*33*33},
  79.       { /*  629,200, */  3-1, 34*34*34},
  80.       { /*  967,310, */  3-1, 35*35*35},
  81.       { /*  359,116, */  3-1, 36*36*36},
  82.     #endif
  83.     #if (intDsize==32)
  84.       { /*   32,  1, */ 31-1, 2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL*2UL},
  85.       { /*  424, 21, */ 20-1, 3UL*3UL*3UL*3UL*3UL*3UL*3UL*3UL*3UL*3UL*3UL*3UL*3UL*3UL*3UL*3UL*3UL*3UL*3UL*3UL},
  86.       { /*   16,  1, */ 15-1, 4UL*4UL*4UL*4UL*4UL*4UL*4UL*4UL*4UL*4UL*4UL*4UL*4UL*4UL*4UL},
  87.       { /*  758, 55, */ 13-1, 5UL*5UL*5UL*5UL*5UL*5UL*5UL*5UL*5UL*5UL*5UL*5UL*5UL},
  88.       { /*  359, 29, */ 12-1, 6UL*6UL*6UL*6UL*6UL*6UL*6UL*6UL*6UL*6UL*6UL*6UL},
  89.       { /*   57,  5, */ 11-1, 7UL*7UL*7UL*7UL*7UL*7UL*7UL*7UL*7UL*7UL*7UL},
  90.       { /* 1003, 94, */ 10-1, 8UL*8UL*8UL*8UL*8UL*8UL*8UL*8UL*8UL*8UL},
  91.       { /*  212, 21, */ 10-1, 9UL*9UL*9UL*9UL*9UL*9UL*9UL*9UL*9UL*9UL},
  92.       { /*  289, 30, */  9-1, 10UL*10UL*10UL*10UL*10UL*10UL*10UL*10UL*10UL},
  93.       { /*  990,107, */  9-1, 11UL*11UL*11UL*11UL*11UL*11UL*11UL*11UL*11UL},
  94.       { /*  848, 95, */  8-1, 12UL*12UL*12UL*12UL*12UL*12UL*12UL*12UL},
  95.       { /*  761, 88, */  8-1, 13UL*13UL*13UL*13UL*13UL*13UL*13UL*13UL},
  96.       { /* 1017,121, */  8-1, 14UL*14UL*14UL*14UL*14UL*14UL*14UL*14UL},
  97.       { /*  901,110, */  8-1, 15UL*15UL*15UL*15UL*15UL*15UL*15UL*15UL},
  98.       { /*    8,  1, */  7-1, 16UL*16UL*16UL*16UL*16UL*16UL*16UL},
  99.       { /*  869,111, */  7-1, 17UL*17UL*17UL*17UL*17UL*17UL*17UL},
  100.       { /*  683, 89, */  7-1, 18UL*18UL*18UL*18UL*18UL*18UL*18UL},
  101.       { /*  113, 15, */  7-1, 19UL*19UL*19UL*19UL*19UL*19UL*19UL},
  102.       { /*  348, 47, */  7-1, 20UL*20UL*20UL*20UL*20UL*20UL*20UL},
  103.       { /*   51,  7, */  7-1, 21UL*21UL*21UL*21UL*21UL*21UL*21UL},
  104.       { /*  653, 91, */  7-1, 22UL*22UL*22UL*22UL*22UL*22UL*22UL},
  105.       { /*  191, 27, */  7-1, 23UL*23UL*23UL*23UL*23UL*23UL*23UL},
  106.       { /*  677, 97, */  6-1, 24UL*24UL*24UL*24UL*24UL*24UL},
  107.       { /*  379, 55, */  6-1, 25UL*25UL*25UL*25UL*25UL*25UL},
  108.       { /*  851,125, */  6-1, 26UL*26UL*26UL*26UL*26UL*26UL},
  109.       { /*  922,137, */  6-1, 27UL*27UL*27UL*27UL*27UL*27UL},
  110.       { /*  872,131, */  6-1, 28UL*28UL*28UL*28UL*28UL*28UL},
  111.       { /*  718,109, */  6-1, 29UL*29UL*29UL*29UL*29UL*29UL},
  112.       { /*  150, 23, */  6-1, 30UL*30UL*30UL*30UL*30UL*30UL},
  113.       { /*  633, 98, */  6-1, 31UL*31UL*31UL*31UL*31UL*31UL},
  114.       { /*   32,  5, */  6-1, 32UL*32UL*32UL*32UL*32UL*32UL},
  115.       { /*  203, 32, */  6-1, 33UL*33UL*33UL*33UL*33UL*33UL},
  116.       { /*  629,100, */  6-1, 34UL*34UL*34UL*34UL*34UL*34UL},
  117.       { /*  967,155, */  6-1, 35UL*35UL*35UL*35UL*35UL*35UL},
  118.       { /*  359, 58, */  6-1, 36UL*36UL*36UL*36UL*36UL*36UL},
  119.     #endif
  120.     };
  121.  
  122. # digits_need(len,base) liefert eine obere Abschätzung für die Anzahl der
  123. # Ziffern im Stellenwertsystem der Basis base, die eine UDS der Länge len
  124. # braucht.
  125.   local uintL digits_need (uintC len, uintWL base);
  126.   local uintL digits_need(len,base)
  127.     var reg3 uintC len;
  128.     var reg2 uintWL base;
  129.     { # 1+ceiling(len * intDsize*log(2)/log(base)) Bytes oder etwas mehr
  130.       var reg1 uintL need = 1+floor(len,1024/intDsize); # > ceiling(len*intDsize/1024) >= 0
  131.       switch (base) # need mit ceiling(1024*log(2)/log(base)) multiplizieren:
  132.         { case 2: need = 1024*need; break;
  133.           case 3: need = 647*need; break;
  134.           case 4: need = 512*need; break;
  135.           case 5: need = 442*need; break;
  136.           case 6: need = 397*need; break;
  137.           case 7: need = 365*need; break;
  138.           case 8: need = 342*need; break;
  139.           case 9: need = 324*need; break;
  140.           case 10: need = 309*need; break;
  141.           case 11: need = 297*need; break;
  142.           case 12: need = 286*need; break;
  143.           case 13: need = 277*need; break;
  144.           case 14: need = 269*need; break;
  145.           case 15: need = 263*need; break;
  146.           case 16: need = 256*need; break;
  147.           case 17: need = 251*need; break;
  148.           case 18: need = 246*need; break;
  149.           case 19: need = 242*need; break;
  150.           case 20: need = 237*need; break;
  151.           case 21: need = 234*need; break;
  152.           case 22: need = 230*need; break;
  153.           case 23: need = 227*need; break;
  154.           case 24: need = 224*need; break;
  155.           case 25: need = 221*need; break;
  156.           case 26: need = 218*need; break;
  157.           case 27: need = 216*need; break;
  158.           case 28: need = 214*need; break;
  159.           case 29: need = 211*need; break;
  160.           case 30: need = 209*need; break;
  161.           case 31: need = 207*need; break;
  162.           case 32: need = 205*need; break;
  163.           case 33: need = 203*need; break;
  164.           case 34: need = 202*need; break;
  165.           case 35: need = 200*need; break;
  166.           case 36: need = 199*need; break;
  167.           default: NOTREACHED
  168.         }
  169.       # Nun gilt need >= len*intDsize*log(2)/log(base).
  170.       need += 1; # Platzbedarf in Bytes
  171.       return need;
  172.     }
  173.  
  174. # Wandelt eine UDS in ein Stellensystem um.
  175. # UDS_to_DIGITS(MSDptr,len,base, &ergebnis);
  176. # > MSDptr/len/..: eine UDS
  177. # > base: Stellensystem-Basis, 2 <= base <= 36.
  178. # > ergebnis.LSBptr: darunter ist mindestens digits_need(len) Bytes Platz
  179. # < ergebnis: fertige Folge MSBptr/len/LSBptr von Ziffern
  180. # Die UDS MSDptr/len/.. wird zerstört.
  181.   typedef struct { uintB* MSBptr; uintL len; uintB* LSBptr; } DIGITS;
  182.   local void UDS_to_DIGITS (uintD* MSDptr, uintC len, uintD base, DIGITS* erg);
  183. # Methode:
  184. # Umwandlung ins Stellensystem der Basis b geht durch Umwandlung ins Stellen-
  185. # system der Basis b^k (k>=1, b^k<2^intDsize, k maximal) vor sich.
  186. # Aufsuchen von k und b^k aus einer Tabelle.
  187. # Reduktion der UWS zu einer NUWS X.
  188. # Falls X=0: die eine Ziffer 0.
  189. # Falls X>0:
  190. #   Dividiere X durch das Wort b^k,
  191. #   (Single-Precision-Division, vgl. UDS_DIVIDE mit n=1:
  192. #     r:=0, j:=m=Länge(X),
  193. #     while j>0 do
  194. #       j:=j-1, r:=r*beta+X[j], X[j]:=floor(r/b^k), r:=r-b^k*q[j].
  195. #     r=Rest.)
  196. #   zerlege den Rest (mit k-1 Divisionen durch b) in k Ziffern, wandle diese
  197. #   Ziffern einzeln in Ascii um und lege sie an die DIGITS an.
  198. #   Teste auf Speicherüberlauf.
  199. #   X := Quotient.
  200. #   Mache aus X wieder eine NUDS (maximal 1 Nulldigit streichen).
  201. #   Dies solange bis X=0.
  202. #   Streiche die führenden Nullen.
  203.   local void UDS_to_DIGITS(MSDptr,len,base,erg)
  204.     var reg5 uintD* MSDptr;
  205.     var reg6 uintC len;
  206.     var reg7 uintD base;
  207.     var reg10 DIGITS* erg;
  208.     { # Aufsuchen von k-1 und b^k aus der Tabelle:
  209.       var reg10 power_table_entry* tableptr = &table[base-2];
  210.       var reg9 uintC k_1 = tableptr->k_1; # k-1
  211.       var reg8 uintD b_hoch_k = tableptr->b_hoch_k; # b^k
  212.       var reg2 uintB* erg_ptr = erg->LSBptr;
  213.       #define next_digit(d)  { *--erg_ptr = (d<10 ? '0'+d : 'A'-10+d); }
  214.       # normalisiere zu einer NUDS:
  215.       loop
  216.         { if (len==0) { next_digit(0); goto fertig; } # 0 -> eine Ziffer '0'
  217.           if (MSDptr[0]==0) { MSDptr++; len--; }
  218.           else break;
  219.         }
  220.       loop
  221.         { # Noch die NUDS MSDptr/len/.. mit len>0 abzuarbeiten.
  222.           # Single-Precision-Division durch b^k:
  223.           var reg3 uintD rest = divu_loop_up(b_hoch_k,MSDptr,len);
  224.           # Zerlegen des Restes in seine k Ziffern:
  225.          {var reg4 uintC count = k_1;
  226.           if ((intDsize>=11) || (count>0))
  227.             # (Bei intDsize>=11 ist wegen b<=36 zwangsläufig
  228.             # k = ceiling(intDsize*log(2)/log(b))-1 >= 2, also count = k_1 > 0.)
  229.             do { var reg1 uintD d;
  230.                  #if HAVE_DD
  231.                    divuD((uintDD)rest,base,rest=,d=);
  232.                  #else
  233.                    divuD(0,rest,base,rest=,d=);
  234.                  #endif
  235.                  next_digit(d);
  236.                }
  237.                until (--count == 0);
  238.           next_digit(rest); # letzte der k Ziffern ablegen
  239.           # Quotienten normalisieren (max. 1 Digit streichen):
  240.           if (MSDptr[0]==0) { MSDptr++; len--; if (len==0) break; }
  241.         }}
  242.       #undef next_digit
  243.       # Streiche führende Nullen:
  244.       while (*erg_ptr == '0') { erg_ptr++; }
  245.       fertig:
  246.       erg->MSBptr = erg_ptr;
  247.       erg->len = erg->LSBptr - erg_ptr;
  248.     }
  249.  
  250.