Compiling Pascalscript in 64 bit mode, events not working? - delphi

I have downloaded and started playing with Pascalscript and its sample programs.
I have come across a problem with interfacing to Forms using the Forms access sample script.
It works in 32 bit mode, in 64 bit mode no events get triggered.
That is, a buttons onpress event never calls the pascalscript onpress code.
I am using Delphi 10 Seattle on windows 7 pro.
Any ideas on how to get scripts working right on the 64 bit platform?

Well seeing as no one had an answer to this I had to do the hard work myself.
So the problem was empty prolog code for x64 in the conversion from delphi to pascalscript method calling which was written in assembler. The empty method handler was called "MyAllMethodhandler" in the uPSruntime unit and my code solution is as follows
function MyAllMethodsHandler2(Self:PScriptMethodInfo; const Stack:PPointer; _EDX,_ECX:Pointer):Integer; forward;
{$ifdef CPUX64}
procedure MyAllMethodsHandler;
// On entry:
// RCX = Self pointer
// RDX, R8, R9 = param1 .. param3
// STACK = param4... paramcount
asm
PUSH R9
MOV R9,R8 // R9:=_ECX
MOV R8,RDX // R8:=_EDX
MOV RDX, RSP // RDX:=Stack
SUB RSP, 20h
CALL MyAllMethodsHandler2
ADD RSP, 20h //Restore stack
POP R9
end;
{$else}
procedure MyAllMethodsHandler; //original x86 code
// On entry:
// EAX = Self pointer
// EDX, ECX = param1 and param2
// STACK = param3... paramcount
asm
push 0
push ecx
push edx
mov edx, esp
add edx, 16 // was 12
pop ecx
call MyAllMethodsHandler2
pop ecx
mov edx, [esp]
add esp, eax
mov [esp], edx
mov eax, ecx
end;
{$endif}
Not sure if this will work with everything but seems to work for at least 2 parameters.
I'll post it as a comment on GitHub, I can't really fix it directly as I have made extensive changes to the whole of Pascal script so it supports complex math.

Related

What apart from the "Compiling" options can change code gen in 64 bit?

Introduction
I encountered a problem with Currency in one of our applications. I was getting different results in Win32 and Win64. I found an article here that shows a similar problem but that one was fixed in XE6. The first thing I tried to do was create a MCVE to duplicate the problem. That's where the wheels fell off. What looks like the identical code in the MCVE produces a different result compared to the application. The generated code 64 bit is different. So my question morphed into why are they different and once I figure that out then I can create a suitable MCVE.
I have a method that is calculating a total. This method calls another method to get a value that needs to be added to the total. The method returns a single. I assign the single value to a variable and then add it to the total which is a Currency. In my main application the value for the total is used later on but adding that to the MCVE doesn't change the behavior. I made sure that the compiler options were the same.
In my main application, the result from the calculation is $2469.6001 in Win32 and 2469.6 in Win64 but I can't duplicate this in the MCVE. Everything on the Compiling options page was the same and optimizations were disabled.
Attempted MCVE
Here is the code for my attempted MCVE. This mimics the actions in the original application.
program Project4;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
type
TTestClass = class
strict private
FMyCurrency: Currency;
function GetTheValue: Single;
public
procedure Calculate;
property MyCurrency: Currency read FMyCurrency write FMyCurrency;
end;
procedure TTestClass.Calculate;
var
myValue: Single;
begin
FMyCurrency := 0.0;
myValue := GetTheValue;
FMyCurrency := FMyCurrency + myValue;
end;
function TTestClass.GetTheValue: Single;
var
myValueExact: Int32;
begin
myValueExact := 1159354778; // 2469.60009765625;
Result := PSingle(#myValueExact)^;
end;
var
testClass: TTestClass;
begin
testClass := TTestClass.Create;
try
testClass.Calculate;
WriteLn(CurrToStr(testClass.MyCurrency));
ReadLn;
finally
testClass.Free;
end;
end.
This code generates the following assembler for the last two lines of TTestClass.Calculate:
Project4.dpr.25: myValue := GetTheValue;
00000000004242A8 488B4D40 mov rcx,[rbp+$40]
00000000004242AC E83F000000 call TTestClass.GetTheValue
00000000004242B1 F30F11452C movss dword ptr [rbp+$2c],xmm0
Project4.dpr.26: FMyCurrency := FMyCurrency + myValue;
00000000004242B6 488B4540 mov rax,[rbp+$40]
00000000004242BA 488B4D40 mov rcx,[rbp+$40]
00000000004242BE F2480F2A4108 cvtsi2sd xmm0,qword ptr [rcx+$08]
00000000004242C4 F3480F5A4D2C cvtss2sd xmm1,qword ptr [rbp+$2c]
00000000004242CA F20F590D16000000 mulsd xmm1,qword ptr [rel $00000016]
00000000004242D2 F20F58C1 addsd xmm0,xmm1
00000000004242D6 F2480F2DC8 cvtsd2si rcx,xmm0
00000000004242DB 48894808 mov [rax+$08],rcx
Main Application
This is an extract from the main application. It's difficult to give more information but I don't think that will change the nature of the question. In this class, FBulkTotal is declared as a Currency that is strict private. UpdateTotals is public.
procedure TMainApplicationClass.UpdateTotals(aMyObject: TMyObject);
var
bulkTotal: Single;
begin
..
bulkTotal := grouping.GetTotal(aMyObject, Self);
FBulkTotal := FBulkTotal + bulkTotal;
..
end;
The generated code for these two lines is:
TheCodeUnit.pas.7357: bulkTotal := grouping.GetTotal(aMyObject, Self);
0000000006DB0804 488B4D68 mov rcx,[rbp+$68]
0000000006DB0808 488B9598000000 mov rdx,[rbp+$00000098]
0000000006DB080F 4C8B8590000000 mov r8,[rbp+$00000090]
0000000006DB0816 E8551C0100 call grouping.GetTotal
0000000006DB081B F30F114564 movss dword ptr [rbp+$64],xmm0
TheCodeUnit.pas.7358: FBulkTotal := FBulkTotal + bulkTotal;
0000000006DB0820 488B8590000000 mov rax,[rbp+$00000090]
0000000006DB0827 488B8D90000000 mov rcx,[rbp+$00000090]
0000000006DB082E F3480F2A8128010000 cvtsi2ss xmm0,qword ptr [rcx+$00000128]
0000000006DB0837 F30F104D64 movss xmm1,dword ptr [rbp+$64]
0000000006DB083C F30F590D54020000 mulss xmm1,dword ptr [rel $00000254]
0000000006DB0844 F30F58C1 addss xmm0,xmm1
0000000006DB0848 F3480F2DC8 cvtss2si rcx,xmm0
0000000006DB084D 48898828010000 mov [rax+$00000128],rcx
What's strange is that the generated code is different. The MCVE has a cvtsi2sd followed by a cvtss2sd but that main application uses a movss in place of the cvtss2sd when copying the contents of the single value into the xmm1 register. I pretty sure that is what is causing the different result but without being able to create a MCVE, I can't even confirm that it is a problem with the compiler.
Question
My question is what can cause these differences in code generation? I assumed that the optimizations could do this type of thing but I made sure those were the same.
You should not be using any floating point type values when dealing with currency.
I recommend you watch Floating Point Numbers video from Computerphile where he explains of how floating point values are handled by computers and why they should not be used when handling currency.
https://www.youtube.com/watch?v=PZRI1IfStY0

With an iOS quick action (shortcut item), what is the purpose of the completion handler parameter?

An iOS quick action / shortcut item is received by the app delegate's implementation of application(_:performActionFor:completionHandler:).
In that implementation, you are supposed to call the completionHandler. It takes a Bool.
Does anyone know what the Bool is for? I see no difference regardless of whether I pass true or false. (In fact, I see no difference even if I neglect to call the completionHandler!)
Short answer: parameter is not used in implementation of block in iOS 10 (guess that in iOS 9 too, but can't check right now).
Long answer: let's see what happens inside of completion block:
___50-[UIApplication _handleApplicationShortcutAction:]_block_invoke:
push rbp ; XREF=-[UIApplication _handleApplicationShortcutAction:]+132
mov rbp, rsp
mov rax, qword [ds:rdi+0x20]
mov rdx, qword [ds:rdi+0x28]
mov rsi, qword [ds:0x1179e88] ; #selector(_updateSnapshotAndStateRestorationWithAction:)
mov rdi, rax ; argument "instance" for method imp___got__objc_msgSend
pop rbp
jmp qword [ds:imp___got__objc_msgSend]
; endp
I run this on Intel64, so first argument should be stored in rdi register (when we calling block under ARC it is an instance of NSMallocBlock). There is no selector, so second parameter (bool argument) should be stored in rsi register. But rsi register is not used in code - it just sends message _updateSnapshotAndStateRestorationWithAction: to object ds:rdi+0x20 with argument ds:rdi+0x28.
Both ds:rdi+0x20 and ds:rdi+0x28 are captured pointers inside of the block.
Think that the guess with parameter as indicator for snapshot function was wrong.

Bitmap image processing with masm32

I am working with masm 32. I want to process bitmap images. But I don't know how to get an image or save an image.
I have no idea about processing images with masm.
Any information will help me.
Thanks
This might get you started... This is basic code to load in a bitmap and display it on a dialog box. I'm not sure what mean by 'processing' bitmap images, I suspect you need something more complex. However, this might get you started...
.386
.model flat,stdcall
option casemap:none
includelib user32.lib
includelib kernel32.lib
includelib shell32.lib
includelib comctl32.lib
includelib comdlg32.lib
includelib gdi32.lib
WinMain PROTO :DWORD,:DWORD,:DWORD,:DWORD
WndProc PROTO :DWORD,:DWORD,:DWORD,:DWORD
IDD_DIALOG equ 1000
IDC_BITMAP equ 100
IDM_MENU equ 10000
.const
ClassName db 'DLGCLASS',0
.data?
hInstance dd ?
CommandLine dd ?
hWnd dd ?
hBitmap dd ?
.code
start:
invoke GetModuleHandle,NULL
mov hInstance,eax
invoke GetCommandLine
invoke InitCommonControls
mov CommandLine,eax
invoke WinMain,hInstance,NULL,CommandLine,SW_SHOWDEFAULT
invoke ExitProcess,eax
WinMain proc hInst:HINSTANCE,hPrevInst:HINSTANCE,CmdLine:LPSTR,CmdShow:DWORD
LOCAL wc:WNDCLASSEX
LOCAL msg:MSG
mov wc.cbSize,sizeof WNDCLASSEX
mov wc.style,CS_HREDRAW or CS_VREDRAW
mov wc.lpfnWndProc,offset WndProc
mov wc.cbClsExtra,NULL
mov wc.cbWndExtra,DLGWINDOWEXTRA
push hInst
pop wc.hInstance
mov wc.hbrBackground,COLOR_BTNFACE+1
mov wc.lpszMenuName, NULL
mov wc.lpszClassName,offset ClassName
invoke LoadIcon,NULL,IDI_APPLICATION
mov wc.hIcon,eax
mov wc.hIconSm,eax
invoke LoadCursor,NULL,IDC_ARROW
mov wc.hCursor,eax
invoke RegisterClassEx,addr wc
invoke CreateDialogParam,hInstance,IDD_DIALOG,NULL,addr WndProc,NULL
invoke ShowWindow,hWnd,SW_SHOWNORMAL
invoke UpdateWindow,hWnd
.while TRUE
invoke GetMessage,addr msg,NULL,0,0
.BREAK .if !eax
invoke TranslateMessage,addr msg
invoke DispatchMessage,addr msg
.endw
mov eax,msg.wParam
ret
WinMain endp
WndProc proc hWin:HWND,uMsg:UINT,wParam:WPARAM,lParam:LPARAM
LOCAL ps:PAINTSTRUCT
LOCAL hdc:HDC
LOCAL hMemDC:HDC
LOCAL rect:RECT
mov eax,uMsg
.if eax==WM_INITDIALOG
push hWin
pop hWnd
; Load up the bitmap
invoke LoadBitmap, hInstance, IDC_BITMAP
mov hBitmap, eax
.elseif eax==WM_COMMAND
mov eax,wParam
mov edx, eax
shr edx, 16
.if lParam==0
.if eax==IDM_FILE_EXIT
invoke SendMessage,hWin,WM_CLOSE,0,0
.elseif eax==IDM_HELP_ABOUT
invoke ShellAbout,hWin,addr AppName,addr AboutMsg,NULL
.endif
.else
.endif
.elseif eax==WM_PAINT
invoke BeginPaint, hWnd, addr ps
mov hdc, eax
invoke CreateCompatibleDC, hdc
mov hMemDC, eax
invoke SelectObject, hMemDC, hBitmap
invoke GetClientRect, hWnd, addr rect
invoke BitBlt, hdc, 10, 10, rect.right, rect.bottom, hMemDC, 0, 0, SRCAND
invoke DeleteDC, hMemDC
invoke EndPaint, hWnd, addr ps
.elseif eax==WM_CLOSE
invoke DestroyWindow,hWin
.elseif uMsg==WM_DESTROY
invoke DeleteObject, hBitmap
invoke PostQuitMessage,NULL
.else
invoke DefWindowProc,hWin,uMsg,wParam,lParam
ret
.endif
xor eax,eax
ret
WndProc endp
end start
Note the LoadBitmap API call and the WM_PAINT routine.
..Forgot the .rc file...
#define IDD_DIALOG 1000
#define IDC_BITMAP 100
IDC_BITMAP BITMAP DISCARDABLE "myfile.bmp"

Delphi 2010 - EDirectoryNotFoundException when trying to save logs

I'm developing a program in Delphi 2010 that has to save the logs that are stored in a Tmemo. I'm trying to create a log file for everyday in which I append the logs from a memo.After I append the text I clear the content of the memo. So in the location of my app i want to create a folder named "loguri-mover_ftp" in which i want to store the log file. EX: log_mover-ftp_2-16-2015.txt
The code I use for this is:
If DirectoryExists(ExtractFilePath(Application.ExeName) + 'loguri-mover_ftp') then
begin
TFile.AppendAllText(ExtractFilePath(Application.ExeName) + 'loguri-mover_ftp\log_mover-ftp_' + datetostr(now) + '.txt',memo_loguri.lines.text, TEncoding.UTF8);
Memo_loguri.lines.text:='';
end
else
begin
CreateDir(ExtractFilePath(Application.ExeName) + 'loguri-mover_ftp');
TFile.AppendAllText(ExtractFilePath(Application.ExeName) + 'loguri-mover_ftp\log_mover-ftp_' + datetostr(now) + '.txt',memo_loguri.lines.text, TEncoding.UTF8);
Memo_loguri.lines.text:='';
end;
Because I'm interested in the stability of my application I've enabled the MadExcept debugger inside my app. After 2 hours 12 minutes i get the following error:
exception class : EDirectoryNotFoundException
exception message : The specified path was not found.
compiled with : Delphi 2010
program up time : 2 hours 12 minutes
madExcept version : 4.0.7
callstack crc : $bed2c7c0, $c58f696b, $05cb237f
count : 5
exception number : 1
disassembling:
[...]
005ce40a push eax
005ce40b call -$13ee30 ($48f5e0) ; SysUtils.TEncoding.GetUTF8
005ce410 mov ecx, eax
005ce412 pop eax
005ce413 pop edx
005ce414 > call -$1144ad ($4b9f6c) ; IOUtils.TFile.AppendAllText
005ce419 775 mov eax, [ebp+8]
005ce41c mov eax, [eax+$2a0]
005ce422 xor edx, edx
005ce424 mov ecx, [eax]
005ce426 call dword ptr [ecx+$2c]
[...]
What am I doing wrong?
The exception is raised by the call to AppendAllText. If you follow the source for that function you will find a call to InternalCheckFilePathParam, the implementation of which looks like this:
class procedure TFile.InternalCheckFilePathParam(const Path: string;
const FileExistsCheck: Boolean);
begin
if (Length(Path) >= MAX_PATH - TFile.FCMinFileNameLen) and
(not TPath.IsExtendedPrefixed(Path)) then
raise EPathTooLongException.CreateRes(#SPathTooLong);
if not TPath.HasPathValidColon(Path) then
raise ENotSupportedException.CreateRes(#SPathFormatNotSupported);
if Trim(Path) = '' then // DO NOT LOCALIZE
raise EArgumentException.CreateRes(#SInvalidCharsInPath);
if not TPath.HasValidPathChars(Path, False) then
raise EArgumentException.CreateRes(#SInvalidCharsInPath);
if not TDirectory.Exists(TPath.DoGetDirectoryName(TPath.DoGetFullPath(Path))) then
raise EDirectoryNotFoundException.CreateRes(#SPathNotFound);
if FileExistsCheck and (not Exists(Path)) then
raise EFileNotFoundException.CreateRes(#SFileNotFound);
end;
Now, Path is the first argument that you passed to AppendAllText. Since EDirectoryNotFoundException is being raised, we can conclude that the directory containing Path does not exist.
Of course, this seems odd give that you check for its existence and then create it. I think the mystery can be solved by looking at what datetostr(now) returns. You imagine that the date separator used is -. But what if the date separator is /? In that case the / will be interpreted as a path delimiter.
The solution is to specify the date separator explicitly by using the DateToStr overload that accepts a TFormatSettings parameter.
I also cannot ignore the duplication in your code. Please don't ever repeat magic strings the way you do. The code should look like this:
LogFileDir := TPath.Combine(ExtractFilePath(Application.ExeName), 'loguri-mover_ftp');
if not DirectoryExists(LogFileDir) then
ForceDirectories(LogFileDir);
DateStr := DateToStr(Now, ...); // you supply an appropriate TFormatSettings
LogFilePath := TPath.Combine(LogFileDir, log_mover-ftp_' + DateStr + '.txt');
TFile.AppendAllText(LogFilePath, memo_loguri.lines.text, TEncoding.UTF8);

MASM - HeapAlloc throws exception

I'm here again. I'm using masm .dll in c# application, but now my code throws 'System.AccessViolationException' in line: INVOKE HeapAlloc, edx, 0, <size>
Can you tell me what cause problem?
Here is my ASM code:
invoke GetProcessHeap
mov edx, eax
INVOKE HeapAlloc, edx, 0, dlText
mov tab, eax
INVOKE HeapAlloc, edx, 0, dlText
mov wynik, eax
I found the cause of error. I was using edx instead of ebx ;)

Resources