i8086.inc 29 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265
  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. procedure MoveData(srcseg,srcoff,destseg,destoff:Word;n:Word);assembler;nostackframe;
  99. asm
  100. mov bx, sp
  101. mov cx, ss:[bx + 2 + extra_param_offset] // count
  102. jcxz @@Done
  103. mov ax, ds // backup ds
  104. lds si, ss:[bx + 8 + extra_param_offset] // @source
  105. les di, ss:[bx + 4 + extra_param_offset] // @dest
  106. cmp si, di
  107. jb @@BackwardsMove
  108. {$ifdef FPC_ENABLED_CLD}
  109. cld
  110. {$endif FPC_ENABLED_CLD}
  111. shr cx, 1
  112. rep movsw
  113. adc cx, cx
  114. rep movsb
  115. jmp @@AfterMove // todo, add mov ds,ax & ret here for performance reasons
  116. @@BackwardsMove:
  117. std
  118. add si, cx
  119. add di, cx
  120. dec si
  121. dec di
  122. dec si
  123. dec di
  124. shr cx, 1
  125. rep movsw
  126. adc cx, cx
  127. inc si
  128. inc di
  129. rep movsb
  130. cld
  131. @@AfterMove:
  132. mov ds, ax
  133. @@Done:
  134. end;
  135. {$ifndef FPC_SYSTEM_HAS_MOVE}
  136. {$define FPC_SYSTEM_HAS_MOVE}
  137. procedure Move(const source;var dest;count:SizeUInt);[public, alias: 'FPC_MOVE'];assembler;nostackframe;
  138. asm
  139. mov bx, sp
  140. mov cx, ss:[bx + 2 + extra_param_offset] // count
  141. jcxz @@Done
  142. mov ax, ds // for far data models, backup ds; for near data models, use to initialize es
  143. {$ifdef FPC_X86_DATA_NEAR}
  144. mov es, ax
  145. mov si, ss:[bx + 6 + extra_param_offset] // @source
  146. mov di, ss:[bx + 4 + extra_param_offset] // @dest
  147. {$else FPC_X86_DATA_NEAR}
  148. lds si, ss:[bx + 8 + extra_param_offset] // @source
  149. les di, ss:[bx + 4 + extra_param_offset] // @dest
  150. {$endif FPC_X86_DATA_NEAR}
  151. cmp si, di
  152. jb @@BackwardsMove
  153. {$ifdef FPC_ENABLED_CLD}
  154. cld
  155. {$endif FPC_ENABLED_CLD}
  156. shr cx, 1
  157. rep movsw
  158. adc cx, cx
  159. rep movsb
  160. jmp @@AfterMove // todo, add mov ds,ax & ret here for performance reasons
  161. @@BackwardsMove:
  162. std
  163. add si, cx
  164. add di, cx
  165. dec si
  166. dec di
  167. dec si
  168. dec di
  169. shr cx, 1
  170. rep movsw
  171. adc cx, cx
  172. inc si
  173. inc di
  174. rep movsb
  175. cld
  176. @@AfterMove:
  177. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  178. mov ds, ax
  179. {$endif}
  180. @@Done:
  181. end;
  182. {$endif FPC_SYSTEM_HAS_MOVE}
  183. {$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
  184. {$define FPC_SYSTEM_HAS_INDEXBYTE}
  185. function IndexByte(Const buf;len:SizeInt;b:byte):SizeInt; assembler; nostackframe;
  186. asm
  187. mov bx, sp
  188. mov cx, ss:[bx + 4 + extra_param_offset] // len
  189. jcxz @@NotFound
  190. {$ifdef FPC_X86_DATA_NEAR}
  191. mov di, ss:[bx + 6 + extra_param_offset] // @buf
  192. mov ax, ds
  193. mov es, ax
  194. {$else FPC_X86_DATA_NEAR}
  195. les di, ss:[bx + 6 + extra_param_offset] // @buf
  196. {$endif FPC_X86_DATA_NEAR}
  197. mov si, di // save the start of the buffer in si
  198. mov al, ss:[bx + 2 + extra_param_offset] // b
  199. {$ifdef FPC_ENABLED_CLD}
  200. cld
  201. {$endif FPC_ENABLED_CLD}
  202. repne scasb
  203. je @@Found
  204. @@NotFound:
  205. mov ax, 0FFFFh // return -1
  206. jmp @@Done
  207. @@Found:
  208. sub di, si
  209. xchg ax, di
  210. dec ax
  211. @@Done:
  212. end;
  213. {$endif FPC_SYSTEM_HAS_INDEXBYTE}
  214. {$ifndef FPC_SYSTEM_HAS_INDEXWORD}
  215. {$define FPC_SYSTEM_HAS_INDEXWORD}
  216. function IndexWord(Const buf;len:SizeInt;b:word):SizeInt; assembler; nostackframe;
  217. asm
  218. mov bx, sp
  219. mov cx, ss:[bx + 4 + extra_param_offset] // len
  220. jcxz @@NotFound
  221. {$ifdef FPC_X86_DATA_NEAR}
  222. mov di, ss:[bx + 6 + extra_param_offset] // @buf
  223. mov ax, ds
  224. mov es, ax
  225. {$else FPC_X86_DATA_NEAR}
  226. les di, ss:[bx + 6 + extra_param_offset] // @buf
  227. {$endif FPC_X86_DATA_NEAR}
  228. mov si, cx // save the length of the buffer in si
  229. mov ax, ss:[bx + 2 + extra_param_offset] // b
  230. {$ifdef FPC_ENABLED_CLD}
  231. cld
  232. {$endif FPC_ENABLED_CLD}
  233. repne scasw
  234. je @@Found
  235. @@NotFound:
  236. mov ax, 0FFFFh // return -1
  237. jmp @@Done
  238. @@Found:
  239. sub si, cx
  240. xchg ax, si
  241. dec ax
  242. @@Done:
  243. end;
  244. {$endif FPC_SYSTEM_HAS_INDEXWORD}
  245. {$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
  246. {$define FPC_SYSTEM_HAS_INDEXDWORD}
  247. function IndexDWord(Const buf;len:SizeInt;b:DWord):SizeInt; assembler; nostackframe;
  248. asm
  249. mov bx, sp
  250. mov cx, ss:[bx + 6 + extra_param_offset] // len
  251. jcxz @@NotFound
  252. {$ifdef FPC_X86_DATA_NEAR}
  253. mov di, ss:[bx + 8 + extra_param_offset] // @buf
  254. mov ax, ds
  255. mov es, ax
  256. {$else FPC_X86_DATA_NEAR}
  257. les di, ss:[bx + 8 + extra_param_offset] // @buf
  258. {$endif FPC_X86_DATA_NEAR}
  259. mov si, cx // save the length of the buffer in si
  260. mov ax, ss:[bx + 2 + extra_param_offset] // b
  261. mov bx, ss:[bx + 4 + extra_param_offset]
  262. {$ifdef FPC_ENABLED_CLD}
  263. cld
  264. {$endif FPC_ENABLED_CLD}
  265. jmp @@LoopStart
  266. @@SkipWord:
  267. scasw
  268. @@LoopStart:
  269. scasw
  270. loopne @@SkipWord
  271. jne @@NotFound
  272. xchg ax, bx
  273. scasw
  274. je @@Found
  275. jcxz @@NotFound
  276. xchg ax, bx
  277. jmp @@LoopStart
  278. @@Found:
  279. sub si, cx
  280. xchg ax, si
  281. dec ax
  282. jmp @@Done
  283. @@NotFound:
  284. mov ax, 0FFFFh // return -1
  285. @@Done:
  286. end;
  287. {$endif FPC_SYSTEM_HAS_INDEXDWORD}
  288. {$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
  289. {$define FPC_SYSTEM_HAS_COMPAREBYTE}
  290. function CompareByte(Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
  291. asm
  292. xor ax, ax // initialize ax=0 (it's the result register, we never use it for anything else in this function)
  293. mov bx, sp
  294. mov cx, ss:[bx + 2 + extra_param_offset] // len
  295. jcxz @@Done
  296. mov dx, ds // for far data models, backup ds; for near data models, use to initialize es
  297. {$ifdef FPC_X86_DATA_NEAR}
  298. mov es, dx
  299. mov si, ss:[bx + 6 + extra_param_offset] // @buf1
  300. mov di, ss:[bx + 4 + extra_param_offset] // @buf2
  301. {$else FPC_X86_DATA_NEAR}
  302. lds si, ss:[bx + 8 + extra_param_offset] // @buf1
  303. les di, ss:[bx + 4 + extra_param_offset] // @buf2
  304. {$endif FPC_X86_DATA_NEAR}
  305. {$ifdef FPC_ENABLED_CLD}
  306. cld
  307. {$endif FPC_ENABLED_CLD}
  308. xor bx, bx
  309. shr cx, 1
  310. adc bx, bx // remainder goes to bx
  311. jcxz @@BytewiseComparison
  312. repe cmpsw
  313. je @@BytewiseComparison
  314. // we found an unequal word
  315. // let's go back and compare it bytewise
  316. mov bl, 2
  317. dec si
  318. dec si
  319. dec di
  320. dec di
  321. @@BytewiseComparison:
  322. mov cx, bx
  323. jcxz @@Equal
  324. repe cmpsb
  325. je @@Equal
  326. // ax is 0
  327. sbb ax, ax
  328. shl ax, 1
  329. inc ax
  330. @@Equal:
  331. // ax is 0
  332. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  333. mov ds, dx
  334. {$endif}
  335. @@Done:
  336. end;
  337. {$endif FPC_SYSTEM_HAS_COMPAREBYTE}
  338. {$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
  339. {$define FPC_SYSTEM_HAS_COMPAREWORD}
  340. function CompareWord(Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
  341. asm
  342. xor ax, ax // initialize ax=0 (it's the result register, we never use it for anything else in this function)
  343. mov bx, sp
  344. mov cx, ss:[bx + 2 + extra_param_offset] // len
  345. jcxz @@Done
  346. mov dx, ds // for far data models, backup ds; for near data models, use to initialize es
  347. {$ifdef FPC_X86_DATA_NEAR}
  348. mov es, dx
  349. mov si, ss:[bx + 6 + extra_param_offset] // @buf1
  350. mov di, ss:[bx + 4 + extra_param_offset] // @buf2
  351. {$else FPC_X86_DATA_NEAR}
  352. lds si, ss:[bx + 8 + extra_param_offset] // @buf1
  353. les di, ss:[bx + 4 + extra_param_offset] // @buf2
  354. {$endif FPC_X86_DATA_NEAR}
  355. {$ifdef FPC_ENABLED_CLD}
  356. cld
  357. {$endif FPC_ENABLED_CLD}
  358. repe cmpsw
  359. je @@Equal
  360. // ax is 0
  361. sbb ax, ax
  362. shl ax, 1
  363. inc ax
  364. @@Equal:
  365. // ax is 0
  366. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  367. mov ds, dx
  368. {$endif}
  369. @@Done:
  370. end;
  371. {$endif FPC_SYSTEM_HAS_COMPAREWORD}
  372. {$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
  373. {$define FPC_SYSTEM_HAS_COMPAREDWORD}
  374. function CompareDWord(Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
  375. asm
  376. xor ax, ax // initialize ax=0 (it's the result register, we never use it for anything else in this function)
  377. mov bx, sp
  378. mov cx, ss:[bx + 2 + extra_param_offset] // len
  379. jcxz @@Done
  380. cmp cx, 4000h
  381. jb @@NotTooBig
  382. mov cx, 4000h
  383. @@NotTooBig:
  384. shl cx, 1
  385. mov dx, ds // for far data models, backup ds; for near data models, use to initialize es
  386. {$ifdef FPC_X86_DATA_NEAR}
  387. mov es, dx
  388. mov si, ss:[bx + 6 + extra_param_offset] // @buf1
  389. mov di, ss:[bx + 4 + extra_param_offset] // @buf2
  390. {$else FPC_X86_DATA_NEAR}
  391. lds si, ss:[bx + 8 + extra_param_offset] // @buf1
  392. les di, ss:[bx + 4 + extra_param_offset] // @buf2
  393. {$endif FPC_X86_DATA_NEAR}
  394. {$ifdef FPC_ENABLED_CLD}
  395. cld
  396. {$endif FPC_ENABLED_CLD}
  397. repe cmpsw
  398. je @@Equal
  399. // ax is 0
  400. sbb ax, ax
  401. shl ax, 1
  402. inc ax
  403. shr cx, 1
  404. jnc @@Skip
  405. xchg ax, bx
  406. xor ax, ax
  407. cmpsw
  408. je @@hi_equal
  409. // ax is 0
  410. sbb ax, ax
  411. shl ax, 1
  412. inc ax
  413. jmp @@Skip
  414. @@hi_equal:
  415. xchg ax, bx
  416. @@Equal:
  417. // ax is 0
  418. @@Skip:
  419. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  420. mov ds, dx
  421. {$endif}
  422. @@Done:
  423. end;
  424. {$endif FPC_SYSTEM_HAS_COMPAREDWORD}
  425. {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
  426. {$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
  427. function fpc_pchar_length(p:pchar):sizeint;assembler;nostackframe;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc;
  428. asm
  429. mov bx, sp
  430. {$ifdef FPC_X86_DATA_NEAR}
  431. mov ax, ss:[bx + 2 + extra_param_offset] // p
  432. test ax, ax
  433. jz @@Done
  434. xchg ax, di
  435. mov ax, ds
  436. mov es, ax
  437. {$else FPC_X86_DATA_NEAR}
  438. les di, ss:[bx + 2 + extra_param_offset] // p
  439. mov ax, es
  440. or ax, di
  441. jz @@Done
  442. {$endif FPC_X86_DATA_NEAR}
  443. mov cx, 0FFFFh
  444. xor ax, ax
  445. {$ifdef FPC_ENABLED_CLD}
  446. cld
  447. {$endif FPC_ENABLED_CLD}
  448. repne scasb
  449. dec ax
  450. dec ax
  451. sub ax, cx
  452. @@Done:
  453. end;
  454. {$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
  455. {$ifndef FPC_SYSTEM_HAS_FPC_PWIDECHAR_LENGTH}
  456. {$define FPC_SYSTEM_HAS_FPC_PWIDECHAR_LENGTH}
  457. function fpc_pwidechar_length(p:pwidechar):sizeint;assembler;nostackframe;[public,alias:'FPC_PWIDECHAR_LENGTH']; compilerproc;
  458. asm
  459. mov bx, sp
  460. {$ifdef FPC_X86_DATA_NEAR}
  461. mov ax, ss:[bx + 2 + extra_param_offset] // p
  462. test ax, ax
  463. jz @@Done
  464. xchg ax, di
  465. mov ax, ds
  466. mov es, ax
  467. {$else FPC_X86_DATA_NEAR}
  468. les di, ss:[bx + 2 + extra_param_offset] // p
  469. mov ax, es
  470. or ax, di
  471. jz @@Done
  472. {$endif FPC_X86_DATA_NEAR}
  473. mov cx, 0FFFFh
  474. xor ax, ax
  475. {$ifdef FPC_ENABLED_CLD}
  476. cld
  477. {$endif FPC_ENABLED_CLD}
  478. repne scasw
  479. dec ax
  480. dec ax
  481. sub ax, cx
  482. @@Done:
  483. end;
  484. {$endif FPC_SYSTEM_HAS_FPC_PWIDECHAR_LENGTH}
  485. {$define FPC_SYSTEM_HAS_SPTR}
  486. Function Sptr : Pointer;assembler;nostackframe;
  487. asm
  488. mov ax, sp
  489. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  490. mov dx, ss
  491. {$endif}
  492. end;
  493. {$define FPC_SYSTEM_HAS_PTR}
  494. function Ptr(sel,off: Word):farpointer;{$ifdef SYSTEMINLINE}inline;{$endif}assembler;nostackframe;
  495. asm
  496. mov si, sp
  497. mov ax, ss:[si + 2 + extra_param_offset] // off
  498. mov dx, ss:[si + 4 + extra_param_offset] // sel
  499. end;
  500. {$define FPC_SYSTEM_HAS_CSEG}
  501. function CSeg: Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  502. begin
  503. CSeg:=fpc_x86_get_cs;
  504. end;
  505. {$define FPC_SYSTEM_HAS_DSEG}
  506. function DSeg: Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  507. begin
  508. DSeg:=fpc_x86_get_ds;
  509. end;
  510. {$define FPC_SYSTEM_HAS_SSEG}
  511. function SSeg: Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  512. begin
  513. SSeg:=fpc_x86_get_ss;
  514. end;
  515. {$IFNDEF INTERNAL_BACKTRACE}
  516. {$define FPC_SYSTEM_HAS_GET_FRAME}
  517. function get_frame:pointer;assembler;nostackframe;{$ifdef SYSTEMINLINE}inline;{$endif}
  518. asm
  519. mov ax, bp
  520. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  521. mov dx, ss
  522. {$endif}
  523. end;
  524. {$ENDIF not INTERNAL_BACKTRACE}
  525. {$define FPC_SYSTEM_HAS_GET_PC_ADDR}
  526. Function Get_pc_addr : CodePointer;assembler;nostackframe;
  527. asm
  528. mov bx, sp
  529. mov ax, ss:[bx]
  530. {$ifdef FPC_X86_CODE_FAR}
  531. mov dx, ss:[bx+2]
  532. {$endif FPC_X86_CODE_FAR}
  533. end;
  534. {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
  535. function get_caller_addr(framebp:pointer;addr:codepointer=nil):codepointer;nostackframe;assembler;
  536. asm
  537. mov si, sp
  538. {$ifdef FPC_X86_CODE_FAR}
  539. xor dx, dx
  540. {$endif FPC_X86_CODE_FAR}
  541. {$ifdef FPC_X86_DATA_NEAR}
  542. mov ax, ss:[si + 4 + extra_param_offset + extra_param_offset] // framebp
  543. {$ifdef WIN16}
  544. mov cx, ax
  545. and al, $FE
  546. {$endif WIN16}
  547. or ax, ax
  548. jz @@Lg_a_null
  549. xchg ax, bx // 1 byte shorter than a mov
  550. mov ax, [bx+2]
  551. {$ifdef FPC_X86_CODE_FAR}
  552. {$ifdef WIN16}
  553. test cl, 1
  554. jnz @@farretaddr
  555. mov dx, ss:[si + 2 + extra_param_offset + extra_param_offset] // Seg(addr^)
  556. jmp @@retsegdone
  557. @@farretaddr:
  558. mov dx, [bx+4]
  559. @@retsegdone:
  560. {$else WIN16}
  561. mov dx, [bx+4]
  562. {$endif WIN16}
  563. {$endif FPC_X86_CODE_FAR}
  564. {$else FPC_X86_DATA_NEAR}
  565. les ax, ss:[si + 4 + extra_param_offset + extra_param_offset] // framebp
  566. {$ifdef WIN16}
  567. mov cx, ax
  568. and al, $FE
  569. {$endif WIN16}
  570. mov dx, es
  571. or dx, ax
  572. jz @@Lg_a_null
  573. xchg ax, bx // 1 byte shorter than a mov
  574. mov ax, es:[bx+2]
  575. {$ifdef FPC_X86_CODE_FAR}
  576. {$ifdef WIN16}
  577. test cl, 1
  578. jnz @@farretaddr
  579. mov dx, ss:[si + 2 + extra_param_offset + extra_param_offset] // Seg(addr^)
  580. jmp @@retsegdone
  581. @@farretaddr:
  582. mov dx, es:[bx+4]
  583. @@retsegdone:
  584. {$else WIN16}
  585. mov dx, es:[bx+4]
  586. {$endif WIN16}
  587. {$endif FPC_X86_CODE_FAR}
  588. {$endif FPC_X86_DATA_NEAR}
  589. @@Lg_a_null:
  590. end;
  591. {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
  592. function get_caller_frame(framebp:pointer;addr:codepointer=nil):pointer;nostackframe;assembler;
  593. asm
  594. {$ifdef FPC_X86_DATA_NEAR}
  595. mov si, sp
  596. mov ax, ss:[si + 4 + extra_param_offset + extra_param_offset] // framebp
  597. {$ifdef WIN16}
  598. and al, $FE
  599. {$endif WIN16}
  600. or ax, ax
  601. jz @@Lgnf_null
  602. xchg ax, si // 1 byte shorter than a mov
  603. lodsw
  604. @@Lgnf_null:
  605. {$else FPC_X86_DATA_NEAR}
  606. mov si, sp
  607. les ax, ss:[si + 4 + extra_param_offset + extra_param_offset] // framebp
  608. {$ifdef WIN16}
  609. and al, $FE
  610. {$endif WIN16}
  611. mov dx, es
  612. or dx, ax
  613. jz @@Lgnf_null
  614. xchg ax, si // 1 byte shorter than a mov
  615. seges lodsw
  616. {$ifdef WIN16}
  617. and al, $FE
  618. {$endif WIN16}
  619. mov dx, es
  620. @@Lgnf_null:
  621. {$endif FPC_X86_DATA_NEAR}
  622. end;
  623. function InterLockedDecrement (var Target: smallint) : smallint;nostackframe;assembler;
  624. asm
  625. mov si, sp
  626. {$ifdef FPC_X86_DATA_NEAR}
  627. mov bx, ss:[si + 2 + extra_param_offset] // Target
  628. {$else FPC_X86_DATA_NEAR}
  629. mov cx, ds
  630. lds bx, ss:[si + 2 + extra_param_offset] // Target
  631. {$endif FPC_X86_DATA_NEAR}
  632. pushf
  633. cli
  634. sub word [bx], 1
  635. mov ax, [bx]
  636. popf
  637. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  638. mov ds, cx
  639. {$endif}
  640. end;
  641. function InterLockedDecrement (var Target: longint) : longint;nostackframe;assembler;
  642. asm
  643. mov si, sp
  644. {$ifdef FPC_X86_DATA_NEAR}
  645. mov bx, ss:[si + 2 + extra_param_offset] // Target
  646. {$else FPC_X86_DATA_NEAR}
  647. mov cx, ds
  648. lds bx, ss:[si + 2 + extra_param_offset] // Target
  649. {$endif FPC_X86_DATA_NEAR}
  650. pushf
  651. cli
  652. sub word [bx], 1
  653. sbb word [bx+2], 0
  654. mov ax, [bx]
  655. mov dx, [bx+2]
  656. popf
  657. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  658. mov ds, cx
  659. {$endif}
  660. end;
  661. function InterLockedIncrement (var Target: smallint) : smallint;nostackframe;assembler;
  662. asm
  663. mov si, sp
  664. {$ifdef FPC_X86_DATA_NEAR}
  665. mov bx, ss:[si + 2 + extra_param_offset] // Target
  666. {$else FPC_X86_DATA_NEAR}
  667. mov cx, ds
  668. lds bx, ss:[si + 2 + extra_param_offset] // Target
  669. {$endif FPC_X86_DATA_NEAR}
  670. pushf
  671. cli
  672. add word [bx], 1
  673. mov ax, [bx]
  674. popf
  675. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  676. mov ds, cx
  677. {$endif}
  678. end;
  679. function InterLockedIncrement (var Target: longint) : longint;nostackframe;assembler;
  680. asm
  681. mov si, sp
  682. {$ifdef FPC_X86_DATA_NEAR}
  683. mov bx, ss:[si + 2 + extra_param_offset] // Target
  684. {$else FPC_X86_DATA_NEAR}
  685. mov cx, ds
  686. lds bx, ss:[si + 2 + extra_param_offset] // Target
  687. {$endif FPC_X86_DATA_NEAR}
  688. pushf
  689. cli
  690. add word [bx], 1
  691. adc word [bx+2], 0
  692. mov ax, [bx]
  693. mov dx, [bx+2]
  694. popf
  695. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  696. mov ds, cx
  697. {$endif}
  698. end;
  699. function InterLockedExchange (var Target: smallint;Source : smallint) : smallint;nostackframe;assembler;
  700. asm
  701. mov si, sp
  702. {$ifdef FPC_X86_DATA_NEAR}
  703. mov bx, ss:[si + 4 + extra_param_offset] // Target
  704. {$else FPC_X86_DATA_NEAR}
  705. mov cx, ds
  706. lds bx, ss:[si + 4 + extra_param_offset] // Target
  707. {$endif FPC_X86_DATA_NEAR}
  708. mov ax, ss:[si + 2 + extra_param_offset] // Source
  709. xchg word [bx], ax
  710. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  711. mov ds, cx
  712. {$endif}
  713. end;
  714. function InterLockedExchange (var Target: longint;Source : longint) : longint;nostackframe;assembler;
  715. asm
  716. mov si, sp
  717. {$ifdef FPC_X86_DATA_NEAR}
  718. mov bx, ss:[si + 6 + extra_param_offset] // Target
  719. {$else FPC_X86_DATA_NEAR}
  720. mov cx, ds
  721. lds bx, ss:[si + 6 + extra_param_offset] // Target
  722. {$endif FPC_X86_DATA_NEAR}
  723. mov ax, ss:[si + 2 + extra_param_offset] // Lo(Source)
  724. mov dx, ss:[si + 4 + extra_param_offset] // Hi(Source)
  725. pushf
  726. cli
  727. xchg word [bx], ax
  728. xchg word [bx+2], dx
  729. popf
  730. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  731. mov ds, cx
  732. {$endif}
  733. end;
  734. function InterLockedExchangeAdd (var Target: smallint;Source : smallint) : smallint;nostackframe;assembler;
  735. asm
  736. mov si, sp
  737. {$ifdef FPC_X86_DATA_NEAR}
  738. mov bx, ss:[si + 4 + extra_param_offset] // Target
  739. {$else FPC_X86_DATA_NEAR}
  740. mov cx, ds
  741. lds bx, ss:[si + 4 + extra_param_offset] // Target
  742. {$endif FPC_X86_DATA_NEAR}
  743. mov di, ss:[si + 2 + extra_param_offset] // Source
  744. pushf
  745. cli
  746. mov ax, [bx]
  747. add word [bx], di
  748. popf
  749. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  750. mov ds, cx
  751. {$endif}
  752. end;
  753. function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint;nostackframe;assembler;
  754. asm
  755. mov si, sp
  756. {$ifdef FPC_X86_DATA_NEAR}
  757. mov bx, ss:[si + 6 + extra_param_offset] // Target
  758. {$else FPC_X86_DATA_NEAR}
  759. mov cx, ds
  760. lds bx, ss:[si + 6 + extra_param_offset] // Target
  761. {$endif FPC_X86_DATA_NEAR}
  762. mov di, ss:[si + 2 + extra_param_offset] // Lo(Source)
  763. mov si, ss:[si + 4 + extra_param_offset] // Hi(Source)
  764. pushf
  765. cli
  766. mov ax, [bx]
  767. mov dx, [bx+2]
  768. add word [bx], di
  769. adc word [bx+2], si
  770. popf
  771. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  772. mov ds, cx
  773. {$endif}
  774. end;
  775. function InterlockedCompareExchange(var Target: smallint; NewValue: smallint; Comperand: smallint): smallint;assembler;
  776. asm
  777. {$ifdef FPC_X86_DATA_NEAR}
  778. mov bx, [Target] // Target
  779. {$else FPC_X86_DATA_NEAR}
  780. mov cx, ds
  781. lds bx, [Target] // Target
  782. {$endif FPC_X86_DATA_NEAR}
  783. mov di, [Comperand]
  784. pushf
  785. cli
  786. mov ax, [bx]
  787. cmp ax, di
  788. jne @@not_equal
  789. mov di, [NewValue]
  790. mov [bx], di
  791. @@not_equal:
  792. popf
  793. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  794. mov ds, cx
  795. {$endif}
  796. end;
  797. function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint;assembler;
  798. asm
  799. {$ifdef FPC_X86_DATA_NEAR}
  800. mov bx, [Target] // Target
  801. {$else FPC_X86_DATA_NEAR}
  802. mov cx, ds
  803. lds bx, [Target] // Target
  804. {$endif FPC_X86_DATA_NEAR}
  805. mov di, word [Comperand]
  806. mov si, word [Comperand+2]
  807. pushf
  808. cli
  809. mov ax, [bx]
  810. mov dx, [bx+2]
  811. cmp ax, di
  812. jne @@not_equal
  813. cmp dx, si
  814. jne @@not_equal
  815. mov di, word [NewValue]
  816. mov si, word [NewValue+2]
  817. mov [bx], di
  818. mov [bx+2], si
  819. @@not_equal:
  820. popf
  821. {$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
  822. mov ds, cx
  823. {$endif}
  824. end;
  825. {****************************************************************************
  826. Stack checking
  827. ****************************************************************************}
  828. procedure fpc_stackcheck_i8086;[public,alias:'FPC_STACKCHECK_I8086'];compilerproc;assembler;nostackframe;
  829. const
  830. STACK_MARGIN=512;
  831. asm
  832. { on entry: AX = required stack size to check if available
  833. (function is called before stack allocation) }
  834. {$ifdef FPC_MM_HUGE}
  835. push ds
  836. push ax
  837. mov ax, SEG @DATA
  838. mov ds, ax
  839. pop ax
  840. {$endif FPC_MM_HUGE}
  841. add ax, STACK_MARGIN
  842. jc @@stack_overflow
  843. add ax, word ptr [__stkbottom]
  844. jc @@stack_overflow
  845. cmp ax, sp
  846. ja @@stack_overflow
  847. @@no_overflow:
  848. {$ifdef FPC_MM_HUGE}
  849. pop ds
  850. {$endif FPC_MM_HUGE}
  851. ret
  852. @@stack_overflow:
  853. { check StackError flag, to avoid recursive calls from the exit routines }
  854. cmp byte ptr [StackError], 1
  855. je @@no_overflow
  856. mov byte ptr [StackError], 1
  857. { cleanup return address (and maybe saved ds) from call to this function }
  858. {$if defined(FPC_MM_HUGE)}
  859. add sp, 6
  860. {$elseif defined(FPC_X86_CODE_FAR)}
  861. pop ax
  862. pop ax
  863. {$else}
  864. pop ax
  865. {$endif}
  866. { call HandleError(202) }
  867. {$ifdef CPU8086}
  868. xor ax, ax
  869. push ax
  870. mov al, 202
  871. push ax
  872. {$else}
  873. push 0
  874. push 202
  875. {$endif}
  876. call HandleError
  877. end;
  878. {****************************************************************************
  879. BSR/BSF
  880. ****************************************************************************}
  881. const
  882. bsr8bit: array [Byte] of Byte = (
  883. $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,
  884. 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,
  885. 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,
  886. 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,
  887. 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,
  888. 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,
  889. 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,
  890. 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
  891. );
  892. bsf8bit: array [Byte] of Byte = (
  893. $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,
  894. 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,
  895. 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,
  896. 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,
  897. 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,
  898. 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,
  899. 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,
  900. 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
  901. );
  902. {$define FPC_SYSTEM_HAS_BSR_BYTE}
  903. function BsrByte(const AValue: Byte): Byte;
  904. begin
  905. BsrByte := bsr8bit[AValue];
  906. end;
  907. {$define FPC_SYSTEM_HAS_BSF_BYTE}
  908. function BsfByte(const AValue: Byte): Byte;
  909. begin
  910. BsfByte := bsf8bit[AValue];
  911. end;
  912. {$define FPC_SYSTEM_HAS_BSR_WORD}
  913. function BsrWord(const AValue: Word): Byte; assembler;
  914. asm
  915. lea bx, bsr8bit
  916. xor cl, cl
  917. mov ax, word [AValue]
  918. test ah, ah
  919. jz @@0
  920. mov cl, 8
  921. mov al, ah
  922. @@0: xlatb
  923. add al, cl
  924. end;
  925. {$define FPC_SYSTEM_HAS_BSF_WORD}
  926. function BsfWord(const AValue: Word): Byte; assembler;
  927. asm
  928. lea bx, bsf8bit
  929. xor cl, cl
  930. mov ax, word [AValue]
  931. test al, al
  932. jnz @@0
  933. or al, ah
  934. jz @@0
  935. add cl, 8
  936. @@0: xlatb
  937. add al, cl
  938. end;
  939. {$define FPC_SYSTEM_HAS_BSR_DWORD}
  940. function BsrDword(const AValue: DWord): Byte; assembler;
  941. asm
  942. lea bx, bsr8bit
  943. mov cl, 16
  944. mov ax, word [AValue+2]
  945. test ax, ax
  946. jnz @@0
  947. xor cl, cl
  948. mov ax, word [AValue]
  949. @@0: test ah, ah
  950. jz @@1
  951. add cl, 8
  952. mov al, ah
  953. @@1: xlatb
  954. add al, cl
  955. end;
  956. {$define FPC_SYSTEM_HAS_BSF_DWORD}
  957. function BsfDword(const AValue: DWord): Byte; assembler;
  958. asm
  959. lea bx, bsf8bit
  960. xor cl, cl
  961. mov ax, word [AValue]
  962. test ax, ax
  963. jnz @@0
  964. or ax, word [AValue+2]
  965. jz @@1
  966. mov cl, 16
  967. @@0: test al, al
  968. jnz @@1
  969. add cl, 8
  970. mov al, ah
  971. @@1: xlatb
  972. add al, cl
  973. end;
  974. {$define FPC_SYSTEM_HAS_BSR_QWORD}
  975. function BsrQword(const AValue: QWord): Byte; assembler;
  976. asm
  977. lea bx, bsr8bit
  978. mov cl, 48
  979. mov ax, word [AValue+6]
  980. test ax, ax
  981. jnz @@0
  982. mov cl, 32
  983. or ax, word [AValue+4]
  984. jnz @@0
  985. mov cl, 16
  986. or ax, word [AValue+2]
  987. jnz @@0
  988. xor cl, cl
  989. mov ax, word [AValue]
  990. @@0: test ah, ah
  991. jz @@1
  992. add cl, 8
  993. mov al, ah
  994. @@1: xlatb
  995. add al, cl
  996. end;
  997. {$define FPC_SYSTEM_HAS_BSF_QWORD}
  998. function BsfQword(const AValue: QWord): Byte; assembler;
  999. asm
  1000. lea bx, bsf8bit
  1001. xor cl, cl
  1002. mov ax, word [AValue]
  1003. test ax, ax
  1004. jnz @@0
  1005. mov cl, 16
  1006. or ax, word [AValue+2]
  1007. jnz @@0
  1008. mov cl, 32
  1009. or ax, word [AValue+4]
  1010. jnz @@0
  1011. xor cl, cl
  1012. or ax, word [AValue+6]
  1013. jz @@1
  1014. mov cl, 48
  1015. @@0: test al, al
  1016. jnz @@1
  1017. add cl, 8
  1018. mov al, ah
  1019. @@1: xlatb
  1020. add al, cl
  1021. end;
  1022. {****************************************************************************
  1023. HexStr
  1024. ****************************************************************************}
  1025. {$define FPC_HAS_HEXSTR_POINTER_SHORTSTR}
  1026. function HexStr(Val: NearPointer): ShortString;
  1027. begin
  1028. HexStr:=HexStr(Word(Val),4);
  1029. end;
  1030. function HexStr(Val: NearCsPointer): ShortString;
  1031. begin
  1032. HexStr:='CS:'+HexStr(Word(Val),4);
  1033. end;
  1034. function HexStr(Val: NearDsPointer): ShortString;
  1035. begin
  1036. HexStr:='DS:'+HexStr(Word(Val),4);
  1037. end;
  1038. function HexStr(Val: NearEsPointer): ShortString;
  1039. begin
  1040. HexStr:='ES:'+HexStr(Word(Val),4);
  1041. end;
  1042. function HexStr(Val: NearSsPointer): ShortString;
  1043. begin
  1044. HexStr:='SS:'+HexStr(Word(Val),4);
  1045. end;
  1046. function HexStr(Val: NearFsPointer): ShortString;
  1047. begin
  1048. HexStr:='FS:'+HexStr(Word(Val),4);
  1049. end;
  1050. function HexStr(Val: NearGsPointer): ShortString;
  1051. begin
  1052. HexStr:='GS:'+HexStr(Word(Val),4);
  1053. end;
  1054. function HexStr(Val: FarPointer): ShortString;
  1055. type
  1056. TFarPointerRec = record
  1057. Offset, Segment: Word;
  1058. end;
  1059. begin
  1060. HexStr:=HexStr(TFarPointerRec(Val).Segment,4)+':'+HexStr(TFarPointerRec(Val).Offset,4);
  1061. end;
  1062. function HexStr(Val: HugePointer): ShortString;{$ifdef SYSTEMINLINE}inline;{$endif}
  1063. begin
  1064. HexStr:=HexStr(FarPointer(Val));
  1065. end;
  1066. {****************************************************************************
  1067. FPU
  1068. ****************************************************************************}
  1069. const
  1070. { Internal constants for use in system unit }
  1071. FPU_Invalid = 1;
  1072. FPU_Denormal = 2;
  1073. FPU_DivisionByZero = 4;
  1074. FPU_Overflow = 8;
  1075. FPU_Underflow = $10;
  1076. FPU_StackUnderflow = $20;
  1077. FPU_StackOverflow = $40;
  1078. FPU_ExceptionMask = $ff;
  1079. { Detects the FPU and initializes the Test8087 variable (and Default8087CW):
  1080. 0 = NO FPU
  1081. 1 = 8087
  1082. 2 = 80287
  1083. 3 = 80387+ }
  1084. procedure DetectFPU;
  1085. var
  1086. localfpucw: word;
  1087. begin
  1088. asm
  1089. xor bx, bx { initialization, 0=NO FPU }
  1090. { FPU presence detection }
  1091. fninit
  1092. mov byte [localfpucw + 1], 0
  1093. nop
  1094. fnstcw localfpucw
  1095. cmp byte [localfpucw + 1], 3
  1096. jne @@Done { No FPU? }
  1097. inc bx
  1098. { FPU found; now test if it's a 8087 }
  1099. and byte [localfpucw], $7F { clear the interrupt enable mask (IEM) }
  1100. fldcw localfpucw
  1101. fdisi { try to set the interrupt enable mask }
  1102. fstcw localfpucw
  1103. test byte [localfpucw], $80 { IEM set? }
  1104. jnz @@Done { if yes, we have an 8087 }
  1105. inc bx
  1106. { we have a 287+; now test if it's a 80287 }
  1107. finit
  1108. fld1
  1109. fldz
  1110. fdiv { calculate 1/0 }
  1111. fld st { copy the value }
  1112. fchs { change the sign }
  1113. fcompp { compare. if the FPU distinguishes +inf from -inf, it's a 387+ }
  1114. fstsw localfpucw
  1115. mov ah, byte [localfpucw + 1]
  1116. sahf
  1117. je @@Done
  1118. inc bx { 387+ }
  1119. @@Done:
  1120. mov Test8087, bl
  1121. end ['AX','BX'];
  1122. if Test8087<=2 then
  1123. Default8087CW:=$1330
  1124. else
  1125. Default8087CW:=$1332;
  1126. end;
  1127. {$ifndef FPC_SYSTEM_HAS_SYSINITFPU}
  1128. {$define FPC_SYSTEM_HAS_SYSINITFPU}
  1129. Procedure SysInitFPU; assembler;
  1130. asm
  1131. fninit
  1132. fldcw Default8087CW
  1133. fwait
  1134. end;
  1135. {$endif ndef FPC_SYSTEM_HAS_SYSINITFPU}
  1136. {$define FPC_SYSTEM_HAS_SYSRESETFPU}
  1137. Procedure SysResetFPU; assembler;
  1138. asm
  1139. fninit
  1140. fwait
  1141. fldcw Default8087CW
  1142. end;
  1143. {$I int32p.inc}
  1144. {$I hugeptr.inc}