home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / sorting.swg / 0020_RADIX1.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  4.2 KB  |  158 lines
  1. {
  2.    Here's my solution to your "contest". The first I'm rather proud
  3.    of, it incorporates bAsm to beat your devilshly efficient CASE
  4.    Implementation by a factor of 2x.
  5.  
  6.    The second, I am rather disappointed With as it doesn't even come
  7.    CLOSE to TP's inbuilt STR Function. (The reason, I have found, is
  8.    because TP's implementaion Uses a table based approach that would
  9.    be hard to duplicate With Variable radixes. I am working on a
  10.    Variable radix table now)
  11.  
  12.  
  13.   ****************************************************************
  14.   Converts String pointed to by S into unsigned Integer V. No
  15.   range or error checking is performed. Caller is responsible for
  16.   ensuring that Radix is in proper range of 2-36, and that no
  17.   invalid Characters exist in the String.
  18.   ****************************************************************
  19. }
  20. Type
  21.   pChar      = ^chr_Array;
  22.   chr_Array  = Array[0..255] of Char;
  23.   Byte_arry  = Array[Char] of Byte;
  24.  
  25. Const
  26.   sym_tab : Byte_arry = (
  27.               0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  28.               0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  29.               0,0,0,0,0,0,0,0,0,1,2,3,4,5,6,7,8,9,
  30.               0,0,0,0,0,0,0,10,11,12,13,14,15,16,17,
  31.               18,19,20,21,22,23,24,25,26,27,28,29,30,
  32.               31,32,33,34,35,0,0,0,0,0,0,10,11,12,13,
  33.               14,15,16,17,18,19,20,21,22,23,24,25,26,
  34.               27,28,29,30,31,32,33,34,35,0,0,0,0,0,0,
  35.               0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  36.               0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  37.               0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  38.               0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  39.               0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  40.               0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  41.               0,0,0,0,0,0,0,0,0,0,0,0,0
  42.                         );
  43.  
  44. Procedure RadixVal(Var V:LongInt; S:PChar;Radix:Byte);
  45. Var
  46.   digit        :Byte;
  47.   p,    p2     :Pointer;
  48.   hiwd, lowd   :Word;
  49. begin
  50.   V  := 0;
  51.   p  := @S^[0];
  52.   p2 := @V;
  53.   Asm
  54.     les  bx, p2
  55.     push ds
  56.     pop  es
  57.     lds  si, p
  58.   @loop3:
  59.     lea  di, [sym_tab]
  60.     xor  ah, ah
  61.     lodsb
  62.     cmp  al, 0
  63.     je   @quit
  64.     add  di, ax             { index to Char position in table }
  65.     mov  al, Byte PTR [di]
  66.     mov  digit, al
  67.     xor  ah, ah
  68.     mov  al, Radix
  69.     mov  cx, ax
  70.     mul  Word PTR [bx]
  71.     mov  lowd, ax
  72.     mov  hiwd, dx
  73.     mov  ax, cx
  74.     mul  Word PTR [bx+2] { mutliply high Word With radix }
  75.     add  hiwd, ax        { add result to previous result - assume hi result 0 }
  76.     mov  ax, lowd
  77.     mov  dx, hiwd
  78.     add  al, digit     { add digit value }
  79.     adc  ah, 0         { resolve any carry }
  80.     mov  [bx], ax      { store final values }
  81.     mov  [bx+2], dx
  82.     jmp  @loop3
  83.   @quit:
  84.   end;
  85. end;
  86.  
  87. {
  88.   ****************************************************************
  89.   Convert unsigned Integer in V to String pointed to by S.
  90.   Radix determines the base to use in the conversion. No range
  91.   checking is performed, the caller is responsible For ensuring
  92.   the radix is in the proper range (2-36), and that V is positive.
  93.   ****************************************************************
  94. }
  95. Type
  96.   Char_arry = Array[0..35] of Char;
  97.  
  98. Const
  99.   symbols :Char_arry = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  100.  
  101. Procedure RadixStr(V:LongInt; S:PChar; Radix:Byte);
  102. Var
  103.   digit, c :Byte;
  104.   ts       :String;
  105.   p, p2    :Pointer;
  106. begin
  107.   c := 255;
  108.   ts[255] := #0;
  109.   p  := @V;
  110.   p2 := @ts[0];
  111.   Asm
  112.     push ds
  113.     lea  si, [symbols]
  114.     les  bx, p
  115.     les  di, p2
  116.     add  di, 255
  117.     std
  118.     xor  cx, cx
  119.     mov  cl, Radix
  120.   @loop:
  121.   SEGES mov  ax, Word PTR [bx]
  122.   SEGES mov  dx, Word PTR [bx+2]
  123.     div  cx
  124.   SEGES mov  Word PTR [bx], ax
  125.   SEGES mov  Word PTR [bx+2], 0
  126.     mov  digit, dl
  127.     push si
  128.     xor  ah, ah
  129.     mov  al, digit
  130.     add  si, ax
  131.     movsb
  132.     pop  si
  133.     dec  c
  134.   SEGES cmp  Word PTR [bx], 0
  135.     je   @done
  136.   SEGES cmp  Word PTR [bx+2], 0
  137.     je   @loop
  138.   @done:
  139.     pop  ds
  140.   end;
  141.   ts[c] := Chr(255-c);
  142.   p  := @S^[0];
  143.   Asm
  144.     push ds
  145.     cld
  146.     lds  si, p2
  147.     les  di, p
  148.     xor  bx, bx
  149.     mov  bl, c
  150.     add  si, bx
  151.     mov  cx, 256
  152.     sub  cl, c
  153.     sbb  ch, 0
  154.     rep movsb
  155.     pop  ds
  156.   end;
  157. end;
  158.