1
+ ! > Implements the native fpm build backend
1
2
module fpm_backend
2
3
3
- ! Implements the native fpm build backend
4
-
5
- use fpm_environment, only: run, get_os_type, OS_WINDOWS
6
- use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir
7
- use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, FPM_UNIT_MODULE, &
8
- FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, &
9
- FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM, &
10
- FPM_SCOPE_TEST, FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE
4
+ use fpm_environment, only: run
5
+ use fpm_filesystem, only: dirname, join_path, exists, mkdir
6
+ use fpm_model, only: fpm_model_t, build_target_t, build_target_ptr, &
7
+ FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE
11
8
12
- use fpm_strings, only: split
9
+ use fpm_strings, only: string_cat
13
10
14
11
implicit none
15
12
16
13
private
17
- public :: build_package
14
+ public :: build_package, sort_target, schedule_targets
18
15
19
16
contains
20
17
21
-
18
+ ! > Top-level routine to build package described by `model`
22
19
subroutine build_package (model )
23
20
type (fpm_model_t), intent (inout ) :: model
24
21
25
- integer :: i, ilib
26
- character (:), allocatable :: base, linking, subdir, link_flags
22
+ integer :: i, j
23
+ type (build_target_ptr), allocatable :: queue(:)
24
+ integer , allocatable :: schedule_ptr(:)
27
25
28
- if (.not. exists(model% output_directory)) then
29
- call mkdir(model% output_directory)
30
- end if
26
+ ! Need to make output directory for include (mod) files
31
27
if (.not. exists(join_path(model% output_directory,model% package_name))) then
32
28
call mkdir(join_path(model% output_directory,model% package_name))
33
29
end if
34
30
35
- if (model% targets(1 )% ptr% target_type == FPM_TARGET_ARCHIVE) then
36
- linking = " " // model% targets(1 )% ptr% output_file
37
- else
38
- linking = " "
39
- end if
40
-
41
- linking = linking// " " // model% link_flags
42
-
31
+ ! Perform depth-first topological sort of targets
43
32
do i= 1 ,size (model% targets)
44
33
45
- call build_target (model,model % targets(i)% ptr,linking )
34
+ call sort_target (model% targets(i)% ptr)
46
35
47
36
end do
48
37
49
- end subroutine build_package
38
+ ! Construct build schedule queue
39
+ call schedule_targets(queue, schedule_ptr, model% targets)
50
40
41
+ ! Loop over parallel schedule regions
42
+ do i= 1 ,size (schedule_ptr)- 1
51
43
44
+ ! Build targets in schedule region i
45
+ ! $omp parallel do default(shared)
46
+ do j= schedule_ptr(i),(schedule_ptr(i+1 )- 1 )
47
+
48
+ call build_target(model,queue(j)% ptr)
49
+
50
+ end do
51
+
52
+ end do
53
+
54
+ end subroutine build_package
52
55
53
- recursive subroutine build_target (model ,target ,linking )
54
- ! Compile Fortran source, called recursively on it dependents
55
- !
56
- type (fpm_model_t), intent (in ) :: model
57
- type (build_target_t), intent (inout ) :: target
58
- character (:), allocatable , intent (in ) :: linking
59
56
60
- integer :: i, j, ilib
57
+ ! > Topologically sort a target for scheduling by
58
+ ! > recursing over its dependencies.
59
+ ! >
60
+ ! > Checks disk-cached source hashes to determine if objects are
61
+ ! > up-to-date. Up-to-date sources are tagged as skipped.
62
+ ! >
63
+ recursive subroutine sort_target (target )
64
+ type (build_target_t), intent (inout ), target :: target
65
+
66
+ integer :: i, j, fh, stat
61
67
type (build_target_t), pointer :: exe_obj
62
- character (:), allocatable :: objs, link_flags
63
68
64
- if (target % built) then
69
+ ! Check if target has already been processed (as a dependency)
70
+ if (target % sorted .or. target % skip) then
65
71
return
66
72
end if
67
73
74
+ ! Check for a circular dependency
75
+ ! (If target has been touched but not processed)
68
76
if (target % touched) then
69
77
write (* ,* ) ' (!) Circular dependency found with: ' ,target % output_file
70
78
stop
71
79
else
72
- target % touched = .true.
80
+ target % touched = .true. ! Set touched flag
73
81
end if
74
82
75
- objs = " "
83
+ ! Load cached source file digest if present
84
+ if (.not. allocated (target % digest_cached) .and. &
85
+ exists(target % output_file) .and. &
86
+ exists(target % output_file// ' .digest' )) then
76
87
77
- do i= 1 ,size (target % dependencies)
88
+ allocate (target % digest_cached)
89
+ open (newunit= fh,file= target % output_file// ' .digest' ,status= ' old' )
90
+ read (fh,* ,iostat= stat) target % digest_cached
91
+ close (fh)
78
92
79
- if (associated ( target % dependencies(i) % ptr)) then
80
- call build_target(model, target % dependencies(i) % ptr,linking )
93
+ if (stat /= 0 ) then ! Cached digest is not recognized
94
+ deallocate ( target % digest_cached )
81
95
end if
82
96
83
- if (target % target_type == FPM_TARGET_ARCHIVE ) then
97
+ end if
98
+
99
+ if (allocated (target % source)) then
84
100
85
- ! Construct object list for archive
86
- objs = objs// " " // target % dependencies(i)% ptr% output_file
101
+ ! Skip if target is source-based and source file is unmodified
102
+ if (allocated (target % digest_cached)) then
103
+ if (target % digest_cached == target % source% digest) target % skip = .true.
104
+ end if
87
105
88
- else if (target % target_type == FPM_TARGET_EXECUTABLE .and. &
89
- target % dependencies(i)% ptr% target_type == FPM_TARGET_OBJECT) then
106
+ elseif (exists(target % output_file)) then
90
107
91
- exe_obj = > target % dependencies(i)% ptr
92
-
93
- ! Construct object list for executable
94
- objs = " " // exe_obj% output_file
95
-
96
- ! Include non-library object dependencies
97
- do j= 1 ,size (exe_obj% dependencies)
108
+ ! Skip if target is not source-based and already exists
109
+ target % skip = .true.
98
110
99
- if (allocated (exe_obj% dependencies(j)% ptr% source)) then
100
- if (exe_obj% dependencies(j)% ptr% source% unit_scope == exe_obj% source% unit_scope) then
101
- objs = objs// " " // exe_obj% dependencies(j)% ptr% output_file
102
- end if
103
- end if
111
+ end if
104
112
105
- end do
113
+ ! Loop over target dependencies
114
+ target % schedule = 1
115
+ do i= 1 ,size (target % dependencies)
116
+
117
+ ! Sort dependency
118
+ call sort_target(target % dependencies(i)% ptr)
119
+
120
+ if (.not. target % dependencies(i)% ptr% skip) then
121
+
122
+ ! Can't skip target if any dependency is not skipped
123
+ target % skip = .false.
124
+
125
+ ! Set target schedule after all of its dependencies
126
+ target % schedule = max (target % schedule,target % dependencies(i)% ptr% schedule+1 )
106
127
107
128
end if
108
129
109
130
end do
110
131
132
+ ! Mark flag as processed: either sorted or skipped
133
+ target % sorted = .not. target % skip
134
+
135
+ end subroutine sort_target
136
+
137
+
138
+ ! > Construct a build schedule from the sorted targets.
139
+ ! >
140
+ ! > The schedule is broken into regions, described by `schedule_ptr`,
141
+ ! > where targets in each region can be compiled in parallel.
142
+ ! >
143
+ subroutine schedule_targets (queue , schedule_ptr , targets )
144
+ type (build_target_ptr), allocatable , intent (out ) :: queue(:)
145
+ integer , allocatable :: schedule_ptr(:)
146
+ type (build_target_ptr), intent (in ) :: targets(:)
147
+
148
+ integer :: i, j
149
+ integer :: n_schedule, n_sorted
150
+
151
+ n_schedule = 0 ! Number of schedule regions
152
+ n_sorted = 0 ! Total number of targets to build
153
+ do i= 1 ,size (targets)
154
+
155
+ if (targets(i)% ptr% sorted) then
156
+ n_sorted = n_sorted + 1
157
+ end if
158
+ n_schedule = max (n_schedule, targets(i)% ptr% schedule)
159
+
160
+ end do
161
+
162
+ allocate (queue(n_sorted))
163
+ allocate (schedule_ptr(n_schedule+1 ))
164
+
165
+ ! Construct the target queue and schedule region pointer
166
+ n_sorted = 1
167
+ schedule_ptr(n_sorted) = 1
168
+ do i= 1 ,n_schedule
169
+
170
+ do j= 1 ,size (targets)
171
+
172
+ if (targets(j)% ptr% sorted) then
173
+ if (targets(j)% ptr% schedule == i) then
174
+
175
+ queue(n_sorted)% ptr = > targets(j)% ptr
176
+ n_sorted = n_sorted + 1
177
+ end if
178
+ end if
179
+
180
+ end do
181
+
182
+ schedule_ptr(i+1 ) = n_sorted
183
+
184
+ end do
185
+
186
+ end subroutine schedule_targets
187
+
188
+
189
+ ! > Call compile/link command for a single target.
190
+ ! >
191
+ ! > If successful, also caches the source file digest to disk.
192
+ ! >
193
+ subroutine build_target (model ,target )
194
+ type (fpm_model_t), intent (in ) :: model
195
+ type (build_target_t), intent (in ), target :: target
196
+
197
+ integer :: ilib, fh
198
+ character (:), allocatable :: link_flags
199
+
111
200
if (.not. exists(dirname(target % output_file))) then
112
201
call mkdir(dirname(target % output_file))
113
202
end if
@@ -119,22 +208,34 @@ recursive subroutine build_target(model,target,linking)
119
208
// " -o " // target % output_file)
120
209
121
210
case (FPM_TARGET_EXECUTABLE)
122
- link_flags = linking
211
+
212
+ link_flags = string_cat(target % link_objects," " )
213
+
214
+ if (allocated (model% library_file)) then
215
+ link_flags = link_flags// " " // model% library_file// " " // model% link_flags
216
+ else
217
+ link_flags = link_flags// " " // model% link_flags
218
+ end if
219
+
123
220
if (allocated (target % link_libraries)) then
124
- do ilib = 1 , size (target % link_libraries)
125
- link_flags = link_flags // " -l" // target % link_libraries(ilib) % s
126
- end do
221
+ if ( size (target % link_libraries) > 0 ) then
222
+ link_flags = link_flags // " -l" // string_cat( target % link_libraries, " -l " )
223
+ end if
127
224
end if
128
-
129
- call run(" gfortran " // objs // model% fortran_compile_flags &
130
- // link_flags// " -o " // target % output_file)
225
+
226
+ call run(" gfortran " // model% fortran_compile_flags &
227
+ // " " // link_flags// " -o " // target % output_file)
131
228
132
229
case (FPM_TARGET_ARCHIVE)
133
- call run(" ar -rs " // target % output_file // objs )
230
+ call run(" ar -rs " // target % output_file // " " // string_cat( target % link_objects, " " ) )
134
231
135
232
end select
136
233
137
- target % built = .true.
234
+ if (allocated (target % source)) then
235
+ open (newunit= fh,file= target % output_file// ' .digest' ,status= ' unknown' )
236
+ write (fh,* ) target % source% digest
237
+ close (fh)
238
+ end if
138
239
139
240
end subroutine build_target
140
241
0 commit comments