Dynamic array in Turbo Pascal - pascal

I am working on my school project and I would like to use Dynamic (not static) array. I worked with ObjectPascal, so I am used to some syntax. But now I am programming in the old TurboPascal (I am using Turbo Pascal 7 for Windows).
It doesn't seem to know the ObjectPascal, so I thought, that you Turbo Pascal doesn't know dynamic arrays.
Could anyone tell me, if my theory is right or not? I tried to google, but I was not succesfull.
Basicly I am asking "how is it with dynamic arrays in Turbo Pascal 7" ?
Thank you for all reactions.

As MartynA says, there is no dynamic array type in Turbo Pascal. You need to manually allocate memory using pointers, and be careful if you use rangechecks.
Typically you define an array type
TYPE
TArrayT = array[0.. ((65535-spillbytes) div sizeof(T))-1] of T;
where spillbytes is a constant for a small deduction because you can't use the whole 64k, see what the compiler accepts. (Probably this deduction is for heapmanager structures inside the 64k block)
Then you define a pointer
PArrayT= ^TArrayT;
and a variable to it
var
P : PArrayT;
and you allocate nrelement elements using getmem;
getmem(P,SizeOf(T) * nrelements);
and optionally fill them with zero to initialize them:
fillchar(p^,SizeOf(T) * nrelements,#0);
You can access elements using
p^[index]
to free them, use freemem using the exact opposite of the getmem line.
freemem(P,Sizeof(T)*nrelements);
Which means you have to save the allocated number of elements somewhere. This was fixed/solved in Delphi and FPC.
Also keep in mind that you can't find bugs with rangechecking anymore.
If you want arrays larger than 64k, that is possible, but only with constraints, and it matters more which exact TP target (dos, dos-protected or Windows you use) I advise you to search for the online SWAG archive that has many examples. And of course I would recommend to go to FreePascal/Lazarus too where you can simply do:
var x : array of t;
begin
setlength(x,1000000);
and be done with it without additional lines and forget about all of this nonsense.

I'm using Turbo Pascal 5.5 and to create a dynamic array, perhaps the trick is to declare an array with zero dimension as follows:
dArray = array [0..0] of integer;
And then declare a pointer to that array:
pArray = ^dArray ;
And finally, create a pointer variable:
ArrayPtr : pArray;
You can now reference the pointer variable ArrayPtr as follows:
ArrayPtr^[i]; { The index 'i' is of type integer}
See the complete example below:
{
Title: dynarr.pas
A simple Pascal program demonstrating dynamic array.
Compiled and tested with Turbo Pascal 5.5.
}
program dynamic_array;
{Main Program starts here}
type
dArray = array [0..0] of integer;
pArray = ^dArray ;
var
i : integer;
ArrayPtr : pArray;
begin
for i := 0 to 9 do { In this case, array index starts at 0 instead of 1. }
ArrayPtr^[i] := i + 1;
writeln('The Dynamic Array now contains the following:');
writeln;
for i := 0 to 9 do
writeln(ArrayPtr^[i]);
end.
In this example, we have declared the array as:
array[0..0] of integer;
Therefore, the index starts at 0 and if we have n elements, the last element is at index n-1 which is similar to array indexing in C/C++.
Regular Pascal arrays start at 1 but for this case, it starts at 0.

unit Vector;
interface
const MaxVector = 8000;
// 64 k div SizeOf(float); number of float-values that fit in 64 K of stack
VectorError: boolean = False;
// toggle if error occurs. Calling routine can handle or abort
type
VectorStruc = record
Length: word;
Data: array [1..MaxVector] of float;
end;
VectorTyp = ^VectorStruc;
procedure CreateVector(var Vec: VectorTyp; Length: word; Value: float);
{ Generates a vector of length Length and sets all elements to Value }
procedure DestroyVector(var Vec: VectorTyp);
{ release memory occupied by vector }
procedure SetVectorElement(var Vec: VectorTyp; n: word; c: float);
function GetVectorElement(const Vec: VectorTyp; n: word): float;
implementation
var ch: char;
function WriteErrorMessage(Text: string): char;
begin
Write(Text);
Read(WriteErrorMessage);
VectorError := True; // toggle the error marker
end;
procedure CreateVector(var Vec: VectorTyp; Length: word; Value: float);
var
i: word;
begin
try
GetMem(Vec, Length * SizeOf(float) + SizeOf(word) + 6);
except
ch := WriteErrorMessage(' Not enough memory to create vector');
exit;
end;
Vec^.Length := Length;
for i := 1 to Length do
Vec^.Data[i] := Value;
end;
procedure DestroyVector(var Vec: VectorTyp);
var
x: word;
begin
x := Vec^.Length * SizeOf(float) + SizeOf(word) + 6;
FreeMem(Vec, x);
end;
function VectorLength(const Vec: VectorTyp): word;
begin
VectorLength := Vec^.Length;
end;
function GetVectorElement(const Vec: VectorTyp; n: word): float;
var
s1, s2: string;
begin
if (n <= VectorLength(Vec)) then
GetVectorElement := Vec^.Data[n]
else
begin
Str(n: 4, s1);
Str(VectorLength(Vec): 4, s2);
ch := WriteErrorMessage(' Attempt to read non-existent vector element No ' +
s1 + ' of ' + s2);
end;
end;
procedure SetVectorElement(var Vec: VectorTyp; n: word; C: float);
begin
if (n <= VectorLength(Vec)) then
Vec^.Data[n] := C
else
ch := WriteErrorMessage(' Attempt to write to non-existent vector element');
end;
end.
As long as your data fit on the stack, i.e., are smaller than 64 kB, the task is relatively simple. The only thing I don't know is where the 6 bit of extra size go, they are required, however.

Related

One row, multiple inputs?

In pascal, as you might know, you can assign multiple variables values in one single line (as long as you have variables to catch them in):
var x, y, z: integer;
readln(x, y, z, etc...);
But what if i wanted to have only one variable, which would sequentially recieve those values which sit, practically, in the void?
Let me explain:
Number of values?
>3 (for example)
Insert values:
4 6 9
Now, these values, would periodically be assigned to 'a' for example, and once i'm done with the number 4, i want it to recieve 6, and 9 afterwards. Is there any way i can do this?
In Extended Pascal, ISO 10206, you can do the following:
program lists(input, output);
procedure processList(length: integer);
var
list: array[1..length] of integer;
var
n: integer;
begin
writeLn('Insert ', length:1, ' values:');
for n := 1 to length do
begin
read(list[n]);
end;
{ Here you can further process `list` }
end;
var
n: integer;
begin
writeLn('Number of values?');
readLn(n);
processList(n);
end.
A better implementation uses schemata for this task:
program lists(input, output);
type
list(length: integer) = array[1..length] of integer;
var
n: integer;
l: ^list;
begin
writeLn('Number of values?');
readLn(n);
{ dynamically allocate memory for `l` }
new(l, n);
writeLn('Insert values:');
for n := 1 to l^.length do
begin
read(l^[n]);
end;
dispose(l);
end.
At compile-time undiscriminated schema data types can only be handled via pointers, which is always a little unpleasant for us programmers, but it works.

Delphi Radix Sort supporting negative integers

Lately I used the great sorting algorythm made by Rebuilder from Habr.com. It served me well, but it sorts only positive integers, and recently I run into the need to sort negatives as well. For now I use QuickSort, but since the array is very large (10k+ elements), I wonder if one could modify RadixSort for this task.
There is the procedure as for now. Comment translation is mine, sorry if I get something wrong.
procedure RSort(var m: array of Longword);
//--------------------------------------------------
procedure Sort_step(var source, dest, offset: array of Longword; const num: Byte);
var i,temp : Longword;
k : Byte;
begin
for i := High(source) downto 0 do
begin
temp := source[i];
k := temp SHR num;
dec(offset[k]);
dest[offset[k]] := temp;
end;
end;
//--------------------------------------------------
// Объявляем массив корзин первым, для выравнивания на стеке
// Creating the bin array first for aligning at the stack
var s : array[0..3] of array[0..255] of Longword;
i,k : longword;
// Смещение байт внутри переменной k
// Byte offset inside of variable k
offset : array[0..3] of byte absolute k;
m_temp : array of Longword;
begin
SetLength(m_temp, Length(m));
// Быстрая очистка корзин
// Quick bin clear
FillChar(s[0], 256 * 4 * SizeOf(Longword), 0);
// Заполнение корзин
// Filling bins
for i := 0 to High(m) do
begin
k := m[i];
Inc(s[0,offset[0]]);
Inc(s[1,offset[1]]);
Inc(s[2,offset[2]]);
Inc(s[3,offset[3]]);
end;
// Пересчёт смещений для корзин
// Recalculating bin offsets
for i := 1 to 255 do
begin
Inc(s[0,i], s[0,i-1]);
Inc(s[1,i], s[1,i-1]);
Inc(s[2,i], s[2,i-1]);
Inc(s[3,i], s[3,i-1]);
end;
// Вызов сортировки по байтам от младших к старшим
// Sorting by byte, from least to most
Sort_step(m, m_temp, s[0], 0);
Sort_step(m_temp, m, s[1], 8);
Sort_step(m, m_temp, s[2], 16);
Sort_step(m_temp, m, s[3], 24);
SetLength(m_temp, 0);
end;
Link: https://habr.com/ru/post/484224/
I found some helpful advice on the Internet, including StackOverflow, but I met two problems:
There are too many different solutions and I can't choose the optimal one for Delphi.
I lack the knowledge and skill to implement them correctly. I've tried some and get wrong results.
So, could someone modify the given function and explain to me what they did and why?
A simple approach is to complement the sign bit somewhere during the process. Note this only affects the most significant "digit" (usually a byte for fast radix sort). The code to handle the most significant "digit" could be handled in a separate loop than the code that handles the other "digits".
The simplest approach would be to make an initial pass to complement the sign bit of every element in the array, do the radix sort, then a final pass complement the sign bit of every element again.

Pascal - Incompatible type: Got "Array Of Extended", expected "QWord" / error

I am trying to sort an array of 100000 extended numbers using a quicksort algorithm, but I keep getting the following errors when calling the procedure:
source.pas(69,26) Error: Incompatible type for arg no. 1: Got "Array[1..100000] Of Extended", expected "QWord"
source.pas(69,36) Error: Incompatible type for arg no. 1: Got "Array[1..100000] Of Extended", expected "QWord"
program test;
type
TVector = array of double;
var
N,M,i,x:longint;
a,b,c,apod,af: Array[1..100000] of extended;
procedure QuickSort(var apod: TVector; iLo, iHi: Integer) ;
var Lo, Hi: Integer;
pivot,t: double;
begin
if (iHi-iLo) <= 0 then exit;
Lo := iLo;
Hi := iHi;
Pivot := apod[(Lo + Hi) div 2];
repeat
while A[Lo] < Pivot do Inc(Lo);
while A[Hi] > Pivot do Dec(Hi);
if Lo <= Hi then
begin
T := apod[Lo];
apod[Lo] := apod[Hi];
apod[Hi] := T;
Inc(Lo) ;
Dec(Hi) ;
end;
until Lo > Hi;
if Hi > iLo then QuickSort(apod, iLo, Hi) ;
if Lo < iHi then QuickSort(apod, Lo, iHi) ;
end;
begin
{a[i],b[i],c[i],af[i],N,M are initialiazed here}
apod[i]:=(a[i]-((a[i]*b[i])/3000)-((c[i]*a[i])/40));
end;
begin
QuickSort(apod, Lo(apod), Hi(apod)) ;
end;
end.
How can I fix this?
You have several syntactical errors in your code. I did not check if your quicksort is actually correct. You can debug that.
Array types
You are confusing several different things:
dynamic arrays (e.g. type array of double),
static arrays (e.g. type array[a..b] of double) and probably
open array parameters (parameter array of double).
Your parameter is a dynamic array type (TVector), but you pass a static array. These are not compatible.
To be able to pass a dynamic as well as a static array, you can use the mentioned open array parameters (note that they look like, but are not the same as dynamic arrays).
procedure QuickSort(var apod: array of Double; iLo, iHi: Integer);
More about open array parameters in an article of mine: Open array parameters and array of const.
Var (reference) parameters
But there is another problem: var parameters must have the exact type (or base type). No conversion will take place. So your a, b, c, apod and af parameters must contain Doubles too:
var
a, b, c, apod, af: array[1..100000] of Double;
Unbound blocks
Then the loose begin endblocks after the QuickSort function don't make sense. That is not Pascal. Rather do something like this in the main block (the last begin ... end. — note the final .):
begin
for i := Low(apod) to High(apod) do
apod[i] := (a[i] - ((a[i] * b[i]) / 3000) - ((c[i] * a[i]) / 40));
QuickSort(apod, Low(apod), High(apod));
end.
But note that the code above doesn't make a lot of sense. Probably all values in apod will be 0, since a, b, c, etc. are not initialized yet (so a[i] etc. are probably all 0).
I have no idea where you got that code, but you may want to try to understand it, before you start translating it to Pascal.
Lo and Hi
Note that you should use Low and High. Lo and Hi are something totally different: they get the low and high byte of a 16 bit word, respectively. Low and High get the bounds of arrays, sets and types.

How to use a variable in an array?

I'm using PASCAL for a course i'm doing and i'm having trouble with an assignment, in my program i'm using 2 arrays that uses a variable from a user's input but when i go to run the program it comes up with, Error: Can't evaluate constant expression. The code for the array is:
Var
x : integer;
s : array[1..x] of real;
n : array[1..x] of string[30];
Here x is the user's input, is there a way for an array to go from 1 to x?
If x is a variable, that won't work indeed. The range of a so called static array must be a constant expression, i.e. it must be known at compile time.
So what you want won't work, as is.
In FreePascal, you can use dynamic arrays, though. Their lengths can be set and changed at runtime.
var
x: Integer;
s: array of Real;
n: array of string[30]; // why not just string?
and later:
x := someUserInput(); // pseudo code!
SetLength(s, x);
SetLength(n, x);
You should be aware of the fact that dynamic arrays are 0-based, so your indexes run from 0 up to x - 1. But for the limits of the array, you should rather use Low() and High() instead:
for q := Low(s) to High(s) do
// access s[q];
(Low() and High() are not the topic, but just know they can also be used for static arrays, and that they return the actual array bounds -- I always use High and Low for this)
Here is not so simple as using managed types like dynamic arrays suggested by #RudyVelthuis but more funny solution providing some comprehension
about how it works internally :)
program dynarr;
{$mode objfpc}{$H+}
type
TArrayReal = array[1..High(Integer)] of Real;
TArrayString30 = array[1..High(Integer)] of string[30];
PArrayReal = ^TArrayReal;
PArrayString30 = ^TArrayString30;
var
i: Integer;
x: Integer;
s: PArrayReal;
n: PArrayString30;
begin
Write('Count: '); Readln(x);
// Allocate memory for the actual count of the elements
s := GetMem(SizeOf(Real) * x);
n := GetMem(SizeOf(string[30]) * x);
try
for i := 1 to x do
begin
Write('Row ', i:3, ': '); Readln(s^[i], n^[i]);
end;
Writeln('Your input was:');
for i := 1 to x do
Writeln('Row ', i:3, ': ', s^[i]:10:3, n^[i]: 20);
finally
// Do not forget to release allocated memory
FreeMem(s);
FreeMem(n);
end;
end.

How to speed up this conversion function?

I have this function called IntToStrLen which converts an integer to a string of a padded size. For example, an integer value of 42 with a size of 4 would result in a string __42 (padded with a given character, space by default).
The problem is when this function is used in bulk (for example 1,000,000 times in a loop), it adds extra weight onto the loop. The loop I'm using this in, without this function, takes about 20 seconds, but with this function, I'm still waiting as of right now for this function to complete, after about 5 minutes.
How can I speed up the following function?
function IntToStrLen(const Value: Integer; const Len: Integer;
const Fill: String = ' '): String;
var
T: String;
begin
Result:= IntToStr(Value); //convert result
if Length(Result) > Len then
Result:= Copy(Result, 1, Len) //forcefully truncate
else if Length(Result) < Len then begin
T:= '';
while Length(T) < (Len - Length(Result)) do //fill space with character
T:= T + Fill;
Result:= T + Result; //return combination
end;
end;
The absolute number one change that you can make here is to avoid heap allocations. Your code presently has multiple heap allocations. Your goal here is to write a function with zero heap allocations.
That means you need the caller to allocate and provide the buffer. Typically they will do so with a stack allocated buffer, which hence costs nothing to allocate (or deallocate). If the caller really needs a string, which is always allocated on the heap, then the caller can wrap your function with a call to SetString.
The function prototype might look like this:
procedure IntToStrLen(const Value, Len: Integer; var Buffer: array of Char;
const Fill: Char = ' ');
The first point to stress here is that Fill must be a Char. Your use of string is inefficient and allows the caller to call a fill "character" with length not equal to one. Doing so would of course break your function because it would return a value with length not equal to Len.
Do note also that the implementation must not call IntToStr because that involves heap allocation. So you need to write your own heap allocation free integer to decimal text conversion code because, astonishingly, the RTL does not offer such functionality. When I do this I use code like so:
procedure DivMod(Dividend, Divisor: Cardinal;
out Quotient, Remainder: Cardinal);
{$IFDEF CPUX86}
asm
PUSH EBX
MOV EBX,EDX
XOR EDX,EDX
DIV EBX
MOV [ECX],EAX
MOV EBX,Remainder
MOV [EBX],EDX
POP EBX
end;
{$ELSE IF Defined(CPUX64)}
asm
.NOFRAME
MOV EAX,ECX
MOV ECX,EDX
XOR EDX,EDX
DIV ECX
MOV [R8],EAX
MOV [R9],EDX
end;
{$ELSE}
{$Message Error 'Unrecognised platform.'}
{$ENDIF}
function CopyIntegerToCharBuffer(const Value: Integer;
var Buffer: array of Char): Integer;
var
i, j: Integer;
val, remainder: Cardinal;
negative: Boolean;
tmp: array [0..15] of Char;
begin
negative := Value<0;
val := abs(Value);
Result := 0;
repeat
DivMod(val, 10, val, remainder);
tmp[Result] := Chr(remainder + ord('0'));
inc(Result);
until val=0;
if negative then begin
tmp[Result] := '-';
inc(Result);
end;
Assert(Result<=Length(Buffer));
i := 0;
j := Result-1;
while i<Result do begin
Buffer[i] := tmp[j];
inc(i);
dec(j);
end;
end;
Now you can make decimal text representations of integers without touching the heap. From there it's a short way to your function.
procedure IntToStrLen(const Value, Len: Integer; var Buffer: array of Char;
const Fill: Char = ' ');
var
tmp: array [0..15] of Char;
i, N: Integer;
begin
Assert(Length(Buffer)>=Len);
N := CopyIntegerToCharBuffer(Value, tmp);
if N>=Len then begin
Move(tmp, Buffer, SizeOf(Char)*Len);
end else begin
for i := 0 to Len-N-1 do begin
Buffer[i] := Fill;
end;
Move(tmp, Buffer[Len-N], SizeOf(Char)*N);
end;
end;
At this point you'll have gained the bulk of the available performance benefits. From here on in you will be into diminishing returns. You could micro-optimise CopyIntegerToCharBuffer as is done in SysUtils._IntToStr32 for instance. Beyond that I'm sure the implementation of IntToStrLen could be optimised with judicious use of assembler. But such optimisations will yield nothing like the benefit you have gained so far from avoiding the heap.
Of course, all this assumes that you have correctly identified your performance bottleneck. It's all too easy to assume that you know where the performance bottleneck is by statically analysing the code. Unless you've actually profiled it carefully expect to find that your intuition is a poor judge of where to invest optimisation effort.
Try this variant
(and you don't treat negative numbers)
function IntToStrLen(const Value: Integer; const Len: Integer;
const Fill: Char = ' '): String;
var
T: String;
begin
Result:= IntToStr(Value);
if Length(Result) > Len then
SetLength(Result, Len) //forcefully truncate
else if Length(Result) < Len then
Result := StringOfChar(Fill, Len - Length(Result)) + Result;
end;
P.S. So strange truncation (2014=>20) - is what you really want?

Resources