@@ -1239,7 +1239,10 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
1239
1239
return ;
1240
1240
}
1241
1241
der_type_name = " " ;
1242
+ uint64_t ptr_loads_copy = ptr_loads;
1243
+ ptr_loads = ptr_loads_copy - ASR::is_a<ASR::Pointer_t>(*ASRUtils::expr_type (x.m_v ));
1242
1244
this ->visit_expr (*x.m_v );
1245
+ ptr_loads = ptr_loads_copy;
1243
1246
ASR::Variable_t* member = down_cast<ASR::Variable_t>(symbol_get_past_external (x.m_m ));
1244
1247
std::string member_name = std::string (member->m_name );
1245
1248
LFORTRAN_ASSERT (der_type_name.size () != 0 );
@@ -1608,15 +1611,9 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
1608
1611
}
1609
1612
case (ASR::ttypeType::Pointer) : {
1610
1613
ASR::ttype_t *t2 = ASR::down_cast<ASR::Pointer_t>(asr_type)->m_type ;
1611
- switch (t2->type ) {
1612
- case (ASR::ttypeType::Derived) : {
1613
- throw CodeGenError (" Pointers for Derived type not implemented yet in conversion." );
1614
- }
1615
- default :
1616
- llvm_type = get_type_from_ttype_t (t2, m_storage, is_array_type,
1614
+ llvm_type = get_type_from_ttype_t (t2, m_storage, is_array_type,
1617
1615
is_malloc_array_type, m_dims, n_dims, a_kind);
1618
- llvm_type = llvm_type->getPointerTo ();
1619
- }
1616
+ llvm_type = llvm_type->getPointerTo ();
1620
1617
break ;
1621
1618
}
1622
1619
case (ASR::ttypeType::List) : {
@@ -2654,9 +2651,14 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
2654
2651
2655
2652
void visit_CPtrToPointer (const ASR::CPtrToPointer_t& x) {
2656
2653
ASR::expr_t *cptr = x.m_cptr , *fptr = x.m_ptr , *shape = x.m_shape ;
2654
+ int reduce_loads = 0 ;
2655
+ if ( ASR::is_a<ASR::Var_t>(*cptr) ) {
2656
+ ASR::Variable_t* cptr_var = ASRUtils::EXPR2VAR (cptr);
2657
+ reduce_loads = cptr_var->m_intent == ASRUtils::intent_in;
2658
+ }
2657
2659
if ( ASRUtils::is_array (ASRUtils::expr_type (fptr)) ) {
2658
2660
uint64_t ptr_loads_copy = ptr_loads;
2659
- ptr_loads = 1 ;
2661
+ ptr_loads = 1 - reduce_loads ;
2660
2662
this ->visit_expr (*cptr);
2661
2663
llvm::Value* llvm_cptr = tmp;
2662
2664
ptr_loads = 0 ;
@@ -2706,7 +2708,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
2706
2708
}
2707
2709
} else {
2708
2710
uint64_t ptr_loads_copy = ptr_loads;
2709
- ptr_loads = 1 ;
2711
+ ptr_loads = 1 - reduce_loads ;
2710
2712
this ->visit_expr (*cptr);
2711
2713
llvm::Value* llvm_cptr = tmp;
2712
2714
ptr_loads = 0 ;
@@ -3704,13 +3706,17 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
3704
3706
switch (t2->type ) {
3705
3707
case ASR::ttypeType::Integer:
3706
3708
case ASR::ttypeType::Real:
3707
- case ASR::ttypeType::Complex: {
3709
+ case ASR::ttypeType::Complex:
3710
+ case ASR::ttypeType::Derived: {
3711
+ if ( t2->type == ASR::ttypeType::Derived ) {
3712
+ ASR::Derived_t* d = ASR::down_cast<ASR::Derived_t>(t2);
3713
+ der_type_name = ASRUtils::symbol_name (d->m_derived_type );
3714
+ }
3708
3715
fetch_ptr (x);
3709
3716
break ;
3710
3717
}
3711
3718
case ASR::ttypeType::Character:
3712
- case ASR::ttypeType::Logical:
3713
- case ASR::ttypeType::Derived: {
3719
+ case ASR::ttypeType::Logical: {
3714
3720
break ;
3715
3721
}
3716
3722
default :
@@ -4095,7 +4101,16 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
4095
4101
std::vector<std::string> fmt;
4096
4102
for (size_t i=0 ; i<x.n_values ; i++) {
4097
4103
uint64_t ptr_loads_copy = ptr_loads;
4098
- ptr_loads = 1 ;
4104
+ int reduce_loads = 0 ;
4105
+ ptr_loads = 2 ;
4106
+ if ( ASR::is_a<ASR::Var_t>(*x.m_values [i]) ) {
4107
+ ASR::Variable_t* var = ASRUtils::EXPR2VAR (x.m_values [i]);
4108
+ reduce_loads = var->m_intent == ASRUtils::intent_in;
4109
+ if ( ASR::is_a<ASR::Pointer_t>(*var->m_type ) ) {
4110
+ ptr_loads = 1 ;
4111
+ }
4112
+ }
4113
+ ptr_loads = ptr_loads - reduce_loads;
4099
4114
this ->visit_expr_wrapper (x.m_values [i], true );
4100
4115
ptr_loads = ptr_loads_copy;
4101
4116
ASR::expr_t *v = x.m_values [i];
@@ -4250,11 +4265,13 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
4250
4265
template <typename T>
4251
4266
inline void set_func_subrout_params (T* func_subrout, ASR::abiType& x_abi,
4252
4267
std::uint32_t & m_h, ASR::Variable_t*& orig_arg,
4253
- std::string& orig_arg_name, size_t arg_idx) {
4268
+ std::string& orig_arg_name, ASR::intentType& arg_intent,
4269
+ size_t arg_idx) {
4254
4270
m_h = get_hash ((ASR::asr_t *)func_subrout);
4255
4271
orig_arg = EXPR2VAR (func_subrout->m_args [arg_idx]);
4256
4272
orig_arg_name = orig_arg->m_name ;
4257
4273
x_abi = func_subrout->m_abi ;
4274
+ arg_intent = orig_arg->m_intent ;
4258
4275
}
4259
4276
4260
4277
@@ -4270,6 +4287,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
4270
4287
ASR::Subroutine_t* sub = down_cast<ASR::Subroutine_t>(func_subrout);
4271
4288
x_abi = sub->m_abi ;
4272
4289
}
4290
+ // TODO: Below if check is dead. Remove.
4273
4291
if ( x_abi == ASR::abiType::Intrinsic ) {
4274
4292
if ( name == " lbound" || name == " ubound" ) {
4275
4293
ASR::Variable_t *arg = EXPR2VAR (x.m_args [0 ].m_value );
@@ -4298,23 +4316,24 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
4298
4316
tmp = llvm_symtab[h];
4299
4317
func_subrout = symbol_get_past_external (x.m_name );
4300
4318
x_abi = (ASR::abiType) 0 ;
4319
+ ASR::intentType orig_arg_intent = ASR::intentType::Unspecified;
4301
4320
std::uint32_t m_h;
4302
4321
ASR::Variable_t *orig_arg = nullptr ;
4303
4322
std::string orig_arg_name = " " ;
4304
4323
if ( func_subrout->type == ASR::symbolType::Function ) {
4305
4324
ASR::Function_t* func = down_cast<ASR::Function_t>(func_subrout);
4306
- set_func_subrout_params (func, x_abi, m_h, orig_arg, orig_arg_name, i);
4325
+ set_func_subrout_params (func, x_abi, m_h, orig_arg, orig_arg_name, orig_arg_intent, i);
4307
4326
} else if ( func_subrout->type == ASR::symbolType::Subroutine ) {
4308
4327
ASR::Subroutine_t* sub = down_cast<ASR::Subroutine_t>(func_subrout);
4309
- set_func_subrout_params (sub, x_abi, m_h, orig_arg, orig_arg_name, i);
4328
+ set_func_subrout_params (sub, x_abi, m_h, orig_arg, orig_arg_name, orig_arg_intent, i);
4310
4329
} else if ( func_subrout->type == ASR::symbolType::ClassProcedure ) {
4311
4330
ASR::ClassProcedure_t* clss_proc = ASR::down_cast<ASR::ClassProcedure_t>(func_subrout);
4312
4331
if ( clss_proc->m_proc ->type == ASR::symbolType::Subroutine ) {
4313
4332
ASR::Subroutine_t* sub = down_cast<ASR::Subroutine_t>(clss_proc->m_proc );
4314
- set_func_subrout_params (sub, x_abi, m_h, orig_arg, orig_arg_name, i);
4333
+ set_func_subrout_params (sub, x_abi, m_h, orig_arg, orig_arg_name, orig_arg_intent, i);
4315
4334
} else if ( clss_proc->m_proc ->type == ASR::symbolType::Function ) {
4316
4335
ASR::Function_t* func = down_cast<ASR::Function_t>(clss_proc->m_proc );
4317
- set_func_subrout_params (func, x_abi, m_h, orig_arg, orig_arg_name, i);
4336
+ set_func_subrout_params (func, x_abi, m_h, orig_arg, orig_arg_name, orig_arg_intent, i);
4318
4337
}
4319
4338
} else {
4320
4339
LFORTRAN_ASSERT (false )
0 commit comments