2005-05-13 00:09:49 -04:00
|
|
|
! Copyright (C) 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
IN: compiler-backend
|
2005-12-02 02:25:44 -05:00
|
|
|
USING: alien arrays assembler compiler inference kernel
|
2005-05-13 00:09:49 -04:00
|
|
|
kernel-internals lists math memory namespaces sequences words ;
|
|
|
|
|
|
|
|
M: %slot generate-node ( vop -- )
|
2005-12-04 22:06:12 -05:00
|
|
|
drop
|
2005-05-13 00:09:49 -04:00
|
|
|
! turn tagged fixnum slot # into an offset, multiple of 4
|
2005-12-07 03:37:05 -05:00
|
|
|
0 input-operand fixnum>slot@
|
2005-12-07 21:46:54 -05:00
|
|
|
! compute slot address
|
2005-12-06 20:42:17 -05:00
|
|
|
dest/src ADD
|
2005-12-07 21:46:54 -05:00
|
|
|
! load slot value
|
2005-12-04 22:06:12 -05:00
|
|
|
0 output-operand dup 1array MOV ;
|
2005-05-13 00:09:49 -04:00
|
|
|
|
|
|
|
M: %fast-slot generate-node ( vop -- )
|
2005-12-05 19:07:41 -05:00
|
|
|
drop 0 output-operand 1 input-operand 0 input 2array MOV ;
|
2005-05-13 00:09:49 -04:00
|
|
|
|
2005-12-05 19:07:41 -05:00
|
|
|
: card-offset 1 getenv ; inline
|
2005-05-13 20:37:28 -04:00
|
|
|
|
2005-06-04 02:20:54 -04:00
|
|
|
M: %write-barrier generate-node ( vop -- )
|
2005-12-06 20:42:17 -05:00
|
|
|
#! Mark the card pointed to by vreg. This could be a tad
|
|
|
|
#! shorter on x86 (use indirect addressing instead of a
|
|
|
|
#! scratch register) however on AMD64, you cannot do this
|
|
|
|
#! with a 64-bit immediate. So we avoid code duplication by
|
|
|
|
#! sacrificing a few bytes of generated code size.
|
2005-12-04 22:06:12 -05:00
|
|
|
drop
|
2005-12-06 20:42:17 -05:00
|
|
|
0 input-operand card-bits SHR
|
|
|
|
0 scratch card-offset MOV 0 rel-cards
|
|
|
|
0 scratch 0 input-operand ADD
|
|
|
|
0 scratch 1array card-mark OR ;
|
2005-05-13 00:09:49 -04:00
|
|
|
|
|
|
|
M: %set-slot generate-node ( vop -- )
|
2005-12-04 22:06:12 -05:00
|
|
|
drop
|
2005-12-04 22:55:02 -05:00
|
|
|
! turn tagged fixnum slot # into an offset
|
|
|
|
2 input-operand fixnum>slot@
|
2005-12-07 21:46:54 -05:00
|
|
|
! compute slot address
|
2005-12-04 22:06:12 -05:00
|
|
|
2 input-operand 1 input-operand ADD
|
2005-05-13 00:09:49 -04:00
|
|
|
! store new slot value
|
2005-12-05 19:07:41 -05:00
|
|
|
2 input-operand 1array 0 input-operand MOV ;
|
2005-05-13 00:09:49 -04:00
|
|
|
|
|
|
|
M: %fast-set-slot generate-node ( vop -- )
|
2005-12-06 20:42:17 -05:00
|
|
|
drop 1 input-operand 2 input 2array 0 input-operand MOV ;
|
2005-05-13 20:37:28 -04:00
|
|
|
|
2005-12-04 22:06:12 -05:00
|
|
|
: userenv@ ( n -- addr ) cell * "userenv" f dlsym + ;
|
2005-05-13 20:37:28 -04:00
|
|
|
|
|
|
|
M: %getenv generate-node ( vop -- )
|
2005-12-04 22:06:12 -05:00
|
|
|
drop
|
|
|
|
0 output-operand 0 input userenv@ 1array MOV
|
|
|
|
0 input 0 rel-userenv ;
|
2005-05-13 20:37:28 -04:00
|
|
|
|
|
|
|
M: %setenv generate-node ( vop -- )
|
2005-12-04 22:06:12 -05:00
|
|
|
drop
|
|
|
|
1 input userenv@ 1array 0 input-operand MOV
|
2005-12-07 22:31:16 -05:00
|
|
|
1 input 0 rel-userenv ;
|