[PATCH] D94714: [flang] Better C_LOC and C_ASSOCIATED in flang/module

[Peter Klausler via Phabricator via llvm-commits]

klausler created this revision.
klausler added a reviewer: jeanPerier.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
klausler requested review of this revision.
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.

The place-holding implementation of C_LOC just didn't work
when used with our more complete semantic checking, specifically
in the case of a polymorphic argument; convert it to an external
function with an implicit interface.  C_ASSOCIATED needs to be
a generic interface with specific implementations for C_PTR and
C_FUNPTR.


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D94714

Files:
  flang/module/__fortran_builtins.f90
  flang/module/iso_c_binding.f90


Index: flang/module/iso_c_binding.f90
===================================================================
--- flang/module/iso_c_binding.f90
+++ flang/module/iso_c_binding.f90
@@ -14,7 +14,8 @@
     c_f_pointer => __builtin_c_f_pointer, &
     c_ptr => __builtin_c_ptr, &
     c_funptr => __builtin_c_funptr, &
-    c_sizeof => sizeof
+    c_sizeof => sizeof, &
+    c_loc => __builtin_c_loc
 
   type(c_ptr), parameter :: c_null_ptr = c_ptr(0)
   type(c_funptr), parameter :: c_null_funptr = c_funptr(0)
@@ -76,25 +77,42 @@
   character(kind=c_char, len=1), parameter :: c_horizontal_tab = achar(9)
   character(kind=c_char, len=1), parameter :: c_vertical_tab =  achar(11)
 
+  interface c_associated
+    module procedure c_associated_c_ptr
+    module procedure c_associated_c_funptr
+  end interface
+  private :: c_associated_c_ptr, c_associated_c_funptr
+
+  ! gfortran extensions
+  integer, parameter :: &
+    c_float128 = 16, &
+    c_float128_complex = c_float128
+
  contains
 
-  logical function c_associated(c_ptr_1, c_ptr_2)
+  logical function c_associated_c_ptr(c_ptr_1, c_ptr_2)
     type(c_ptr), intent(in) :: c_ptr_1
     type(c_ptr), intent(in), optional :: c_ptr_2
     if (c_ptr_1%__address == c_null_ptr%__address) then
-      c_associated = .false.
+      c_associated_c_ptr = .false.
     else if (present(c_ptr_2)) then
-      c_associated = c_ptr_1%__address == c_ptr_2%__address
+      c_associated_c_ptr = c_ptr_1%__address == c_ptr_2%__address
     else
-      c_associated = .true.
+      c_associated_c_ptr = .true.
     end if
-  end function c_associated
+  end function c_associated_c_ptr
 
-  function c_loc(x)
-    type(c_ptr) :: c_loc
-    type(*), dimension(..), intent(in) :: x
-    c_loc = c_ptr(loc(x))
-  end function c_loc
+  logical function c_associated_c_funptr(c_funptr_1, c_funptr_2)
+    type(c_funptr), intent(in) :: c_funptr_1
+    type(c_funptr), intent(in), optional :: c_funptr_2
+    if (c_funptr_1%__address == c_null_ptr%__address) then
+      c_associated_c_funptr = .false.
+    else if (present(c_funptr_2)) then
+      c_associated_c_funptr = c_funptr_1%__address == c_funptr_2%__address
+    else
+      c_associated_c_funptr = .true.
+    end if
+  end function c_associated_c_funptr
 
   function c_funloc(x)
     type(c_funptr) :: c_funloc
Index: flang/module/__fortran_builtins.f90
===================================================================
--- flang/module/__fortran_builtins.f90
+++ flang/module/__fortran_builtins.f90
@@ -29,4 +29,6 @@
   type :: __builtin_team_type
     integer(kind=int64) :: __id
   end type
+
+  procedure(type(__builtin_c_ptr)) :: __builtin_c_loc
 end module


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D94714.316754.patch
Type: text/x-patch
Size: 2663 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20210114/0b17cd55/attachment.bin>