factor/library/compiler/x86/generator.factor

97 lines
2.8 KiB
Factor
Raw Normal View History

2005-02-14 21:58:07 -05:00
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
2005-05-09 02:34:15 -04:00
IN: compiler-backend
2005-12-02 02:25:44 -05:00
USING: alien arrays assembler compiler inference kernel
2005-05-09 02:34:15 -04:00
kernel-internals lists math memory namespaces sequences words ;
2005-01-08 16:43:18 -05:00
2005-05-06 18:33:40 -04:00
! Not used on x86
M: %prologue generate-node drop ;
2005-01-08 16:43:18 -05:00
: compile-dlsym ( symbol dll quot -- )
>r 2dup dlsym r> call 1 0 rel-dlsym ; inline
: compile-c-call ( symbol dll -- ) [ CALL ] compile-dlsym ;
M: %call generate-node ( vop -- )
2005-12-04 19:56:42 -05:00
drop label dup postpone-word CALL ;
2005-05-06 18:33:40 -04:00
M: %call-label generate-node ( vop -- )
2005-12-04 19:56:42 -05:00
drop label CALL ;
2005-03-21 20:53:26 -05:00
2005-05-06 18:33:40 -04:00
M: %jump generate-node ( vop -- )
2005-12-04 19:56:42 -05:00
drop label dup postpone-word JMP ;
2005-03-19 00:30:49 -05:00
M: %jump-label generate-node ( vop -- )
2005-12-04 19:56:42 -05:00
drop label JMP ;
2005-05-06 18:33:40 -04:00
M: %jump-t generate-node ( vop -- )
2005-12-04 19:56:42 -05:00
drop
! Compare input with f
0 input-operand f address CMP
! If not equal, jump
label JNE ;
2005-05-06 18:33:40 -04:00
M: %return-to generate-node ( vop -- )
2005-12-04 19:56:42 -05:00
drop 0 PUSH label absolute-4 ;
2005-05-06 18:33:40 -04:00
M: %return generate-node ( vop -- )
drop RET ;
M: %dispatch generate-node ( vop -- )
2005-01-08 16:43:18 -05:00
#! Compile a piece of code that jumps to an offset in a
#! jump table indexed by the fixnum at the top of the stack.
#! The jump table must immediately follow this macro.
2005-12-04 19:56:42 -05:00
<label> "end" set
drop
! Untag and multiply by 4 to get a jump table offset
2005-12-04 19:56:42 -05:00
0 input-operand tag-bits 2 - SHR
! Add to jump table base
2005-12-04 19:56:42 -05:00
0 input-operand HEX: ffff ADD "end" get absolute-4
! Jump to jump table entry
2005-12-04 19:56:42 -05:00
0 input-operand 1array JMP
! Align for better performance
2005-01-08 16:43:18 -05:00
compile-aligned
! Fix up jump table pointer
2005-12-04 19:56:42 -05:00
"end" get save-xt ;
M: %type generate-node ( vop -- )
#! Intrinstic version of type primitive.
2005-12-04 19:56:42 -05:00
drop
<label> "header" set
<label> "f" set
<label> "end" set
! Make a copy
2005-12-04 22:06:12 -05:00
0 scratch 0 output-operand MOV
! Get the tag
2005-12-04 19:56:42 -05:00
0 output-operand tag-mask AND
! Compare with object tag number (3).
2005-12-04 19:56:42 -05:00
0 output-operand object-tag CMP
! Jump if the object doesn't store type info in its header
"header" get JE
! It doesn't store type info in its header
2005-12-04 19:56:42 -05:00
0 output-operand tag-bits SHL
"end" get JMP
"header" get save-xt
! It does store type info in its header
! Is the pointer itself equal to 3? Then its F_TYPE (9).
2005-12-04 22:06:12 -05:00
0 scratch object-tag CMP
"f" get JE
! The pointer is not equal to 3. Load the object header.
2005-12-04 19:56:42 -05:00
0 output-operand ECX object-tag neg 2array MOV
! Mask off header tag, making a fixnum.
2005-12-04 19:56:42 -05:00
0 output-operand object-tag XOR
"end" get JMP
"f" get save-xt
! The pointer is equal to 3. Load F_TYPE (9).
2005-12-04 19:56:42 -05:00
0 output-operand f type tag-bits shift MOV
"end" get save-xt ;
M: %tag generate-node ( vop -- )
2005-12-04 19:56:42 -05:00
drop
0 input-operand tag-mask AND
0 input-operand tag-bits SHL ;
M: %untag generate-node ( vop -- )
2005-12-04 19:56:42 -05:00
drop
0 output-operand tag-mask bitnot AND ;