timo/decont Secret

## decont
(template: decont
    (if (all 3
            (nz $1)
            (zr (^is_type_obj $1))
            (load (addr (^stable $1) (&offsetof MVMSTable container_spec)) ptr_sz)
        )
        (call
                (^func (load (addr
                    (load (addr (^stable $1) (&offsetof MVMSTable container_spec)) ptr_sz)
                    (&offsetof MVMContainerSpec fetch)) ptr_sz))
                (arglist 3
                    (carg (tc) ptr)
                    (carg $1 ptr)
                    (carg $0 ptr)
                )
                ptr
        )
        (copy $1)
    )
)

            OP(decont): {
                MVMObject *obj = GET_REG(cur_op, 2).o;
                MVMRegister *r = &GET_REG(cur_op, 0);
                cur_op += 4;
                if (obj && IS_CONCRETE(obj) && STABLE(obj)->container_spec)
                    STABLE(obj)->container_spec->fetch(tc, obj, r);
                else
                    r->o = obj;
                goto NEXT;
            }

## gistfile1.txt
# SYNTAX: opcode ':' s-exp
#    s-exp represents tree

# Number with dollars stand for the arguments of the opcode.  The
# opcode preprocessor inserts loads, and immediate nodes for arguments
# automatically.

(template: const_i16 (copy $1))
(template: const_i64_16 (copy $1))
(template: const_i64_32 (copy $1))
(template: const_i64 (copy $1))
(macro: ^cu_string (,a) (idx (load (addr (cu) (&offsetof MVMCompUnit body.strings)) ptr_sz)
                                    ,a ptr_sz))
(template: const_s (load (^cu_string $1) ptr_sz))

(template: set (copy $1))
(template: add_i (add $1 $2))
(template: sub_i (sub $1 $2))
(template: inc_i (add $0 (const 1 int_sz)))
(template: dec_i (sub $0 (const 1 int_sz)))

(macro: ^parg (,a) (idx (load (addr (frame) (&offsetof MVMFrame params.args)) ptr_sz) ,a reg_sz))
(template: sp_getarg_o (load (^parg $1) ptr_sz))
(template: sp_getarg_s (load (^parg $1) ptr_sz))
(template: sp_getarg_i (load (^parg $1) int_sz))
(template: sp_getarg_n (load (^parg $1) int_sz))

(macro: ^params () (addr (frame) (&offsetof MVMFrame params)) )
(macro: ^caller () (addr (frame) (&offsetof MVMFrame caller)) )

(macro: ^func (,a) (const (&CONST_PTR ,a) ptr_sz))
(macro: ^p6obody (,a) (let: (($replace (load (addr ,a (&offsetof MVMP6opaque body.replaced)) ptr_sz)))
                      (if (nz $replace)
                              $replace
                              (addr ,a (&offsetof MVMP6opaque body)))))
# get spesh slot address
(macro: ^spesh_slot (,a)
   (idx (load
            (addr (frame) (&offsetof MVMFrame effective_spesh_slots))
             ptr_sz)
       ,a ptr_sz))


(template: sp_getspeshslot (load (^spesh_slot $1) ptr_sz))

(template: sp_p6oget_i (load (add (^p6obody $1) $2) int_sz))
(template: sp_p6oget_n (load (add (^p6obody $1) $2) (&sizeof MVMnum64)))
(template: sp_p6oget_s (load (add (^p6obody $1) $2) ptr_sz))
(template: sp_p6oget_o
           (let: (($val (load (add (^p6obody $1) $2) ptr_sz)))
                (if (nz $val) $val (vmnull))))

# hit write barrier for object - this one is rather large
# NB - it is probably better to use direct variables, rather than trees,
# as arguments to the write-barrier macro. Usually the compiler can
# eliminate duplications, but call is a notable exception

(macro: ^write_barrier (,obj ,ref)
        (let: (($obj_flags (load (addr ,obj (&offsetof MVMCollectable flags)) 2))
               ($ref_flags (load (addr ,ref (&offsetof MVMCollectable flags)) 2)))
              (when (all 3 (nz (and $obj_flags (const (&QUOTE MVM_CF_SECOND_GEN) 2)))
                           (nz ,ref)
                           (zr (and $ref_flags (const (&QUOTE MVM_CF_SECOND_GEN) 2))))
                     (call (^func &MVM_gc_write_barrier_hit)
                           (arglist 2 (carg (tc) ptr)
                                      (carg ,obj ptr))
                            void))))

(template: sp_p6ogetvt_o
           (let: (($addr (add (^p6obody $1) $2))
                 ($val (load $addr ptr_sz))
                 ($type (load (^spesh_slot $3) ptr_sz)))
                 (if (nz $val)
                      $val
                      (do 3 (^write_barrier $1 $type)
                            (store $addr $type ptr_sz)
                             $type))))

(template: sp_p6obind_i (store (add (^p6obody $0) $1) $2 int_sz))
(template: sp_p6obind_n (store (add (^p6obody $0) $1) $2 int_sz))
(template: sp_p6obind_o (let: (($addr (add (^p6obody $0) $1)))
                             (do 2 (^write_barrier $0 $2)
                                   (store $addr $2 ptr_sz))))
(template: sp_p6obind_s (let: (($addr (add (^p6obody $0) $1)))
                             (do 2 (^write_barrier $0 $2)
                                   (store $addr $2 ptr_sz))))

(template: null_s (const 0 ptr_sz))
(template: null (vmnull))

(macro: ^stable (,a) (load (addr ,a (&offsetof MVMObject st)) ptr_sz))
(macro: ^repr (,a) (load (addr (^stable ,a) (&offsetof MVMSTable REPR)) ptr_sz))
(macro: ^is_type_obj (,a)
  (nz (and (load (addr ,a (&offsetof MVMObject header.flags)) (&SIZEOF_MEMBER MVMObject header.flags))
           (const (&QUOTE MVM_CF_TYPE_OBJECT) (&SIZEOF_MEMBER MVMObject header.flags)))))


(template: getwhat (load (addr (^stable $1) (&offsetof MVMSTable WHAT)) ptr_sz))
(template: getwho  (let: (($who (load (addr (^stable $1) (&offsetof MVMSTable WHO)) ptr_sz)))
                         (if (nz $who) $who (vmnull))))


(template: say (call (^func &MVM_string_say)
                     (arglist 2 (carg (tc) ptr)
                                (carg $0 ptr))
                     void))


(template: getlex_no
  (let: (($res
    (call (^func &MVM_frame_find_lexical_by_name)
          (arglist 3 (carg (tc) ptr)
                     (carg (load (^cu_string $1) ptr_sz) ptr)
                     (carg (const (&QUOTE MVM_reg_obj) int_sz) int))
           ptr)))
   (if (nz $res) (load $res ptr_sz) $res)))


(template: wval (call (^func MVM_sc_get_sc_object)
                      (arglist 4 (carg (tc) ptr)
                                 (carg (cu) ptr)
                                 (carg $1 int)
                                 (carg $2 int))
                       ptr))

(template: goto (branch (label $0)))

(macro: ^jump_out () (branch (label (const branch_exit int_sz))))

(template: return
  (do 3
     (call (^func &MVM_args_assert_void_return_ok)
           (arglist 2
              (carg (tc) ptr)
              (carg (const 0 int_sz) int))
           void)
     (call (^func &MVM_frame_try_return)
           (arglist 1 (carg (tc) ptr))
           void)
     (^jump_out)))

(template: return_o
  (do 3
     (call (^func &MVM_args_set_result_obj)
           (arglist 3
              (carg (tc) ptr)
              (carg $0 ptr)
              (carg (const 0 int_sz) int))
           void)
     (call (^func &MVM_frame_try_return)
           (arglist 1 (carg (tc) ptr))
           void)
     (^jump_out)))

(template: setdispatcher
  (store (addr (tc) (&offsetof MVMThreadContext cur_dispatcher))
         $0 ptr_sz))

(template: takedispatcher
  (let: (($cur (load (addr (tc) (&offsetof MVMThreadContext cur_dispatcher)) ptr_sz)))
        (do 2
           (store (addr (tc) (&offsetof MVMThreadContext cur_dispatcher))
                        (const 0 ptr_sz) ptr_sz)
            $cur)))

(macro: ^hllconfig ()
    ($hllconf (load (addr (cu) (&offsetof MVMCompUnit body.hll_config)) ptr_sz)))

(template: hllboxtype_i
    (load (addr (^hllconfig) (&offsetof MVMHLLConfig int_box_type)) ptr_sz))

(template: curcode
  (load (addr (frame) (&offsetof MVMFrame code_ref)) ptr_sz))

(template: getcode
  (let: (($arr (load (addr (cu) (&offsetof MVMCompUnit body.coderefs)) ptr_sz)))
        (load (idx $arr $1 ptr_sz) ptr_sz)))

(template: callercode
  (let: (($caller (load (addr (frame) (&offsetof MVMFrame caller)) ptr_sz)))
        (if (nz $caller)
            (load (addr $caller (&offsetof MVMFrame code_ref)) ptr_sz)
            (const 0 ptr_sz))))

(template: sp_fastcreate
   (let: (($block
           (call (^func &MVM_gc_allocate_zeroed)
                 (arglist 2 (carg (tc) ptr)
                            (carg $1 int))
                  ptr)))
      (do 4
        (store (addr $block (&offsetof MVMObject st)) (load (^spesh_slot $2) ptr_sz) ptr_sz)
        (store (addr $block (&offsetof MVMObject header.size)) $1 2)
        (store (addr $block (&offsetof MVMObject header.owner))
               (load (addr (tc) (&offsetof MVMThreadContext thread_id)) 4) 4)
        $block)))

(macro: ^throw_adhoc (,msg)
   (call (^func &MVM_exception_throw_adhoc)
         (arglist 2 (carg (tc) ptr)
                    (carg (const ,msg ptr_sz) ptr))
         void))

(template: ifnonnull
    (when (any 2
            (nz $0) (ne $0 (vmnull)))
        (branch (label $1)) ))

(template: ctxcode
  (do 2
    (when (any 2 (^is_type_obj $1)
                 (ne (load (addr (^repr $1) (&offsetof MVMREPROps ID)) (&SIZEOF_MEMBER MVMREPROps ID))
                     (const (&QUOTE MVM_REPR_ID_MVMContext) (&SIZEOF_MEMBER MVMREPROps ID))))
          (^throw_adhoc (&MSG ctxcode needs an MVMContext)))
    (load (addr (load (addr $1 (&offsetof MVMContext body.context)) ptr_sz)
                (&offsetof MVMFrame code_ref)) ptr_sz)))

# These properly yield a flag, not a register value.
# I maybe want to add a flag-to-register op

#(template: isnull_s
#  (nz $1))

#(template: eq_i
#  (eq $1 $2))

#(template: not_i
#  (zr $1)

(macro: ^body (,a) (addr ,a (&offsetof MVMObjectStooge data)))
#  GET_REG(cur_op, 0).i64 = (MVMint64)REPR(obj)->elems(tc, STABLE(obj), obj, OBJECT_BODY(obj));
(template: elems
   (let: (($func (load (addr (^repr $1) (&offsetof MVMREPROps elems)) ptr_sz)))
        (call $func
              (arglist 4
                (carg (tc) ptr)
                (carg (^stable $1) ptr)
                (carg $1 ptr)
                (carg (^body $1) ptr))
              int)))

#  REPR(obj)->pos_funcs.at_pos(tc, STABLE(obj), obj,
#       OBJECT_BODY(obj), GET_REG(cur_op, 4).i64,
#       &GET_REG(cur_op, 0), MVM_reg_obj);
(template: atpos_o!
# maybe have another operator for statement if-with-else
  (let: (($addr (copy $0)))
    (either (^is_type_obj $1)
      (store $addr (vmnull) ptr_sz)
# else
      (call (load (addr (^repr $1) (&offsetof MVMREPROps pos_funcs.at_pos)) ptr_sz)
         (arglist 7
           (carg (tc) ptr)
           (carg (^stable $1) ptr)
           (carg $1 ptr)
           (carg (^body $1) ptr)
           (carg $2 int)
# our write address
           (carg $addr ptr)
           (carg (const (&QUOTE MVM_reg_obj) int_sz) int))
         void))))
	(template: decont
	(if (all 3
	(nz $1)
	(zr (^is_type_obj $1))
	(load (addr (^stable $1) (&offsetof MVMSTable container_spec)) ptr_sz)
	)
	(call
	(^func (load (addr
	(load (addr (^stable $1) (&offsetof MVMSTable container_spec)) ptr_sz)
	(&offsetof MVMContainerSpec fetch)) ptr_sz))
	(arglist 3
	(carg (tc) ptr)
	(carg $1 ptr)
	(carg $0 ptr)
	)
	ptr
	)
	(copy $1)
	)
	)

	OP(decont): {
	MVMObject *obj = GET_REG(cur_op, 2).o;
	MVMRegister *r = &GET_REG(cur_op, 0);
	cur_op += 4;
	if (obj && IS_CONCRETE(obj) && STABLE(obj)->container_spec)
	STABLE(obj)->container_spec->fetch(tc, obj, r);
	else
	r->o = obj;
	goto NEXT;
	}
	# SYNTAX: opcode ':' s-exp
	# s-exp represents tree

	# Number with dollars stand for the arguments of the opcode. The
	# opcode preprocessor inserts loads, and immediate nodes for arguments
	# automatically.

	(template: const_i16 (copy $1))
	(template: const_i64_16 (copy $1))
	(template: const_i64_32 (copy $1))
	(template: const_i64 (copy $1))
	(macro: ^cu_string (,a) (idx (load (addr (cu) (&offsetof MVMCompUnit body.strings)) ptr_sz)
	,a ptr_sz))
	(template: const_s (load (^cu_string $1) ptr_sz))

	(template: set (copy $1))
	(template: add_i (add $1 $2))
	(template: sub_i (sub $1 $2))
	(template: inc_i (add $0 (const 1 int_sz)))
	(template: dec_i (sub $0 (const 1 int_sz)))

	(macro: ^parg (,a) (idx (load (addr (frame) (&offsetof MVMFrame params.args)) ptr_sz) ,a reg_sz))
	(template: sp_getarg_o (load (^parg $1) ptr_sz))
	(template: sp_getarg_s (load (^parg $1) ptr_sz))
	(template: sp_getarg_i (load (^parg $1) int_sz))
	(template: sp_getarg_n (load (^parg $1) int_sz))

	(macro: ^params () (addr (frame) (&offsetof MVMFrame params)) )
	(macro: ^caller () (addr (frame) (&offsetof MVMFrame caller)) )

	(macro: ^func (,a) (const (&CONST_PTR ,a) ptr_sz))
	(macro: ^p6obody (,a) (let: (($replace (load (addr ,a (&offsetof MVMP6opaque body.replaced)) ptr_sz)))
	(if (nz $replace)
	$replace
	(addr ,a (&offsetof MVMP6opaque body)))))
	# get spesh slot address
	(macro: ^spesh_slot (,a)
	(idx (load
	(addr (frame) (&offsetof MVMFrame effective_spesh_slots))
	ptr_sz)
	,a ptr_sz))


	(template: sp_getspeshslot (load (^spesh_slot $1) ptr_sz))

	(template: sp_p6oget_i (load (add (^p6obody $1) $2) int_sz))
	(template: sp_p6oget_n (load (add (^p6obody $1) $2) (&sizeof MVMnum64)))
	(template: sp_p6oget_s (load (add (^p6obody $1) $2) ptr_sz))
	(template: sp_p6oget_o
	(let: (($val (load (add (^p6obody $1) $2) ptr_sz)))
	(if (nz $val) $val (vmnull))))

	# hit write barrier for object - this one is rather large
	# NB - it is probably better to use direct variables, rather than trees,
	# as arguments to the write-barrier macro. Usually the compiler can
	# eliminate duplications, but call is a notable exception

	(macro: ^write_barrier (,obj ,ref)
	(let: (($obj_flags (load (addr ,obj (&offsetof MVMCollectable flags)) 2))
	($ref_flags (load (addr ,ref (&offsetof MVMCollectable flags)) 2)))
	(when (all 3 (nz (and $obj_flags (const (&QUOTE MVM_CF_SECOND_GEN) 2)))
	(nz ,ref)
	(zr (and $ref_flags (const (&QUOTE MVM_CF_SECOND_GEN) 2))))
	(call (^func &MVM_gc_write_barrier_hit)
	(arglist 2 (carg (tc) ptr)
	(carg ,obj ptr))
	void))))

	(template: sp_p6ogetvt_o
	(let: (($addr (add (^p6obody $1) $2))
	($val (load $addr ptr_sz))
	($type (load (^spesh_slot $3) ptr_sz)))
	(if (nz $val)
	$val
	(do 3 (^write_barrier $1 $type)
	(store $addr $type ptr_sz)
	$type))))

	(template: sp_p6obind_i (store (add (^p6obody $0) $1) $2 int_sz))
	(template: sp_p6obind_n (store (add (^p6obody $0) $1) $2 int_sz))
	(template: sp_p6obind_o (let: (($addr (add (^p6obody $0) $1)))
	(do 2 (^write_barrier $0 $2)
	(store $addr $2 ptr_sz))))
	(template: sp_p6obind_s (let: (($addr (add (^p6obody $0) $1)))
	(do 2 (^write_barrier $0 $2)
	(store $addr $2 ptr_sz))))

	(template: null_s (const 0 ptr_sz))
	(template: null (vmnull))

	(macro: ^stable (,a) (load (addr ,a (&offsetof MVMObject st)) ptr_sz))
	(macro: ^repr (,a) (load (addr (^stable ,a) (&offsetof MVMSTable REPR)) ptr_sz))
	(macro: ^is_type_obj (,a)
	(nz (and (load (addr ,a (&offsetof MVMObject header.flags)) (&SIZEOF_MEMBER MVMObject header.flags))
	(const (&QUOTE MVM_CF_TYPE_OBJECT) (&SIZEOF_MEMBER MVMObject header.flags)))))



	(template: getwhat (load (addr (^stable $1) (&offsetof MVMSTable WHAT)) ptr_sz))
	(template: getwho (let: (($who (load (addr (^stable $1) (&offsetof MVMSTable WHO)) ptr_sz)))
	(if (nz $who) $who (vmnull))))


	(template: say (call (^func &MVM_string_say)
	(arglist 2 (carg (tc) ptr)
	(carg $0 ptr))
	void))


	(template: getlex_no
	(let: (($res
	(call (^func &MVM_frame_find_lexical_by_name)
	(arglist 3 (carg (tc) ptr)
	(carg (load (^cu_string $1) ptr_sz) ptr)
	(carg (const (&QUOTE MVM_reg_obj) int_sz) int))
	ptr)))
	(if (nz $res) (load $res ptr_sz) $res)))


	(template: wval (call (^func MVM_sc_get_sc_object)
	(arglist 4 (carg (tc) ptr)
	(carg (cu) ptr)
	(carg $1 int)
	(carg $2 int))
	ptr))

	(template: goto (branch (label $0)))

	(macro: ^jump_out () (branch (label (const branch_exit int_sz))))

	(template: return
	(do 3
	(call (^func &MVM_args_assert_void_return_ok)
	(arglist 2
	(carg (tc) ptr)
	(carg (const 0 int_sz) int))
	void)
	(call (^func &MVM_frame_try_return)
	(arglist 1 (carg (tc) ptr))
	void)
	(^jump_out)))

	(template: return_o
	(do 3
	(call (^func &MVM_args_set_result_obj)
	(arglist 3
	(carg (tc) ptr)
	(carg $0 ptr)
	(carg (const 0 int_sz) int))
	void)
	(call (^func &MVM_frame_try_return)
	(arglist 1 (carg (tc) ptr))
	void)
	(^jump_out)))

	(template: setdispatcher
	(store (addr (tc) (&offsetof MVMThreadContext cur_dispatcher))
	$0 ptr_sz))

	(template: takedispatcher
	(let: (($cur (load (addr (tc) (&offsetof MVMThreadContext cur_dispatcher)) ptr_sz)))
	(do 2
	(store (addr (tc) (&offsetof MVMThreadContext cur_dispatcher))
	(const 0 ptr_sz) ptr_sz)
	$cur)))

	(macro: ^hllconfig ()
	($hllconf (load (addr (cu) (&offsetof MVMCompUnit body.hll_config)) ptr_sz)))

	(template: hllboxtype_i
	(load (addr (^hllconfig) (&offsetof MVMHLLConfig int_box_type)) ptr_sz))

	(template: curcode
	(load (addr (frame) (&offsetof MVMFrame code_ref)) ptr_sz))

	(template: getcode
	(let: (($arr (load (addr (cu) (&offsetof MVMCompUnit body.coderefs)) ptr_sz)))
	(load (idx $arr $1 ptr_sz) ptr_sz)))

	(template: callercode
	(let: (($caller (load (addr (frame) (&offsetof MVMFrame caller)) ptr_sz)))
	(if (nz $caller)
	(load (addr $caller (&offsetof MVMFrame code_ref)) ptr_sz)
	(const 0 ptr_sz))))

	(template: sp_fastcreate
	(let: (($block
	(call (^func &MVM_gc_allocate_zeroed)
	(arglist 2 (carg (tc) ptr)
	(carg $1 int))
	ptr)))
	(do 4
	(store (addr $block (&offsetof MVMObject st)) (load (^spesh_slot $2) ptr_sz) ptr_sz)
	(store (addr $block (&offsetof MVMObject header.size)) $1 2)
	(store (addr $block (&offsetof MVMObject header.owner))
	(load (addr (tc) (&offsetof MVMThreadContext thread_id)) 4) 4)
	$block)))

	(macro: ^throw_adhoc (,msg)
	(call (^func &MVM_exception_throw_adhoc)
	(arglist 2 (carg (tc) ptr)
	(carg (const ,msg ptr_sz) ptr))
	void))

	(template: ifnonnull
	(when (any 2
	(nz $0) (ne $0 (vmnull)))
	(branch (label $1)) ))

	(template: ctxcode
	(do 2
	(when (any 2 (^is_type_obj $1)
	(ne (load (addr (^repr $1) (&offsetof MVMREPROps ID)) (&SIZEOF_MEMBER MVMREPROps ID))
	(const (&QUOTE MVM_REPR_ID_MVMContext) (&SIZEOF_MEMBER MVMREPROps ID))))
	(^throw_adhoc (&MSG ctxcode needs an MVMContext)))
	(load (addr (load (addr $1 (&offsetof MVMContext body.context)) ptr_sz)
	(&offsetof MVMFrame code_ref)) ptr_sz)))

	# These properly yield a flag, not a register value.
	# I maybe want to add a flag-to-register op

	#(template: isnull_s
	# (nz $1))

	#(template: eq_i
	# (eq $1 $2))

	#(template: not_i
	# (zr $1)

	(macro: ^body (,a) (addr ,a (&offsetof MVMObjectStooge data)))
	# GET_REG(cur_op, 0).i64 = (MVMint64)REPR(obj)->elems(tc, STABLE(obj), obj, OBJECT_BODY(obj));
	(template: elems
	(let: (($func (load (addr (^repr $1) (&offsetof MVMREPROps elems)) ptr_sz)))
	(call $func
	(arglist 4
	(carg (tc) ptr)
	(carg (^stable $1) ptr)
	(carg $1 ptr)
	(carg (^body $1) ptr))
	int)))

	# REPR(obj)->pos_funcs.at_pos(tc, STABLE(obj), obj,
	# OBJECT_BODY(obj), GET_REG(cur_op, 4).i64,
	# &GET_REG(cur_op, 0), MVM_reg_obj);
	(template: atpos_o!
	# maybe have another operator for statement if-with-else
	(let: (($addr (copy $0)))
	(either (^is_type_obj $1)
	(store $addr (vmnull) ptr_sz)
	# else
	(call (load (addr (^repr $1) (&offsetof MVMREPROps pos_funcs.at_pos)) ptr_sz)
	(arglist 7
	(carg (tc) ptr)
	(carg (^stable $1) ptr)
	(carg $1 ptr)
	(carg (^body $1) ptr)
	(carg $2 int)
	# our write address
	(carg $addr ptr)
	(carg (const (&QUOTE MVM_reg_obj) int_sz) int))
	void))))