111 lines
2.5 KiB
Factor
111 lines
2.5 KiB
Factor
! Copyright (C) 2008 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors namespaces math kernel alien classes ;
|
|
IN: compiler.cfg.registers
|
|
|
|
! Virtual CPU registers, used by CFG and machine IRs
|
|
|
|
MIXIN: value
|
|
|
|
GENERIC: >vreg ( obj -- vreg )
|
|
GENERIC: set-value-class ( class obj -- )
|
|
GENERIC: value-class* ( operand -- class )
|
|
|
|
: value-class ( operand -- class ) value-class* object or ;
|
|
|
|
M: value >vreg drop f ;
|
|
M: value set-value-class 2drop ;
|
|
M: value value-class* drop f ;
|
|
|
|
! Register classes
|
|
SINGLETON: int-regs
|
|
SINGLETON: single-float-regs
|
|
SINGLETON: double-float-regs
|
|
UNION: float-regs single-float-regs double-float-regs ;
|
|
UNION: reg-class int-regs float-regs ;
|
|
|
|
! Virtual registers
|
|
TUPLE: vreg reg-class n ;
|
|
SYMBOL: vreg-counter
|
|
: next-vreg ( reg-class -- vreg ) \ vreg-counter counter vreg boa ;
|
|
|
|
M: vreg >vreg ;
|
|
|
|
INSTANCE: vreg value
|
|
|
|
! Stack locations
|
|
TUPLE: loc n class ;
|
|
|
|
! A data stack location.
|
|
TUPLE: ds-loc < loc ;
|
|
: <ds-loc> ( n -- loc ) f ds-loc boa ;
|
|
|
|
TUPLE: rs-loc < loc ;
|
|
: <rs-loc> ( n -- loc ) f rs-loc boa ;
|
|
|
|
INSTANCE: loc value
|
|
|
|
! A stack location which has been loaded into a register. To
|
|
! read the location, we just read the register, but when time
|
|
! comes to save it back to the stack, we know the register just
|
|
! contains a stack value so we don't have to redundantly write
|
|
! it back.
|
|
TUPLE: cached loc vreg ;
|
|
C: <cached> cached
|
|
|
|
M: cached set-value-class vreg>> set-value-class ;
|
|
M: cached value-class* vreg>> value-class* ;
|
|
M: cached >vreg vreg>> >vreg ;
|
|
|
|
INSTANCE: cached value
|
|
|
|
! A tagged pointer
|
|
TUPLE: tagged vreg class ;
|
|
: <tagged> ( vreg -- tagged ) f tagged boa ;
|
|
|
|
M: tagged set-value-class (>>class) ;
|
|
M: tagged value-class* class>> ;
|
|
M: tagged >vreg vreg>> ;
|
|
|
|
INSTANCE: tagged value
|
|
|
|
! Unboxed value
|
|
TUPLE: unboxed vreg ;
|
|
C: <unboxed> unboxed
|
|
|
|
M: unboxed >vreg vreg>> ;
|
|
|
|
INSTANCE: unboxed value
|
|
|
|
! Unboxed alien pointer
|
|
TUPLE: unboxed-alien < unboxed ;
|
|
C: <unboxed-alien> unboxed-alien
|
|
|
|
M: unboxed-alien value-class* drop simple-alien ;
|
|
|
|
! Untagged byte array pointer
|
|
TUPLE: unboxed-byte-array < unboxed ;
|
|
C: <unboxed-byte-array> unboxed-byte-array
|
|
|
|
M: unboxed-byte-array value-class* drop c-ptr ;
|
|
|
|
! A register set to f
|
|
TUPLE: unboxed-f < unboxed ;
|
|
C: <unboxed-f> unboxed-f
|
|
|
|
M: unboxed-f value-class* drop \ f ;
|
|
|
|
! An alien, byte array or f
|
|
TUPLE: unboxed-c-ptr < unboxed ;
|
|
C: <unboxed-c-ptr> unboxed-c-ptr
|
|
|
|
M: unboxed-c-ptr value-class* drop c-ptr ;
|
|
|
|
! A constant value
|
|
TUPLE: constant value ;
|
|
C: <constant> constant
|
|
|
|
M: constant value-class* value>> class ;
|
|
|
|
INSTANCE: constant value
|