i8086.inc 25 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2013 by the Free Pascal development team.
  4. Processor dependent implementation for the system unit for
  5. intel i8086+
  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. {$ifndef FPC_SYSTEM_HAS_FILLCHAR}
  16. {$define FPC_SYSTEM_HAS_FILLCHAR}
  17. procedure FillChar(var x;count:SizeUInt;value:byte);assembler;nostackframe;
  18. asm
  19. mov bx, sp
  20. mov cx, ss:[bx + 4 + extra_param_offset] // count
  21. jcxz @@Done
  22. {$ifdef FPC_X86_DATA_NEAR}
  23. mov di, ss:[bx + 6 + extra_param_offset] // @x
  24. mov ax, ds
  25. mov es, ax
  26. {$else FPC_X86_DATA_NEAR}
  27. les di, ss:[bx + 6 + extra_param_offset] // @x
  28. {$endif FPC_X86_DATA_NEAR}
  29. mov al, ss:[bx + 2 + extra_param_offset] // value
  30. mov ah, al
  31. shr cx, 1
  32. {$ifdef FPC_ENABLED_CLD}
  33. cld
  34. {$endif FPC_ENABLED_CLD}
  35. rep stosw
  36. adc cx, cx
  37. rep stosb
  38. @@Done:
  39. end;
  40. {$endif FPC_SYSTEM_HAS_FILLCHAR}
  41. {$ifndef FPC_SYSTEM_HAS_FILLWORD}
  42. {$define FPC_SYSTEM_HAS_FILLWORD}
  43. procedure FillWord(var x;count : SizeInt;value : word);assembler;nostackframe;
  44. asm
  45. mov bx, sp
  46. mov cx, ss:[bx + 4 + extra_param_offset] // count
  47. or cx, cx
  48. jle @@Done
  49. {$ifdef FPC_X86_DATA_NEAR}
  50. mov di, ss:[bx + 6 + extra_param_offset] // @x
  51. mov ax, ds
  52. mov es, ax
  53. {$else FPC_X86_DATA_NEAR}
  54. les di, ss:[bx + 6 + extra_param_offset] // @x
  55. {$endif FPC_X86_DATA_NEAR}
  56. mov ax, ss:[bx + 2 + extra_param_offset] // value
  57. {$ifdef FPC_ENABLED_CLD}
  58. cld
  59. {$endif FPC_ENABLED_CLD}
  60. rep stosw
  61. @@Done:
  62. end;
  63. {$endif FPC_SYSTEM_HAS_FILLWORD}
  64. {$ifndef FPC_SYSTEM_HAS_FILLDWORD}
  65. {$define FPC_SYSTEM_HAS_FILLDWORD}
  66. procedure FillDWord(var x;count : SizeInt;value : dword);assembler;nostackframe;
  67. asm
  68. mov bx, sp
  69. mov cx, ss:[bx + 6 + extra_param_offset] // count
  70. or cx, cx
  71. jle @@Done
  72. {$ifdef FPC_X86_DATA_NEAR}
  73. mov di, ss:[bx + 8 + extra_param_offset] // @x
  74. mov ax, ds
  75. mov es, ax
  76. {$else FPC_X86_DATA_NEAR}
  77. les di, ss:[bx + 8 + extra_param_offset] // @x
  78. {$endif FPC_X86_DATA_NEAR}
  79. mov ax, ss:[bx + 2 + extra_param_offset] // lo(value)
  80. mov bx, ss:[bx + 4 + extra_param_offset] // hi(value)
  81. {$ifdef FPC_ENABLED_CLD}
  82. cld
  83. {$endif FPC_ENABLED_CLD}
  84. cmp ax, bx
  85. jne @@lo_hi_different
  86. shl cx, 1
  87. rep stosw
  88. jmp @@Done
  89. @@lo_hi_different:
  90. stosw
  91. xchg ax, bx
  92. stosw
  93. xchg ax, bx
  94. loop @@lo_hi_different
  95. @@Done:
  96. end;
  97. {$endif FPC_SYSTEM_HAS_FILLDWORD}
  98. {$ifndef FPC_SYSTEM_HAS_MOVE}
  99. {$define FPC_SYSTEM_HAS_MOVE}
  100. procedure Move(const source;var dest;count:SizeUInt);[public, alias: 'FPC_MOVE'];assembler;nostackframe;
  101. asm
  102. mov bx, sp
  103. mov cx, ss:[bx + 2 + extra_param_offset] // count
  104. jcxz @@Done
  105. mov ax, ds // for far data models, backup ds; for near data models, use to initialize es
  106. {$ifdef FPC_X86_DATA_NEAR}
  107. mov es, ax
  108. mov si, ss:[bx + 6 + extra_param_offset] // @source
  109. mov di, ss:[bx + 4 + extra_param_offset] // @dest
  110. {$else FPC_X86_DATA_NEAR}
  111. lds si, ss:[bx + 8 + extra_param_offset] // @source
  112. les di, ss:[bx + 4 + extra_param_offset] // @dest
  113. {$endif FPC_X86_DATA_NEAR}
  114. cmp si, di
  115. jb @@BackwardsMove
  116. {$ifdef FPC_ENABLED_CLD}
  117. cld
  118. {$endif FPC_ENABLED_CLD}
  119. shr cx, 1
  120. rep movsw
  121. adc cx, cx
  122. rep movsb
  123. jmp @@AfterMove // todo, add mov ds,ax & ret here for performance reasons
  124. @@BackwardsMove:
  125. std
  126. add si, cx
  127. add di, cx
  128. dec si
  129. dec di
  130. rep movsb // todo: movsw
  131. cld
  132. @@AfterMove:
  133. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  134. mov ds, ax
  135. {$endif}
  136. @@Done:
  137. end;
  138. {$endif FPC_SYSTEM_HAS_MOVE}
  139. {$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
  140. {$define FPC_SYSTEM_HAS_INDEXBYTE}
  141. function IndexByte(Const buf;len:SizeInt;b:byte):SizeInt; assembler; nostackframe;
  142. asm
  143. mov bx, sp
  144. mov cx, ss:[bx + 4 + extra_param_offset] // len
  145. jcxz @@NotFound
  146. {$ifdef FPC_X86_DATA_NEAR}
  147. mov di, ss:[bx + 6 + extra_param_offset] // @buf
  148. mov ax, ds
  149. mov es, ax
  150. {$else FPC_X86_DATA_NEAR}
  151. les di, ss:[bx + 6 + extra_param_offset] // @buf
  152. {$endif FPC_X86_DATA_NEAR}
  153. mov si, di // save the start of the buffer in si
  154. mov al, ss:[bx + 2 + extra_param_offset] // b
  155. {$ifdef FPC_ENABLED_CLD}
  156. cld
  157. {$endif FPC_ENABLED_CLD}
  158. repne scasb
  159. je @@Found
  160. @@NotFound:
  161. mov ax, 0FFFFh // return -1
  162. jmp @@Done
  163. @@Found:
  164. sub di, si
  165. xchg ax, di
  166. dec ax
  167. @@Done:
  168. end;
  169. {$endif FPC_SYSTEM_HAS_INDEXBYTE}
  170. {$ifndef FPC_SYSTEM_HAS_INDEXWORD}
  171. {$define FPC_SYSTEM_HAS_INDEXWORD}
  172. function IndexWord(Const buf;len:SizeInt;b:word):SizeInt; assembler; nostackframe;
  173. asm
  174. mov bx, sp
  175. mov cx, ss:[bx + 4 + extra_param_offset] // len
  176. jcxz @@NotFound
  177. {$ifdef FPC_X86_DATA_NEAR}
  178. mov di, ss:[bx + 6 + extra_param_offset] // @buf
  179. mov ax, ds
  180. mov es, ax
  181. {$else FPC_X86_DATA_NEAR}
  182. les di, ss:[bx + 6 + extra_param_offset] // @buf
  183. {$endif FPC_X86_DATA_NEAR}
  184. mov si, cx // save the length of the buffer in si
  185. mov ax, ss:[bx + 2 + extra_param_offset] // b
  186. {$ifdef FPC_ENABLED_CLD}
  187. cld
  188. {$endif FPC_ENABLED_CLD}
  189. repne scasw
  190. je @@Found
  191. @@NotFound:
  192. mov ax, 0FFFFh // return -1
  193. jmp @@Done
  194. @@Found:
  195. sub si, cx
  196. xchg ax, si
  197. dec ax
  198. @@Done:
  199. end;
  200. {$endif FPC_SYSTEM_HAS_INDEXWORD}
  201. {$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
  202. {$define FPC_SYSTEM_HAS_INDEXDWORD}
  203. function IndexDWord(Const buf;len:SizeInt;b:DWord):SizeInt; assembler; nostackframe;
  204. asm
  205. mov bx, sp
  206. mov cx, ss:[bx + 6 + extra_param_offset] // len
  207. jcxz @@NotFound
  208. {$ifdef FPC_X86_DATA_NEAR}
  209. mov di, ss:[bx + 8 + extra_param_offset] // @buf
  210. mov ax, ds
  211. mov es, ax
  212. {$else FPC_X86_DATA_NEAR}
  213. les di, ss:[bx + 8 + extra_param_offset] // @buf
  214. {$endif FPC_X86_DATA_NEAR}
  215. mov si, cx // save the length of the buffer in si
  216. mov ax, ss:[bx + 2 + extra_param_offset] // b
  217. mov bx, ss:[bx + 4 + extra_param_offset]
  218. {$ifdef FPC_ENABLED_CLD}
  219. cld
  220. {$endif FPC_ENABLED_CLD}
  221. jmp @@LoopStart
  222. @@SkipWord:
  223. scasw
  224. @@LoopStart:
  225. scasw
  226. loopne @@SkipWord
  227. jne @@NotFound
  228. xchg ax, bx
  229. scasw
  230. je @@Found
  231. jcxz @@NotFound
  232. xchg ax, bx
  233. jmp @@LoopStart
  234. @@Found:
  235. sub si, cx
  236. xchg ax, si
  237. dec ax
  238. jmp @@Done
  239. @@NotFound:
  240. mov ax, 0FFFFh // return -1
  241. @@Done:
  242. end;
  243. {$endif FPC_SYSTEM_HAS_INDEXDWORD}
  244. {$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
  245. {$define FPC_SYSTEM_HAS_COMPAREBYTE}
  246. function CompareByte(Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
  247. asm
  248. xor ax, ax // initialize ax=0 (it's the result register, we never use it for anything else in this function)
  249. mov bx, sp
  250. mov cx, ss:[bx + 2 + extra_param_offset] // len
  251. jcxz @@Done
  252. mov dx, ds // for far data models, backup ds; for near data models, use to initialize es
  253. {$ifdef FPC_X86_DATA_NEAR}
  254. mov es, dx
  255. mov si, ss:[bx + 6 + extra_param_offset] // @buf1
  256. mov di, ss:[bx + 4 + extra_param_offset] // @buf2
  257. {$else FPC_X86_DATA_NEAR}
  258. lds si, ss:[bx + 8 + extra_param_offset] // @buf1
  259. les di, ss:[bx + 4 + extra_param_offset] // @buf2
  260. {$endif FPC_X86_DATA_NEAR}
  261. {$ifdef FPC_ENABLED_CLD}
  262. cld
  263. {$endif FPC_ENABLED_CLD}
  264. xor bx, bx
  265. shr cx, 1
  266. adc bx, bx // remainder goes to bx
  267. jcxz @@BytewiseComparison
  268. repe cmpsw
  269. je @@BytewiseComparison
  270. // we found an unequal word
  271. // let's go back and compare it bytewise
  272. mov bl, 2
  273. dec si
  274. dec si
  275. dec di
  276. dec di
  277. @@BytewiseComparison:
  278. mov cx, bx
  279. jcxz @@Equal
  280. repe cmpsb
  281. je @@Equal
  282. // ax is 0
  283. sbb ax, ax
  284. shl ax, 1
  285. inc ax
  286. @@Equal:
  287. // ax is 0
  288. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  289. mov ds, dx
  290. {$endif}
  291. @@Done:
  292. end;
  293. {$endif FPC_SYSTEM_HAS_COMPAREBYTE}
  294. {$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
  295. {$define FPC_SYSTEM_HAS_COMPAREWORD}
  296. function CompareWord(Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
  297. asm
  298. xor ax, ax // initialize ax=0 (it's the result register, we never use it for anything else in this function)
  299. mov bx, sp
  300. mov cx, ss:[bx + 2 + extra_param_offset] // len
  301. jcxz @@Done
  302. mov dx, ds // for far data models, backup ds; for near data models, use to initialize es
  303. {$ifdef FPC_X86_DATA_NEAR}
  304. mov es, dx
  305. mov si, ss:[bx + 6 + extra_param_offset] // @buf1
  306. mov di, ss:[bx + 4 + extra_param_offset] // @buf2
  307. {$else FPC_X86_DATA_NEAR}
  308. lds si, ss:[bx + 8 + extra_param_offset] // @buf1
  309. les di, ss:[bx + 4 + extra_param_offset] // @buf2
  310. {$endif FPC_X86_DATA_NEAR}
  311. {$ifdef FPC_ENABLED_CLD}
  312. cld
  313. {$endif FPC_ENABLED_CLD}
  314. repe cmpsw
  315. je @@Equal
  316. // ax is 0
  317. sbb ax, ax
  318. shl ax, 1
  319. inc ax
  320. @@Equal:
  321. // ax is 0
  322. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  323. mov ds, dx
  324. {$endif}
  325. @@Done:
  326. end;
  327. {$endif FPC_SYSTEM_HAS_COMPAREWORD}
  328. {$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
  329. {$define FPC_SYSTEM_HAS_COMPAREDWORD}
  330. function CompareDWord(Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
  331. asm
  332. xor ax, ax // initialize ax=0 (it's the result register, we never use it for anything else in this function)
  333. mov bx, sp
  334. mov cx, ss:[bx + 2 + extra_param_offset] // len
  335. jcxz @@Done
  336. cmp cx, 4000h
  337. jb @@NotTooBig
  338. mov cx, 4000h
  339. @@NotTooBig:
  340. shl cx, 1
  341. mov dx, ds // for far data models, backup ds; for near data models, use to initialize es
  342. {$ifdef FPC_X86_DATA_NEAR}
  343. mov es, dx
  344. mov si, ss:[bx + 6 + extra_param_offset] // @buf1
  345. mov di, ss:[bx + 4 + extra_param_offset] // @buf2
  346. {$else FPC_X86_DATA_NEAR}
  347. lds si, ss:[bx + 8 + extra_param_offset] // @buf1
  348. les di, ss:[bx + 4 + extra_param_offset] // @buf2
  349. {$endif FPC_X86_DATA_NEAR}
  350. {$ifdef FPC_ENABLED_CLD}
  351. cld
  352. {$endif FPC_ENABLED_CLD}
  353. repe cmpsw
  354. je @@Equal
  355. // ax is 0
  356. sbb ax, ax
  357. shl ax, 1
  358. inc ax
  359. shr cx, 1
  360. jnc @@Skip
  361. xchg ax, bx
  362. xor ax, ax
  363. cmpsw
  364. je @@hi_equal
  365. // ax is 0
  366. sbb ax, ax
  367. shl ax, 1
  368. inc ax
  369. jmp @@Skip
  370. @@hi_equal:
  371. xchg ax, bx
  372. @@Equal:
  373. // ax is 0
  374. @@Skip:
  375. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  376. mov ds, dx
  377. {$endif}
  378. @@Done:
  379. end;
  380. {$endif FPC_SYSTEM_HAS_COMPAREDWORD}
  381. {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
  382. {$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
  383. function fpc_pchar_length(p:pchar):sizeint;assembler;nostackframe;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc;
  384. asm
  385. mov bx, sp
  386. {$ifdef FPC_X86_DATA_NEAR}
  387. mov ax, ss:[bx + 2 + extra_param_offset] // p
  388. test ax, ax
  389. jz @@Done
  390. xchg ax, di
  391. mov ax, ds
  392. mov es, ax
  393. {$else FPC_X86_DATA_NEAR}
  394. les di, ss:[bx + 2 + extra_param_offset] // p
  395. mov ax, es
  396. or ax, di
  397. jz @@Done
  398. {$endif FPC_X86_DATA_NEAR}
  399. mov cx, 0FFFFh
  400. xor ax, ax
  401. {$ifdef FPC_ENABLED_CLD}
  402. cld
  403. {$endif FPC_ENABLED_CLD}
  404. repne scasb
  405. dec ax
  406. dec ax
  407. sub ax, cx
  408. @@Done:
  409. end;
  410. {$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
  411. {$define FPC_SYSTEM_HAS_SPTR}
  412. Function Sptr : Pointer;assembler;nostackframe;
  413. asm
  414. mov ax, sp
  415. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  416. mov dx, ss
  417. {$endif}
  418. end;
  419. {$define FPC_SYSTEM_HAS_PTR}
  420. function Ptr(sel,off: Word):farpointer;{$ifdef SYSTEMINLINE}inline;{$endif}assembler;nostackframe;
  421. asm
  422. mov si, sp
  423. mov ax, ss:[si + 2 + extra_param_offset] // off
  424. mov dx, ss:[si + 4 + extra_param_offset] // sel
  425. end;
  426. {$define FPC_SYSTEM_HAS_CSEG}
  427. function CSeg: Word;{$ifdef SYSTEMINLINE}inline;{$endif}assembler;nostackframe;
  428. asm
  429. mov ax, cs
  430. end;
  431. {$define FPC_SYSTEM_HAS_DSEG}
  432. function DSeg: Word;{$ifdef SYSTEMINLINE}inline;{$endif}assembler;nostackframe;
  433. asm
  434. mov ax, ds
  435. end;
  436. {$define FPC_SYSTEM_HAS_SSEG}
  437. function SSeg: Word;{$ifdef SYSTEMINLINE}inline;{$endif}assembler;nostackframe;
  438. asm
  439. mov ax, ss
  440. end;
  441. {$IFNDEF INTERNAL_BACKTRACE}
  442. {$define FPC_SYSTEM_HAS_GET_FRAME}
  443. function get_frame:pointer;assembler;nostackframe;{$ifdef SYSTEMINLINE}inline;{$endif}
  444. asm
  445. mov ax, bp
  446. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  447. mov dx, ss
  448. {$endif}
  449. end;
  450. {$ENDIF not INTERNAL_BACKTRACE}
  451. {$define FPC_SYSTEM_HAS_GET_PC_ADDR}
  452. Function Get_pc_addr : CodePointer;assembler;nostackframe;
  453. asm
  454. mov bx, sp
  455. mov ax, ss:[bx]
  456. {$ifdef FPC_X86_CODE_FAR}
  457. mov dx, ss:[bx+2]
  458. {$endif FPC_X86_CODE_FAR}
  459. end;
  460. {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
  461. function get_caller_addr(framebp:pointer;addr:codepointer=nil):codepointer;nostackframe;assembler;
  462. asm
  463. mov si, sp
  464. {$ifdef FPC_X86_CODE_FAR}
  465. xor dx, dx
  466. {$endif FPC_X86_CODE_FAR}
  467. {$ifdef FPC_X86_DATA_NEAR}
  468. mov ax, ss:[si + 4 + extra_param_offset + extra_param_offset] // framebp
  469. {$ifdef WIN16}
  470. mov cx, ax
  471. and al, $FE
  472. {$endif WIN16}
  473. or ax, ax
  474. jz @@Lg_a_null
  475. xchg ax, bx // 1 byte shorter than a mov
  476. mov ax, [bx+2]
  477. {$ifdef FPC_X86_CODE_FAR}
  478. {$ifdef WIN16}
  479. test cl, 1
  480. jnz @@farretaddr
  481. mov dx, ss:[si + 2 + extra_param_offset + extra_param_offset] // Seg(addr^)
  482. jmp @@retsegdone
  483. @@farretaddr:
  484. mov dx, [bx+4]
  485. @@retsegdone:
  486. {$else WIN16}
  487. mov dx, [bx+4]
  488. {$endif WIN16}
  489. {$endif FPC_X86_CODE_FAR}
  490. {$else FPC_X86_DATA_NEAR}
  491. les ax, ss:[si + 4 + extra_param_offset + extra_param_offset] // framebp
  492. {$ifdef WIN16}
  493. mov cx, ax
  494. and al, $FE
  495. {$endif WIN16}
  496. mov dx, es
  497. or dx, ax
  498. jz @@Lg_a_null
  499. xchg ax, bx // 1 byte shorter than a mov
  500. mov ax, es:[bx+2]
  501. {$ifdef FPC_X86_CODE_FAR}
  502. {$ifdef WIN16}
  503. test cl, 1
  504. jnz @@farretaddr
  505. mov dx, ss:[si + 2 + extra_param_offset + extra_param_offset] // Seg(addr^)
  506. jmp @@retsegdone
  507. @@farretaddr:
  508. mov dx, es:[bx+4]
  509. @@retsegdone:
  510. {$else WIN16}
  511. mov dx, es:[bx+4]
  512. {$endif WIN16}
  513. {$endif FPC_X86_CODE_FAR}
  514. {$endif FPC_X86_DATA_NEAR}
  515. @@Lg_a_null:
  516. end;
  517. {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
  518. function get_caller_frame(framebp:pointer;addr:codepointer=nil):pointer;nostackframe;assembler;
  519. asm
  520. {$ifdef FPC_X86_DATA_NEAR}
  521. mov si, sp
  522. mov ax, ss:[si + 4 + extra_param_offset + extra_param_offset] // framebp
  523. {$ifdef WIN16}
  524. and al, $FE
  525. {$endif WIN16}
  526. or ax, ax
  527. jz @@Lgnf_null
  528. xchg ax, si // 1 byte shorter than a mov
  529. lodsw
  530. @@Lgnf_null:
  531. {$else FPC_X86_DATA_NEAR}
  532. mov si, sp
  533. les ax, ss:[si + 4 + extra_param_offset + extra_param_offset] // framebp
  534. {$ifdef WIN16}
  535. and al, $FE
  536. {$endif WIN16}
  537. mov dx, es
  538. or dx, ax
  539. jz @@Lgnf_null
  540. xchg ax, si // 1 byte shorter than a mov
  541. seges lodsw
  542. mov dx, es
  543. @@Lgnf_null:
  544. {$endif FPC_X86_DATA_NEAR}
  545. end;
  546. {TODO: use smallint?}
  547. function InterLockedDecrement (var Target: longint) : longint;nostackframe;assembler;
  548. asm
  549. mov si, sp
  550. {$ifdef FPC_X86_DATA_NEAR}
  551. mov bx, ss:[si + 2 + extra_param_offset] // Target
  552. {$else FPC_X86_DATA_NEAR}
  553. mov cx, ds
  554. lds bx, ss:[si + 2 + extra_param_offset] // Target
  555. {$endif FPC_X86_DATA_NEAR}
  556. pushf
  557. cli
  558. sub word [bx], 1
  559. sbb word [bx+2], 0
  560. mov ax, [bx]
  561. mov dx, [bx+2]
  562. popf
  563. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  564. mov ds, cx
  565. {$endif}
  566. end;
  567. {TODO: use smallint?}
  568. function InterLockedIncrement (var Target: longint) : longint;nostackframe;assembler;
  569. asm
  570. mov si, sp
  571. {$ifdef FPC_X86_DATA_NEAR}
  572. mov bx, ss:[si + 2 + extra_param_offset] // Target
  573. {$else FPC_X86_DATA_NEAR}
  574. mov cx, ds
  575. lds bx, ss:[si + 2 + extra_param_offset] // Target
  576. {$endif FPC_X86_DATA_NEAR}
  577. pushf
  578. cli
  579. add word [bx], 1
  580. adc word [bx+2], 0
  581. mov ax, [bx]
  582. mov dx, [bx+2]
  583. popf
  584. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  585. mov ds, cx
  586. {$endif}
  587. end;
  588. {TODO: use smallint?}
  589. function InterLockedExchange (var Target: longint;Source : longint) : longint;nostackframe;assembler;
  590. asm
  591. mov si, sp
  592. {$ifdef FPC_X86_DATA_NEAR}
  593. mov bx, ss:[si + 6 + extra_param_offset] // Target
  594. {$else FPC_X86_DATA_NEAR}
  595. mov cx, ds
  596. lds bx, ss:[si + 6 + extra_param_offset] // Target
  597. {$endif FPC_X86_DATA_NEAR}
  598. mov ax, ss:[si + 2 + extra_param_offset] // Lo(Source)
  599. mov dx, ss:[si + 4 + extra_param_offset] // Hi(Source)
  600. pushf
  601. cli
  602. xchg word [bx], ax
  603. xchg word [bx+2], dx
  604. popf
  605. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  606. mov ds, cx
  607. {$endif}
  608. end;
  609. {TODO: use smallint?}
  610. function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint;nostackframe;assembler;
  611. asm
  612. mov si, sp
  613. {$ifdef FPC_X86_DATA_NEAR}
  614. mov bx, ss:[si + 6 + extra_param_offset] // Target
  615. {$else FPC_X86_DATA_NEAR}
  616. mov cx, ds
  617. lds bx, ss:[si + 6 + extra_param_offset] // Target
  618. {$endif FPC_X86_DATA_NEAR}
  619. mov di, ss:[si + 2 + extra_param_offset] // Lo(Source)
  620. mov si, ss:[si + 4 + extra_param_offset] // Hi(Source)
  621. pushf
  622. cli
  623. mov ax, [bx]
  624. mov dx, [bx+2]
  625. add word [bx], di
  626. adc word [bx+2], si
  627. popf
  628. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  629. mov ds, cx
  630. {$endif}
  631. end;
  632. {TODO: use smallint?}
  633. function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint;assembler;
  634. asm
  635. {$ifdef FPC_X86_DATA_NEAR}
  636. mov bx, [Target] // Target
  637. {$else FPC_X86_DATA_NEAR}
  638. mov cx, ds
  639. lds bx, [Target] // Target
  640. {$endif FPC_X86_DATA_NEAR}
  641. mov di, [Comperand]
  642. mov si, [Comperand+2]
  643. pushf
  644. cli
  645. mov ax, [bx]
  646. mov dx, [bx+2]
  647. cmp ax, di
  648. jne @@not_equal
  649. cmp dx, si
  650. jne @@not_equal
  651. mov di, [NewValue]
  652. mov si, [NewValue+2]
  653. mov [bx], di
  654. mov [bx+2], si
  655. @@not_equal:
  656. popf
  657. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  658. mov ds, cx
  659. {$endif}
  660. end;
  661. {****************************************************************************
  662. Stack checking
  663. ****************************************************************************}
  664. procedure fpc_stackcheck_i8086;[public,alias:'FPC_STACKCHECK_I8086'];compilerproc;assembler;nostackframe;
  665. const
  666. STACK_MARGIN=512;
  667. asm
  668. { on entry: AX = required stack size to check if available
  669. (function is called before stack allocation) }
  670. {$ifdef FPC_MM_HUGE}
  671. push ds
  672. push ax
  673. mov ax, SEG @DATA
  674. mov ds, ax
  675. pop ax
  676. {$endif FPC_MM_HUGE}
  677. add ax, STACK_MARGIN
  678. jc @@stack_overflow
  679. add ax, word ptr [__stkbottom]
  680. jc @@stack_overflow
  681. cmp ax, sp
  682. ja @@stack_overflow
  683. @@no_overflow:
  684. {$ifdef FPC_MM_HUGE}
  685. pop ds
  686. {$endif FPC_MM_HUGE}
  687. ret
  688. @@stack_overflow:
  689. { check StackError flag, to avoid recursive calls from the exit routines }
  690. cmp byte ptr [StackError], 1
  691. je @@no_overflow
  692. mov byte ptr [StackError], 1
  693. { cleanup return address (and maybe saved ds) from call to this function }
  694. {$if defined(FPC_MM_HUGE)}
  695. add sp, 6
  696. {$elseif defined(FPC_X86_CODE_FAR)}
  697. pop ax
  698. pop ax
  699. {$else}
  700. pop ax
  701. {$endif}
  702. { call HandleError(202) }
  703. {$ifdef CPU8086}
  704. xor ax, ax
  705. push ax
  706. mov al, 202
  707. push ax
  708. {$else}
  709. push 0
  710. push 202
  711. {$endif}
  712. call HandleError
  713. end;
  714. {****************************************************************************
  715. BSR/BSF
  716. ****************************************************************************}
  717. const
  718. bsr8bit: array [Byte] of Byte = (
  719. $ff,0,1,1,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,
  720. 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
  721. 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
  722. 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
  723. 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
  724. 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
  725. 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
  726. 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
  727. );
  728. bsf8bit: array [Byte] of Byte = (
  729. $ff,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
  730. 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
  731. 6,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
  732. 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
  733. 7,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
  734. 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
  735. 6,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
  736. 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0
  737. );
  738. {$define FPC_SYSTEM_HAS_BSR_BYTE}
  739. function BsrByte(const AValue: Byte): Byte;
  740. begin
  741. BsrByte := bsr8bit[AValue];
  742. end;
  743. {$define FPC_SYSTEM_HAS_BSF_BYTE}
  744. function BsfByte(const AValue: Byte): Byte;
  745. begin
  746. BsfByte := bsf8bit[AValue];
  747. end;
  748. {$define FPC_SYSTEM_HAS_BSR_WORD}
  749. function BsrWord(const AValue: Word): Byte; assembler;
  750. asm
  751. lea bx, bsr8bit
  752. xor cl, cl
  753. mov ax, word [AValue]
  754. test ah, ah
  755. jz @@0
  756. mov cl, 8
  757. mov al, ah
  758. @@0: xlatb
  759. add al, cl
  760. end;
  761. {$define FPC_SYSTEM_HAS_BSF_WORD}
  762. function BsfWord(const AValue: Word): Byte; assembler;
  763. asm
  764. lea bx, bsf8bit
  765. xor cl, cl
  766. mov ax, word [AValue]
  767. test al, al
  768. jnz @@0
  769. or al, ah
  770. jz @@0
  771. add cl, 8
  772. @@0: xlatb
  773. add al, cl
  774. end;
  775. {$define FPC_SYSTEM_HAS_BSR_DWORD}
  776. function BsrDword(const AValue: DWord): Byte; assembler;
  777. asm
  778. lea bx, bsr8bit
  779. mov cl, 16
  780. mov ax, word [AValue+2]
  781. test ax, ax
  782. jnz @@0
  783. xor cl, cl
  784. mov ax, word [AValue]
  785. @@0: test ah, ah
  786. jz @@1
  787. add cl, 8
  788. mov al, ah
  789. @@1: xlatb
  790. add al, cl
  791. end;
  792. {$define FPC_SYSTEM_HAS_BSF_DWORD}
  793. function BsfDword(const AValue: DWord): Byte; assembler;
  794. asm
  795. lea bx, bsf8bit
  796. xor cl, cl
  797. mov ax, word [AValue]
  798. test ax, ax
  799. jnz @@0
  800. or ax, word [AValue+2]
  801. jz @@1
  802. mov cl, 16
  803. @@0: test al, al
  804. jnz @@1
  805. add cl, 8
  806. mov al, ah
  807. @@1: xlatb
  808. add al, cl
  809. end;
  810. {$define FPC_SYSTEM_HAS_BSR_QWORD}
  811. function BsrQword(const AValue: QWord): Byte; assembler;
  812. asm
  813. lea bx, bsr8bit
  814. mov cl, 48
  815. mov ax, word [AValue+6]
  816. test ax, ax
  817. jnz @@0
  818. mov cl, 32
  819. or ax, word [AValue+4]
  820. jnz @@0
  821. mov cl, 16
  822. or ax, word [AValue+2]
  823. jnz @@0
  824. xor cl, cl
  825. mov ax, word [AValue]
  826. @@0: test ah, ah
  827. jz @@1
  828. add cl, 8
  829. mov al, ah
  830. @@1: xlatb
  831. add al, cl
  832. end;
  833. {$define FPC_SYSTEM_HAS_BSF_QWORD}
  834. function BsfQword(const AValue: QWord): Byte; assembler;
  835. asm
  836. lea bx, bsf8bit
  837. xor cl, cl
  838. mov ax, word [AValue]
  839. test ax, ax
  840. jnz @@0
  841. mov cl, 16
  842. or ax, word [AValue+2]
  843. jnz @@0
  844. mov cl, 32
  845. or ax, word [AValue+4]
  846. jnz @@0
  847. xor cl, cl
  848. or ax, word [AValue+6]
  849. jz @@1
  850. mov cl, 48
  851. @@0: test al, al
  852. jnz @@1
  853. add cl, 8
  854. mov al, ah
  855. @@1: xlatb
  856. add al, cl
  857. end;
  858. {****************************************************************************
  859. HexStr
  860. ****************************************************************************}
  861. {$define FPC_HAS_HEXSTR_POINTER_SHORTSTR}
  862. function HexStr(Val: NearPointer): ShortString;
  863. begin
  864. HexStr:=HexStr(Word(Val),4);
  865. end;
  866. function HexStr(Val: FarPointer): ShortString;
  867. type
  868. TFarPointerRec = record
  869. Offset, Segment: Word;
  870. end;
  871. begin
  872. HexStr:=HexStr(TFarPointerRec(Val).Segment,4)+':'+HexStr(TFarPointerRec(Val).Offset,4);
  873. end;
  874. function HexStr(Val: HugePointer): ShortString;{$ifdef SYSTEMINLINE}inline;{$endif}
  875. begin
  876. HexStr:=HexStr(FarPointer(Val));
  877. end;
  878. {****************************************************************************
  879. FPU
  880. ****************************************************************************}
  881. const
  882. { Internal constants for use in system unit }
  883. FPU_Invalid = 1;
  884. FPU_Denormal = 2;
  885. FPU_DivisionByZero = 4;
  886. FPU_Overflow = 8;
  887. FPU_Underflow = $10;
  888. FPU_StackUnderflow = $20;
  889. FPU_StackOverflow = $40;
  890. FPU_ExceptionMask = $ff;
  891. { Detects the FPU and initializes the Test8087 variable (and Default8087CW):
  892. 0 = NO FPU
  893. 1 = 8087
  894. 2 = 80287
  895. 3 = 80387+ }
  896. procedure DetectFPU;
  897. var
  898. localfpucw: word;
  899. begin
  900. asm
  901. xor bx, bx { initialization, 0=NO FPU }
  902. { FPU presence detection }
  903. fninit
  904. mov byte [localfpucw + 1], 0
  905. nop
  906. fnstcw localfpucw
  907. cmp byte [localfpucw + 1], 3
  908. jne @@Done { No FPU? }
  909. inc bx
  910. { FPU found; now test if it's a 8087 }
  911. and byte [localfpucw], $7F { clear the interrupt enable mask (IEM) }
  912. fldcw localfpucw
  913. fdisi { try to set the interrupt enable mask }
  914. fstcw localfpucw
  915. test byte [localfpucw], $80 { IEM set? }
  916. jnz @@Done { if yes, we have an 8087 }
  917. inc bx
  918. { we have a 287+; now test if it's a 80287 }
  919. finit
  920. fld1
  921. fldz
  922. fdiv { calculate 1/0 }
  923. fld st { copy the value }
  924. fchs { change the sign }
  925. fcompp { compare. if the FPU distinguishes +inf from -inf, it's a 387+ }
  926. fstsw localfpucw
  927. mov ah, byte [localfpucw + 1]
  928. sahf
  929. je @@Done
  930. inc bx { 387+ }
  931. @@Done:
  932. mov Test8087, bl
  933. end ['AX','BX'];
  934. if Test8087<=2 then
  935. Default8087CW:=$1330
  936. else
  937. Default8087CW:=$1332;
  938. end;
  939. {$define FPC_SYSTEM_HAS_SYSINITFPU}
  940. Procedure SysInitFPU;
  941. var
  942. { these locals are so we don't have to hack pic code in the assembler }
  943. localfpucw: word;
  944. begin
  945. localfpucw:=Default8087CW;
  946. asm
  947. fninit
  948. fldcw localfpucw
  949. fwait
  950. end;
  951. end;
  952. {$define FPC_SYSTEM_HAS_SYSRESETFPU}
  953. Procedure SysResetFPU;
  954. var
  955. { these locals are so we don't have to hack pic code in the assembler }
  956. localfpucw: word;
  957. begin
  958. localfpucw:=Default8087CW;
  959. asm
  960. fninit
  961. fwait
  962. fldcw localfpucw
  963. end;
  964. end;
  965. {$I int32p.inc}
  966. {$I hugeptr.inc}