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, build_target_ptr, &
8
- FPM_UNIT_MODULE, 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
22
integer :: i, j
26
23
type (build_target_ptr), allocatable :: queue(:)
27
- integer , allocatable :: region_ptr (:)
24
+ integer , allocatable :: schedule_ptr (:)
28
25
29
- if (.not. exists(model% output_directory)) then
30
- call mkdir(model% output_directory)
31
- end if
26
+ ! Need to make output directory for include (mod) files
32
27
if (.not. exists(join_path(model% output_directory,model% package_name))) then
33
28
call mkdir(join_path(model% output_directory,model% package_name))
34
29
end if
35
30
31
+ ! Perform depth-first topological sort of targets
36
32
do i= 1 ,size (model% targets)
37
33
38
- call schedule_target (model% targets(i)% ptr)
34
+ call sort_target (model% targets(i)% ptr)
39
35
40
36
end do
41
37
42
- call get_build_queue(queue, region_ptr, model% targets)
38
+ ! Construct build schedule queue
39
+ call schedule_targets(queue, schedule_ptr, model% targets)
43
40
44
- do i= 1 ,size (region_ptr)- 1
41
+ ! Loop over parallel schedule regions
42
+ do i= 1 ,size (schedule_ptr)- 1
45
43
44
+ ! Build targets in schedule region i
46
45
! $OMP PARALLEL DO DEFAULT(SHARED)
47
- do j= region_ptr (i),(region_ptr (i+1 )- 1 )
46
+ do j= schedule_ptr (i),(schedule_ptr (i+1 )- 1 )
48
47
49
48
call build_target(model,queue(j)% ptr)
50
49
51
50
end do
52
51
! $OMP END PARALLEL DO
53
52
54
53
end do
55
-
56
54
57
55
end subroutine build_package
58
56
59
57
60
-
61
- recursive subroutine schedule_target (target )
62
- !
63
- !
58
+ ! > Topologically sort a target for scheduling by
59
+ ! > recursing over it's dependencies.
60
+ ! >
61
+ ! > Checks disk-cached source hashes to determine if objects are
62
+ ! > up-to-date. Up-to-date sources are tagged as skipped.
63
+ ! >
64
+ recursive subroutine sort_target (target )
64
65
type (build_target_t), intent (inout ), target :: target
65
66
66
67
integer :: i, j, fh, stat
67
68
type (build_target_t), pointer :: exe_obj
68
69
69
- if (target % scheduled .or. target % skip) then
70
+ ! Check if target has already been processed (as a dependency)
71
+ if (target % sorted .or. target % skip) then
70
72
return
71
73
end if
72
74
73
- if (.not. exists(dirname(target % output_file))) then
74
- call mkdir(dirname(target % output_file))
75
- end if
76
-
75
+ ! Check for a circular dependency
76
+ ! (If target has been touched but not processed)
77
77
if (target % touched) then
78
78
write (* ,* ) ' (!) Circular dependency found with: ' ,target % output_file
79
79
stop
80
80
else
81
- target % touched = .true.
81
+ target % touched = .true. ! Set touched flag
82
82
end if
83
83
84
+ ! Load cached source file digest if present
84
85
if (.not. allocated (target % digest_cached) .and. &
85
86
exists(target % output_file) .and. &
86
87
exists(target % output_file// ' .digest' )) then
@@ -90,120 +91,117 @@ recursive subroutine schedule_target(target)
90
91
read (fh,* ,iostat= stat) target % digest_cached
91
92
close (fh)
92
93
93
- if (stat /= 0 ) then
94
- write (* ,* ) ' Internal error: unable to read cached source hash'
95
- write (* ,* ) target % output_file// ' .digest' ,' stat = ' , stat
96
- error stop
94
+ if (stat /= 0 ) then ! Cached digest is not recognized
95
+ deallocate (target % digest_cached)
97
96
end if
98
97
99
98
end if
100
99
101
100
if (allocated (target % source)) then
101
+
102
+ ! Skip if target is source-based and source file is unmodified
102
103
if (allocated (target % digest_cached)) then
103
104
if (target % digest_cached == target % source% digest) target % skip = .true.
104
105
end if
106
+
105
107
elseif (exists(target % output_file)) then
108
+
109
+ ! Skip if target is not source-based and already exists
106
110
target % skip = .true.
111
+
107
112
end if
108
113
109
- target % link_objects = " "
110
- target % region = 1
114
+ ! Loop over target dependencies
115
+ target % schedule = 1
111
116
do i= 1 ,size (target % dependencies)
112
117
113
- call schedule_target(target % dependencies(i)% ptr)
118
+ ! Sort dependency
119
+ call sort_target(target % dependencies(i)% ptr)
114
120
115
121
if (.not. target % dependencies(i)% ptr% skip) then
116
122
123
+ ! Can't skip target if any dependency is not skipped
117
124
target % skip = .false.
118
- target % region = max (target % region,target % dependencies(i)% ptr% region+1 )
119
125
120
- end if
121
-
122
- if (target % target_type == FPM_TARGET_ARCHIVE ) then
123
-
124
- ! Construct object list for archive
125
- target % link_objects = target % link_objects// " " // target % dependencies(i)% ptr% output_file
126
-
127
- else if (target % target_type == FPM_TARGET_EXECUTABLE .and. &
128
- target % dependencies(i)% ptr% target_type == FPM_TARGET_OBJECT) then
129
-
130
- exe_obj = > target % dependencies(i)% ptr
131
-
132
- ! Construct object list for executable
133
- target % link_objects = " " // exe_obj% output_file
134
-
135
- ! Include non-library object dependencies
136
- do j= 1 ,size (exe_obj% dependencies)
137
-
138
- if (allocated (exe_obj% dependencies(j)% ptr% source)) then
139
- if (exe_obj% dependencies(j)% ptr% source% unit_scope == exe_obj% source% unit_scope) then
140
- target % link_objects = target % link_objects// " " // exe_obj% dependencies(j)% ptr% output_file
141
- end if
142
- end if
143
-
144
- end do
126
+ ! Set target schedule after all of its dependencies
127
+ target % schedule = max (target % schedule,target % dependencies(i)% ptr% schedule+1 )
145
128
146
129
end if
147
130
148
131
end do
149
132
150
- target % scheduled = .not. target % skip
133
+ ! Mark flag as processed: either sorted or skipped
134
+ target % sorted = .not. target % skip
151
135
152
- end subroutine schedule_target
136
+ end subroutine sort_target
153
137
154
138
155
- subroutine get_build_queue (queue , region_ptr , targets )
139
+ ! > Construct a build schedule from the sorted targets.
140
+ ! >
141
+ ! > The schedule is broken into regions, described by `schedule_ptr`,
142
+ ! > where targets in each region can be compiled in parallel.
143
+ ! >
144
+ subroutine schedule_targets (queue , schedule_ptr , targets )
156
145
type (build_target_ptr), allocatable , intent (out ) :: queue(:)
157
- integer , allocatable :: region_ptr (:)
146
+ integer , allocatable :: schedule_ptr (:)
158
147
type (build_target_ptr), intent (in ) :: targets(:)
159
148
160
149
integer :: i, j
161
- integer :: nRegion, n_scheduled
150
+ integer :: n_schedule, n_sorted
162
151
163
- nRegion = 0
164
- n_scheduled = 0
152
+ n_schedule = 0 ! Number of schedule regions
153
+ n_sorted = 0 ! Total number of targets to build
165
154
do i= 1 ,size (targets)
166
155
167
- if (targets(i)% ptr% scheduled ) then
168
- n_scheduled = n_scheduled + 1
156
+ if (targets(i)% ptr% sorted ) then
157
+ n_sorted = n_sorted + 1
169
158
end if
170
- nRegion = max (nRegion , targets(i)% ptr% region )
159
+ n_schedule = max (n_schedule , targets(i)% ptr% schedule )
171
160
172
161
end do
173
162
174
- allocate (queue(n_scheduled ))
175
- allocate (region_ptr(nRegion +1 ))
163
+ allocate (queue(n_sorted ))
164
+ allocate (schedule_ptr(n_schedule +1 ))
176
165
177
- n_scheduled = 1
178
- region_ptr(n_scheduled) = 1
179
- do i= 1 ,nRegion
166
+ ! Construct the target queue and schedule region pointer
167
+ n_sorted = 1
168
+ schedule_ptr(n_sorted) = 1
169
+ do i= 1 ,n_schedule
180
170
181
171
do j= 1 ,size (targets)
182
172
183
- if (targets(j)% ptr% scheduled ) then
184
- if (targets(j)% ptr% region == i) then
173
+ if (targets(j)% ptr% sorted ) then
174
+ if (targets(j)% ptr% schedule == i) then
185
175
186
- queue(n_scheduled )% ptr = > targets(j)% ptr
187
- n_scheduled = n_scheduled + 1
176
+ queue(n_sorted )% ptr = > targets(j)% ptr
177
+ n_sorted = n_sorted + 1
188
178
end if
189
179
end if
190
180
191
181
end do
192
182
193
- region_ptr (i+1 ) = n_scheduled
183
+ schedule_ptr (i+1 ) = n_sorted
194
184
195
185
end do
196
186
197
- end subroutine get_build_queue
187
+ end subroutine schedule_targets
198
188
199
189
190
+ ! > Call compile/link command for a single target.
191
+ ! >
192
+ ! > If successful, also caches the source file digest to disk.
193
+ ! >
200
194
subroutine build_target (model ,target )
201
195
type (fpm_model_t), intent (in ) :: model
202
196
type (build_target_t), intent (in ), target :: target
203
197
204
198
integer :: ilib, fh
205
199
character (:), allocatable :: link_flags
206
200
201
+ if (.not. exists(dirname(target % output_file))) then
202
+ call mkdir(dirname(target % output_file))
203
+ end if
204
+
207
205
select case (target % target_type)
208
206
209
207
case (FPM_TARGET_OBJECT)
@@ -218,16 +216,16 @@ subroutine build_target(model,target)
218
216
end if
219
217
220
218
if (allocated (target % link_libraries)) then
221
- do ilib = 1 , size (target % link_libraries)
222
- link_flags = link_flags // " -l" // target % link_libraries(ilib) % s
223
- end do
219
+ if ( size (target % link_libraries) > 0 ) then
220
+ link_flags = link_flags // " -l" // string_cat( target % link_libraries, " -l " )
221
+ end if
224
222
end if
225
223
226
- call run(" gfortran " // target % link_objects // model% fortran_compile_flags &
224
+ call run(" gfortran " // string_cat( target % link_objects, " " ) // model% fortran_compile_flags &
227
225
// link_flags// " -o " // target % output_file)
228
226
229
227
case (FPM_TARGET_ARCHIVE)
230
- call run(" ar -rs " // target % output_file // target % link_objects)
228
+ call run(" ar -rs " // target % output_file // " " // string_cat( target % link_objects, " " ) )
231
229
232
230
end select
233
231
0 commit comments