freepascal.compiler/rtl/win64/x86_64/cpuwin.inc

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2006 by Florian Klaempfl and Pavel Ozerski
    member of the Free Pascal development team.

    FPC Pascal system unit x86-64 specific part for the Win64 API.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

{$asmmode att}

function StackTop: pointer; assembler;nostackframe;
asm
   movq  %gs:(8),%rax
end;

{$ifdef FPC_USE_WIN64_SEH}
function main_wrapper(arg: Pointer; proc: Pointer): ptrint; assembler; nostackframe;
asm
    subq   $40, %rsp
.seh_stackalloc 40
.seh_endprologue
    call   %rdx             { "arg" is passed in %rcx }
    nop                     { this nop is critical for exception handling }
    addq   $40, %rsp
.seh_handler __FPC_default_handler,@except,@unwind
end;
{$endif FPC_USE_WIN64_SEH}

var
  { old compilers emitted a reference to _fltused if a module contains
    floating type code so the linker could leave away floating point
    libraries or not. VC does this as well so we need to define this
    symbol as well (FK)
  }
  _fltused : int64;cvar;public;
  { value of the stack segment
    to check if the call stack can be written on exceptions }
  _SS : Cardinal;

procedure Exe_entry(constref info: TEntryInformation);[public,alias:'_FPC_EXE_Entry'];
  begin
     SetupEntryInformation(info);
     IsLibrary:=false;
     { install the handlers for exe only ?
       or should we install them for DLL also ? (PM) }
{$ifndef SYSTEM_USE_WIN_SEH}
     install_exception_handlers;
{$endif SYSTEM_USE_WIN_SEH}
     ExitCode:=0;
     asm
        xorq %rax,%rax
        movw %ss,%ax
        movl %eax,_SS(%rip)
        movq %rbp,%rsi
        xorq %rbp,%rbp
{$ifdef FPC_USE_WIN64_SEH}
        xor  %rcx,%rcx
        lea  EntryInformation(%rip),%rdx
        movq TEntryInformation.PascalMain(%rdx),%rdx
        call main_wrapper
{$else FPC_USE_WIN64_SEH}
        lea  EntryInformation(%rip),%rdx
        call TEntryInformation.PascalMain(%rdx)
{$endif FPC_USE_WIN64_SEH}
        movq %rsi,%rbp
     end ['RSI','RBP'];     { <-- specifying RSI allows compiler to save/restore it properly }
     { if we pass here there was no error ! }
     system_exit;
  end;

function is_prefetch(p : pointer) : boolean;
  var
    a : array[0..15] of byte;
    doagain : boolean;
    instrlo,instrhi,opcode : byte;
    i : longint;
  begin
    result:=false;
    { read memory savely without causing another exeception }
    if not(ReadProcessMemory(GetCurrentProcess,p,@a,sizeof(a),nil)) then
      exit;
    i:=0;
    doagain:=true;
    while doagain and (i<15) do
      begin
        opcode:=a[i];
        instrlo:=opcode and $f;
        instrhi:=opcode and $f0;
        case instrhi of
          { prefix? }
          $20,$30:
            doagain:=(instrlo and 7)=6;
          $60:
            doagain:=(instrlo and $c)=4;
          $f0:
            doagain:=instrlo in [0,2,3];
          $0:
            begin
              result:=(instrlo=$f) and (a[i+1] in [$d,$18]);
              exit;
            end;
          else
            doagain:=false;
        end;
        inc(i);
      end;
  end;