API tools faq
paste
Guest User

Methods für PascalScript on x64 Laz/FPC, take 2

a guest
Sep 5th, 2012
343
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 12.16 KB | None | 0 0
raw download clone embed print report
  1. Index: x64.inc
  2. ===================================================================
  3. --- x64.inc (revision 38441)
  4. +++ x64.inc (working copy)
  5. @@ -14,7 +14,7 @@
  6.    _RCX, _RDX, _R8, _R9: IPointer;
  7.    var _XMM0: Double;
  8.    _XMM1, _XMM2, _XMM3: Double;
  9. -  aStack: Pointer; aItems: IntPtr); assembler; {$IFDEF FPC}nostackframe;{$ENDIF}
  10. +  aStack: Pointer; aItems: PtrUInt); assembler; {$IFDEF FPC}nostackframe;{$ENDIF}
  11.  asm
  12.  (* Registers:
  13.      RCX: Address
  14. @@ -37,7 +37,7 @@
  15.    mov rdx, aStack
  16.    jmp @compareitems
  17.  @work:
  18. -  push [rdx]
  19. +  push qword ptr [rdx]
  20.    dec rcx
  21.    sub rdx,8
  22.  @compareitems:
  23. @@ -280,6 +280,9 @@
  24.    CallData: TPSList;
  25.    I: Integer;
  26.    pp: ^Byte;
  27. +{$IFDEF FPC}
  28. +  IsVirtualCons: Boolean;
  29. +{$ENDIF}
  30.  
  31.    function rp(p: PPSVariantIFC): PPSVariantIFC;
  32.    begin
  33. @@ -535,8 +538,10 @@
  34.            begin
  35.              GetMem(p, PointerSize2);
  36.              TMethod(p^) := MKMethod(Self, Longint(FVar.Dta^));
  37. -            StoreStack(p^, Pointersize2);
  38. -            FreeMem(p);
  39. +            //StoreStack(p^, Pointersize2);
  40. +            StoreReg(IPointer(p));
  41. +            //_RAX:=IPointer(TMethod(p^).Code);
  42. +            //FreeMem(p);
  43.            end;
  44.  
  45.          bts64:
  46. @@ -579,8 +584,21 @@
  47.  {$ENDIF}
  48.      _RAX := 0;
  49.      RegUsage := 0;
  50. +    {$IFDEF FPC}
  51. +    // FIX FOR FPC constructor calls
  52. +    if (Integer(CallingConv) and 128) <> 0 then begin
  53. +      IsVirtualCons := true;
  54. +    end else
  55. +      IsVirtualCons:= false;
  56. +    if IsVirtualCons then begin
  57. +      if not GetPtr(rp(Params[0])) then exit; // this goes first
  58. +      StoreReg(IPointer(_Self));
  59. +      Params.Delete(0);
  60. +    end else
  61. +    {$ENDIF}
  62.      if assigned(_Self) then begin
  63.        StoreReg(IPointer(_Self));
  64. +      //_RAX := IPointer(_Self);
  65.      end;
  66.  {$IFNDEF WINDOWS}
  67.      if assigned(res) and (res^.atype.basetype = btSingle) then begin
  68. Index: uPSRuntime.pas
  69. ===================================================================
  70. --- uPSRuntime.pas  (revision 38441)
  71. +++ uPSRuntime.pas  (working copy)
  72. @@ -11462,8 +11462,10 @@
  73.  {$ENDIF}
  74.  
  75.  {$ifdef fpc}
  76. -  {$if defined(cpupowerpc) or defined(cpuarm) or defined(cpu64)}
  77. +  {$if defined(cpupowerpc) or defined(cpuarm)}
  78.      {$define empty_methods_handler}
  79. +  {$elseif defined(cpu64)}
  80. +    {$define fpc_64_methods_handler}
  81.    {$ifend}
  82.  {$endif}
  83.  
  84. @@ -11473,9 +11475,352 @@
  85.  end;
  86.  {$else}
  87.  
  88. +{$ifdef fpc_64_methods_handler}
  89. +function SupportsRegister(b: TPSTypeRec): Boolean;
  90. +begin
  91. +  case b.BaseType of
  92. +    btU8,
  93. +    bts8,
  94. +    bts16,
  95. +    btu16,
  96. +    bts32,
  97. +    btu32,
  98. +    btstring,
  99. +    btclass,
  100. +{$IFNDEF PS_NOINTERFACES}
  101. +    btinterface,
  102. +{$ENDIF}
  103. +    btPChar,
  104. +{$IFNDEF PS_NOWIDESTRING}
  105. +    btwidestring,
  106. +    btUnicodeString,
  107. +    btWideChar,
  108. +{$ENDIF}
  109. +    btChar,
  110. +    btArray,
  111. +    btSingle,
  112. +    btDouble,
  113. +    btEnum: Result := true;
  114. +    btSet: Result := b.RealSize <= PointerSize;
  115. +    btStaticArray: Result := b.RealSize <= PointerSize;
  116. +  else
  117. +    Result := false;
  118. +  end;
  119. +end;
  120.  
  121. +function ResultAsRegister(b: TPSTypeRec): Boolean;
  122. +begin
  123. +  case b.BaseType of
  124. +    btSingle,
  125. +    btDouble,
  126. + //   btExtended,            <-- What about that??
  127. +    btU8,
  128. +    bts8,
  129. +    bts16,
  130. +    btu16,
  131. +    bts32,
  132. +    btu32,
  133. +{$IFDEF PS_FPCSTRINGWORKAROUND}
  134. +    btString,
  135. +{$ENDIF}
  136. +{$IFNDEF PS_NOINT64}
  137. +    bts64,
  138. +{$ENDIF}
  139. +    btPChar,
  140. +{$IFNDEF PS_NOWIDESTRING}
  141. +    btWideChar,
  142. +{$ENDIF}
  143. +    btChar,
  144. +    btclass,
  145. +    btEnum: Result := true;
  146. +    btSet: Result := b.RealSize <= PointerSize;
  147. +    btStaticArray: Result := b.RealSize <= PointerSize;
  148. +  else
  149. +    Result := false;
  150. +  end;
  151. +end;
  152. +
  153. +function AlwaysAsVariable(aType: TPSTypeRec): Boolean;
  154. +begin
  155. +  case atype.BaseType of
  156. +    btVariant: Result := true;
  157. +    btSet: Result := atype.RealSize > PointerSize;
  158. +    btRecord: Result := atype.RealSize > PointerSize;
  159. +    btStaticArray: Result := atype.RealSize > PointerSize;
  160. +  else
  161. +    Result := false;
  162. +  end;
  163. +end;
  164. +
  165. +function MyAllMethodsHandler2_64(Self: PScriptMethodInfo; const StackAndParams: Pointer): Integer;
  166. +type
  167. +  __PARAM_RECORD = packed record
  168. +    _xmm3_a, _xmm3_b: Pointer;
  169. +    _xmm2_a, _xmm2_b: Pointer;
  170. +    _xmm1_a, _xmm1_b: Pointer;
  171. +    _xmm0_a, _xmm0_b: Pointer;
  172. +    R9, R8, RDX, RCX, RAX: Pointer;
  173. +    Rest: array [0..0] of Pointer;
  174. +  end;
  175. +  PPARAM_RECORD = ^__PARAM_RECORD;
  176. +
  177. +var
  178. +  Decl: tbtString;
  179. +  I, C, regno: Integer;
  180. +  Params: TPSList;
  181. +  Res, Tmp: PIFVariant;
  182. +  cpt: PIFTypeRec;
  183. +  fmod: tbtchar;
  184. +  s,e: tbtString;
  185. +  FStack: pointer;
  186. +  ex: TPSExceptionHandler;
  187. +  paramRecord:PPARAM_RECORD;
  188. +begin
  189. +  //Get Declaration, i.e. Types & Number of Parameters
  190. +  Decl := TPSInternalProcRec(Self^.Se.FProcs[Self^.ProcNo]).ExportDecl;
  191. +
  192. +  paramRecord:=StackAndParams;
  193. +  FStack := @paramRecord^.Rest;
  194. +  Params := TPSList.Create;
  195. +  s := decl;
  196. +  grfw(s);
  197. +  //Add spare parameters
  198. +  while s <> '' do
  199. +  begin
  200. +    Params.Add(nil);
  201. +    grfw(s);
  202. +  end;
  203. +  c := Params.Count;
  204. +  regno := 0;
  205. +  Result := 0;
  206. +  s := decl;
  207. +  grfw(s);
  208. +
  209. +  //Fill parameters
  210. +  for i := c-1 downto 0 do
  211. +  begin
  212. +    //Get parameter Type and Param-Object
  213. +    e := grfw(s);
  214. +    fmod := e[1];
  215. +    delete(e, 1, 1);
  216. +    //Type of Parameter
  217. +    cpt := Self.Se.GetTypeNo(StrToInt(e));
  218. +    //--Pointers etc.
  219. +    if ((fmod = '%') or (fmod = '!') or (AlwaysAsVariable(cpt))) and (RegNo < 4) then
  220. +    begin
  221. +      tmp := CreateHeapVariant(self.Se.FindType2(btPointer));
  222. +      PPSVariantPointer(tmp).DestType := cpt;
  223. +      Params[i] := tmp;
  224. +      case regno of
  225. +        0: begin
  226. +            PPSVariantPointer(tmp).DataDest := paramRecord^.RCX;
  227. +            inc(regno);
  228. +          end;
  229. +        1: begin
  230. +            PPSVariantPointer(tmp).DataDest := paramRecord^.RDX;
  231. +            inc(regno);
  232. +          end;
  233. +        2: begin
  234. +            PPSVariantPointer(tmp).DataDest := paramRecord^.R8;
  235. +            inc(regno);
  236. +          end;
  237. +        3: begin
  238. +            PPSVariantPointer(tmp).DataDest := paramRecord^.R9;
  239. +            inc(regno);
  240. +          end;
  241. +      end;
  242. +    end
  243. +    //--all types of parameters that can be stored in registers
  244. +    else if SupportsRegister(cpt) and (RegNo < 4) then
  245. +    begin
  246. +      tmp := CreateHeapVariant(cpt);
  247. +      Params[i] := tmp;
  248. +      case regno of
  249. +        0: begin
  250. +            if (cpt.BaseType=btSingle) or (cpt.BaseType=btDouble) then
  251. +              CopyArrayContents(@PPSVariantData(tmp)^.Data, @paramRecord^._xmm0_a, 1, cpt)
  252. +            else
  253. +              CopyArrayContents(@PPSVariantData(tmp)^.Data, @paramRecord^.RCX, 1, cpt);
  254. +            inc(regno);
  255. +          end;
  256. +        1: begin
  257. +            if (cpt.BaseType=btSingle) or (cpt.BaseType=btDouble) then
  258. +              CopyArrayContents(@PPSVariantData(tmp)^.Data, @paramRecord^._xmm1_a, 1, cpt)
  259. +            else
  260. +              CopyArrayContents(@PPSVariantData(tmp)^.Data, @paramRecord^.RDX, 1, cpt);
  261. +            inc(regno);
  262. +          end;
  263. +        2: begin
  264. +            if (cpt.BaseType=btSingle) or (cpt.BaseType=btDouble) then
  265. +              CopyArrayContents(@PPSVariantData(tmp)^.Data, @paramRecord^._xmm2_a, 1, cpt)
  266. +            else
  267. +              CopyArrayContents(@PPSVariantData(tmp)^.Data, @paramRecord^.R8, 1, cpt);
  268. +            inc(regno);
  269. +          end;
  270. +        3: begin
  271. +            if (cpt.BaseType=btSingle) or (cpt.BaseType=btDouble) then
  272. +              CopyArrayContents(@PPSVariantData(tmp)^.Data, @paramRecord^._xmm3_a, 1, cpt)
  273. +            else
  274. +              CopyArrayContents(@PPSVariantData(tmp)^.Data, @paramRecord^.R9, 1, cpt) ;
  275. +            inc(regno);
  276. +          end;
  277. +      end;
  278. +    end;
  279. +  end;
  280. +  //Start over for Returnvalue
  281. +  s := decl;
  282. +  e := grfw(s);
  283. +  if e <> '-1' then
  284. +  begin
  285. +    cpt := Self.Se.GetTypeNo(StrToInt(e));
  286. +    if not ResultAsRegister(cpt) then
  287. +    begin
  288. +      Res := CreateHeapVariant(Self.Se.FindType2(btPointer));
  289. +      PPSVariantPointer(Res).DestType := cpt;
  290. +      Params.Add(Res);
  291. +      PPSVariantPointer(Res).DataDest := @paramRecord^.RAX;
  292. +    end{ else      //Are there return values on the Stack in x64 - probably yes, but how?
  293. +    begin
  294. +      Res := CreateHeapVariant(cpt);
  295. +      Params.Add(Res);
  296. +    end};
  297. +  end else Res := nil;
  298. +
  299. +  //Now push remaining parameters on the Stack
  300. +  s := decl;
  301. +  grfw(s);
  302. +  for i := 0 to c -1 do
  303. +  begin
  304. +    //Get type
  305. +    e := grlw(s);
  306. +    fmod := e[1];
  307. +    delete(e, 1, 1);
  308. +    //Already in a register?
  309. +    if Params[i] <> nil then Continue;
  310. +    cpt := Self.Se.GetTypeNo(StrToInt(e));
  311. +    //Pointer?
  312. +    if (fmod = '%') or (fmod = '!') or (AlwaysAsVariable(cpt)) then
  313. +    begin
  314. +      tmp := CreateHeapVariant(self.Se.FindType2(btPointer));
  315. +      PPSVariantPointer(tmp).DestType := cpt;
  316. +      Params[i] := tmp;
  317. +      PPSVariantPointer(tmp).DataDest := Pointer(FStack^);
  318. +      FStack := Pointer(IPointer(FStack) + PointerSize);
  319. +      Inc(Result, PointerSize);
  320. +    end
  321. +(*    else if SupportsRegister(cpt) then
  322. +    begin
  323. +      tmp := CreateHeapVariant(cpt);
  324. +      Params[i] := tmp;
  325. +      CopyArrayContents(@PPSVariantData(tmp)^.Data, Pointer(FStack), 1, cpt);
  326. +      FStack := Pointer(IPointer(FStack) + 4);
  327. +      end;
  328. +    end *)else
  329. +    begin
  330. +      tmp := CreateHeapVariant(cpt);
  331. +      Params[i] := tmp;
  332. +      CopyArrayContents(@PPSVariantData(tmp)^.Data, Pointer(FStack), 1, cpt);
  333. +      FStack := Pointer((IPointer(FStack) + cpt.RealSize + 3) and not 3);
  334. +      Inc(Result, (cpt.RealSize + 3) and not 3);
  335. +    end;
  336. +  end;
  337. +
  338. +  //Create exception handler and call the beast!
  339. +  ex := TPSExceptionHandler.Create;
  340. +  ex.FinallyOffset := InvalidVal;
  341. +  ex.ExceptOffset := InvalidVal;
  342. +  ex.Finally2Offset := InvalidVal;
  343. +  ex.EndOfBlock := InvalidVal;
  344. +  ex.CurrProc := nil;
  345. +  ex.BasePtr := Self.Se.FCurrStackBase;
  346. +  Ex.StackSize := Self.Se.FStack.Count;
  347. +  i :=  Self.Se.FExceptionStack.Add(ex);
  348. +  Self.Se.RunProc(Params, Self.ProcNo);
  349. +  if Self.Se.FExceptionStack[i] = ex then
  350. +  begin
  351. +    Self.Se.FExceptionStack.Remove(ex);
  352. +    ex.Free;
  353. +  end;
  354. +
  355. +  //Anything to return?
  356. +  if (Res <> nil) then
  357. +  begin
  358. +    Params.DeleteLast;
  359. +    if (ResultAsRegister(Res.FType)) then
  360. +    begin
  361. +      CopyArrayContents(@paramRecord^.RAX, @PPSVariantData(res)^.Data, 1, Res^.FType);
  362. +    end;
  363. +    DestroyHeapVariant(res);
  364. +  end;
  365. +
  366. +  //Free allocated data
  367. +  for i := 0 to Params.Count -1 do
  368. +    DestroyHeapVariant(Params[i]);
  369. +  Params.Free;
  370. +
  371. +  //Any exceptions?
  372. +  if Self.Se.ExEx <> erNoError then
  373. +  begin
  374. +    if Self.Se.ExObject <> nil then
  375. +    begin
  376. +      FStack := Self.Se.ExObject;
  377. +      Self.Se.ExObject := nil;
  378. +      raise TObject(FStack);
  379. +    end else
  380. +      raise EPSException.Create(PSErrorToString(Self.SE.ExceptionCode, Self.Se.ExceptionString), Self.Se, Self.Se.ExProc, Self.Se.ExPos);
  381. +  end;
  382. +end;
  383. +
  384. +procedure MyAllMethodsHandler;
  385. +asm
  386. +  push rbp
  387. +  mov rbp,rsp
  388. +  push rax  // for eventual result values...
  389. +  push rcx  // SELF
  390. +  push rdx  // PARAM 1  (bossibly)
  391. +  push r8   // PARAM 2
  392. +  push r9   // PARAM 3
  393. +  sub rsp, 16
  394. +  movdqu [rsp], xmm0
  395. +  sub rsp, 16
  396. +  movdqu [rsp], xmm1
  397. +  sub rsp, 16
  398. +  movdqu [rsp], xmm2
  399. +  sub rsp, 16
  400. +  movdqu [rsp], xmm3
  401. +
  402. +  mov rdx, rsp
  403. +
  404. +  sub RSP, 32    //Create Savehouse for storing registers...
  405. +
  406. +  call MyAllMethodsHandler2_64
  407. +
  408. +  add RSP, 32
  409. +
  410. +  movdqu xmm3, [rsp]
  411. +  add rsp, 16
  412. +  movdqu xmm2, [rsp]
  413. +  add rsp, 16
  414. +  movdqu xmm1, [rsp]
  415. +  add rsp, 16
  416. +  movdqu xmm0, [rsp]
  417. +  add rsp, 16
  418. +  pop r9
  419. +  pop r8
  420. +  pop rdx
  421. +  pop rcx
  422. +  pop rax
  423. +
  424. +  leave
  425. +
  426. +  add rsp, 8 //cleanup stackframe generated by FPC
  427. +  ret
  428. +end;
  429. +{$else}
  430. +
  431.  function MyAllMethodsHandler2(Self: PScriptMethodInfo; const Stack: PPointer; _EDX, _ECX: Pointer): Integer; forward;
  432.  
  433. +
  434.  procedure MyAllMethodsHandler;
  435.  //  On entry:
  436.  //     EAX = Self pointer
  437. @@ -11781,7 +12126,9 @@
  438.        raise EPSException.Create(PSErrorToString(Self.SE.ExceptionCode, Self.Se.ExceptionString), Self.Se, Self.Se.ExProc, Self.Se.ExPos);
  439.    end;
  440.  end;
  441. -{$endif}
  442. +{$endif} //fpc_64_method_handler
  443. +{$endif} //empty_method_handler
  444. +
  445.  function TPSRuntimeClassImporter.FindClass(const Name: tbtString): TPSRuntimeClass;
  446.  var
  447.    h, i: Longint;
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!