arm.inc 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2003 by the Free Pascal development team.
  4. Processor dependent implementation for the system unit for
  5. ARM
  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. {$asmmode gas}
  13. {$ifndef FPC_SYSTEM_HAS_MOVE}
  14. {$define FPC_SYSTEM_FPC_MOVE}
  15. {$endif FPC_SYSTEM_HAS_MOVE}
  16. {$ifdef FPC_SYSTEM_FPC_MOVE}
  17. const
  18. cpu_has_edsp : boolean = false;
  19. in_edsp_test : boolean = false;
  20. {$endif FPC_SYSTEM_FPC_MOVE}
  21. {$if not(defined(wince)) and not(defined(gba)) and not(defined(nds)) and not(defined(FPUSOFT)) and not(defined(FPULIBGCC))}
  22. {$define FPC_SYSTEM_HAS_SYSINITFPU}
  23. {$if not defined(darwin) and not defined(FPUVFPV2) and not defined(FPUVFPV3) and not defined(FPUVFPV3_D16)}
  24. Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
  25. begin
  26. { Enable FPU exceptions, but disable INEXACT, UNDERFLOW, DENORMAL }
  27. asm
  28. rfs r0
  29. and r0,r0,#0xffe0ffff
  30. orr r0,r0,#0x00070000
  31. wfs r0
  32. end;
  33. end;
  34. {$else}
  35. Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
  36. begin
  37. { Enable FPU exceptions, but disable INEXACT, UNDERFLOW, DENORMAL }
  38. asm
  39. fmrx r0,fpscr
  40. // set "round to nearest" mode
  41. and r0,r0,#0xff3fffff
  42. // mask "exception happened" and overflow flags
  43. and r0,r0,#0xffffff20
  44. // mask exception flags
  45. and r0,r0,#0xffff40ff
  46. {$ifndef darwin}
  47. // Floating point exceptions cause kernel panics on iPhoneOS 2.2.1...
  48. // disable flush-to-zero mode (IEEE math compliant)
  49. and r0,r0,#0xfeffffff
  50. // enable invalid operation, div-by-zero and overflow exceptions
  51. orr r0,r0,#0x00000700
  52. {$endif}
  53. fmxr fpscr,r0
  54. end;
  55. end;
  56. {$endif}
  57. {$endif}
  58. procedure fpc_cpuinit;
  59. begin
  60. { don't let libraries influence the FPU cw set by the host program }
  61. if not IsLibrary then
  62. SysInitFPU;
  63. end;
  64. {$ifdef wince}
  65. function _controlfp(new: DWORD; mask: DWORD): DWORD; cdecl; external 'coredll';
  66. {$define FPC_SYSTEM_HAS_SYSRESETFPU}
  67. Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
  68. begin
  69. softfloat_exception_flags:=0;
  70. end;
  71. {$define FPC_SYSTEM_HAS_SYSINITFPU}
  72. Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
  73. begin
  74. softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
  75. { Enable FPU exceptions, but disable INEXACT, UNDERFLOW, DENORMAL }
  76. { FPU precision 64 bit, rounding to nearest, affine infinity }
  77. _controlfp($000C0003, $030F031F);
  78. end;
  79. {$endif wince}
  80. {****************************************************************************
  81. stack frame related stuff
  82. ****************************************************************************}
  83. {$IFNDEF INTERNAL_BACKTRACE}
  84. {$define FPC_SYSTEM_HAS_GET_FRAME}
  85. function get_frame:pointer;assembler;nostackframe;
  86. asm
  87. {$ifndef darwin}
  88. mov r0,r11
  89. {$else}
  90. mov r0,r7
  91. {$endif}
  92. end;
  93. {$ENDIF not INTERNAL_BACKTRACE}
  94. {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
  95. function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;assembler;nostackframe;
  96. asm
  97. cmp r0,#0
  98. {$ifndef darwin}
  99. ldrne r0,[r0,#-4]
  100. {$else}
  101. ldrne r0,[r0,#4]
  102. {$endif}
  103. end;
  104. {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
  105. function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;assembler;nostackframe;
  106. asm
  107. cmp r0,#0
  108. {$ifndef darwin}
  109. ldrne r0,[r0,#-12]
  110. {$else}
  111. ldrne r0,[r0]
  112. {$endif}
  113. end;
  114. {$define FPC_SYSTEM_HAS_SPTR}
  115. Function Sptr : pointer;assembler;nostackframe;
  116. asm
  117. mov r0,sp
  118. end;
  119. {$ifndef FPC_SYSTEM_HAS_FILLCHAR}
  120. {$define FPC_SYSTEM_HAS_FILLCHAR}
  121. Procedure FillChar(var x;count:longint;value:byte);assembler;nostackframe;
  122. asm
  123. // less than 0?
  124. cmp r1,#0
  125. {$if defined(cpuarmv3) or defined(cpuarmv4)}
  126. movle pc,lr
  127. {$else}
  128. bxle lr
  129. {$endif}
  130. mov r3,r0
  131. orr r2,r2,r2,lsl #8
  132. orr r2,r2,r2,lsl #16
  133. tst r3, #3 // Aligned?
  134. bne .LFillchar_do_align
  135. .LFillchar_is_aligned:
  136. subs r1,r1,#8
  137. bmi .LFillchar_less_than_8bytes
  138. mov ip,r2
  139. .LFillchar_at_least_8bytes:
  140. // Do 16 bytes per loop
  141. // More unrolling is uncessary, as we'll just stall on the write buffers
  142. stmia r3!,{r2,ip}
  143. subs r1,r1,#8
  144. stmplia r3!,{r2,ip}
  145. subpls r1,r1,#8
  146. bpl .LFillchar_at_least_8bytes
  147. .LFillchar_less_than_8bytes:
  148. // Do the rest
  149. adds r1, r1, #8
  150. {$if defined(cpuarmv3) or defined(cpuarmv4)}
  151. moveq pc,lr
  152. {$else}
  153. bxeq lr
  154. {$endif}
  155. tst r1, #4
  156. strne r2,[r3],#4
  157. tst r1, #2
  158. strneh r2,[r3],#2
  159. tst r1, #1
  160. strneb r2,[r3],#1
  161. {$if defined(cpuarmv3) or defined(cpuarmv4)}
  162. mov pc,lr
  163. {$else}
  164. bx lr
  165. {$endif}
  166. // Special case for unaligned start
  167. // We make a maximum of 3 loops here
  168. .LFillchar_do_align:
  169. strb r2,[r3],#1
  170. subs r1, r1, #1
  171. {$if defined(cpuarmv3) or defined(cpuarmv4)}
  172. moveq pc,lr
  173. {$else}
  174. bxeq lr
  175. {$endif}
  176. tst r3,#3
  177. bne .LFillchar_do_align
  178. b .LFillchar_is_aligned
  179. end;
  180. {$endif FPC_SYSTEM_HAS_FILLCHAR}
  181. {$ifndef FPC_SYSTEM_HAS_MOVE}
  182. {$define FPC_SYSTEM_HAS_MOVE}
  183. procedure Move_pld(const source;var dest;count:longint);assembler;nostackframe;
  184. asm
  185. pld [r0]
  186. // count <=0 ?
  187. cmp r2,#0
  188. {$if defined(cpuarmv3) or defined(cpuarmv4)}
  189. movle pc,lr
  190. {$else}
  191. bxle lr
  192. {$endif}
  193. // overlap?
  194. cmp r1,r0
  195. bls .Lnooverlap
  196. add r3,r0,r2
  197. cmp r3,r1
  198. bls .Lnooverlap
  199. // overlap, copy backward
  200. .Loverlapped:
  201. subs r2,r2,#1
  202. ldrb r3,[r0,r2]
  203. strb r3,[r1,r2]
  204. bne .Loverlapped
  205. {$if defined(cpuarmv3) or defined(cpuarmv4)}
  206. mov pc,lr
  207. {$else}
  208. bx lr
  209. {$endif}
  210. .Lnooverlap:
  211. // less then 16 bytes to copy?
  212. cmp r2,#8
  213. // yes, the forget about the whole optimizations
  214. // and do a bytewise copy
  215. blt .Lbyteloop
  216. // both aligned?
  217. orr r3,r0,r1
  218. tst r3,#3
  219. bne .Lbyteloop
  220. (*
  221. // yes, then align
  222. // alignment to 4 byte boundries is enough
  223. ldrb ip,[r0],#1
  224. sub r2,r2,#1
  225. stb ip,[r1],#1
  226. tst r3,#2
  227. bne .Ldifferentaligned
  228. ldrh ip,[r0],#2
  229. sub r2,r2,#2
  230. sth ip,[r1],#2
  231. .Ldifferentaligned
  232. // qword aligned?
  233. orrs r3,r0,r1
  234. tst r3,#7
  235. bne .Ldwordloop
  236. *)
  237. pld [r0,#32]
  238. .Ldwordloop:
  239. sub r2,r2,#4
  240. ldr r3,[r0],#4
  241. // preload
  242. pld [r0,#64]
  243. cmp r2,#4
  244. str r3,[r1],#4
  245. bcs .Ldwordloop
  246. cmp r2,#0
  247. {$if defined(cpuarmv3) or defined(cpuarmv4)}
  248. moveq pc,lr
  249. {$else}
  250. bxeq lr
  251. {$endif}
  252. .Lbyteloop:
  253. subs r2,r2,#1
  254. ldrb r3,[r0],#1
  255. strb r3,[r1],#1
  256. bne .Lbyteloop
  257. {$if defined(cpuarmv3) or defined(cpuarmv4)}
  258. mov pc,lr
  259. {$else}
  260. bx lr
  261. {$endif}
  262. end;
  263. procedure Move_blended(const source;var dest;count:longint);assembler;nostackframe;
  264. asm
  265. // count <=0 ?
  266. cmp r2,#0
  267. {$if defined(cpuarmv3) or defined(cpuarmv4)}
  268. movle pc,lr
  269. {$else}
  270. bxle lr
  271. {$endif}
  272. // overlap?
  273. cmp r1,r0
  274. bls .Lnooverlap
  275. add r3,r0,r2
  276. cmp r3,r1
  277. bls .Lnooverlap
  278. // overlap, copy backward
  279. .Loverlapped:
  280. subs r2,r2,#1
  281. ldrb r3,[r0,r2]
  282. strb r3,[r1,r2]
  283. bne .Loverlapped
  284. {$if defined(cpuarmv3) or defined(cpuarmv4)}
  285. mov pc,lr
  286. {$else}
  287. bx lr
  288. {$endif}
  289. .Lnooverlap:
  290. // less then 16 bytes to copy?
  291. cmp r2,#8
  292. // yes, the forget about the whole optimizations
  293. // and do a bytewise copy
  294. blt .Lbyteloop
  295. // both aligned?
  296. orr r3,r0,r1
  297. tst r3,#3
  298. bne .Lbyteloop
  299. (*
  300. // yes, then align
  301. // alignment to 4 byte boundries is enough
  302. ldrb ip,[r0],#1
  303. sub r2,r2,#1
  304. stb ip,[r1],#1
  305. tst r3,#2
  306. bne .Ldifferentaligned
  307. ldrh ip,[r0],#2
  308. sub r2,r2,#2
  309. sth ip,[r1],#2
  310. .Ldifferentaligned
  311. // qword aligned?
  312. orrs r3,r0,r1
  313. tst r3,#7
  314. bne .Ldwordloop
  315. *)
  316. .Ldwordloop:
  317. sub r2,r2,#4
  318. ldr r3,[r0],#4
  319. cmp r2,#4
  320. str r3,[r1],#4
  321. bcs .Ldwordloop
  322. cmp r2,#0
  323. {$if defined(cpuarmv3) or defined(cpuarmv4)}
  324. moveq pc,lr
  325. {$else}
  326. bxeq lr
  327. {$endif}
  328. .Lbyteloop:
  329. subs r2,r2,#1
  330. ldrb r3,[r0],#1
  331. strb r3,[r1],#1
  332. bne .Lbyteloop
  333. {$if defined(cpuarmv3) or defined(cpuarmv4)}
  334. mov pc,lr
  335. {$else}
  336. bx lr
  337. {$endif}
  338. end;
  339. const
  340. moveproc : pointer = @move_blended;
  341. procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler;nostackframe;
  342. asm
  343. ldr ip,.Lmoveproc
  344. ldr pc,[ip]
  345. .Lmoveproc:
  346. .long moveproc
  347. end;
  348. {$endif FPC_SYSTEM_HAS_MOVE}
  349. {****************************************************************************
  350. String
  351. ****************************************************************************}
  352. {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
  353. {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
  354. {$ifndef FPC_STRTOSHORTSTRINGPROC}
  355. function fpc_shortstr_to_shortstr(len:longint;const sstr:shortstring):shortstring;assembler;nostackframe;[public,alias: 'FPC_SHORTSTR_TO_SHORTSTR'];compilerproc;
  356. {$else}
  357. procedure fpc_shortstr_to_shortstr(out res:shortstring;const sstr:shortstring);assembler;nostackframe;[public,alias: 'FPC_SHORTSTR_TO_SHORTSTR'];compilerproc;
  358. {$endif}
  359. {r0: __RESULT
  360. r1: len
  361. r2: sstr}
  362. asm
  363. ldrb r12,[r2],#1
  364. cmp r12,r1
  365. movgt r12,r1
  366. strb r12,[r0],#1
  367. cmp r12,#6 (* 6 seems to be the break even point. *)
  368. blt .LStartTailCopy
  369. (* Align destination on 32bits. This is the only place where unrolling
  370. really seems to help, since in the common case, sstr is aligned on
  371. 32 bits, therefore in the common case we need to copy 3 bytes to
  372. align, i.e. in the case of a loop, you wouldn't branch out early.*)
  373. rsb r3,r0,#0
  374. ands r3,r3,#3
  375. sub r12,r12,r3
  376. ldrneb r1,[r2],#1
  377. strneb r1,[r0],#1
  378. subnes r3,r3,#1
  379. ldrneb r1,[r2],#1
  380. strneb r1,[r0],#1
  381. subnes r3,r3,#1
  382. ldrneb r1,[r2],#1
  383. strneb r1,[r0],#1
  384. subnes r3,r3,#1
  385. .LDoneAlign:
  386. (* Destination should be aligned now, but source might not be aligned,
  387. if this is the case, do a byte-per-byte copy. *)
  388. tst r2,#3
  389. bne .LStartTailCopy
  390. (* Start the main copy, 32 bit at a time. *)
  391. movs r3,r12,lsr #2
  392. and r12,r12,#3
  393. beq .LStartTailCopy
  394. .LNext4bytes:
  395. (* Unrolling this loop would save a little bit of time for long strings
  396. (>20 chars), but alas, it hurts for short strings and they are the
  397. common case.*)
  398. ldrne r1,[r2],#4
  399. strne r1,[r0],#4
  400. subnes r3,r3,#1
  401. bne .LNext4bytes
  402. .LStartTailCopy:
  403. (* Do remaining bytes. *)
  404. cmp r12,#0
  405. beq .LDoneTail
  406. .LNextChar3:
  407. ldrb r1,[r2],#1
  408. strb r1,[r0],#1
  409. subs r12,r12,#1
  410. bne .LNextChar3
  411. .LDoneTail:
  412. end;
  413. procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);assembler;nostackframe;[public,alias:'FPC_SHORTSTR_ASSIGN'];compilerproc;
  414. {r0: len
  415. r1: sstr
  416. r2: dstr}
  417. asm
  418. ldrb r12,[r1],#1
  419. cmp r12,r0
  420. movgt r12,r0
  421. strb r12,[r2],#1
  422. cmp r12,#6 (* 6 seems to be the break even point. *)
  423. blt .LStartTailCopy
  424. (* Align destination on 32bits. This is the only place where unrolling
  425. really seems to help, since in the common case, sstr is aligned on
  426. 32 bits, therefore in the common case we need to copy 3 bytes to
  427. align, i.e. in the case of a loop, you wouldn't branch out early.*)
  428. rsb r3,r2,#0
  429. ands r3,r3,#3
  430. sub r12,r12,r3
  431. ldrneb r0,[r1],#1
  432. strneb r0,[r2],#1
  433. subnes r3,r3,#1
  434. ldrneb r0,[r1],#1
  435. strneb r0,[r2],#1
  436. subnes r3,r3,#1
  437. ldrneb r0,[r1],#1
  438. strneb r0,[r2],#1
  439. subnes r3,r3,#1
  440. .LDoneAlign:
  441. (* Destination should be aligned now, but source might not be aligned,
  442. if this is the case, do a byte-per-byte copy. *)
  443. tst r1,#3
  444. bne .LStartTailCopy
  445. (* Start the main copy, 32 bit at a time. *)
  446. movs r3,r12,lsr #2
  447. and r12,r12,#3
  448. beq .LStartTailCopy
  449. .LNext4bytes:
  450. (* Unrolling this loop would save a little bit of time for long strings
  451. (>20 chars), but alas, it hurts for short strings and they are the
  452. common case.*)
  453. ldrne r0,[r1],#4
  454. strne r0,[r2],#4
  455. subnes r3,r3,#1
  456. bne .LNext4bytes
  457. .LStartTailCopy:
  458. (* Do remaining bytes. *)
  459. cmp r12,#0
  460. beq .LDoneTail
  461. .LNextChar3:
  462. ldrb r0,[r1],#1
  463. strb r0,[r2],#1
  464. subs r12,r12,#1
  465. bne .LNextChar3
  466. .LDoneTail:
  467. end;
  468. {$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
  469. {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
  470. {$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
  471. function fpc_Pchar_length(p:Pchar):sizeint;assembler;nostackframe;[public,alias:'FPC_PCHAR_LENGTH'];compilerproc;
  472. asm
  473. cmp r0,#0
  474. mov r1,r0
  475. beq .Ldone
  476. .Lnextchar:
  477. (*Are we aligned?*)
  478. tst r1,#3
  479. bne .Ltest_unaligned (*No, do byte per byte.*)
  480. ldr r3,.L01010101
  481. .Ltest_aligned:
  482. (*Aligned, load 4 bytes at a time.*)
  483. ldr r12,[r1],#4
  484. (*Check wether r12 contains a 0 byte.*)
  485. sub r2,r12,r3
  486. mvn r12,r12
  487. and r2,r2,r12
  488. ands r2,r2,r3,lsl #7 (*r3 lsl 7 = $80808080*)
  489. beq .Ltest_aligned (*No 0 byte, repeat.*)
  490. sub r1,r1,#4
  491. .Ltest_unaligned:
  492. ldrb r12,[r1],#1
  493. cmp r12,#1 (*r12<1 same as r12=0, but result in carry flag*)
  494. bcs .Lnextchar
  495. (*Dirty trick: we need to subtract 1 extra because we have counted the
  496. terminating 0, due to the known carry flag sbc can do this.*)
  497. sbc r0,r1,r0
  498. .Ldone:
  499. {$if defined(cpuarmv3) or defined(cpuarmv4)}
  500. mov pc,lr
  501. {$else}
  502. bx lr
  503. {$endif}
  504. .L01010101:
  505. .long 0x01010101
  506. end;
  507. {$endif}
  508. var
  509. fpc_system_lock: longint; export name 'fpc_system_lock';
  510. function InterLockedDecrement (var Target: longint) : longint; assembler; nostackframe;
  511. asm
  512. {$if defined(cpuarmv6) or defined(cpuarmv7m) or defined(cpucortexm3)}
  513. .Lloop:
  514. ldrex r1, [r0]
  515. sub r1, r1, #1
  516. strex r2, r1, [r0]
  517. cmp r2, #0
  518. bne .Lloop
  519. mov r0, r1
  520. bx lr
  521. {$else}
  522. {$if defined(LINUX) and defined(CPUARMEL)}
  523. stmfd r13!, {lr}
  524. mov r2, r0 // kuser_cmpxchg does not clobber r2 by definition
  525. .Latomic_dec_loop:
  526. ldr r0, [r2] // Load the current value
  527. // We expect this to work without looping most of the time
  528. // R3 gets clobbered in kuser_cmpxchg so in the unlikely case that we have to
  529. // loop here again, we have to reload the value. Normaly this just fills the
  530. // load stall-cycles from the above ldr so in reality we'll not get any additional
  531. // delays because of this
  532. // Don't use ldr to load r3 to avoid cacheline trashing
  533. // Load 0xffff0fff into r3 and substract to 0xffff0fc0,
  534. // the kuser_cmpxchg entry point
  535. mvn r3, #0x0000f000
  536. sub r3, r3, #0x3F
  537. sub r1, r0, #1 // Decrement value
  538. blx r3 // Call kuser_cmpxchg, sets C-Flag on success
  539. movcs r0, r1 // We expect that to work most of the time so keep it pipeline friendly
  540. ldmcsfd r13!, {pc}
  541. b .Latomic_dec_loop // kuser_cmpxchg sets C flag on error
  542. {$else}
  543. // lock
  544. ldr r3, .Lfpc_system_lock
  545. mov r1, #1
  546. .Lloop:
  547. swp r2, r1, [r3]
  548. cmp r2, #0
  549. bne .Lloop
  550. // do the job
  551. ldr r1, [r0]
  552. sub r1, r1, #1
  553. str r1, [r0]
  554. mov r0, r1
  555. // unlock and return
  556. str r2, [r3]
  557. bx lr
  558. .Lfpc_system_lock:
  559. .long fpc_system_lock
  560. {$endif}
  561. {$endif}
  562. end;
  563. function InterLockedIncrement (var Target: longint) : longint; assembler; nostackframe;
  564. asm
  565. {$if defined(cpuarmv6) or defined(cpuarmv7m) or defined(cpucortexm3)}
  566. .Lloop:
  567. ldrex r1, [r0]
  568. add r1, r1, #1
  569. strex r2, r1, [r0]
  570. cmp r2, #0
  571. bne .Lloop
  572. mov r0, r1
  573. bx lr
  574. {$else}
  575. {$if defined(LINUX) and defined(CPUARMEL)}
  576. stmfd r13!, {lr}
  577. mov r2, r0 // kuser_cmpxchg does not clobber r2 by definition
  578. .Latomic_inc_loop:
  579. ldr r0, [r2] // Load the current value
  580. // We expect this to work without looping most of the time
  581. // R3 gets clobbered in kuser_cmpxchg so in the unlikely case that we have to
  582. // loop here again, we have to reload the value. Normaly this just fills the
  583. // load stall-cycles from the above ldr so in reality we'll not get any additional
  584. // delays because of this
  585. // Don't use ldr to load r3 to avoid cacheline trashing
  586. // Load 0xffff0fff into r3 and substract to 0xffff0fc0,
  587. // the kuser_cmpxchg entry point
  588. mvn r3, #0x0000f000
  589. sub r3, r3, #0x3F
  590. add r1, r0, #1 // Increment value
  591. blx r3 // Call kuser_cmpxchg, sets C-Flag on success
  592. movcs r0, r1 // We expect that to work most of the time so keep it pipeline friendly
  593. ldmcsfd r13!, {pc}
  594. b .Latomic_inc_loop // kuser_cmpxchg sets C flag on error
  595. {$else}
  596. // lock
  597. ldr r3, .Lfpc_system_lock
  598. mov r1, #1
  599. .Lloop:
  600. swp r2, r1, [r3]
  601. cmp r2, #0
  602. bne .Lloop
  603. // do the job
  604. ldr r1, [r0]
  605. add r1, r1, #1
  606. str r1, [r0]
  607. mov r0, r1
  608. // unlock and return
  609. str r2, [r3]
  610. bx lr
  611. .Lfpc_system_lock:
  612. .long fpc_system_lock
  613. {$endif}
  614. {$endif}
  615. end;
  616. function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler; nostackframe;
  617. asm
  618. {$if defined(cpuarmv6) or defined(cpuarmv7m) or defined(cpucortexm3)}
  619. // swp is deprecated on ARMv6 and above
  620. .Lloop:
  621. ldrex r2, [r0]
  622. strex r3, r1, [r0]
  623. cmp r3, #0
  624. bne .Lloop
  625. mov r0, r2
  626. bx lr
  627. {$else}
  628. swp r1, r1, [r0]
  629. mov r0,r1
  630. {$endif}
  631. end;
  632. function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler; nostackframe;
  633. asm
  634. {$if defined(cpuarmv6) or defined(cpuarmv7m) or defined(cpucortexm3)}
  635. .Lloop:
  636. ldrex r2, [r0]
  637. add r12, r1, r2
  638. strex r3, r12, [r0]
  639. cmp r3, #0
  640. bne .Lloop
  641. mov r0, r2
  642. bx lr
  643. {$else}
  644. {$if defined(LINUX) and defined(CPUARMEL)}
  645. stmfd r13!, {r4, lr}
  646. mov r2, r0 // kuser_cmpxchg does not clobber r2 by definition
  647. mov r4, r1 // Save addend
  648. .Latomic_add_loop:
  649. ldr r0, [r2] // Load the current value
  650. // We expect this to work without looping most of the time
  651. // R3 gets clobbered in kuser_cmpxchg so in the unlikely case that we have to
  652. // loop here again, we have to reload the value. Normaly this just fills the
  653. // load stall-cycles from the above ldr so in reality we'll not get any additional
  654. // delays because of this
  655. // Don't use ldr to load r3 to avoid cacheline trashing
  656. // Load 0xffff0fff into r3 and substract to 0xffff0fc0,
  657. // the kuser_cmpxchg entry point
  658. mvn r3, #0x0000f000
  659. sub r3, r3, #0x3F
  660. add r1, r0, r4 // Add to value
  661. blx r3 // Call kuser_cmpxchg, sets C-Flag on success
  662. // r1 does not get clobbered, so just get back the original value
  663. // Otherwise we would have to allocate one more register and store the
  664. // temporary value
  665. subcs r0, r1, r4
  666. ldmcsfd r13!, {r4, pc}
  667. b .Latomic_add_loop // kuser_cmpxchg failed, loop back
  668. {$else}
  669. // lock
  670. ldr r3, .Lfpc_system_lock
  671. mov r2, #1
  672. .Lloop:
  673. swp r2, r2, [r3]
  674. cmp r2, #0
  675. bne .Lloop
  676. // do the job
  677. ldr r2, [r0]
  678. add r1, r1, r2
  679. str r1, [r0]
  680. mov r0, r2
  681. // unlock and return
  682. mov r2, #0
  683. str r2, [r3]
  684. bx lr
  685. .Lfpc_system_lock:
  686. .long fpc_system_lock
  687. {$endif}
  688. {$endif}
  689. end;
  690. function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; assembler; nostackframe;
  691. asm
  692. {$if defined(cpuarmv6) or defined(cpuarmv7m) or defined(cpucortexm3)}
  693. .Lloop:
  694. ldrex r3, [r0]
  695. mov r12, #0
  696. cmp r3, r2
  697. strexeq r12, r1, [r0]
  698. cmp r12, #0
  699. bne .Lloop
  700. mov r0, r3
  701. bx lr
  702. {$else}
  703. {$if defined(LINUX) and defined(CPUARMEL)}
  704. stmfd r13!, {r4, lr}
  705. mvn r3, #0x0000f000
  706. sub r3, r3, #0x3F
  707. mov r4, r2 // Swap parameters around
  708. mov r2, r0
  709. mov r0, r4 // Use r4 because we'll need the new value for later
  710. // r1 and r2 will not be clobbered by kuser_cmpxchg
  711. // If we have to loop, r0 will be set to the original Comperand
  712. .Linterlocked_compare_exchange_loop:
  713. blx r3 // Call kuser_cmpxchg sets C-Flag on success
  714. movcs r0, r4 // Return the previous value on success
  715. ldmcsfd r13!, {r4, pc}
  716. // The error case is a bit tricky, kuser_cmpxchg does not return the current value
  717. // So we may need to loop to avoid race conditions
  718. // The loop case is HIGHLY unlikely, it would require that we got rescheduled between
  719. // calling kuser_cmpxchg and the ldr. While beeing rescheduled another process/thread
  720. // would have the set the value to our comperand
  721. ldr r0, [r2] // Load the currently set value
  722. cmp r0, r4 // Return if Comperand != current value, otherwise loop again
  723. ldmnefd r13!, {r4, pc}
  724. // If we need to loop here, we have to
  725. b .Linterlocked_compare_exchange_loop
  726. {$else}
  727. // lock
  728. ldr r12, .Lfpc_system_lock
  729. mov r3, #1
  730. .Lloop:
  731. swp r3, r3, [r12]
  732. cmp r3, #0
  733. bne .Lloop
  734. // do the job
  735. ldr r3, [r0]
  736. cmp r3, r2
  737. streq r1, [r0]
  738. mov r0, r3
  739. // unlock and return
  740. mov r3, #0
  741. str r3, [r12]
  742. bx lr
  743. .Lfpc_system_lock:
  744. .long fpc_system_lock
  745. {$endif}
  746. {$endif}
  747. end;
  748. {$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
  749. function declocked(var l: longint) : boolean; inline;
  750. begin
  751. Result:=InterLockedDecrement(l) = 0;
  752. end;
  753. {$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
  754. procedure inclocked(var l: longint); inline;
  755. begin
  756. InterLockedIncrement(l);
  757. end;
  758. procedure fpc_cpucodeinit;
  759. begin
  760. {$ifdef FPC_SYSTEM_FPC_MOVE}
  761. cpu_has_edsp:=true;
  762. in_edsp_test:=true;
  763. asm
  764. bic r0,sp,#7
  765. ldrd r0,[r0]
  766. end;
  767. in_edsp_test:=false;
  768. if cpu_has_edsp then
  769. moveproc:=@move_pld
  770. else
  771. moveproc:=@move_blended;
  772. {$endif FPC_SYSTEM_FPC_MOVE}
  773. end;
  774. {$define FPC_SYSTEM_HAS_SWAPENDIAN}
  775. { SwapEndian(<16 Bit>) being inlined is faster than using assembler }
  776. function SwapEndian(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  777. begin
  778. { the extra Word type cast is necessary because the "AValue shr 8" }
  779. { is turned into "longint(AValue) shr 8", so if AValue < 0 then }
  780. { the sign bits from the upper 16 bits are shifted in rather than }
  781. { zeroes. }
  782. Result := SmallInt((Word(AValue) shr 8) or (Word(AValue) shl 8));
  783. end;
  784. function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  785. begin
  786. Result := Word((AValue shr 8) or (AValue shl 8));
  787. end;
  788. (*
  789. This is kept for reference. Thats what the compiler COULD generate in these cases.
  790. But FPC currently does not support inlining of asm-functions, so the whole call-overhead
  791. is bigger than the gain of the optimized function.
  792. function AsmSwapEndian(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif};assembler;nostackframe;
  793. asm
  794. // We're starting with 4321
  795. {$if defined(cpuarmv3) or defined(cpuarmv4) or defined(cpuarmv5)}
  796. mov r0, r0, shl #16 // Shift to make that 2100
  797. mov r0, r0, ror #24 // Rotate to 1002
  798. orr r0, r0, r0 shr #16 // Shift and combine into 0012
  799. {$else}
  800. rev r0, r0 // Reverse byteorder r0 = 1234
  801. mov r0, r0, shr #16 // Shift down to 16bits r0 = 0012
  802. {$endif}
  803. end;
  804. *)
  805. {
  806. These used to be an assembler-function, but with newer improvements to the compiler this
  807. generates a perfect 4 cycle code sequence and can be inlined.
  808. }
  809. function SwapEndian(const AValue: LongWord): LongWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  810. begin
  811. Result:= AValue xor rordword(AValue,16);
  812. Result:= Result and $FF00FFFF;
  813. Result:= (Result shr 8) xor rordword(AValue,8);
  814. end;
  815. function SwapEndian(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  816. begin
  817. Result:=LongInt(SwapEndian(DWord(AValue)));
  818. end;
  819. {
  820. Currently freepascal will not generate a good assembler sequence for
  821. Result:=(SwapEndian(longword(lo(AValue))) shl 32) or
  822. (SwapEndian(longword(hi(AValue))));
  823. So we keep an assembly version for now
  824. }
  825. function SwapEndian(const AValue: Int64): Int64; assembler; nostackframe;
  826. asm
  827. {$if defined(cpuarmv3) or defined(cpuarmv4) or defined(cpuarmv5)}
  828. mov ip, r1
  829. // We're starting with r0 = $87654321
  830. eor r1, r0, r0, ror #16 // r1 = $C444C444
  831. bic r1, r1, #16711680 // r1 = r1 and $ff00ffff = $C400C444
  832. mov r0, r0, ror #8 // r0 = $21876543
  833. eor r1, r0, r1, lsr #8 // r1 = $21436587
  834. eor r0, ip, ip, ror #16
  835. bic r0, r0, #16711680
  836. mov ip, ip, ror #8
  837. eor r0, ip, r0, lsr #8
  838. {$else}
  839. rev r2, r0
  840. rev r0, r1
  841. mov r1, r2
  842. {$endif}
  843. end;
  844. function SwapEndian(const AValue: QWord): QWord; {$ifdef SYSTEMINLINE}inline;{$endif}
  845. begin
  846. Result:=QWord(SwapEndian(Int64(AValue)));
  847. end;
  848. {include hand-optimized assembler division code}
  849. {$i divide.inc}