2005-01-06 21:42:07 -05:00
|
|
|
! Copyright (C) 2005 Slava Pestov.
|
2005-02-14 21:58:07 -05:00
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
2005-05-09 02:34:15 -04:00
|
|
|
IN: compiler-backend
|
|
|
|
USING: alien assembler compiler inference kernel lists math
|
|
|
|
memory sequences words ;
|
2005-01-06 21:42:07 -05:00
|
|
|
|
|
|
|
: rel-cs ( -- )
|
|
|
|
#! Add an entry to the relocation table for the 32-bit
|
|
|
|
#! immediate just compiled.
|
2005-05-13 18:27:18 -04:00
|
|
|
"cs" f 0 0 rel-dlsym ;
|
2005-01-06 21:42:07 -05:00
|
|
|
|
|
|
|
: CS ( -- [ address ] ) "cs" f dlsym unit ;
|
|
|
|
: CS> ( register -- ) CS MOV rel-cs ;
|
|
|
|
: >CS ( register -- ) CS swap MOV rel-cs ;
|
|
|
|
|
2005-05-06 18:33:40 -04:00
|
|
|
: reg-stack ( reg n -- op ) cell * neg 2list ;
|
|
|
|
: ds-op ( n -- op ) ESI swap reg-stack ;
|
2005-05-07 22:39:00 -04:00
|
|
|
: cs-op ( n -- op ) ECX swap reg-stack ;
|
2005-01-06 21:42:07 -05:00
|
|
|
|
2005-05-06 18:33:40 -04:00
|
|
|
M: %peek-d generate-node ( vop -- )
|
2005-05-16 17:01:39 -04:00
|
|
|
dup vop-out-1 v>operand swap vop-in-1 ds-op MOV ;
|
2005-01-06 21:42:07 -05:00
|
|
|
|
2005-05-06 18:33:40 -04:00
|
|
|
M: %replace-d generate-node ( vop -- )
|
2005-05-16 17:01:39 -04:00
|
|
|
dup vop-in-2 v>operand swap vop-in-1 ds-op swap MOV ;
|
2005-01-06 21:42:07 -05:00
|
|
|
|
2005-05-06 18:33:40 -04:00
|
|
|
M: %inc-d generate-node ( vop -- )
|
2005-05-16 17:01:39 -04:00
|
|
|
ESI swap vop-in-1 cell *
|
2005-05-09 02:34:15 -04:00
|
|
|
dup 0 > [ ADD ] [ neg SUB ] ifte ;
|
2005-01-06 21:42:07 -05:00
|
|
|
|
2005-05-06 18:33:40 -04:00
|
|
|
M: %immediate generate-node ( vop -- )
|
2005-05-16 17:01:39 -04:00
|
|
|
dup vop-out-1 v>operand swap vop-in-1 address MOV ;
|
2005-01-06 21:42:07 -05:00
|
|
|
|
2005-05-07 22:39:00 -04:00
|
|
|
: load-indirect ( dest literal -- )
|
2005-05-13 18:27:18 -04:00
|
|
|
intern-literal unit MOV 0 0 rel-address ;
|
2005-05-07 22:39:00 -04:00
|
|
|
|
2005-05-06 18:33:40 -04:00
|
|
|
M: %indirect generate-node ( vop -- )
|
|
|
|
#! indirect load of a literal through a table
|
2005-05-16 17:01:39 -04:00
|
|
|
dup vop-out-1 v>operand swap vop-in-1 load-indirect ;
|
2005-01-06 21:42:07 -05:00
|
|
|
|
2005-05-06 18:33:40 -04:00
|
|
|
M: %peek-r generate-node ( vop -- )
|
2005-05-16 17:01:39 -04:00
|
|
|
ECX CS> dup vop-out-1 v>operand swap vop-in-1 cs-op MOV ;
|
2005-01-06 21:42:07 -05:00
|
|
|
|
2005-05-06 18:33:40 -04:00
|
|
|
M: %dec-r generate-node ( vop -- )
|
|
|
|
#! Can only follow a %peek-r
|
2005-05-16 17:01:39 -04:00
|
|
|
vop-in-1 ECX swap cell * SUB ECX >CS ;
|
2005-01-06 21:42:07 -05:00
|
|
|
|
2005-05-06 18:33:40 -04:00
|
|
|
M: %replace-r generate-node ( vop -- )
|
|
|
|
#! Can only follow a %inc-r
|
2005-05-16 17:01:39 -04:00
|
|
|
dup vop-in-2 v>operand swap vop-in-1 cs-op swap MOV
|
2005-05-06 18:33:40 -04:00
|
|
|
ECX >CS ;
|
2005-01-06 21:42:07 -05:00
|
|
|
|
2005-05-06 18:33:40 -04:00
|
|
|
M: %inc-r generate-node ( vop -- )
|
|
|
|
#! Can only follow a %peek-r
|
2005-01-06 21:42:07 -05:00
|
|
|
ECX CS>
|
2005-05-16 17:01:39 -04:00
|
|
|
vop-in-1 ECX swap cell * ADD ;
|