1 ! Copyright (C) 2005, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
4 USING: accessors assocs alien alien.c-types arrays strings
5 cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
6 cpu.architecture kernel kernel.private math memory namespaces make
7 sequences words system layouts combinators math.order fry locals
8 compiler.constants byte-arrays
10 compiler.cfg.instructions
11 compiler.cfg.intrinsics
12 compiler.cfg.comparisons
13 compiler.cfg.stack-frame
15 compiler.codegen.fixup ;
17 USING: accessors alien combinators compiler.cfg.comparisons
18 compiler.cfg.intrinsics compiler.cfg.registers
19 compiler.cfg.stack-frame compiler.codegen.fixup compiler.constants
20 cpu.architecture cpu.x86.assembler cpu.x86.assembler.operands fry
21 kernel layouts locals make math math.order namespaces sequences system
23 >>>>>>> Added a vm C-STRUCT, using it for struct offsets in x86 asm
26 << enable-fixnum-log2 >>
28 ! Add some methods to the assembler to be more useful to the backend
29 M: label JMP 0 JMP rc-relative label-fixup ;
30 M: label JUMPcc [ 0 ] dip JUMPcc rc-relative label-fixup ;
32 M: x86 two-operand? t ;
34 HOOK: stack-reg cpu ( -- reg )
36 HOOK: reserved-area-size cpu ( -- n )
38 : stack@ ( n -- op ) stack-reg swap [+] ;
40 : param@ ( n -- op ) reserved-area-size + stack@ ;
42 : spill@ ( n -- op ) spill-offset param@ ;
44 : gc-root@ ( n -- op ) gc-root-offset param@ ;
46 : decr-stack-reg ( n -- )
47 dup 0 = [ drop ] [ stack-reg swap SUB ] if ;
49 : incr-stack-reg ( n -- )
50 dup 0 = [ drop ] [ stack-reg swap ADD ] if ;
52 : align-stack ( n -- n' )
53 os macosx? cpu x86.64? or [ 16 align ] when ;
55 M: x86 stack-frame-size ( stack-frame -- i )
56 (stack-frame-size) 3 cells reserved-area-size + + align-stack ;
58 ! Must be a volatile register not used for parameter passing, for safe
59 ! use in calls in and out of C
60 HOOK: temp-reg cpu ( -- reg )
62 ! Fastcall calling convention
63 HOOK: param-reg-1 cpu ( -- reg )
64 HOOK: param-reg-2 cpu ( -- reg )
66 HOOK: pic-tail-reg cpu ( -- reg )
68 M: x86 %load-immediate dup 0 = [ drop dup XOR ] [ MOV ] if ;
70 M: x86 %load-reference swap 0 MOV rc-absolute-cell rel-immediate ;
72 HOOK: ds-reg cpu ( -- reg )
73 HOOK: rs-reg cpu ( -- reg )
75 : reg-stack ( n reg -- op ) swap cells neg [+] ;
77 GENERIC: loc>operand ( loc -- operand )
79 M: ds-loc loc>operand n>> ds-reg reg-stack ;
80 M: rs-loc loc>operand n>> rs-reg reg-stack ;
82 M: x86 %peek loc>operand MOV ;
83 M: x86 %replace loc>operand swap MOV ;
84 : (%inc) ( n reg -- ) swap cells dup 0 > [ ADD ] [ neg SUB ] if ; inline
85 M: x86 %inc-d ( n -- ) ds-reg (%inc) ;
86 M: x86 %inc-r ( n -- ) rs-reg (%inc) ;
88 M: x86 %call ( word -- ) 0 CALL rc-relative rel-word-pic ;
90 : xt-tail-pic-offset ( -- n )
91 #! See the comment in vm/cpu-x86.hpp
94 M: x86 %jump ( word -- )
95 pic-tail-reg 0 MOV xt-tail-pic-offset rc-absolute-cell rel-here
96 0 JMP rc-relative rel-word-pic-tail ;
98 M: x86 %jump-label ( label -- ) 0 JMP rc-relative label-fixup ;
100 M: x86 %return ( -- ) 0 RET ;
102 : code-alignment ( align -- n )
103 [ building get length dup ] dip align swap - ;
105 : align-code ( n -- )
108 :: (%slot) ( obj slot tag temp -- op )
109 temp slot obj [+] LEA
110 temp tag neg [+] ; inline
112 :: (%slot-imm) ( obj slot tag -- op )
113 obj slot cells tag - [+] ; inline
115 M: x86 %slot ( dst obj slot tag temp -- ) (%slot) MOV ;
116 M: x86 %slot-imm ( dst obj slot tag -- ) (%slot-imm) MOV ;
117 M: x86 %set-slot ( src obj slot tag temp -- ) (%slot) swap MOV ;
118 M: x86 %set-slot-imm ( src obj slot tag -- ) (%slot-imm) swap MOV ;
120 M: x86 %add 2over eq? [ nip ADD ] [ [+] LEA ] if ;
121 M: x86 %add-imm 2over eq? [ nip ADD ] [ [+] LEA ] if ;
122 M: x86 %sub nip SUB ;
123 M: x86 %sub-imm 2over eq? [ nip SUB ] [ neg [+] LEA ] if ;
124 M: x86 %mul nip swap IMUL2 ;
125 M: x86 %mul-imm IMUL3 ;
126 M: x86 %and nip AND ;
127 M: x86 %and-imm nip AND ;
129 M: x86 %or-imm nip OR ;
130 M: x86 %xor nip XOR ;
131 M: x86 %xor-imm nip XOR ;
132 M: x86 %shl-imm nip SHL ;
133 M: x86 %shr-imm nip SHR ;
134 M: x86 %sar-imm nip SAR ;
136 M: x86 %min nip [ CMP ] [ CMOVG ] 2bi ;
137 M: x86 %max nip [ CMP ] [ CMOVL ] 2bi ;
139 M: x86 %not drop NOT ;
142 GENERIC: copy-register* ( dst src rep -- )
144 M: int-rep copy-register* drop MOV ;
145 M: tagged-rep copy-register* drop MOV ;
146 M: float-rep copy-register* drop MOVSS ;
147 M: double-rep copy-register* drop MOVSD ;
148 M: float-4-rep copy-register* drop MOVUPS ;
149 M: double-2-rep copy-register* drop MOVUPD ;
150 M: vector-rep copy-register* drop MOVDQU ;
152 : copy-register ( dst src rep -- )
153 2over eq? [ 3drop ] [ copy-register* ] if ;
155 M: x86 %copy ( dst src rep -- ) copy-register ;
157 :: overflow-template ( label dst src1 src2 insn -- )
161 M: x86 %fixnum-add ( label dst src1 src2 -- )
162 [ ADD ] overflow-template ;
164 M: x86 %fixnum-sub ( label dst src1 src2 -- )
165 [ SUB ] overflow-template ;
167 M: x86 %fixnum-mul ( label dst src1 src2 -- )
168 [ swap IMUL2 ] overflow-template ;
170 : bignum@ ( reg n -- op )
171 cells bignum tag-number - [+] ; inline
173 M:: x86 %integer>bignum ( dst src temp -- )
174 #! on entry, inreg is a signed 32-bit quantity
175 #! exits with tagged ptr to bignum in outreg
176 #! 1 cell header, 1 cell length, 1 cell sign, + digits
177 #! length is the # of digits + sign
180 ! Load cached zero value
181 dst 0 >bignum %load-reference
183 ! Is it zero? Then just go to the end and return this zero
186 dst 4 cells bignum temp %allot
188 dst 1 bignum@ 2 tag-fixnum MOV
190 dst 3 bignum@ src MOV
193 temp cell-bits 1 - SAR
196 dst 2 bignum@ temp MOV
197 ! Make negative value positive
203 dst 3 bignum@ temp MOV
207 M:: x86 %bignum>integer ( dst src temp -- )
211 temp src 1 bignum@ MOV
212 ! if the length is 1, its just the sign and nothing else,
215 temp 1 tag-fixnum CMP
218 dst src 3 bignum@ MOV
220 temp src 2 bignum@ MOV
221 ! convert it into -1 or 1
230 M: x86 %add-float nip ADDSD ;
231 M: x86 %sub-float nip SUBSD ;
232 M: x86 %mul-float nip MULSD ;
233 M: x86 %div-float nip DIVSD ;
234 M: x86 %min-float nip MINSD ;
235 M: x86 %max-float nip MAXSD ;
236 M: x86 %sqrt SQRTSD ;
238 M: x86 %single>double-float CVTSS2SD ;
239 M: x86 %double>single-float CVTSD2SS ;
241 M: x86 %integer>float CVTSI2SD ;
242 M: x86 %float>integer CVTTSD2SI ;
244 M: x86 %unbox-float ( dst src -- )
245 float-offset [+] MOVSD ;
247 M:: x86 %box-float ( dst src temp -- )
248 dst 16 float temp %allot
249 dst float-offset [+] src MOVSD ;
251 M:: x86 %box-vector ( dst src rep temp -- )
252 dst rep rep-size 2 cells + byte-array temp %allot
253 16 tag-fixnum dst 1 byte-array tag-number %set-slot-imm
254 dst byte-array-offset [+]
255 src rep copy-register ;
257 M:: x86 %unbox-vector ( dst src rep -- )
258 dst src byte-array-offset [+]
261 M: x86 %broadcast-vector ( dst src rep -- )
263 { float-4-rep [ [ MOVSS ] [ drop dup 0 SHUFPS ] 2bi ] }
264 { double-2-rep [ [ MOVSD ] [ drop dup UNPCKLPD ] 2bi ] }
267 M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- )
280 M:: x86 %gather-vector-2 ( dst src1 src2 rep -- )
291 M: x86 %add-vector ( dst src1 src2 rep -- )
293 { float-4-rep [ ADDPS ] }
294 { double-2-rep [ ADDPD ] }
295 { char-16-rep [ PADDB ] }
296 { uchar-16-rep [ PADDB ] }
297 { short-8-rep [ PADDW ] }
298 { ushort-8-rep [ PADDW ] }
299 { int-4-rep [ PADDD ] }
300 { uint-4-rep [ PADDD ] }
303 M: x86 %sub-vector ( dst src1 src2 rep -- )
305 { float-4-rep [ SUBPS ] }
306 { double-2-rep [ SUBPD ] }
307 { char-16-rep [ PSUBB ] }
308 { uchar-16-rep [ PSUBB ] }
309 { short-8-rep [ PSUBW ] }
310 { ushort-8-rep [ PSUBW ] }
311 { int-4-rep [ PSUBD ] }
312 { uint-4-rep [ PSUBD ] }
315 M: x86 %mul-vector ( dst src1 src2 rep -- )
317 { float-4-rep [ MULPS ] }
318 { double-2-rep [ MULPD ] }
319 { int-4-rep [ PMULLW ] }
322 M: x86 %div-vector ( dst src1 src2 rep -- )
324 { float-4-rep [ DIVPS ] }
325 { double-2-rep [ DIVPD ] }
328 M: x86 %min-vector ( dst src1 src2 rep -- )
330 { float-4-rep [ MINPS ] }
331 { double-2-rep [ MINPD ] }
334 M: x86 %max-vector ( dst src1 src2 rep -- )
336 { float-4-rep [ MAXPS ] }
337 { double-2-rep [ MAXPD ] }
340 M: x86 %sqrt-vector ( dst src rep -- )
342 { float-4-rep [ SQRTPS ] }
343 { double-2-rep [ SQRTPD ] }
346 M: x86 %horizontal-add-vector ( dst src rep -- )
348 { float-4-rep [ [ MOVAPS ] [ HADDPS ] [ HADDPS ] 2tri ] }
349 { double-2-rep [ [ MOVAPD ] [ HADDPD ] 2bi ] }
352 M: x86 %unbox-alien ( dst src -- )
353 alien-offset [+] MOV ;
355 M:: x86 %unbox-any-c-ptr ( dst src temp -- )
357 { "is-byte-array" "end" "start" } [ define-label ] each
360 ! We come back here with displaced aliens
361 "start" resolve-label
363 temp \ f tag-number CMP
365 ! Is the object an alien?
366 temp header-offset [+] alien type-number tag-fixnum CMP
367 "is-byte-array" get JNE
368 ! If so, load the offset and add it to the address
369 dst temp alien-offset [+] ADD
370 ! Now recurse on the underlying alien
371 temp temp underlying-alien-offset [+] MOV
373 "is-byte-array" resolve-label
374 ! Add byte array address to address being computed
376 ! Add an offset to start of byte array's data
377 dst byte-array-offset ADD
381 : alien@ ( reg n -- op ) cells alien tag-number - [+] ;
383 :: %allot-alien ( dst displacement base temp -- )
384 dst 4 cells alien temp %allot
385 dst 1 alien@ base MOV ! alien
386 dst 2 alien@ \ f tag-number MOV ! expired
387 dst 3 alien@ displacement MOV ! displacement
390 M:: x86 %box-alien ( dst src temp -- )
393 dst \ f tag-number MOV
396 dst src \ f tag-number temp %allot-alien
400 M:: x86 %box-displaced-alien ( dst displacement base displacement' base' base-class -- )
404 ! If displacement is zero, return the base
408 ! Quickly use displacement' before its needed for real, as allot temporary
409 dst 4 cells alien displacement' %allot
410 ! If base is already a displaced alien, unpack it
412 displacement' displacement MOV
413 base \ f tag-number CMP
415 base header-offset [+] alien type-number tag-fixnum CMP
417 ! displacement += base.displacement
418 displacement' base 3 alien@ ADD
420 base' base 1 alien@ MOV
422 dst 1 alien@ base' MOV ! alien
423 dst 2 alien@ \ f tag-number MOV ! expired
424 dst 3 alien@ displacement' MOV ! displacement
428 ! The 'small-reg' mess is pretty crappy, but its only used on x86-32.
429 ! On x86-64, all registers have 8-bit versions. However, a similar
430 ! problem arises for shifts, where the shift count must be in CL, and
431 ! so one day I will fix this properly by adding precoloring to the
432 ! register allocator.
434 HOOK: has-small-reg? cpu ( reg size -- ? )
436 CONSTANT: have-byte-regs { EAX ECX EDX EBX }
438 M: x86.32 has-small-reg?
440 { 8 [ have-byte-regs memq? ] }
445 M: x86.64 has-small-reg? 2drop t ;
447 : small-reg-that-isn't ( exclude -- reg' )
448 [ have-byte-regs ] dip
449 [ native-version-of ] map
450 '[ _ memq? not ] find nip ;
452 : with-save/restore ( reg quot -- )
453 [ drop PUSH ] [ call ] [ drop POP ] 2tri ; inline
455 :: with-small-register ( dst exclude size quot: ( new-dst -- ) -- )
456 ! If the destination register overlaps a small register with
457 ! 'size' bits, we call the quot with that. Otherwise, we find a
458 ! small register that is not in exclude, and call quot, saving and
459 ! restoring the small register.
460 dst size has-small-reg? [ dst quot call ] [
461 exclude small-reg-that-isn't
462 [ quot call ] with-save/restore
465 : ?MOV ( dst src -- )
466 2dup = [ 2drop ] [ MOV ] if ; inline
468 M:: x86 %string-nth ( dst src index temp -- )
469 ! We request a small-reg of size 8 since those of size 16 are
472 dst { src index temp } 8 [| new-dst |
473 ! Load the least significant 7 bits into new-dst.
474 ! 8th bit indicates whether we have to load from
475 ! the aux vector or not.
476 temp src index [+] LEA
477 new-dst 8-bit-version-of temp string-offset [+] MOV
478 new-dst new-dst 8-bit-version-of MOVZX
479 ! Do we have to look at the aux vector?
482 ! Yes, this is a non-ASCII character. Load aux vector
483 temp src string-aux-offset [+] MOV
489 new-dst 16-bit-version-of new-dst byte-array-offset [+] MOV
490 new-dst new-dst 16-bit-version-of MOVZX
496 ] with-small-register ;
498 M:: x86 %set-string-nth-fast ( ch str index temp -- )
499 ch { index str temp } 8 [| new-ch |
501 temp str index [+] LEA
502 temp string-offset [+] new-ch 8-bit-version-of MOV
503 ] with-small-register ;
505 :: %alien-integer-getter ( dst src size quot -- )
506 dst { src } size [| new-dst |
507 new-dst dup size n-bit-version-of dup src [] MOV
510 ] with-small-register ; inline
512 : %alien-unsigned-getter ( dst src size -- )
513 [ MOVZX ] %alien-integer-getter ; inline
515 M: x86 %alien-unsigned-1 8 %alien-unsigned-getter ;
516 M: x86 %alien-unsigned-2 16 %alien-unsigned-getter ;
517 M: x86 %alien-unsigned-4 32 [ 2drop ] %alien-integer-getter ;
519 : %alien-signed-getter ( dst src size -- )
520 [ MOVSX ] %alien-integer-getter ; inline
522 M: x86 %alien-signed-1 8 %alien-signed-getter ;
523 M: x86 %alien-signed-2 16 %alien-signed-getter ;
524 M: x86 %alien-signed-4 32 %alien-signed-getter ;
526 M: x86 %alien-cell [] MOV ;
527 M: x86 %alien-float [] MOVSS ;
528 M: x86 %alien-double [] MOVSD ;
529 M: x86 %alien-vector [ [] ] dip copy-register ;
531 :: %alien-integer-setter ( ptr value size -- )
532 value { ptr } size [| new-value |
534 ptr [] new-value size n-bit-version-of MOV
535 ] with-small-register ; inline
537 M: x86 %set-alien-integer-1 8 %alien-integer-setter ;
538 M: x86 %set-alien-integer-2 16 %alien-integer-setter ;
539 M: x86 %set-alien-integer-4 32 %alien-integer-setter ;
540 M: x86 %set-alien-cell [ [] ] dip MOV ;
541 M: x86 %set-alien-float [ [] ] dip MOVSS ;
542 M: x86 %set-alien-double [ [] ] dip MOVSD ;
543 M: x86 %set-alien-vector [ [] ] 2dip copy-register ;
545 : shift-count? ( reg -- ? ) { ECX RCX } memq? ;
547 :: emit-shift ( dst src1 src2 quot -- )
556 ECX native-version-of [
558 drop dst CL quot call
563 M: x86 %shl [ SHL ] emit-shift ;
564 M: x86 %shr [ SHR ] emit-shift ;
565 M: x86 %sar [ SAR ] emit-shift ;
567 : load-zone-ptr ( reg -- )
568 #! Load pointer to start of zone array
569 [ 0 MOV rc-absolute-cell rt-vm rel-fixup ]
570 [ "nursery" vm-field-offset ADD ] bi ;
572 : load-allot-ptr ( nursery-ptr allot-ptr -- )
573 [ drop load-zone-ptr ] [ swap cell [+] MOV ] 2bi ;
575 : inc-allot-ptr ( nursery-ptr n -- )
576 [ cell [+] ] dip 8 align ADD ;
578 : store-header ( temp class -- )
579 [ [] ] [ type-number tag-fixnum ] bi* MOV ;
581 : store-tagged ( dst tag -- )
584 M:: x86 %allot ( dst size class nursery-ptr -- )
585 nursery-ptr dst load-allot-ptr
586 dst class store-header
587 dst class store-tagged
588 nursery-ptr size inc-allot-ptr ;
590 : %vm-field-ptr ( reg field -- )
591 [ drop 0 MOV rc-absolute-cell rt-vm rel-fixup ]
592 [ vm-field-offset ADD ] 2bi ;
594 M:: x86 %write-barrier ( src card# table -- )
595 #! Mark the card pointed to by vreg.
599 table "cards_offset" %vm-field-ptr
601 table card# [+] card-mark <byte> MOV
604 card# deck-bits card-bits - SHR
605 table "decks_offset" %vm-field-ptr
607 table card# [+] card-mark <byte> MOV ;
609 M:: x86 %check-nursery ( label temp1 temp2 -- )
611 temp2 temp1 cell [+] MOV
613 temp1 temp1 3 cells [+] MOV
617 M: x86 %save-gc-root ( gc-root register -- ) [ gc-root@ ] dip MOV ;
619 M: x86 %load-gc-root ( gc-root register -- ) swap gc-root@ MOV ;
621 M:: x86 %call-gc ( gc-root-count -- )
622 ! Pass pointer to start of GC roots as first parameter
623 param-reg-1 gc-root-base param@ LEA
624 ! Pass number of roots as second parameter
625 param-reg-2 gc-root-count MOV
627 "inline_gc" f %vm-invoke ;
629 M: x86 %alien-global ( dst symbol library -- )
630 [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
632 M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
634 :: %boolean ( dst temp word -- )
635 dst \ f tag-number MOV
636 temp 0 MOV \ t rc-absolute-cell rel-immediate
637 dst temp word execute ; inline
639 M:: x86 %compare ( dst src1 src2 cc temp -- )
642 { cc< [ dst temp \ CMOVL %boolean ] }
643 { cc<= [ dst temp \ CMOVLE %boolean ] }
644 { cc> [ dst temp \ CMOVG %boolean ] }
645 { cc>= [ dst temp \ CMOVGE %boolean ] }
646 { cc= [ dst temp \ CMOVE %boolean ] }
647 { cc/= [ dst temp \ CMOVNE %boolean ] }
650 M: x86 %compare-imm ( dst src1 src2 cc temp -- )
653 : %cmov-float= ( dst src -- )
655 "no-move" define-label
657 "no-move" get [ JNE ] [ JP ] bi
659 "no-move" resolve-label
662 : %cmov-float/= ( dst src -- )
664 "no-move" define-label
671 "no-move" resolve-label
674 :: (%compare-float) ( dst src1 src2 cc temp compare -- )
676 { cc< [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVA %boolean ] }
677 { cc<= [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVAE %boolean ] }
678 { cc> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVA %boolean ] }
679 { cc>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVAE %boolean ] }
680 { cc= [ src1 src2 \ compare execute( a b -- ) dst temp \ %cmov-float= %boolean ] }
681 { cc<> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVNE %boolean ] }
682 { cc<>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVNP %boolean ] }
683 { cc/< [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVBE %boolean ] }
684 { cc/<= [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVB %boolean ] }
685 { cc/> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVBE %boolean ] }
686 { cc/>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVB %boolean ] }
687 { cc/= [ src1 src2 \ compare execute( a b -- ) dst temp \ %cmov-float/= %boolean ] }
688 { cc/<> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVE %boolean ] }
689 { cc/<>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVP %boolean ] }
692 M: x86 %compare-float-ordered ( dst src1 src2 cc temp -- )
693 \ COMISD (%compare-float) ;
695 M: x86 %compare-float-unordered ( dst src1 src2 cc temp -- )
696 \ UCOMISD (%compare-float) ;
698 M:: x86 %compare-branch ( label src1 src2 cc -- )
702 { cc<= [ label JLE ] }
704 { cc>= [ label JGE ] }
706 { cc/= [ label JNE ] }
709 M: x86 %compare-imm-branch ( label src1 src2 cc -- )
712 : %jump-float= ( label -- )
714 "no-jump" define-label
717 "no-jump" resolve-label
720 : %jump-float/= ( label -- )
723 :: (%compare-float-branch) ( label src1 src2 cc compare -- )
725 { cc< [ src2 src1 \ compare execute( a b -- ) label JA ] }
726 { cc<= [ src2 src1 \ compare execute( a b -- ) label JAE ] }
727 { cc> [ src1 src2 \ compare execute( a b -- ) label JA ] }
728 { cc>= [ src1 src2 \ compare execute( a b -- ) label JAE ] }
729 { cc= [ src1 src2 \ compare execute( a b -- ) label %jump-float= ] }
730 { cc<> [ src1 src2 \ compare execute( a b -- ) label JNE ] }
731 { cc<>= [ src1 src2 \ compare execute( a b -- ) label JNP ] }
732 { cc/< [ src2 src1 \ compare execute( a b -- ) label JBE ] }
733 { cc/<= [ src2 src1 \ compare execute( a b -- ) label JB ] }
734 { cc/> [ src1 src2 \ compare execute( a b -- ) label JBE ] }
735 { cc/>= [ src1 src2 \ compare execute( a b -- ) label JB ] }
736 { cc/= [ src1 src2 \ compare execute( a b -- ) label %jump-float/= ] }
737 { cc/<> [ src1 src2 \ compare execute( a b -- ) label JE ] }
738 { cc/<>= [ src1 src2 \ compare execute( a b -- ) label JP ] }
741 M: x86 %compare-float-ordered-branch ( label src1 src2 cc -- )
742 \ COMISD (%compare-float-branch) ;
744 M: x86 %compare-float-unordered-branch ( label src1 src2 cc -- )
745 \ UCOMISD (%compare-float-branch) ;
747 M:: x86 %spill ( src rep n -- )
748 n spill@ src rep copy-register ;
750 M:: x86 %reload ( dst rep n -- )
751 dst n spill@ rep copy-register ;
753 M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
755 M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
756 #! Save Factor stack pointers in case the C code calls a
757 #! callback which does a GC, which must reliably trace
759 temp1 0 MOV rc-absolute-cell rt-vm rel-fixup
760 temp1 temp1 "stack_chain" vm-field-offset [+] MOV
761 temp2 stack-reg cell neg [+] LEA
764 temp1 2 cells [+] ds-reg MOV
765 temp1 3 cells [+] rs-reg MOV
768 M: x86 value-struct? drop t ;
770 M: x86 small-enough? ( n -- ? )
771 HEX: -80000000 HEX: 7fffffff between? ;
773 : next-stack@ ( n -- operand )
774 #! nth parameter from the next stack frame. Used to box
775 #! input values to callbacks; the callback has its own
776 #! stack frame set up, and we want to read the frame
777 #! set up by the caller.
778 stack-frame get total-size>> + stack@ ;
781 enable-float-intrinsics