home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / src / intread.d < prev    next >
Encoding:
Text File  |  1996-04-15  |  3.6 KB  |  87 lines
  1. # Hilfsfunktion zur Eingabe von Integers
  2.  
  3. # Wandelt eine Ziffernfolge in ein Integer >=0 um.
  4. # DIGITS_to_I(MSBptr,len,base)
  5. # > base: Stellenwertsystem-Basis, >=2, <=36
  6. # > MSBptr/len/..: Ziffernfolge, bestehend aus Punkten (werden überlesen)
  7. #     und Ziffern/Buchstaben mit Wert < base.
  8. # < ergebnis: der dargestellte Integer >=0
  9. # kann GC auslösen
  10.   local object DIGITS_to_I (uintB* MSBptr, uintL len, uintD base);
  11.   local object DIGITS_to_I(MSBptr,len,base)
  12.     var reg2 uintB* MSBptr;
  13.     var reg3 uintL len;
  14.     var reg8 uintD base;
  15.     { SAVE_NUM_STACK # num_stack retten
  16.       var reg6 uintD* erg_MSDptr;
  17.       var reg7 uintC erg_len;
  18.       var reg5 uintD* erg_LSDptr;
  19.       # Platz fürs Ergebnis:
  20.       # 1+ceiling(len*log(base)/(intDsize*log(2))) oder etwas mehr Digits
  21.       var reg9 uintL need = 1+floor(len,intDsize*256); # > len/(intDsize*256) >=0
  22.       switch (base) # need mit ceiling(256*log(base)/log(2)) multiplizieren:
  23.         { case 2: need = 256*need; break;
  24.           case 3: need = 406*need; break;
  25.           case 4: need = 512*need; break;
  26.           case 5: need = 595*need; break;
  27.           case 6: need = 662*need; break;
  28.           case 7: need = 719*need; break;
  29.           case 8: need = 768*need; break;
  30.           case 9: need = 812*need; break;
  31.           case 10: need = 851*need; break;
  32.           case 11: need = 886*need; break;
  33.           case 12: need = 918*need; break;
  34.           case 13: need = 948*need; break;
  35.           case 14: need = 975*need; break;
  36.           case 15: need = 1001*need; break;
  37.           case 16: need = 1024*need; break;
  38.           case 17: need = 1047*need; break;
  39.           case 18: need = 1068*need; break;
  40.           case 19: need = 1088*need; break;
  41.           case 20: need = 1107*need; break;
  42.           case 21: need = 1125*need; break;
  43.           case 22: need = 1142*need; break;
  44.           case 23: need = 1159*need; break;
  45.           case 24: need = 1174*need; break;
  46.           case 25: need = 1189*need; break;
  47.           case 26: need = 1204*need; break;
  48.           case 27: need = 1218*need; break;
  49.           case 28: need = 1231*need; break;
  50.           case 29: need = 1244*need; break;
  51.           case 30: need = 1257*need; break;
  52.           case 31: need = 1269*need; break;
  53.           case 32: need = 1280*need; break;
  54.           case 33: need = 1292*need; break;
  55.           case 34: need = 1303*need; break;
  56.           case 35: need = 1314*need; break;
  57.           case 36: need = 1324*need; break;
  58.           default: NOTREACHED
  59.         }
  60.       # Nun gilt need >= len*log(base)/(intDsize*log(2)).
  61.       need += 1;
  62.       if ((intCsize < 32) && (need > (uintL)(bitc(intCsize)-1))) { BN_ueberlauf(); }
  63.       num_stack_need(need,_EMA_,erg_LSDptr=);
  64.       erg_MSDptr = erg_LSDptr; erg_len = 0;
  65.       # Ziffern einzeln draufaddieren:
  66.       dotimesL(len,len,
  67.         { # erg_MSDptr/erg_len/erg_LSDptr ist eine NUDS, erg_len < need.
  68.           var reg1 uintB ch = *MSBptr++; # nächstes Character
  69.           if (!(ch=='.')) # Punkt überlesen
  70.             { # Wert von ch ('0'-'9','A'-'Z','a'-'z') bilden:
  71.               ch = ch - '0';
  72.               if (ch > '9'-'0') # keine Ziffer?
  73.                 { ch = ch+'0'-'A'+10;
  74.                   if (ch > 'Z'-'A'+10) # kein Großbuchstabe?
  75.                     { ch = ch+'A'-'a'; } # dann ein Kleinbuchstabe
  76.                 }
  77.               # multipliziere erg mit base und addiere ch:
  78.              {var reg4 uintD carry = mulusmall_loop_down(base,erg_LSDptr,erg_len,ch);
  79.               if (!(carry==0))
  80.                 # muß NUDS vergrößern:
  81.                 { *--erg_MSDptr = carry; erg_len++; }
  82.         }   }});
  83.       RESTORE_NUM_STACK # num_stack (vorzeitig) zurück
  84.       return NUDS_to_I(erg_MSDptr,erg_len);
  85.     }
  86.  
  87.