Domanda

In C++ you can send parameters that allow pointer arithmetic on arrays. I need to be able to do that in a Delphi 7 project. I tried doing it this way, but the receiving procedure is coughing. If an array pointer is incremented shouldn't c^[0] be at the new increment location?

The first procedure calls makect() but first moves the pointer to a memory location higher in the array by incrementing it. However the second procedure, when set to the array pointer position 0, does not like it. (of course there could be something else wrong, but I want to know if I am doing this correctly).

types listed here for clarity

type
  Pflt = ^flt;
  flt = double;

  Pflt_arr = ^flt_arr;
  flt_arr = array of flt;

  Pint_arr = ^int_arr;
  int_arr = array of integer;

constructor

constructor TRefT.Create(const length:integer);
begin
  len := length;
  SetLength(_ip, 2 + (1 shl trunc(ln(length / 4.0) / ln(2.0) + 0.5) shr 1) );
  _ip[0] := 0;
  SetLength(_w, length shr 1);
end;


procedure TRefT.CF(buff: pflt_arr);
begin
  rdft(len, 1, buff, @_ip, @_w);
end;

calling procedure

procedure TRefT.rdft(n:integer; isgn:integer; a:Pflt_arr; ip:Pint_arr; w:Pflt_arr);
var nw, nc: integer;
xi: flt;
begin
 nw := ip^[0];
 nc := ip^[1];
 if n > (nc shl 2) then
 begin
  nc := n shr 2;
  inc(w, nw);       <--attempt at pointer arithmetic
  makect(nc, ip, w); <-- C++ version is makect(nc, ip, w + nw);
 end;
end;

receiving procedure (with incremented array);

procedure TRefT.makect(nc:integer; ip:Pint_arr; c:Pflt_arr);
var j, nch: integer;
  delta: flt;
begin
ip^[1] := nc;
if nc > 1 then
 begin
    nch := nc shr 1;
    delta := arctan(1.0) / nch;
    c^[0] := cos(delta * nch);  <-- coughs here!
    c^[nch] := 0.5 * c^[0];
    for j := 1 to nch do
     begin
        c^[j] := 0.5 * cos(delta * j);
        c^[nc - j] := 0.5 * sin(delta * j);
     end;
 end;
end;
È stato utile?

Soluzione

Your code is incorrect. You've got an extra, erroneous, level of indirection. What you need here is pointers to static array of Double rather than pointers to dynamic array of Double.

Remember that a dynamic array is implemented as a pointer to the first element of the array. So your types are, in terms of indirection, equivalent to pointer to pointer to scalar.

One way to proceed is to declare types like this

type
  Pflt_arr = ^Tflt_arr;
  Tflt_arr = array [0..0] of flt;

  Pint_arr = ^Tint_arr;
  Tint_arr = array [0..0] of Integer;

and make sure change checking is disabled for this code.

This will allow you to write:

a^[i]

when a is of type Pflt_array.

What's more if you write:

inc(a, n);

then it will increment the address a by n*sizeof(a^) which is n*sizeof(Tflt_array) which is n*sizeof(flt)*Length(a^)) which is n*sizeof(flt) which is exactly as you want.

This breaks down when you supply a constant expression as an index. As per this line:

nc := ip^[1];

Here the compiler will object that 1 is not in the range 0..0. So you cannot have it both ways.

In this case you appear to need to crack the first two elements of ip. Which you can do like this:

type
  Phuge_int_arr = ^Thuge_int_arr; 
  Thuge_int_arr = array [0..(MaxInt div sizeof(Integer))-1] of Integer;

and then writing:

nc := Phuge_int_arr(ip)^[1];

That feels a little messy.


The alternative is to write the types like this:

type
  Pflt_arr = ^Tflt_arr;
  Tflt_arr = array [0..(MaxInt div sizeof(flt))-1] of flt;

That works fine for all indexing scenarios, and allows you to leave range checking enabled. But it makes pointer incrementing more difficult. Now you have to write:

inc(Pflt(a), n);

On balance, this latter approach is probably the lesser of the two evils.


The code that declares the actual storage still should use dynamic arrays, SetLength etc. When you need a Pflt_array, or a Pint_array cast the dynamic array:

Pflt_array(dyn_array)

This works because dynamic arrays are implemented as pointers to the first element of the array.


With the 0..0 variant, your code looks like this:

type
  Pflt = ^flt;
  flt = Double;

  Pflt_arr = ^Tflt_arr;
  Tflt_arr = array [0..0] of flt;

  Pint_arr = ^Tint_arr;
  Tint_arr = array [0..0] of Integer;

  Phuge_int_arr = ^Thuge_int_arr; 
  Thuge_int_arr = array [0..(MaxInt div sizeof(Integer))-1] of Integer;

....

constructor TRefT.Create(const length:integer);
begin
  len := length;
  SetLength(_ip, 2 + (1 shl trunc(ln(length / 4.0) / ln(2.0) + 0.5) shr 1) );
  SetLength(_w, length shr 1);
end;

procedure TRefT.CF(buff: pflt_arr);
begin
  rdft(len, 1, buff, Pint_arr(_ip), Pflt_arr(_w));
end;

procedure TRefT.rdft(n:integer; isgn:integer; a:Pflt_arr; ip:Pint_arr; w:Pflt_arr);
var nw, nc: integer;
    xi: flt;
begin
  nw := Phuge_int_arr(ip)^[0];
  nc := Phuge_int_arr(ip)^[1];
  if n > (nc shl 2) then
  begin
    nc := n shr 2;
    inc(w, nw);
    makect(nc, ip, w);
  end;
end;

procedure TRefT.makect(nc:integer; ip:Pint_arr; c:Pflt_arr);
var j, nch: integer;
    delta: flt;
begin
  Phuge_int_arr(ip)^[1] := nc;
  if nc > 1 then
  begin
    nch := nc shr 1;
    delta := arctan(1.0) / nch;
    c^[0] := cos(delta * nch);
    c^[nch] := 0.5 * c^[0];
    for j := 1 to nch do
    begin
      c^[j] := 0.5 * cos(delta * j);
      c^[nc - j] := 0.5 * sin(delta * j);
    end;
  end;
end;

Or the alternative using 0..(MaxInt div sizeof(scalar))-1 looks like this:

type
  Pflt = ^flt;
  flt = Double;

  Pflt_arr = ^Tflt_arr;
  Tflt_arr = array [0..(MaxInt div sizeof(flt))-1] of flt;

  Pint_arr = ^Tint_arr;
  Tint_arr = array [0..(MaxInt div sizeof(Integer))-1] of Integer;

....

constructor TRefT.Create(const length:integer);
begin
  len := length;
  SetLength(_ip, 2 + (1 shl trunc(ln(length / 4.0) / ln(2.0) + 0.5) shr 1) );
  SetLength(_w, length shr 1);
end;

procedure TRefT.CF(buff: pflt_arr);
begin
  rdft(len, 1, buff, Pint_arr(_ip), Pflt_arr(_w));
end;

procedure TRefT.rdft(n:integer; isgn:integer; a:Pflt_arr; ip:Pint_arr; w:Pflt_arr);
var nw, nc: integer;
    xi: flt;
begin
  nw := ip^[0];
  nc := ip^[1];
  if n > (nc shl 2) then
  begin
    nc := n shr 2;
    inc(Pflt(w), nw);
    makect(nc, ip, w);
  end;
end;

procedure TRefT.makect(nc:integer; ip:Pint_arr; c:Pflt_arr);
var j, nch: integer;
    delta: flt;
begin
  ip^[1] := nc;
  if nc > 1 then
  begin
    nch := nc shr 1;
    delta := arctan(1.0) / nch;
    c^[0] := cos(delta * nch);
    c^[nch] := 0.5 * c^[0];
    for j := 1 to nch do
    begin
      c^[j] := 0.5 * cos(delta * j);
      c^[nc - j] := 0.5 * sin(delta * j);
    end;
  end;
end;

Take your pick!


FWIW you might take the opportunity whilst porting this code to change the shl 2 and shr 2 operations into arithmetic operations for the sake of clarity.

An option that you may not be aware of is not translating at all. Compile the original .c files into objects and link them statically using $LINK.

One final comment is that it is a shame you are stuck with such an old version of Delphi. Modern versions have the $POINTERMATH compiler option. This allows C style pointer arithmetic and indexing on plain pointer to scalar variables. A huge boon for such porting tasks.

Altri suggerimenti

Note: this answer is not an attempt to answer the question at hand. David did that and presented ways to handle the pointer arithmetics.

I don't know how much code you have similar to what is presented here. Working with pointers can be cumbersome and sometimes leads to simple mistakes when typecasting.

A more straight Delphi solution would be to work with dynamic arrays, and declare methods with open arrays.

A solution with your example would look like this:

Type
 TRefT = class
 private
   len : Integer;
   _ip : array of integer;
   _w  : array of double;
 public
   Constructor Create(const length : integer);
   procedure CF(const buff : array of double);  // Or var
   procedure rdft(       n    : integer;
                         isgn : integer;
                   const a    : array of double;  // Or var
                     var ip   : array of integer;
                     var w    : array of double);
   procedure makect(     nc : integer;
                         nw : integer; // c array index offset
                     var ip : array of integer;
                     var c  : array of double);
 end;

constructor TRefT.Create(const length:integer);
begin
  len := length;
  SetLength(_ip, 2 + (1 shl trunc(ln(length / 4.0) / ln(2.0) + 0.5) shr 1) );
  SetLength(_w, length shr 1);
end;

procedure TRefT.CF(const buff: array of double);
begin
  rdft(len, 1, buff, _ip, _w);
end;

procedure TRefT.rdft(       n    : integer;
                            isgn : integer;
                      const a    : array of double;
                        var ip   : array of integer;
                        var w    : array of double);
var
  nw, nc: integer;
begin
  nw := ip[0];
  nc := ip[1];
  if n > (nc shl 2) then
  begin
    nc := n shr 2;
    makect(nc, nw, ip, w);
  end;
end;

procedure TRefT.makect(     nc : integer;
                            nw : integer;  // c array index offset
                        var ip : array of integer;
                        var c  : array of double);
var
  j, nch: integer;
  delta: double;
begin
  ip[1] := nc;
  if nc > 1 then
  begin
    nch := nc shr 1;
    delta := ArcTan(1.0) / nch;
    c[nw] := Cos(delta * nch);
    c[nch + nw] := 0.5 * c[nw];
    for j := 1 to nch do
    begin
      c[j + nw] := 0.5 * Cos(delta * j);
      c[nc - j + nw] := 0.5 * Sin(delta * j);
    end;
  end;
end;

If you have large c++ libraries to translate, I would suggest to follow David's recommendations, otherwise this more pascal/Delphi like way is easier to work with.

Autorizzato sotto: CC-BY-SA insieme a attribuzione
Non affiliato a StackOverflow
scroll top