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
|
|
|
|
USING: alien assembler compiler inference kernel
|
|
|
|
kernel-internals lists math memory namespaces sequences words ;
|
|
|
|
|
|
|
|
M: %slot generate-node ( vop -- )
|
|
|
|
dest/src
|
|
|
|
! turn tagged fixnum slot # into an offset, multiple of 4
|
|
|
|
dup 1 SHR
|
2005-09-08 22:23:54 -04:00
|
|
|
! compute slot address in 0 vop-out
|
2005-05-13 00:09:49 -04:00
|
|
|
dupd ADD
|
2005-09-08 22:23:54 -04:00
|
|
|
! load slot value in 0 vop-out
|
2005-05-13 00:09:49 -04:00
|
|
|
dup unit MOV ;
|
|
|
|
|
|
|
|
M: %fast-slot generate-node ( vop -- )
|
2005-09-08 22:23:54 -04:00
|
|
|
dup 0 vop-in swap 0 vop-out v>operand tuck >r 2list r>
|
2005-05-13 00:09:49 -04:00
|
|
|
swap MOV ;
|
|
|
|
|
2005-05-13 20:37:28 -04:00
|
|
|
: card-offset 1 getenv ;
|
|
|
|
|
2005-06-04 02:20:54 -04:00
|
|
|
M: %write-barrier generate-node ( vop -- )
|
2005-05-13 20:37:28 -04:00
|
|
|
#! Mark the card pointed to by vreg.
|
2005-09-08 22:23:54 -04:00
|
|
|
0 vop-in v>operand
|
2005-05-13 20:37:28 -04:00
|
|
|
dup card-bits SHR
|
2005-05-14 00:23:00 -04:00
|
|
|
card-offset 2list card-mark OR
|
|
|
|
0 rel-cards ;
|
2005-05-13 00:09:49 -04:00
|
|
|
|
|
|
|
M: %set-slot generate-node ( vop -- )
|
2005-09-08 22:23:54 -04:00
|
|
|
dup 2 vop-in v>operand over 1 vop-in v>operand
|
2005-05-13 00:09:49 -04:00
|
|
|
! turn tagged fixnum slot # into an offset, multiple of 4
|
|
|
|
over 1 SHR
|
2005-09-08 22:23:54 -04:00
|
|
|
! compute slot address in 1 vop-in
|
2005-06-04 02:20:54 -04:00
|
|
|
dupd ADD
|
2005-05-13 00:09:49 -04:00
|
|
|
! store new slot value
|
2005-09-08 22:23:54 -04:00
|
|
|
>r 0 vop-in v>operand r> unit swap MOV ;
|
2005-05-13 00:09:49 -04:00
|
|
|
|
|
|
|
M: %fast-set-slot generate-node ( vop -- )
|
2005-09-08 22:23:54 -04:00
|
|
|
dup 2 vop-in over 1 vop-in v>operand
|
|
|
|
swap 2list swap 0 vop-in v>operand MOV ;
|
2005-05-13 20:37:28 -04:00
|
|
|
|
|
|
|
: userenv@ ( n -- addr )
|
|
|
|
cell * "userenv" f dlsym + ;
|
|
|
|
|
|
|
|
M: %getenv generate-node ( vop -- )
|
2005-09-08 22:23:54 -04:00
|
|
|
dup 0 vop-out v>operand swap 0 vop-in
|
2005-05-14 00:23:00 -04:00
|
|
|
[ userenv@ unit MOV ] keep 0 rel-userenv ;
|
2005-05-13 20:37:28 -04:00
|
|
|
|
|
|
|
M: %setenv generate-node ( vop -- )
|
2005-09-08 22:23:54 -04:00
|
|
|
dup 1 vop-in
|
|
|
|
[ userenv@ unit swap 0 vop-in v>operand MOV ] keep
|
2005-05-14 00:23:00 -04:00
|
|
|
0 rel-userenv ;
|