i386.inc 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1993,97 by the Free Pascal development team.
  5. Processor dependent implementation for the system unit for
  6. intel i386+
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. {$ASMMODE ATT}
  14. {****************************************************************************
  15. Move / Fill
  16. ****************************************************************************}
  17. procedure Move(var source;var dest;count:longint);
  18. begin
  19. asm
  20. movl dest,%edi
  21. movl source,%esi
  22. movl %edi,%eax
  23. movl count,%ebx
  24. { Check for back or forward }
  25. sub %esi,%eax
  26. jz .LMoveEnd { Do nothing when source=dest }
  27. jc .LFMove { Do forward, dest<source }
  28. cmp %ebx,%eax
  29. jb .LBMove { Dest is in range of move, do backward }
  30. { Forward Copy }
  31. .LFMove:
  32. cld
  33. cmpl $15,%ebx
  34. jl .LFMove1
  35. movl %edi,%ecx { Align on 32bits }
  36. negl %ecx
  37. andl $3,%ecx
  38. subl %ecx,%ebx
  39. rep
  40. movsb
  41. movl %ebx,%ecx
  42. andl $3,%ebx
  43. shrl $2,%ecx
  44. rep
  45. movsl
  46. .LFMove1:
  47. movl %ebx,%ecx
  48. rep
  49. movsb
  50. jmp .LMoveEnd
  51. { Backward Copy }
  52. .LBMove:
  53. std
  54. addl %ebx,%esi
  55. addl %ebx,%edi
  56. movl %edi,%ecx
  57. decl %esi
  58. decl %edi
  59. cmpl $15,%ebx
  60. jl .LBMove1
  61. negl %ecx { Align on 32bits }
  62. andl $3,%ecx
  63. subl %ecx,%ebx
  64. rep
  65. movsb
  66. movl %ebx,%ecx
  67. andl $3,%ebx
  68. shrl $2,%ecx
  69. subl $3,%esi
  70. subl $3,%edi
  71. rep
  72. movsl
  73. addl $3,%esi
  74. addl $3,%edi
  75. .LBMove1:
  76. movl %ebx,%ecx
  77. rep
  78. movsb
  79. cld
  80. .LMoveEnd:
  81. end;
  82. end;
  83. Procedure FillChar(var x;count:longint;value:byte);[alias: 'FILL_OBJECT'];
  84. begin
  85. asm
  86. cld
  87. movl x,%edi
  88. movl value,%eax { Only lower 8 bits will be used }
  89. movl count,%ecx
  90. cmpl $7,%ecx
  91. jl .LFill1
  92. movb %al,%ah
  93. movl %eax,%ebx
  94. shll $16,%eax
  95. movl %ecx,%edx
  96. movw %bx,%ax
  97. movl %edi,%ecx { Align on 32bits }
  98. negl %ecx
  99. andl $3,%ecx
  100. subl %ecx,%edx
  101. rep
  102. stosb
  103. movl %edx,%ecx
  104. andl $3,%edx
  105. shrl $2,%ecx
  106. rep
  107. stosl
  108. movl %edx,%ecx
  109. .LFill1:
  110. rep
  111. stosb
  112. end;
  113. end;
  114. procedure fillword(var x;count : longint;value : word);
  115. begin
  116. asm
  117. movl 8(%ebp),%edi
  118. movl 12(%ebp),%ecx
  119. movl 16(%ebp),%eax
  120. movl %eax,%edx
  121. shll $16,%eax
  122. movw %dx,%ax
  123. movl %ecx,%edx
  124. shrl $1,%ecx
  125. cld
  126. rep
  127. stosl
  128. movl %edx,%ecx
  129. andl $1,%ecx
  130. rep
  131. stosw
  132. end ['EAX','ECX','EDX','EDI'];
  133. end;
  134. {****************************************************************************
  135. Object Helpers
  136. ****************************************************************************}
  137. {$ASMMODE DIRECT}
  138. procedure int_help_constructor;assembler; [public,alias:'HELP_CONSTRUCTOR'];
  139. asm
  140. { Entry without preamble, since we need the ESP of the constructor
  141. Stack (relative to %ebp):
  142. 12 Self
  143. 8 VMT-Address
  144. 4 main programm-Addr
  145. 0 %ebp
  146. }
  147. { eax isn't touched anywhere, so it doesn't have to reloaded }
  148. movl 8(%ebp),%eax
  149. { initialise self ? }
  150. orl %esi,%esi
  151. jne .LHC_4
  152. { get memory, but save register first temporary variable }
  153. subl $4,%esp
  154. movl %esp,%esi
  155. { Save Register}
  156. pushal
  157. { Memory size }
  158. pushl (%eax)
  159. pushl %esi
  160. call GETMEM
  161. popal
  162. { Memory size to %esi }
  163. movl (%esi),%esi
  164. addl $4,%esp
  165. { If no memory available : fail() }
  166. orl %esi,%esi
  167. jz .LHC_5
  168. { init self for the constructor }
  169. movl %esi,12(%ebp)
  170. .LHC_4:
  171. { is there a VMT address ? }
  172. orl %eax,%eax
  173. jnz .LHC_7
  174. { In case the constructor doesn't do anything, the Zero-Flag }
  175. { can't be put, because this calls Fail() }
  176. incl %eax
  177. ret
  178. .LHC_7:
  179. { set zero inside the object }
  180. pushal
  181. pushw $0
  182. pushl (%eax)
  183. pushl %esi
  184. call FILL_OBJECT
  185. popal
  186. { set the VMT address for the new created object }
  187. movl %eax,(%esi)
  188. orl %eax,%eax
  189. .LHC_5:
  190. end;
  191. procedure help_fail;assembler;
  192. asm
  193. end;
  194. procedure int_new_class;assembler;[public,alias:'NEW_CLASS'];
  195. asm
  196. { create class ? }
  197. movl 8(%ebp),%edi
  198. orl %edi,%edi
  199. jz .LNEW_CLASS1
  200. { esi contains the vmt }
  201. pushl %esi
  202. { call newinstance (class method!) }
  203. call 16(%esi)
  204. { newinstance returns a pointer to the new created }
  205. { instance in eax }
  206. { load esi and insert self }
  207. movl %eax,8(%ebp)
  208. movl %eax,%esi
  209. ret
  210. .LNEW_CLASS1:
  211. movl %esi,8(%ebp)
  212. end;
  213. procedure int_dispose_class;assembler;[public,alias:'DISPOSE_CLASS'];
  214. asm
  215. { destroy class ? }
  216. movl 8(%ebp),%edi
  217. { save self }
  218. movl %esi,8(%ebp)
  219. orl %edi,%edi
  220. jz .LDISPOSE_CLASS1
  221. { no inherited call }
  222. movl (%esi),%edi
  223. { push self }
  224. pushl %esi
  225. { call freeinstance }
  226. call 20(%edi)
  227. .LDISPOSE_CLASS1:
  228. { load self }
  229. movl 8(%ebp),%esi
  230. end;
  231. { checks for a correct vmt pointer }
  232. procedure int_check_object;assembler;[public,alias:'CHECK_OBJECT'];
  233. asm
  234. pushl %edi
  235. movl 8(%esp),%edi
  236. pushl %eax
  237. { Here we must check if the VMT pointer is nil before }
  238. { accessing it... }
  239. { WARNING: Will only probably work with GAS, as fields }
  240. { are ZEROED automatically in BSS, which might not be }
  241. { the case with other linkers/assemblers... }
  242. orl %edi,%edi
  243. jz .Lco_re
  244. movl (%edi),%eax
  245. addl 4(%edi),%eax
  246. jnz .Lco_re
  247. popl %eax
  248. popl %edi
  249. ret $4
  250. .Lco_re:
  251. pushw $210
  252. call runerror
  253. end;
  254. procedure int_help_destructor;assembler;[public,alias:'HELP_DESTRUCTOR'];
  255. asm
  256. { Stack (relative to %ebp):
  257. 12 Self
  258. 8 VMT-Address
  259. 4 Main program-Addr
  260. 0 %ebp
  261. }
  262. { temporary Variable }
  263. subl $4,%esp
  264. movl %esp,%edi
  265. pushal
  266. { Should the object be resolved ? }
  267. movl 8(%ebp),%eax
  268. orl %eax,%eax
  269. jz .LHD_3
  270. { Yes, get size from SELF! }
  271. movl 12(%ebp),%eax
  272. { get VMT-pointer (from Self) to %ebx }
  273. movl (%eax),%ebx
  274. { And put size on the Stack }
  275. pushl (%ebx)
  276. { SELF }
  277. { I think for precaution }
  278. { that we should clear the VMT here }
  279. movl $0,(%eax)
  280. movl %eax,(%edi)
  281. pushl %edi
  282. call FREEMEM
  283. .LHD_3:
  284. popal
  285. addl $4,%esp
  286. end;
  287. {$ASMMODE ATT}
  288. {****************************************************************************
  289. String
  290. ****************************************************************************}
  291. procedure strcopy(dstr,sstr:pointer;len:longint);[public,alias:'STRCOPY'];
  292. {
  293. this procedure must save all modified registers except EDI and ESI !!!
  294. }
  295. begin
  296. asm
  297. pushl %eax
  298. pushl %ecx
  299. cld
  300. movl 16(%ebp),%edi
  301. movl 12(%ebp),%esi
  302. xorl %eax,%eax
  303. movl 8(%ebp),%ecx
  304. lodsb
  305. cmpl %ecx,%eax
  306. jbe .LStrCopy1
  307. movl %ecx,%eax
  308. .LStrCopy1:
  309. stosb
  310. cmpl $7,%eax
  311. jl .LStrCopy2
  312. movl %edi,%ecx { Align on 32bits }
  313. negl %ecx
  314. andl $3,%ecx
  315. subl %ecx,%eax
  316. rep
  317. movsb
  318. movl %eax,%ecx
  319. andl $3,%eax
  320. shrl $2,%ecx
  321. rep
  322. movsl
  323. .LStrCopy2:
  324. movl %eax,%ecx
  325. rep
  326. movsb
  327. popl %ecx
  328. popl %eax
  329. end ['ECX','EAX','ESI','EDI'];
  330. end;
  331. procedure strconcat(s1,s2 : pointer);[public,alias: 'STRCONCAT'];
  332. begin
  333. asm
  334. xorl %ecx,%ecx
  335. movl 12(%ebp),%edi
  336. movl 8(%ebp),%esi
  337. movl %edi,%ebx
  338. movb (%edi),%cl
  339. lea 1(%edi,%ecx),%edi
  340. negl %ecx
  341. xor %eax,%eax
  342. addl $0xff,%ecx
  343. lodsb
  344. cmpl %ecx,%eax
  345. jbe .LStrConcat1
  346. movl %ecx,%eax
  347. .LStrConcat1:
  348. addb %al,(%ebx)
  349. cmpl $7,%eax
  350. jl .LStrConcat2
  351. movl %edi,%ecx { Align on 32bits }
  352. negl %ecx
  353. andl $3,%ecx
  354. subl %ecx,%eax
  355. rep
  356. movsb
  357. movl %eax,%ecx
  358. andl $3,%eax
  359. shrl $2,%ecx
  360. rep
  361. movsl
  362. .LStrConcat2:
  363. movl %eax,%ecx
  364. rep
  365. movsb
  366. end ['EBX','ECX','EAX','ESI','EDI'];
  367. end;
  368. procedure strcmp(dstr,sstr : pointer);[public,alias: 'STRCMP'];
  369. begin
  370. asm
  371. cld
  372. xorl %ebx,%ebx
  373. xorl %eax,%eax
  374. movl 12(%ebp),%esi
  375. movl 8(%ebp),%edi
  376. movb (%esi),%al
  377. movb (%edi),%bl
  378. movl %eax,%edx
  379. incl %esi
  380. incl %edi
  381. cmpl %ebx,%eax
  382. jbe .LStrCmp1
  383. movl %ebx,%eax
  384. .LStrCmp1:
  385. cmpl $7,%eax
  386. jl .LStrCmp2
  387. movl %edi,%ecx { Align on 32bits }
  388. negl %ecx
  389. andl $3,%ecx
  390. subl %ecx,%eax
  391. orl %ecx,%ecx
  392. rep
  393. cmpsb
  394. jne .LStrCmp3
  395. movl %eax,%ecx
  396. andl $3,%eax
  397. shrl $2,%ecx
  398. orl %ecx,%ecx
  399. rep
  400. cmpsl
  401. je .LStrCmp2
  402. movl $4,%eax
  403. sub %eax,%esi
  404. sub %eax,%edi
  405. .LStrCmp2:
  406. movl %eax,%ecx
  407. orl %eax,%eax
  408. rep
  409. cmpsb
  410. jne .LStrCmp3
  411. cmp %ebx,%edx
  412. .LStrCmp3:
  413. end ['EDX','ECX','EBX','EAX','ESI','EDI'];
  414. end;
  415. {$ASMMODE DIRECT}
  416. function strpas(p:pchar):string;
  417. begin
  418. asm
  419. cld
  420. movl 12(%ebp),%edi
  421. movl $0xff,%ecx
  422. xorl %eax,%eax
  423. movl %edi,%esi
  424. repne
  425. scasb
  426. movl %ecx,%eax
  427. movl 8(%ebp),%edi
  428. notb %al
  429. decl %eax
  430. stosb
  431. cmpl $7,%eax
  432. jl .LStrPas2
  433. movl %edi,%ecx { Align on 32bits }
  434. negl %ecx
  435. andl $3,%ecx
  436. subl %ecx,%eax
  437. rep
  438. movsb
  439. movl %eax,%ecx
  440. andl $3,%eax
  441. shrl $2,%ecx
  442. rep
  443. movsl
  444. .LStrPas2:
  445. movl %eax,%ecx
  446. rep
  447. movsb
  448. end ['ECX','EAX','ESI','EDI'];
  449. end;
  450. {$ASMMODE ATT}
  451. function strlen(p:pchar):longint;assembler;
  452. asm
  453. movl p,%edi
  454. movl $0xffffffff,%ecx
  455. xorl %eax,%eax
  456. cld
  457. repne
  458. scasb
  459. movl $0xfffffffe,%eax
  460. subl %ecx,%eax
  461. end ['EDI','ECX','EAX'];
  462. {****************************************************************************
  463. Other
  464. ****************************************************************************}
  465. function get_addr(addrbp:longint):longint;assembler;
  466. asm
  467. movl addrbp,%eax
  468. orl %eax,%eax
  469. jz .Lg_a_null
  470. movl 4(%eax),%eax
  471. .Lg_a_null:
  472. end ['EAX'];
  473. function get_next_frame(framebp:longint):longint;assembler;
  474. asm
  475. movl framebp,%eax
  476. orl %eax,%eax
  477. jz .Lgnf_null
  478. movl (%eax),%eax
  479. .Lgnf_null:
  480. end ['EAX'];
  481. procedure runerror(w : word);[alias: 'runerror'];
  482. function get_addr : longint;
  483. begin
  484. asm
  485. movl (%ebp),%eax
  486. movl 4(%eax),%eax
  487. movl %eax,__RESULT
  488. end ['EAX'];
  489. end;
  490. function get_error_bp : longint;
  491. begin
  492. asm
  493. movl (%ebp),%eax {%ebp of run_error}
  494. movl %eax,__RESULT
  495. end ['EAX'];
  496. end;
  497. begin
  498. errorcode:=w;
  499. exitcode:=w;
  500. erroraddr:=pointer(get_addr);
  501. DoError := TRUE;
  502. errorbase:=get_error_bp;
  503. halt(errorcode);
  504. end;
  505. procedure int_iocheck(addr : longint);[public,alias: 'IOCHECK'];
  506. var
  507. l : longint;
  508. begin
  509. { Since IOCHECK is called directly and only later the optimiser }
  510. { Maybe also save global registers }
  511. asm
  512. pushal
  513. end;
  514. l:=ioresult;
  515. if l<>0 then
  516. begin
  517. {$ifndef RTLLITE}
  518. writeln('IO-Error ',l,' at 0x',HexStr(addr,8));
  519. {$else}
  520. writeln('IO-Error ',l,' at ',addr);
  521. {$endif}
  522. halt(byte(l));
  523. end;
  524. asm
  525. popal
  526. end;
  527. end;
  528. procedure int_re_overflow;[public,alias: 'RE_OVERFLOW'];
  529. var
  530. addr : longint;
  531. begin
  532. { Overflow was shortly before the return address }
  533. asm
  534. movl 4(%ebp),%edi
  535. movl %edi,addr
  536. end;
  537. {$ifndef RTLLITE}
  538. writeln('Overflow at 0x',HexStr(addr,8));
  539. {$else}
  540. writeln('Overflow at ',addr);
  541. {$endif}
  542. RunError(215);
  543. end;
  544. function abs(l:longint):longint;assembler;
  545. asm
  546. movl l,%eax
  547. orl %eax,%eax
  548. jns .LMABS1
  549. negl %eax
  550. .LMABS1:
  551. end ['EAX'];
  552. function odd(l:longint):boolean;assembler;
  553. asm
  554. movl l,%eax
  555. andl $1,%eax
  556. setnz %al
  557. end ['EAX'];
  558. function sqr(l:longint):longint;assembler;
  559. asm
  560. mov l,%eax
  561. imull %eax,%eax
  562. end ['EAX'];
  563. procedure int_str(l : longint;var s : string);
  564. var
  565. buffer : array[0..11] of byte;
  566. begin
  567. { Workaround: }
  568. if l=$80000000 then
  569. begin
  570. s:='-2147483648';
  571. exit;
  572. end;
  573. asm
  574. movl 8(%ebp),%eax // load Integer
  575. movl 12(%ebp),%edi // Load String address
  576. xorl %ecx,%ecx // String length=0
  577. xorl %ebx,%ebx // Buffer length=0
  578. movl $0x0a,%esi // load 10 as dividing constant.
  579. or %eax,%eax // Sign ?
  580. jns .LM2
  581. neg %eax
  582. movb $0x2d,1(%edi) // put '-' in String
  583. incl %ecx
  584. .LM2:
  585. cdq
  586. idivl %esi,%eax
  587. addb $0x30,%dl // convert Rest to ASCII.
  588. movb %dl,-12(%ebp,%ebx)
  589. incl %ebx
  590. cmpl $0,%eax
  591. jnz .LM2
  592. // copy String
  593. .LM3:
  594. movb -13(%ebp,%ebx),%al // -13 because EBX is decreased only
  595. // later.
  596. movb %al,1(%edi,%ecx)
  597. incl %ecx
  598. decl %ebx
  599. jnz .LM3
  600. movb %cl,(%edi) // Copy String length
  601. end;
  602. end;
  603. procedure int_str(c : cardinal;var s : string);
  604. var
  605. buffer : array[0..14] of byte;
  606. begin
  607. asm
  608. movl 8(%ebp),%eax // load CARDINAL
  609. movl 12(%ebp),%edi // Load String address
  610. xorl %ecx,%ecx // String length=0
  611. xorl %ebx,%ebx // Buffer length=0
  612. movl $0x0a,%esi // load 10 as dividing constant.
  613. .LM4:
  614. xorl %edx,%edx
  615. divl %esi,%eax
  616. addb $0x30,%dl // convert Rest to ASCII.
  617. movb %dl,-12(%ebp,%ebx)
  618. incl %ebx
  619. cmpl $0,%eax
  620. jnz .LM4
  621. { now copy the string }
  622. .LM5:
  623. movb -13(%ebp,%ebx),%al // -13 because EBX is decreased only
  624. // later.
  625. movb %al,1(%edi,%ecx)
  626. incl %ecx
  627. decl %ebx
  628. jnz .LM5
  629. movb %cl,(%edi) // Copy String length
  630. end;
  631. end;
  632. {$IFNDEF NEW_READWRITE}
  633. procedure f1;[public,alias: 'FLUSH_STDOUT'];
  634. begin
  635. asm
  636. pushal
  637. end;
  638. FileFunc(textrec(output).flushfunc)(textrec(output));
  639. asm
  640. popal
  641. end;
  642. end;
  643. {$ENDIF NEW_READWRITE}
  644. Function Sptr : Longint;
  645. begin
  646. asm
  647. movl %esp,%eax
  648. addl $8,%eax
  649. movl %eax,-4(%ebp)
  650. end ['EAX'];
  651. end;
  652. {$I386_ATT} {can be removed}
  653. {$I386_DIRECT} {can be removed}
  654. {$ASMMODE ATT}
  655. {
  656. $Log$
  657. Revision 1.16 1998-07-02 12:55:04 carl
  658. * Put back DoError, DO NOT TOUCH!
  659. Revision 1.15 1998/07/02 12:19:32 carl
  660. + IO-Error and Overflow now print address in hex
  661. Revision 1.14 1998/07/01 15:29:58 peter
  662. * better readln/writeln
  663. Revision 1.13 1998/06/26 08:20:57 daniel
  664. - Doerror removed.
  665. Revision 1.12 1998/05/31 14:15:47 peter
  666. * force to use ATT or direct parsing
  667. Revision 1.11 1998/05/30 14:30:21 peter
  668. * force att reading
  669. Revision 1.10 1998/05/25 10:40:49 peter
  670. * remake3 works again on tflily
  671. Revision 1.5 1998/04/29 13:28:19 peter
  672. * some cleanup and i386_att usage
  673. Revision 1.4 1998/04/10 15:41:54 florian
  674. + some small comments added
  675. Revision 1.3 1998/04/10 15:25:23 michael
  676. - Removed so-called better random function
  677. Revision 1.2 1998/04/08 07:53:31 michael
  678. + Changed Random() function. Moved from system to processor dependent files (from Pedro Gimeno)
  679. }