# -*-whitespace-*-

(macro: ^addrf (,object ,type ,field)
    (addr ,object (&offsetof ,type ,field)))
(macro: ^getf (,object ,type ,field)
   (load (^addrf ,object ,type ,field) (&SIZEOF_MEMBER ,type ,field)))
(macro: ^setf (,object ,type ,field ,value)
    (store (^addrf ,object ,type ,field) ,value (&SIZEOF_MEMBER ,type ,field)))

(macro: ^getf_scast (,object ,type ,field ,cast_to_sz)
  (scast
    (^getf ,object ,type ,field)
    ,cast_to_sz (&SIZEOF_MEMBER ,type ,field)))

(macro: ^getf_ucast (,object ,type ,field ,cast_to_sz)
  (ucast
    (^getf ,object ,type ,field)
    ,cast_to_sz (&SIZEOF_MEMBER ,type ,field)))

(macro: ^cu_callsite_addr (,a) (idx  (^getf (cu) MVMCompUnit body.callsites) ,a ptr_sz))

(macro: ^frame    () (^getf (tc) MVMThreadContext cur_frame))
(macro: ^arg_source () (^getf (^frame) MVMFrame params.arg_info.source))
(macro: ^arg_map () (^getf (^frame) MVMFrame params.arg_info.map))
(macro: ^source_arg_addr (,a) (idx (^arg_source) (load (idx (^arg_map) ,a 2) 2) reg_sz))

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

# get spesh slot address
(macro: ^spesh_slot_addr (,a)
   (idx (^getf (^frame) MVMFrame effective_spesh_slots) ,a ptr_sz))
(macro: ^spesh_slot_value (,a)
    (load (^spesh_slot_addr ,a) ptr_sz))

(macro: ^get_instance_field (,field)
    (^getf
          (^getf (tc) MVMThreadContext instance)
          MVMInstance ,field))

(macro: ^vmnull ()
    (^get_instance_field VMNull))

(macro: ^is_vmnull (,obj)
    (nz (or (flagval (zr ,obj)) (flagval (eq ,obj (^vmnull))))))

(macro: ^stable (,a) (^getf ,a MVMObject st))

(macro: ^hllconfig ()
    (^getf (cu) MVMCompUnit body.hll_config))

(macro: ^exit () (branch (label branch_exit)))

(macro: ^func (,x) (const_ptr ,x))

(macro: ^p6obody (,a)
   (let: (($replace (^getf ,a MVMP6opaque body.replaced)))
         (if (nz $replace)
              $replace
              (addr ,a (&offsetof MVMP6opaque body)))))


(macro: ^indirect_cu_string (,cu ,a)
    (let: (($str (load (idx (^getf ,cu  MVMCompUnit body.strings) ,a ptr_sz) ptr_sz)))
    (if (nz $str) $str
        (call (^func MVM_cu_string)
              (arglist (carg (tc) ptr) (carg ,cu ptr) (carg ,a int))
              ptr_sz))))

(macro: ^cu_string (,a)
    (^indirect_cu_string (cu) ,a))

(macro: ^objflag1 (,cv) (const (&QUOTE ,cv) (&SIZEOF_MEMBER MVMObject header.flags1)))
(macro: ^objflag2 (,cv) (const (&QUOTE ,cv) (&SIZEOF_MEMBER MVMObject header.flags2)))

(macro: ^write_barrier (,root ,obj)
  (when (all (nz (and (^getf ,root MVMCollectable flags2) (^objflag2 MVM_CF_SECOND_GEN)))
             (nz ,obj)
             (zr (and (^getf ,obj MVMCollectable flags2) (^objflag2 MVM_CF_SECOND_GEN))))
    (callv (^func &MVM_gc_write_barrier_hit_by)
     (arglist (carg (tc) ptr)
              (carg ,root ptr)
              (carg ,obj ptr)))))

(macro: ^store_write_barrier! (,root ,addr ,obj)
  (dov
    (store ,addr ,obj ptr_sz)
    (^write_barrier ,root ,obj)))


(macro: ^repr (,obj) (^getf (^stable ,obj) MVMSTable REPR))
(macro: ^repr_id (,obj) (^getf (^repr ,obj) MVMREPROps ID))
(macro: ^is_repr_id (,obj ,id) (eq (^repr_id ,obj) (const (&QUOTE ,id) (&SIZEOF_MEMBER MVMREPROps ID))))
(macro: ^not_repr_id (,obj ,id) (ne (^repr_id ,obj) (const (&QUOTE ,id) (&SIZEOF_MEMBER MVMREPROps ID))))

(macro: ^is_type_obj (,a)
    (nz (and (^getf ,a MVMObject header.flags1) (^objflag1 MVM_CF_TYPE_OBJECT))))
(macro: ^is_conc_obj (,a)
    (zr (and (^getf ,a MVMObject header.flags1) (^objflag1 MVM_CF_TYPE_OBJECT))))

(macro: ^bigint_is_smallint (,a)
    (eq (^getf ,a MVMP6bigintBody u.smallint.flag) (const (&QUOTE MVM_BIGINT_32_FLAG) 4)))

(macro: ^stable_cont_func (,obj ,func)
    (^getf
          (^getf (^stable ,obj) MVMSTable container_spec)
          MVMContainerSpec ,func))

(macro: ^body (,a) (addr ,a (&offsetof MVMObjectStooge data)))

(macro: ^storage_spec (,a)
  (call (^getf (^repr ,a) MVMREPROps get_storage_spec)
    (arglist
      (carg (tc) ptr)
      (carg (^stable ,a) ptr)) ptr_sz))

(macro: ^nullptr () (const 0 ptr_sz))

(macro: ^throw_adhoc (,msg)
  (callv (^func MVM_exception_throw_adhoc)
    (arglist
      (carg (tc) ptr)
      (carg (const_ptr ,msg) ptr))))

(macro: ^decoder_ensure_decoder (,decoder ,op)
    (when (any
           (^not_repr_id ,decoder MVM_REPR_ID_Decoder)
           (zr (flagval (^is_conc_obj ,decoder))))
       (^throw_adhoc (&CAT3 "Operation '" ,op "'can only work on an object with the Decoder representation"))))

(macro: ^zero () (const 0 int_sz))
(macro: ^one  () (const 1 int_sz))

(macro: ^reg_int () (const (&QUOTE MVM_reg_int64) int_sz))
(macro: ^reg_uint () (const (&QUOTE MVM_reg_uint64) int_sz))
(macro: ^reg_num () (const (&QUOTE MVM_reg_num64) int_sz))
(macro: ^reg_str () (const (&QUOTE MVM_reg_str)   int_sz))
(macro: ^reg_obj () (const (&QUOTE MVM_reg_obj)   int_sz))