This is not exactly a straight-out question because I have just solved it, but more like "am I getting it right" type of question and a reminder for those who might get stuck into that.
Turns out, Delphi does not align variables on stack and there are no directives/options to control this behavior. Default COM marshaller on my XP SP3 seem to require 4-byte alignment when marshaling records though. Worse, when it encounters unaligned pointer, it does not return an error, oh no: it rounds the pointer down to the nearest 4-byte boundary and continues like that.
Therefore, if you pass a record you have allocated on stack into COM-marshaled function by reference, you're screwed and you won't even know.
The problem can be solved by using New/Dispose to allocate records, as memory managers tend to align everything at 8 bytes or better, but god, this is annoying, both the misalignment part and the "trim-down-pointers" part.
Is this really the reason, or am I wrong somewhere?
Update: How to reproduce (Delphi 2007 for Win32).
uses SysUtils;
type
TRec = packed record
a, b, c, d, e: int64;
end;
TDummy = class
protected
procedure Proc(param1: integer);
end;
procedure TDummy.Proc(param1: integer);
var a, b, c: byte;
rec: TRec;
begin
a := 5;
b := 9;
c := 100;
rec.a := param1;
rec.b := a;
rec.c := b;
rec.d := c;
writeln(IntToHex(integer(#rec), 8));
readln;
end;
var Obj: TDummy;
begin
obj := TDummy.Create;
try
obj.Proc(0);
finally
FreeAndNil(obj);
end;
end.
This gives odd result address, clearly not aligned on anything. If it doesn't, try adding more byte variables to "a, b, c: byte" (and don't forget to simulate some work with them at the end of the function).
The part with COM is easier to reproduce but longer to explain. Create a new VCL app called Sample Server, add a COM object SampleObject implementing ISampleObject, with a type library, free-threaded, single instance (make sure to check ISampleObject is marked as Ole Automation in type library). Open the type library, declare a new SampleRecord with five __int64 fields. Add a SampleFunction with a single SampleRecord* out parameter to ISampleObject. Implement SampleFunction in TSampleObject by returning fixed values:
function TSampleObject.SampleFunction(out rec: SampleRecord): HResult;
begin
rec.a := 1291;
rec.b := 742310;
//...
Result := S_OK;
end;
Note how Delphi declares SampleRecord as "packed record" in automatically generated type library header code:
SampleRecord = packed record
a: Int64;
b: Int64;
//...
end;
I have checked, and this, at least, was fixed in Delphi 2010. Automatically generated records are not packed there.
Register the COM server. Run it.
Now modify the source above (sample 1) to call this server instead of just doing writeln:
uses SysUtils, Windows, ActiveX, SampleServer_TLB;
procedure TDummy.Proc(param1: integer);
var a, b, c: byte;
rec: SampleRecord;
Server: ISampleObject;
begin
a := 5;
b := 9;
c := 100;
rec.a := param1;
rec.b := a;
rec.c := b;
rec.d := c;
Server := CoSampleObject.Create;
hr := Server.SampleFunction(rec);
writeln('#: 'IntToHex(integer(#rec), 8)+', rec.a='+IntToStr(rec.a));
readln;
end;
var Obj: TDummy;
begin
CoInitializeEx(nil, COINIT_MULTITHREADED);
obj := TDummy.Create;
try
obj.Proc(0);
finally
FreeAndNil(obj);
CoUninitialize();
end;
end.
Observe that when the address of rec is not aligned, values of rec fields are wrong (specifically, bitshifted to 8, 16 or 24 bits, sometimes wrapped over to the next value).
Do you have an example of the stack being misaligned? Delphi should be aligning everything to 4 byte boundaries. The only case I can think of that would cause misalignment is if someplace along the call-chain is some assembler code that has explicitly done something to the stack to mis-align it.
Related
I'm work on a program for school (Cinema app) but I have a problem with my array. My app closed but nothing is showed.
program TFE;
{$APPTYPE CONSOLE}
uses
SysUtils,
StrUtils,
Crt;
var
MovieList, MovieInfo: Text;
Choice: Byte;
i: Integer;
L: String;
S: array of String[14];
begin
i := 0
Assign(MovieInfo, 'MovieInfo.txt');
Reset(MovieInfo);
Readln(Choice);
i := 0;
ClrScr;
While not eof (MovieInfo) do
begin
Readln(MovieInfo, L);
S[i] := L;
i := i + 1;
end;
Writeln(S[Choice]);
Readln;
end.
It's all my code for the moment.
Somebody can help me ?
In the title you speak about a variable MyVar, but the code doesn't show any such variable. For future reference, please carefully proof read your question before posting.
You have declared a dynamic array:
S: array of String[14];
that is, an array of 14 character strings (short strings). But you have never set the length of this array, and so it can not hold any strings at all.
Use procedure SetLength(var S: <string or dynamic array>; NewLength: Integer); to allocate space for items in the array.
As you dont know (I presume) how many movies there might be in the file, you must first allocate some amount, and then be prepared to expand the array (with a new call to SetLength()) if the array becomes filled up before all movies are read from the file. For example, initialize (before the while loop) with space for 10 movies:
SetLength(S, 10);
and then in the while loop, e.g. just before ReadLn(),
if i > (Length(S)-1) then
SetLength(S, Length(S)+10);
Another comment is that the user is not presented any prompt when requested for a choice, but maybe this is still under development ;-)
The message you got is correct, because you only work with the array inside the while not eof loop. At that moment, the compiler cannot know the content of the file. It may be blank, as far as he's concerned. If the file is, indeed, blank, he'll skip entirely the while not eof part and go straight to the array writing part. Because the array was never used, it doesn't have a defined value, hence this message.
The solution is simple: initialize the array's values with 0:
program TFE;
{$APPTYPE CONSOLE}
uses
SysUtils,
StrUtils,
Crt;
var
MovieList, MovieInfo: Text;
Choice: Byte;
i: Integer;
L: String;
S: array of String[14];
begin
SetLength(s,10); //10 is an example
for i:=0 to Length(s) do
s[i]:='';
Assign(MovieInfo, 'MovieInfo.txt');
Reset(MovieInfo);
Readln(Choice);
i := 0;
ClrScr;
While not eof (MovieInfo) do
begin
Readln(MovieInfo, L);
S[i] := L;
i := i + 1;
end;
Writeln(S[Choice]);
Readln;
end.
Digging deep into your code, you define MovieList and MovieInfo, but you only use MovieInfo. Why?
I'm want to convert a string value to a global memory handle and vice versa, using the following functions I've just written.
But StrToGlobalHandle() causes my testing program hangs. So GlobalHandleToStr() is untest-able yet and I'm also wondering if my code is logical or not.
function StrToGlobalHandle(const aText: string): HGLOBAL;
var
ptr: PChar;
begin
Result := 0;
if aText <> '' then
begin
Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, length(aText) + 1);
if Result <> 0 then
begin
ptr := GlobalLock(Result);
if Assigned(ptr) then
begin
StrCopy(ptr, PChar(aText));
GlobalUnlock(Result);
end
end;
end;
end;
function GlobalHandleToStr(const aHandle: HGLOBAL): string;
var
ptrSrc: PChar;
begin
ptrSrc := GlobalLock(aHandle);
if Assigned(ptrSrc) then
begin
SetLength(Result, Length(ptrSrc));
StrCopy(PChar(Result), ptrSrc);
GlobalUnlock(aHandle);
end
end;
Testing code:
procedure TForm3.Button1Click(Sender: TObject);
var
h: HGLOBAL;
s: string;
s2: string;
begin
s := 'this is a test string';
h := StrToGlobalHandle(s);
s2 := GlobalHandleToStr(h);
ShowMessage(s2);
GlobalFree(h);
end;
BTW, I want to use these two functions as helpers to send string values between programs - send a global handle from process A to process B, and process B get the string using GlobalHandleToStr().
BTW 2, I know WM_COPY and other IPC methods, those are not suitable in my case.
The strings in Delphi 2010 are unicode, so you are not allocating the proper buffer size.
replace this line
Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, length(aText) + 1);
with this
Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, (length(aText) + 1)* SizeOf(Char));
If your program hangs when you call GlobalAlloc, then you probably have heap corruption from earlier in your program. That leads to undefined behavior; the function might detect the problem and return an error, it might crash your program, it might silently corrupt yet more of your memory, it might hang, or it might do any number of other things.
That heap corruption might come from a previous call to StrToGlobalHandle because your StrCopy call writes beyond the end of the allocated memory. You're allocating bytes, but the Length function returns the number of characters in the string. That's only valid when characters are one byte wide, which isn't the case as of Delphi 2009. Multiply by SizeOf(Char) to get a byte count:
Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, SizeOf(Char) * (Length(aText) + 1));
You can't send data between programs using GlobalAlloc - it worked only in 16-bit Windows. Use Memory Mapped File instead.
In Delphi you can speed up your code by passing parameters as const, e.g.
function A(const AStr: string): integer;
//or
function B(AStr: string): integer;
Suppose both functions have the same code inside, the speed difference between them is negligible and I doubt it can even be measured with a cycle-counter like:
function RDTSC: comp;
var
TimeStamp: record case byte of
1: (Whole: comp);
2: (Lo, Hi: Longint);
end;
begin
asm
db $0F; db $31;
mov [TimeStamp.Lo], eax
mov [TimeStamp.Hi], edx
end;
Result := TimeStamp.Whole;
end;
The reason for this is that all the const does in function A is to prevent the reference count of AStr to be incremented.
But the increment only takes one cycle of one core of my multicore CPU, so...
Why should I bother with const?
If there is no other reason for the function to contain an implicit try/finally, and the function itself is not doing much work, the use of const can result in a significant speedup (I once got one function that was using >10% of total runtime in a profiling run down to <2% just by adding a const in the right place).
Also, the reference counting takes much much more than one cycle because it has to be performed with the lock prefix for threadsafety reasons, so we are talking more like 50-100 cycles. More if something in the same cache line has been modified by another core in between.
As for not being able to measure it:
program Project;
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils,
Math;
function GetThreadTime: Int64;
var
CreationTime, ExitTime, KernelTime, UserTime: TFileTime;
begin
GetThreadTimes(GetCurrentThread, CreationTime, ExitTime, KernelTime, UserTime);
Result := PInt64(#UserTime)^;
end;
function ConstLength(const s: string): Integer;
begin
Result := Length(s);
end;
function NoConstLength(s: string): Integer;
begin
Result := Length(s);
end;
var
s : string;
i : Integer;
j : Integer;
ConstTime, NoConstTime: Int64;
begin
try
// make sure we got an heap allocated string;
s := 'abc';
s := s + '123';
//make sure we minimize thread context switches during the timing
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
j := 0;
ConstTime := GetThreadTime;
for i := 0 to 100000000 do
Inc(j, ConstLength(s));
ConstTime := GetThreadTime - ConstTime;
j := 0;
NoConstTime := GetThreadTime;
for i := 0 to 100000000 do
Inc(j, NoConstLength(s));
NoConstTime := GetThreadTime - NoConstTime;
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_NORMAL);
WriteLn('Const: ', ConstTime);
WriteLn('NoConst: ', NoConstTime);
WriteLn('Const is ', (NoConstTime/ConstTime):2:2, ' times faster.');
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
if DebugHook <> 0 then
ReadLn;
end.
Produces this output on my system:
Const: 6084039
NoConst: 36192232
Const is 5.95 times faster.
EDIT: it gets a bit more interesting if we add some thread contention:
program Project;
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils,
Classes,
Math;
function GetThreadTime: Int64;
var
CreationTime, ExitTime, KernelTime, UserTime: TFileTime;
begin
GetThreadTimes(GetCurrentThread, CreationTime, ExitTime, KernelTime, UserTime);
Result := PInt64(#UserTime)^;
end;
function ConstLength(const s: string): Integer;
begin
Result := Length(s);
end;
function NoConstLength(s: string): Integer;
begin
Result := Length(s);
end;
function LockedAdd(var Target: Integer; Value: Integer): Integer; register;
asm
mov ecx, eax
mov eax, edx
lock xadd [ecx], eax
add eax, edx
end;
var
x : Integer;
s : string;
ConstTime, NoConstTime: Integer;
StartEvent: THandle;
ActiveCount: Integer;
begin
try
// make sure we got an heap allocated string;
s := 'abc';
s := s + '123';
ConstTime := 0;
NoConstTime := 0;
StartEvent := CreateEvent(nil, True, False, '');
ActiveCount := 0;
for x := 0 to 2 do
TThread.CreateAnonymousThread(procedure
var
i : Integer;
j : Integer;
ThreadConstTime: Int64;
begin
//make sure we minimize thread context switches during the timing
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_HIGHEST);
InterlockedIncrement(ActiveCount);
WaitForSingleObject(StartEvent, INFINITE);
j := 0;
ThreadConstTime := GetThreadTime;
for i := 0 to 100000000 do
Inc(j, ConstLength(s));
ThreadConstTime := GetThreadTime - ThreadConstTime;
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_NORMAL);
LockedAdd(ConstTime, ThreadConstTime);
InterlockedDecrement(ActiveCount);
end).Start;
while ActiveCount < 3 do
Sleep(100);
SetEvent(StartEvent);
while ActiveCount > 0 do
Sleep(100);
WriteLn('Const: ', ConstTime);
ResetEvent(StartEvent);
for x := 0 to 2 do
TThread.CreateAnonymousThread(procedure
var
i : Integer;
j : Integer;
ThreadNoConstTime: Int64;
begin
//make sure we minimize thread context switches during the timing
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_HIGHEST);
InterlockedIncrement(ActiveCount);
WaitForSingleObject(StartEvent, INFINITE);
j := 0;
ThreadNoConstTime := GetThreadTime;
for i := 0 to 100000000 do
Inc(j, NoConstLength(s));
ThreadNoConstTime := GetThreadTime - ThreadNoConstTime;
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_NORMAL);
LockedAdd(NoConstTime, ThreadNoConstTime);
InterlockedDecrement(ActiveCount);
end).Start;
while ActiveCount < 3 do
Sleep(100);
SetEvent(StartEvent);
while ActiveCount > 0 do
Sleep(100);
WriteLn('NoConst: ', NoConstTime);
WriteLn('Const is ', (NoConstTime/ConstTime):2:2, ' times faster.');
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
if DebugHook <> 0 then
ReadLn;
end.
On a 6 core machine, this gives me:
Const: 19968128
NoConst: 1313528420
Const is 65.78 times faster.
EDIT2: replacing the call to Length with a call to Pos (I picked the worst case, search for something not contained in the string):
function ConstLength(const s: string): Integer;
begin
Result := Pos('x', s);
end;
function NoConstLength(s: string): Integer;
begin
Result := Pos('x', s);
end;
results in:
Const: 51792332
NoConst: 1377644831
Const is 26.60 times faster.
for the threaded case, and:
Const: 15912102
NoConst: 44616286
Const is 2.80 times faster.
for the non-threaded case.
Don't forget that const isn't only there to provide those tiny performance improvements.
Using const explains to anybody reading or maintaining the code that the value shouldn't be updated, and allows the compiler to catch any accidental attempts to do so.
So making your code more readable and maintainable can also make it marginally faster. What good reasons are there for not using const?
Using const prevents an implicit try/finally block which on x86 is rather more expensive than reference counting. That's really a separate issue to the semantic meaning of const. It's a shame that performance and semantics are mixed up in this way.
The type String is a special case, because it is managed by Delphi (copy on demand), and therefore not ideal to answer your question.
If you test your function with other types that are bigger than a pointer, records or arrays for example, you should see a bigger time difference, because with const only a pointer is passed, without const the record would be copied before passing to the function.
Using the keyword const, you can leave the decision of optimization to the compiler.
The documentation says:
Using const allows the compiler to optimize code for structured- and string-type parameters.
So, it is better, thus rational, to use const for string parameters, simply because the manual says so. ;)
Now, this may be well enough an answer for the questioner, but it is even more interesting to look at the general question whether to use const parameters or not.
Again, the documentation says at just one click away from the Delphi Language Guide Index:
Value and constant (const) parameters are passed by value or by reference, depending on the type and size of the parameter:
Note the apparent equality of value and constant parameters in this sentence. This concludes that using const for parameters, being not string- or structured-typed, makes no difference in performance nor code-size. (A short test, derived from Thorsten Engler's test code, indeed shows an average indifference between with and without const for parameters of ordinal and real types.)
So it turns out that whether or not using const only makes a difference to the programmer, not the executable.
As follow-up, and as LukeH already asked: What good reasons are there for not using const?
To follow Delphi's own syntax:
function FindDragTarget(const Pos: TPoint; AllowDisabled: Boolean): TControl;
function UpperCase(const S: string): string;
function UpCase(Ch: Char): Char;
function EncodeDate(Year, Month, Day: Word): TDateTime;
To produce more compact are therefore possibly slightly more readable code. For instance: using constant parameters in property setters really is superfluous, which surprisingly often leads to single line declarations instead of double, if you like to honour a line length limit.
To comfortably provide variables to virtual methods and event handlers. Note that none of the VCL event handler types use const parameters (for other than string- or record-typed members). It is just nice service for the users of your code or your components.
Of course, there also may be fine reasons for using const:
As LukeH already answered, if there is really no need at all to change the value of the parameter.
For (personal) protection, like the documentation says:
Using const also provides a safeguard against unintentionally passing a parameter by reference to another routine.
Partial origin of this answer: http://www.nldelphi.com.
Generally, I would avoid any optimizations (in any language) that don't solve real problems that you can measure. Profile your code, and fix the problems that you can actually see. Optimizing for theoretical issues is just a waste of your time.
If you suspect that something is wrong, and this somehow fixes it/speeds it up, then great, but implementing these kinds of micro optimizations by default are rarely worth the time.
One of the most important fact that people omitted. Interlock ... instruction is very costly in Multicore CPUs of x86 instruction. Read Intel manual. The cost is when refcounter var is taken placed and it is not in cpu cache, ALL other CPUs must be stopped for instruction to carried out.
Cheers
Is it possible to write a method which takes any ordinal type as a parameter? The same way Inc() or High() do?
I'm using Delphi 2007
You'd need to use an untyped parameter:
procedure Foo(const ordinal);
or
procedure Foo(var ordinal);
Of course, you are somewhat limited in what you could do inside such a routine because you have abandoned the type system.
Found a possible way, might not be what you expect, but hey, I found a way! Use Variants. The problem with passing typeless parameters to a procedure is that you get a plain pointer, no type information, so you can't do anything useful with it. Bytes are 1 byte, enums of up to 256 elements are 1 byte byte, enums of up to 2^16 elements are 2 bytes, integers are 4 bytes (unless they're 8). But there is one type that allows anything to be passed and cares enough type information to make things work: the Variant. I intentionally wrote the following example in Delphi 7, to make sure I don't accidentally use any Delphi 2010 or Delphi XE goodness.
Edit: Updated the code sample to handle any type that's considered Ordinal by the Variants.VarTypeIsOrdinal. That includes all integer types + Boolean. Apparently Enum is seen as Byte, so it swallows that too.
program Project1;
{$APPTYPE CONSOLE}
uses
ExceptionLog,
SysUtils, Variants;
type TSomeEnum = (e0, e1, e2, e3, e4);
procedure DoSomethingWithEnum(V: Variant);
var i: Integer;
b: Byte;
lw: LongWord; // Cardinal!
i64: Integer;
begin
case VarType(V) of
varInt64:
begin
i64 := V;
WriteLn(i64);
end;
varSmallint, varInteger, varShortInt:
begin
i := V;
WriteLn(i);
end;
varByte:
begin
b := V;
WriteLn(b);
end;
varWord, varLongWord:
begin
lw := V;
WriteLn(lw);
end;
varBoolean:
begin
if V then WriteLn('True') else WriteLn('False');
end;
else WriteLn('NOT a variant type (type = #' + IntToStr(Ord(VarType(V))));
end;
end;
var i: Integer;
b: Byte;
c: Cardinal;
enum: TSomeEnum;
w: Word;
si: Shortint;
begin
i := 1;
b := 2;
c := 3;
enum := e4;
w := 5;
si := -6;
DoSomethingWithEnum(i);
DoSomethingWithEnum(b);
DoSomethingWithEnum(c);
DoSomethingWithEnum(enum);
DoSomethingWithEnum(True);
DoSomethingWithEnum(w);
DoSomethingWithEnum(si);
Readln;
end.
The reason why doing this is difficult is that Inc(x), Dec(x) and others like Pred(x) and Succ(x) are actually, generated by the compiler, and are, if you like, merely Function style syntax sugar over an inherent compiler operation.
You can, as some people suggest, do some of this with overloading, some of it with clever use of generics, and some of it with variants. But nothing will be as convenient for emulating these functions, or exactly the same functionally.
The compiler implements Inc() for example, for all ordered types, including Enums, Integers, and subranges on those types (a now rather obscure feature of classic "Wirth" Pascal is that all types can have subranges defined on those types).
If you actually told us more about what you were doing, it might be possible to get closer. But the general answer is, No, there isn't even source code for Inc, and Dec, because these are compiler primitives. If there was RTL source code to the function Inc, you could go look at it, and adapt it.
inc(x) could be defined as x := Succ(x), but then, how do you define Succ(x)? As x := Inc(x)? You see. At some point, compiler "magic" takes over.
I'm doing some heavy work on large integer numbers in UInt64 values, and was wondering if Delphi has an integer square root function.
Fow now I'm using Trunc(Sqrt(x*1.0)) but I guess there must be a more performant way, perhaps with a snippet of inline assembler? (Sqrt(x)with x:UInt64 throws an invalid type compiler error in D7, hence the *1.0 bit.)
I am very far from an expert on assembly, so this answer is just me fooling around.
However, this seems to work:
function isqrt(const X: Extended): integer;
asm
fld X
fsqrt
fistp #Result
fwait
end;
as long as you set the FPU control word's rounding setting to "truncate" prior to calling isqrt. The easiest way might be to define the helper function
function SetupRoundModeForSqrti: word;
begin
result := Get8087CW;
Set8087CW(result or $600);
end;
and then you can do
procedure TForm1.FormCreate(Sender: TObject);
var
oldCW: word;
begin
oldCW := SetupRoundModeForSqrti; // setup CW
// Compute a few million integer square roots using isqrt here
Set8087CW(oldCW); // restore CW
end;
Test
Does this really improve performance? Well, I tested
procedure TForm1.FormCreate(Sender: TObject);
var
oldCW: word;
p1, p2: Int64;
i: Integer;
s1, s2: string;
const
N = 10000000;
begin
oldCW := SetupRoundModeForSqrti;
QueryPerformanceCounter(p1);
for i := 0 to N do
Tag := isqrt(i);
QueryPerformanceCounter(p2);
s1 := inttostr(p2-p1);
QueryPerformanceCounter(p1);
for i := 0 to N do
Tag := trunc(Sqrt(i));
QueryPerformanceCounter(p2);
s2 := inttostr(p2-p1);
Set8087CW(oldCW);
ShowMessage(s1 + #13#10 + s2);
end;
and got the result
371802
371774.
Hence, it is simply not worth it. The naive approach trunc(sqrt(x)) is far easier to read and maintain, has superior future and backward compatibility, and is less prone to errors.
I believe that the answer is no it does not have an integer square root function and that your solution is reasonable.
I'm a bit surprised at the need to multiple by 1.0 to convert to a floating point value. I think that must be a Delphi bug and more recent versions certainly behave as you would wish.
This is the code I end up using, based on one of the algorhythms listed on wikipedia
type
baseint=UInt64;//or cardinal for the 32-bit version
function isqrt(x:baseint):baseint;
var
p,q:baseint;
begin
//get highest power of four
p:=0;
q:=4;
while (q<>0) and (q<=x) do
begin
p:=q;
q:=q shl 2;
end;
//
q:=0;
while p<>0 do
begin
if x>=p+q then
begin
dec(x,p);
dec(x,q);
q:=(q shr 1)+p;
end
else
q:=q shr 1;
p:=p shr 2;
end;
Result:=q;
end;