wasm32.inc 4.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2017 by the Free Pascal development team.
  4. Processor dependent implementation for the system unit for
  5. WebAssembly 32-bit
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. procedure fpc_cpuinit;
  13. begin
  14. end;
  15. {$define FPC_SYSTEM_HAS_FILLCHAR}
  16. Procedure FillChar(var x;count:SizeInt;value:byte);
  17. begin
  18. if count>0 then
  19. fpc_wasm32_memory_fill(PtrUInt(@x),value,count);
  20. end;
  21. {$define FPC_SYSTEM_HAS_MOVE}
  22. procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE'];
  23. begin
  24. if count>0 then
  25. fpc_wasm32_memory_copy(PtrUInt(@dest),PtrUInt(@source),count);
  26. end;
  27. {$define FPC_SYSTEM_HAS_GET_PC_ADDR}
  28. Function Get_pc_addr : CodePointer;
  29. begin
  30. { dummy, produces a small, fake backtrace, otherwise programs terminate
  31. with no output at all, in case of a runtime error }
  32. result:=CodePointer($eeeeeeef);
  33. end;
  34. {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
  35. function get_caller_addr(framebp:pointer;addr:codepointer=nil):pointer;
  36. begin
  37. { dummy, produces a small, fake backtrace, otherwise programs terminate
  38. with no output at all, in case of a runtime error }
  39. if addr=CodePointer($eeeeeeef) then
  40. result:=CodePointer($eeeeeeee)
  41. else
  42. result:=nil;
  43. end;
  44. {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
  45. function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;
  46. begin
  47. result:=nil;
  48. end;
  49. {$define FPC_SYSTEM_HAS_SPTR}
  50. function Sptr : pointer;
  51. begin
  52. result:=nil;
  53. end;
  54. function InterLockedDecrement (var Target: longint) : longint;
  55. begin
  56. {$ifdef FPC_WASM_THREADS}
  57. {$push}{$R-,Q-}
  58. Result:=fpc_wasm32_i32_atomic_rmw_sub(@Target,1)-1;
  59. {$pop}
  60. {$else FPC_WASM_THREADS}
  61. dec(Target);
  62. Result:=Target;
  63. {$endif FPC_WASM_THREADS}
  64. end;
  65. function InterLockedIncrement (var Target: longint) : longint;
  66. begin
  67. {$ifdef FPC_WASM_THREADS}
  68. {$push}{$R-,Q-}
  69. Result:=fpc_wasm32_i32_atomic_rmw_add(@Target,1)+1;
  70. {$pop}
  71. {$else FPC_WASM_THREADS}
  72. inc(Target);
  73. Result:=Target;
  74. {$endif FPC_WASM_THREADS}
  75. end;
  76. function InterLockedExchange (var Target: longint;Source : longint) : longint;
  77. begin
  78. {$ifdef FPC_WASM_THREADS}
  79. Result:=LongInt(fpc_wasm32_i32_atomic_rmw_xchg(@Target,LongWord(Source)));
  80. {$else FPC_WASM_THREADS}
  81. Result:=Target;
  82. Target:=Source;
  83. {$endif FPC_WASM_THREADS}
  84. end;
  85. function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint;
  86. begin
  87. {$ifdef FPC_WASM_THREADS}
  88. Result:=LongInt(fpc_wasm32_i32_atomic_rmw_cmpxchg_u(@Target,LongWord(Comperand),LongWord(NewValue)));
  89. {$else FPC_WASM_THREADS}
  90. Result:=Target;
  91. if Target=Comperand then
  92. Target:=NewValue;
  93. {$endif FPC_WASM_THREADS}
  94. end;
  95. function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint;
  96. begin
  97. {$ifdef FPC_WASM_THREADS}
  98. Result:=LongInt(fpc_wasm32_i32_atomic_rmw_add(@Target,LongWord(Source)));
  99. {$else FPC_WASM_THREADS}
  100. Result:=Target;
  101. inc(Target,Source);
  102. {$endif FPC_WASM_THREADS}
  103. end;
  104. function InterLockedDecrement (var Target: smallint) : smallint;
  105. begin
  106. {$ifdef FPC_WASM_THREADS}
  107. {$push}{$R-,Q-}
  108. Result:=smallint(fpc_wasm32_i32_atomic_rmw16_sub_u(@Target,1)-1);
  109. {$pop}
  110. {$else FPC_WASM_THREADS}
  111. dec(Target);
  112. Result:=Target;
  113. {$endif FPC_WASM_THREADS}
  114. end;
  115. function InterLockedIncrement (var Target: smallint) : smallint;
  116. begin
  117. {$ifdef FPC_WASM_THREADS}
  118. {$push}{$R-,Q-}
  119. Result:=smallint(fpc_wasm32_i32_atomic_rmw16_add_u(@Target,1)+1);
  120. {$pop}
  121. {$else FPC_WASM_THREADS}
  122. inc(Target);
  123. Result:=Target;
  124. {$endif FPC_WASM_THREADS}
  125. end;
  126. function InterLockedExchange (var Target: smallint;Source : smallint) : smallint;
  127. begin
  128. {$ifdef FPC_WASM_THREADS}
  129. Result:=SmallInt(fpc_wasm32_i32_atomic_rmw16_xchg_u(@Target,Word(Source)));
  130. {$else FPC_WASM_THREADS}
  131. Result:=Target;
  132. Target:=Source;
  133. {$endif FPC_WASM_THREADS}
  134. end;
  135. function InterlockedCompareExchange(var Target: smallint; NewValue: smallint; Comperand: smallint): smallint;
  136. begin
  137. {$ifdef FPC_WASM_THREADS}
  138. Result:=SmallInt(fpc_wasm32_i32_atomic_rmw16_cmpxchg_u(@Target,Word(Comperand),Word(NewValue)));
  139. {$else FPC_WASM_THREADS}
  140. Result:=Target;
  141. if Target=Comperand then
  142. Target:=NewValue;
  143. {$endif FPC_WASM_THREADS}
  144. end;
  145. function InterLockedExchangeAdd (var Target: smallint;Source : smallint) : smallint;
  146. begin
  147. {$ifdef FPC_WASM_THREADS}
  148. Result:=SmallInt(fpc_wasm32_i32_atomic_rmw16_add_u(@Target,Word(Source)));
  149. {$else FPC_WASM_THREADS}
  150. Result:=Target;
  151. inc(Target,Source);
  152. {$endif FPC_WASM_THREADS}
  153. end;