! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: layouts namespaces kernel accessors sequences
classes.algebra compiler.tree.propagation.info
compiler.cfg.stacks compiler.cfg.hats compiler.cfg.instructions
compiler.cfg.utilities ;
IN: compiler.cfg.intrinsics.slots

: value-tag ( info -- n ) class>> class-tag ; inline

: (emit-slot) ( infos -- dst )
    [ 2inputs ^^offset>slot ] [ first value-tag ] bi*
    ^^slot ;

: (emit-slot-imm) ( infos -- dst )
    ds-drop
    [ ds-pop ]
    [ [ second literal>> ] [ first value-tag ] bi ] bi*
    ^^slot-imm ;

: emit-slot ( node -- )
    dup node-input-infos
    dup first value-tag [
        nip
        dup second value-info-small-fixnum?
        [ (emit-slot-imm) ] [ (emit-slot) ] if
        ds-push
    ] [ drop emit-primitive ] if ;

: (emit-set-slot) ( infos -- obj-reg )
    [ 3inputs [ tuck ] dip ^^offset>slot ]
    [ second value-tag ]
    bi* ^^set-slot ;

: (emit-set-slot-imm) ( infos -- obj-reg )
    ds-drop
    [ 2inputs tuck ]
    [ [ third literal>> ] [ second value-tag ] bi ] bi*
    ##set-slot-imm ;

: emit-set-slot ( node -- )
    dup node-input-infos
    dup second value-tag [
        nip
        [
            dup third value-info-small-fixnum?
            [ (emit-set-slot-imm) ] [ (emit-set-slot) ] if
        ] [ first class>> immediate class<= ] bi
        [ drop ] [ i i ##write-barrier ] if
    ] [ drop emit-primitive ] if ;

: emit-string-nth ( -- )
    2inputs swap ^^untag-fixnum ^^string-nth ^^tag-fixnum ds-push ;

: emit-set-string-nth-fast ( -- )
    3inputs [ ^^untag-fixnum ] [ ^^untag-fixnum ] [ ] tri*
    swap i ##set-string-nth-fast ;