[fpc-pascal] rotating bits

[Пётр Косаревский]

> On 24 mei 2006, at 10:56, Пётр Косаревский wrote:
> > Is there high level operator/(inline)function for rotating bits?
> No.
> > Am I supposed to implement rotating bits (like ror/rol in i386 asm)  
> > by inline assembler or some ugly workarounds (shifts and or-s)?
> Yes. I think there's already a feature request to provide these  
> operations, but no one worked on it yet.
> Jonas_______________________________________________

Why don't use this code?

{$INLINE ON}
interface
{$IFDEF CPUI386}
 function brol(b: byte; c: byte): byte; assembler; inline;
 function wrol(w: word; c: byte): word; assembler; inline;
 function lrol(l: longword; c: byte): longword; assembler; inline;
 function bror(b: byte; c: byte): byte; assembler; inline;
 function wror(w: word; c: byte): word; assembler; inline;
 function lror(l: longword; c: byte): longword; assembler; inline;
{$ELSE}
 function brol(b: byte; c: byte): byte; inline;
 function wrol(w: word; c: byte): word; inline;
 function lrol(l: longword; c: byte): longword; inline;
 function bror(b: byte; c: byte): byte; inline;
 function wror(w: word; c: byte): word; inline;
 function lror(l: longword; c: byte): longword; inline;
{$ENDIF}

implementation
{$IFDEF CPUI386}
 function brol(b: byte; c: byte): byte; assembler; inline;
   asm
   movb  b,%al
   movb  c,%cl
   rolb  %cl,%al
   movb  %al,result
   end ['al','cl'];
 function wrol(w: word; c: byte): word; assembler; inline;
   asm
   movw  w,%ax
   movb  c,%cl
   rolw  %cl,%ax
   movw  %ax,result
   end ['ax','cl'];
 function lrol(l: longword; c: byte): longword; assembler; inline;
   asm
   movl  l,%eax
   movb  c,%cl
   roll  %cl,%eax
   movl  %eax,result
   end ['eax','cl'];
 function bror(b: byte; c: byte): byte; assembler; inline;
   asm
   movb  b,%al
   movb  c,%cl
   rorb  %cl,%al
   movb  %al,result
   end ['al','cl'];
 function wror(w: word; c: byte): word; assembler; inline;
   asm
   movw  w,%ax
   movb  c,%cl
   rorw  %cl,%ax
   movw  %ax,result
   end ['ax','cl'];
 function lror(l: longword; c: byte): longword; assembler; inline;
   asm
   movl  l,%eax
   movb  c,%cl
   rorl  %cl,%eax
   movl  %eax,result
   end ['eax','cl'];
{$ELSE}
 function brol(b: byte; c: byte): byte; inline;
   var s,r: byte;
   begin
   s:=c and $7;
   r:=byte(b shl s);
   r:=r or byte(b shr (8-s)); // c may be over 8 and should be processed correctly
   brol:=r; // "result" is not supported in inline procedures
   end;
 function wrol(w: word; c: byte): word; inline;
   var s: byte; r: word;
   begin
   s:=c and $f;
   r:=word(w shl s);
   r:=r or word(w shr (16-s)); // c may be over 16 and should be processed correctly
   wrol:=r;
   end;
 function lrol(l: longword; c: byte): longword; inline;
   var s: byte; r: longword;
   begin
   s:=c and $1f;
   r:=longword(l shl s);
   r:=r or longword(l shr (32-s)); // c may be over 32 and should be processed correctly
   lrol:=r;
   end;
 function bror(b: byte; c: byte): byte; inline;
   var s,r: byte;
   begin
   s:=c and $7;
   r:=byte(b shr s);
   r:=r or byte(b shl (8-s)); // c may be over 8 and should be processed correctly
   bror:=r;
   end;
 function wror(w: word; c: byte): word; inline;
   var s: byte; r: word;
   begin
   s:=c and $f;
   r:=word(w shr s);
   r:=r or word(w shl (16-s)); // c may be over 16 and should be processed correctly
   wror:=r;
   end;
 function lror(l: longword; c: byte): longword; inline;
   var s: byte; r: longword;
   begin
   s:=c and $1f;
   r:=longword(l shr s);
   r:=r or longword(l shl (32-s)); // c may be over 32 and should be processed correctly
   lror:=r;
   end;
{$ENDIF}


Comments:
   I. style/consistency
      I didn't use all needed {$if}s: current code should word with range checks on both on i386 and not.
      {$Asmmode} was not used either.
      First symbol denotes type: while shl/shr emit longword, cyclic shifts shouldn't
      Endianness is not supported, because I don't understand, why it should be.
   II. performance
      "Result" is not supported in the inline mode.
      I don't know how to use "ret" to achieve the same goal with fewer commands.

Test:
{$INLINE ON}
program testb;
  uses commonthingies;
var i: byte;    b: byte;    w: word;    l: longword;
begin
write('Enter byte (dec):');readln(b);
for i:=0 to 16 do
  writeln('Orig:',binstr(b,8),'   Left:',binstr(brol(b,i),8),'   Right:',binstr(bror(b,i),8));
write('Enter word (dec):');readln(w);
for i:=0 to 32 do
  writeln('Orig:',binstr(w,16),'   Left:',binstr(wrol(w,i),16),'   Right:',binstr(wror(w,i),16));
write('Enter lw (dec)  :');readln(l);
for i:=0 to 64 do
  writeln('Orig:',binstr(l,32),'   Left:',binstr(lrol(l,i),32),'   Right:',binstr(lror(l,i),32));
end.