1 /*
2 * Copyright (c) 2015-2019, NVIDIA CORPORATION. All rights reserved.
3 *
4 * Licensed under the Apache License, Version 2.0 (the "License");
5 * you may not use this file except in compliance with the License.
6 * You may obtain a copy of the License at
7 *
8 * http://www.apache.org/licenses/LICENSE-2.0
9 *
10 * Unless required by applicable law or agreed to in writing, software
11 * distributed under the License is distributed on an "AS IS" BASIS,
12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 * See the License for the specific language governing permissions and
14 * limitations under the License.
15 *
16 */
17
18 /**
19 \file
20 \brief extract regions into subroutines; add uplevel references as
21 arguments
22 */
23
24 #include "outliner.h"
25 #include "error.h"
26 #include "semant.h"
27 #include "llassem.h"
28 #include "exputil.h"
29 #include "ilmtp.h"
30 #include "ilm.h"
31 #include "expand.h"
32 #include "kmpcutil.h"
33 #include "machreg.h"
34 #include "mp.h"
35 #include "ll_structure.h"
36 #include "llmputil.h"
37 #include "llutil.h"
38 #include "expsmp.h"
39 #include "dtypeutl.h"
40 #include "ll_ftn.h"
41 #include "cgllvm.h"
42 #include <unistd.h>
43 #include "regutil.h"
44 #include "symfun.h"
45 #if !defined(TARGET_WIN)
46 #include <unistd.h>
47 #endif
48 #if defined(OMP_OFFLOAD_LLVM) || defined(OMP_OFFLOAD_PGI)
49 #include "ompaccel.h"
50 #endif
51 #ifdef OMP_OFFLOAD_LLVM
52 static bool isReplacerEnabled = false;
53 static int op1Pld = 0;
54 #endif
55
56 #define MAX_PARFILE_LEN 15
57
58 FILE *orig_ilmfil;
59 FILE *par_file1 = NULL;
60 FILE *par_file2 = NULL;
61 FILE *par_curfile = NULL; /* current tempfile for ilm rewrite */
62
63 static FILE *savedILMFil = NULL;
64 static char parFileNm1[MAX_PARFILE_LEN]; /* temp ilms file: pgipar1XXXXXX */
65 static char parFileNm2[MAX_PARFILE_LEN]; /* temp ilms file: pgipar2XXXXXX */
66 static bool hasILMRewrite; /* if set, tempfile is not empty. */
67 static bool isRewritingILM; /* if set, write ilm to tempfile */
68 static int funcCnt = 0; /* keep track how many outlined region */
69 static int llvmUniqueSym; /* keep sptr of unique symbol */
70 static SPTR uplevelSym;
71 static SPTR gtid;
72 static bool writeTaskdup; /* if set, write IL_NOP to TASKDUP_FILE */
73 static int pos;
74
75 /* store taskdup ILMs */
76 static struct taskdupSt {
77 ILM_T *file;
78 int sz;
79 int avl;
80 } taskdup;
81
82 #define TASKDUP_FILE taskdup.file
83 #define TASKDUP_SZ taskdup.sz
84 #define TASKDUP_AVL taskdup.avl
85 static void allocTaskdup(int);
86
87 /* Forward decls */
88 static void resetThreadprivate(void);
89
90 /* Check shall we eliminate outlined or not */
91 static bool eliminate_outlining(ILM_OP opc);
92
93 /* Generate a name for outlined function */
94 static char *ll_get_outlined_funcname(int fileno, int lineno, bool isompaccel, ILM_OP opc);
95
96 #define DT_VOID_NONE DT_NONE
97
98 #define MXIDLEN 250
99
100 /* Dump the values being stored in the uplevel argument */
101 static void
dumpUplevel(int uplevel_sptr)102 dumpUplevel(int uplevel_sptr)
103 {
104 int i;
105 FILE *fp = gbl.dbgfil ? gbl.dbgfil : stdout;
106
107 fprintf(fp, "********* UPLEVEL Struct *********\n");
108 for (i = DTyAlgTyMember(DTYPEG(uplevel_sptr)); i > NOSYM; i = SYMLKG(i))
109 fprintf(fp, "==> %s %s\n", SYMNAME(i), stb.tynames[DTY(DTYPEG(i))]);
110 fprintf(fp, "**********\n\n");
111 }
112
113 void
dump_parsyms(int sptr,int isTeams)114 dump_parsyms(int sptr, int isTeams)
115 {
116 int i;
117 const LLUplevel *up;
118 FILE *fp = gbl.dbgfil ? gbl.dbgfil : stdout;
119 //TODO Add more OpenMP regions
120 const char* ompRegion = isTeams ? "Teams" : "Parallel";
121 assert(STYPEG(sptr) == ST_BLOCK, "Invalid OpenMP region sptr", sptr,
122 ERR_Fatal);
123
124 up = llmp_get_uplevel(sptr);
125 fprintf(fp,
126 "\n********** OUTLINING: %s Region "
127 "%d (%d variables) **********\n",
128 ompRegion, sptr, up->vals_count);
129
130 for (i = 0; i < up->vals_count; ++i) {
131 const int var = up->vals[i];
132 fprintf(fp, "==> %d) %d (%s) (stype:%d, sc:%d)\n", i + 1, var, SYMNAME(var),
133 STYPEG(var), SCG(var));
134 }
135 }
136 const char* ilmfile_states[] = {"ORIGINAL", "PARFILE1", "PARFILE2" };
137 const char* outliner_state_names[] = {"Inactive", "Parfile1", "ParFile2", "SwitchParFiles", "Reset", "Error"};
138
139 static const char*
get_file_state(FILE * ilmfile)140 get_file_state(FILE *ilmfile) {
141 if(ilmfile == orig_ilmfil )
142 return ilmfile_states[0];
143 else if(ilmfile == par_file1 )
144 return ilmfile_states[1];
145 else if(ilmfile == par_file2 )
146 return ilmfile_states[2];
147 else
148 //orig_ilmfil is not set yet, so the state is original.
149 return ilmfile_states[0];
150 }
151
152 /* Outliner State */
153 static outliner_states_t outl_state = outliner_not_active;
154
155 void
set_outliner_state(outliner_states_t next)156 set_outliner_state(outliner_states_t next)
157 {
158 if(DBGBIT(233, 0x100))
159 fprintf(gbl.dbgfil, "[Outliner] Compiling [%50s], State: [%10s] -> [%10s] \n", SYMNAME(GBL_CURRFUNC), outliner_state_names[outl_state], outliner_state_names[next]);
160 outl_state = next;
161 }
162 static void
dump_ilmfile_state(FILE * previous_file)163 dump_ilmfile_state(FILE *previous_file)
164 {
165 FILE *dfile = gbl.dbgfil ? gbl.dbgfil : stderr;
166 if(DBGBIT(233, 0x200)) {
167 fprintf(dfile , "[Outliner] ILM File:\t[%10s] --> [%10s]\n", get_file_state(previous_file), get_file_state(gbl.ilmfil));
168 }
169 }
dump_outliner()170 void dump_outliner() {
171 FILE *dfile = gbl.dbgfil ? gbl.dbgfil : stderr;
172 fprintf(dfile , "State: %10s\n", outliner_state_names[outl_state]);
173 fprintf(dfile , "ILM File: %10s\n", get_file_state(gbl.ilmfil));
174 fprintf(dfile , "Saving ILMs into parfile: %10s\n", isRewritingILM ? "Yes" : "No");
175 }
176
177 static void
set_ilmfile(FILE * file)178 set_ilmfile(FILE *file)
179 {
180 FILE *prev = gbl.ilmfil;
181 gbl.ilmfil = file;
182 dump_ilmfile_state(prev);
183 }
184
185 static int
genNullArg()186 genNullArg()
187 {
188 int con, ili;
189 INT tmp[2];
190
191 tmp[0] = 0;
192 tmp[1] = 0;
193 con = getcon(tmp, DT_INT);
194 ili = ad1ili(IL_ACON, con);
195 return ili;
196 }
197
198 static ISZ_T
ll_parent_vals_count(int stblk_sptr)199 ll_parent_vals_count(int stblk_sptr)
200 {
201 const LLUplevel *up_parent;
202 const LLUplevel *up = llmp_get_uplevel(stblk_sptr);
203 ISZ_T sz = 0;
204 if (up && up->parent) {
205 up_parent = llmp_get_uplevel(up->parent);
206 while (up_parent) {
207 sz = sz + up_parent->vals_count;
208 if (up_parent->parent) {
209 up_parent = llmp_get_uplevel(up_parent->parent);
210 } else {
211 break;
212 }
213 }
214 }
215 return sz;
216 }
217 /* Returns size in bytes for task shared variable addresses */
218
219 ISZ_T
getTaskSharedSize(SPTR scope_sptr)220 getTaskSharedSize(SPTR scope_sptr)
221 {
222 ISZ_T sz;
223 const LLUplevel *up;
224 const SPTR uplevel_sptr = (SPTR)PARUPLEVELG(scope_sptr);
225 sz = 0;
226 if (gbl.internal >= 1)
227 sz = sz + 1;
228 if (llmp_has_uplevel(uplevel_sptr)) {
229 sz = ll_parent_vals_count(uplevel_sptr);
230 up = llmp_get_uplevel(uplevel_sptr);
231 if (up) {
232 sz = sz + up->vals_count;
233 }
234 }
235 sz = sz * size_of(DT_CPTR);
236 return sz;
237 }
238
239 /* Returns a dtype for arguments referenced by stblk_sptr */
240 DTYPE
ll_make_uplevel_type(SPTR stblk_sptr)241 ll_make_uplevel_type(SPTR stblk_sptr)
242 {
243 int i, j;
244 DTYPE dtype;
245 int nmems, psyms_idx, count, presptr;
246 const LLUplevel *up;
247 KMPC_ST_TYPE *meminfo = NULL;
248 ISZ_T sz;
249
250 up = llmp_get_uplevel(stblk_sptr);
251 count = nmems = up->vals_count;
252
253 if (gbl.internal >= 1)
254 nmems = nmems + 1;
255
256 /* Add members */
257 if (nmems)
258 meminfo = (KMPC_ST_TYPE *)calloc(nmems, sizeof(KMPC_ST_TYPE));
259 i = 0;
260 if (gbl.internal >= 1) {
261 meminfo[i].name = strdup(SYMNAME(aux.curr_entry->display));
262 meminfo[i].dtype = DT_CPTR;
263 meminfo[i].byval = false;
264 meminfo[i].psptr = aux.curr_entry->display;
265 i++;
266 }
267 presptr = 0;
268 for (j = 0; j < count; ++j) {
269 int sptr = up->vals[j];
270 meminfo[i].name = strdup(SYMNAME(sptr));
271 meminfo[i].dtype = DT_CPTR;
272 meminfo[i].byval = false;
273 meminfo[i].psptr = sptr;
274 ++i;
275 }
276 sz = ll_parent_vals_count(stblk_sptr) * size_of(DT_CPTR);
277 if (sz == 0 && !nmems)
278 return DT_CPTR;
279 dtype = ll_make_kmpc_struct_type(nmems, NULL, meminfo, sz);
280
281 /* Cleanup */
282 for (i = 0; i < nmems; ++i)
283 free(meminfo[i].name);
284 if (meminfo)
285 free(meminfo);
286 meminfo = NULL;
287
288 return dtype;
289 }
290
291 /**
292 This symbol is used only for its name, if none is found, a unique name is
293 generated.
294 */
295 int
llvm_get_unique_sym(void)296 llvm_get_unique_sym(void)
297 {
298 return llvmUniqueSym;
299 }
300
301 static const char*
get_opc_name(ILM_OP opc)302 get_opc_name(ILM_OP opc)
303 {
304 switch(opc) {
305 case IM_BTARGET:
306 return "TARGET";
307 break;
308 case IM_BTEAMS:
309 case IM_BTEAMSN:
310 return "TEAMS";
311 break;
312 case IM_BPAR:
313 case IM_BPARA:
314 case IM_BPARD:
315 case IM_BPARN:
316 return "PARALLEL";
317 break;
318 case IM_BTASK:
319 return "TASK";
320 break;
321 default:
322 return "NOPC";
323 break;
324 }
325 }
326
327 static char *
ll_get_outlined_funcname(int fileno,int lineno,bool isompaccel,ILM_OP opc)328 ll_get_outlined_funcname(int fileno, int lineno, bool isompaccel, ILM_OP opc) {
329 char *name;
330 static unsigned nmLen = 0;
331 const unsigned maxDigitLen = 10; /* Len of 2147483647 */
332 unsigned nmSize;
333 int r;
334 char *name_currfunc = getsname(GBL_CURRFUNC);
335 char *prefix = "";
336 int plen;
337 char *host_prefix = "__nv_";
338 char *device_prefix = "nvkernel_";
339 if(isompaccel) {
340 prefix = device_prefix;
341 } else {
342 funcCnt++;
343 prefix = host_prefix;
344 }
345 if(gbl.outlined) {
346 {
347 plen = strlen(host_prefix);
348 name_currfunc = strtok(&name_currfunc[plen], "_");
349 }
350 }
351 nmSize = (3 * maxDigitLen) + 5 + strlen(name_currfunc) + 1;
352 name = (char *)malloc(nmSize + strlen(prefix));
353 r = snprintf(name, nmSize, "%s%s_F%dL%d_%d", prefix, name_currfunc, fileno, lineno, funcCnt);
354 assert(r < nmSize, "buffer overrun", r, ERR_Fatal);
355 return name;
356 }
357
358 /**
359 \p argili is in order
360 */
361 int
ll_make_outlined_garg(int nargs,int * argili,DTYPE * arg_dtypes)362 ll_make_outlined_garg(int nargs, int *argili, DTYPE *arg_dtypes)
363 {
364 int i, gargl = ad1ili(IL_NULL, 0);
365 if (arg_dtypes != NULL) {
366 for (i = nargs - 1; i >= 0; --i) {
367 if (argili[i]) /* Null if this is a varargs ellipsis */ {
368 if (arg_dtypes[i] == 0)
369 gargl = ad4ili(IL_GARG, argili[i], gargl, DT_CPTR, 0);
370 else
371 gargl = ad4ili(IL_GARG, argili[i], gargl, arg_dtypes[i], 0);
372 }
373 }
374 } else {
375 for (i = nargs - 1; i >= 0; --i)
376 if (argili[i]) /* Null if this is a varargs ellipsis */
377 gargl = ad4ili(IL_GARG, argili[i], gargl, DT_CPTR, 0);
378 }
379 return gargl;
380 }
381
382 int
ll_make_outlined_gjsr(int func_sptr,int nargs,int arg1,int arg2,int arg3)383 ll_make_outlined_gjsr(int func_sptr, int nargs, int arg1, int arg2, int arg3)
384 {
385 int gjsr;
386 int garg;
387 int arglist[10];
388
389 arglist[0] = arg1;
390 arglist[1] = arg2;
391 arglist[2] = arg3;
392
393 garg = ll_make_outlined_garg(3, arglist, NULL);
394 gjsr = ad3ili(IL_GJSR, func_sptr, garg, 0);
395
396 return gjsr;
397 }
398
399 int
ll_ad_outlined_func2(ILI_OP result_opc,ILI_OP call_opc,int sptr,int nargs,int * args)400 ll_ad_outlined_func2(ILI_OP result_opc, ILI_OP call_opc, int sptr, int nargs,
401 int *args)
402 {
403 int i, arg, rg, argl, ilix;
404 int *argsp = args;
405
406 rg = 0;
407 argl = ad1ili(IL_NULL, 0);
408 for (i = 0; i < nargs; i++) {
409 int arg = *argsp++;
410 if (!arg) /* If varargs ellipses */
411 continue;
412 switch (IL_RES(ILI_OPC(arg))) {
413 case ILIA_AR:
414 argl = ad3ili(IL_ARGAR, arg, argl, 0);
415 rg++;
416 break;
417 case ILIA_IR:
418 argl = ad3ili(IL_ARGIR, arg, argl, 0);
419 rg++;
420 break;
421 case ILIA_SP:
422 argl = ad3ili(IL_ARGSP, arg, argl, 0);
423 rg++;
424 break;
425 case ILIA_DP:
426 argl = ad3ili(IL_ARGDP, arg, argl, 0);
427 rg += 2;
428 break;
429 case ILIA_KR:
430 argl = ad3ili(IL_ARGKR, arg, argl, 0);
431 rg += 2;
432 break;
433 default:
434 interr("ll_ad_outlined_func2: illegal arg", arg, ERR_Severe);
435 break;
436 }
437 }
438
439 ilix = ad2ili(call_opc, sptr, argl);
440 if (result_opc)
441 ilix = genretvalue(ilix, result_opc);
442
443 return ilix;
444 }
445
446 /* right now, the last argument is the uplevel struct */
447 SPTR
ll_get_shared_arg(SPTR func_sptr)448 ll_get_shared_arg(SPTR func_sptr)
449 {
450 int paramct, dpdscp;
451 SPTR sym;
452
453 paramct = PARAMCTG(func_sptr);
454 dpdscp = DPDSCG(func_sptr);
455
456 while (paramct--) {
457 sym = (SPTR)aux.dpdsc_base[dpdscp++];
458 if (ISTASKDUPG(func_sptr) && paramct == 2)
459 break;
460 }
461 return sym;
462 }
463
464 void
ll_make_ftn_outlined_params(int func_sptr,int paramct,DTYPE * argtype)465 ll_make_ftn_outlined_params(int func_sptr, int paramct, DTYPE *argtype)
466 {
467 int count = 0;
468 int sym, dtype;
469 char name[MXIDLEN + 2];
470 int dpdscp = aux.dpdsc_avl;
471
472 PARAMCTP(func_sptr, paramct);
473 DPDSCP(func_sptr, dpdscp);
474 aux.dpdsc_avl += paramct;
475 NEED(aux.dpdsc_avl, aux.dpdsc_base, int, aux.dpdsc_size,
476 aux.dpdsc_size + paramct + 100);
477
478 while (paramct--) {
479 sprintf(name, "%sArg%d", SYMNAME(func_sptr), count++);
480 sym = getsymbol(name);
481 SCP(sym, SC_DUMMY);
482 if (*argtype == DT_CPTR) { /* either i8* or actual type( pass by value). */
483 DTYPEP(sym, DT_INT8);
484 } else {
485 DTYPEP(sym, *argtype);
486 PASSBYVALP(sym, 1);
487 }
488 argtype++;
489 STYPEP(sym, ST_VAR);
490 aux.dpdsc_base[dpdscp++] = sym;
491 }
492 }
493
494 /**
495 This is a near duplicate of ll_make_ftn_outlined_params but handles by value
496 for fortran.
497 */
498 static void
llMakeFtnOutlinedSignature(int func_sptr,int n_params,const KMPC_ST_TYPE * params)499 llMakeFtnOutlinedSignature(int func_sptr, int n_params,
500 const KMPC_ST_TYPE *params)
501 {
502 int i, sym;
503 char name[MXIDLEN + 2];
504 int count = 0;
505 int dpdscp = aux.dpdsc_avl;
506
507 PARAMCTP(func_sptr, n_params);
508 DPDSCP(func_sptr, dpdscp);
509 aux.dpdsc_avl += n_params;
510 NEED(aux.dpdsc_avl, aux.dpdsc_base, int, aux.dpdsc_size,
511 aux.dpdsc_size + n_params + 100);
512
513 for (i = 0; i < n_params; ++i) {
514 DTYPE dtype = params[i].dtype;
515 const int byval = params[i].byval;
516
517 sprintf(name, "%sArg%d", SYMNAME(func_sptr), count++);
518 sym = getsymbol(name);
519 SCP(sym, SC_DUMMY);
520
521 if (dtype == DT_CPTR) {
522 dtype = DT_INT8;
523 }
524
525 DTYPEP(sym, dtype);
526 STYPEP(sym, ST_VAR);
527 PASSBYVALP(sym, byval);
528 aux.dpdsc_base[dpdscp++] = sym;
529 }
530 }
531
532 /* Update ACC information such that our OpenACC code generator will be aware of
533 * this routine.
534 *
535 * fnsptr: Function sptr
536 */
537 void
update_acc_with_fn_flags(int fnsptr,int flags)538 update_acc_with_fn_flags(int fnsptr, int flags)
539 {
540 }
541 void
update_acc_with_fn(int fnsptr)542 update_acc_with_fn(int fnsptr)
543 {
544 }
545
546 static SPTR
llGetSym(char * name,DTYPE dtype)547 llGetSym(char *name, DTYPE dtype)
548 {
549 SPTR gtid;
550 if (!name)
551 return SPTR_NULL;
552 gtid = getsymbol(name);
553 DTYPEP(gtid, dtype);
554 SCP(gtid, SC_AUTO);
555 ENCLFUNCP(gtid, GBL_CURRFUNC);
556 STYPEP(gtid, ST_VAR);
557 /* to prevent llassem.c setting it to SC_STATIC for Fortran */
558 CCSYMP(gtid, 1);
559 return gtid;
560 }
561
562 static int
findBihForGtid()563 findBihForGtid()
564 {
565 int bih;
566 bih = BIH_NEXT(BIHNUMG(GBL_CURRFUNC));
567 if (bih == expb.curbih)
568 return 0;
569 return bih;
570 }
571
572 /* Return the ili representing the global thread id:
573 * This value is generated from:
574 * 1) Calling the kmpc api directly: kmpc_global_thread_num
575 * 2) Using the 1st formal parameter if this is a microtask (i.e., outlined
576 * function called by kmpc_fork_call).
577 * 3) Using the 1st parameter if this is a task.
578 * where 'this' is gbl.curr_func.
579 *
580 * * If this is a task, the 1st formal param represents the gtid: i32 gtid.
581 * * If this is an outlined func, the 1st formal represents gtid: i32* gtid.
582 */
583 int
ll_get_gtid_val_ili(void)584 ll_get_gtid_val_ili(void)
585 {
586 int ili, nme;
587 char *name;
588
589 if (!gtid) {
590 name = (char *)malloc(strlen(getsname(GBL_CURRFUNC)) + 10);
591 sprintf(name, "%s%s", "__gtid_", getsname(GBL_CURRFUNC));
592 gtid = llGetSym(name, DT_INT);
593 if (flg.omptarget)
594 PDALNP(gtid, 3);
595 sym_is_refd(gtid);
596 free(name);
597 }
598 ili = ad_acon(gtid, 0);
599 nme = addnme(NT_VAR, gtid, 0, 0);
600 ili = ad3ili(IL_LD, ili, nme, MSZ_WORD);
601 return ili;
602 }
603
604 int
ll_get_gtid_addr_ili(void)605 ll_get_gtid_addr_ili(void)
606 {
607 int ili, nme;
608 char *name;
609
610 if (!gtid) {
611 name = (char *)malloc(strlen(getsname(GBL_CURRFUNC)) + 10);
612 sprintf(name, "%s%s", "__gtid_", getsname(GBL_CURRFUNC));
613 gtid = llGetSym(name, DT_INT);
614 if (flg.omptarget)
615 PDALNP(gtid, 3);
616 sym_is_refd(gtid);
617 free(name);
618 }
619 ili = ad_acon(gtid, 0);
620 return ili;
621 }
622
623 static int
llLoadGtid(void)624 llLoadGtid(void)
625 {
626 int ili, nme, rhs;
627 SPTR gtid = ll_get_gtid();
628
629 if (!gtid)
630 return 0;
631
632 if (gbl.outlined) {
633 SPTR arg = ll_get_hostprog_arg(GBL_CURRFUNC, 1);
634 int nme = addnme(NT_VAR, arg, 0, 0);
635 int ili = ad_acon(arg, 0);
636 if (!TASKFNG(GBL_CURRFUNC)) {
637 ili = mk_address(arg);
638 nme = addnme(NT_VAR, arg, 0, (INT)0);
639 arg = mk_argasym(arg);
640 ili = ad2ili(IL_LDA, ili, addnme(NT_VAR, arg, 0, (INT)0));
641 }
642 rhs = ad3ili(IL_LD, ili, nme, MSZ_WORD);
643 } else {
644 rhs = ll_make_kmpc_global_thread_num();
645 }
646 ili = ad_acon(gtid, 0);
647 nme = addnme(NT_VAR, gtid, 0, 0);
648 ili = ad4ili(IL_ST, rhs, ili, nme, MSZ_WORD);
649 ASSNP(gtid, 1);
650
651 return ili;
652 }
653
654 int
ll_save_gtid_val(int bih)655 ll_save_gtid_val(int bih)
656 {
657 int ili;
658 #ifdef CUDAG
659 if ((CUDAG(GBL_CURRFUNC) & CUDA_GLOBAL) || CUDAG(GBL_CURRFUNC) == CUDA_DEVICE)
660 return 0;
661 #endif
662
663 if (ll_get_gtid()) {
664 if (!bih) {
665 bih = expb.curbih = BIH_NEXT(BIHNUMG(GBL_CURRFUNC));
666 }
667 rdilts(bih); /* get block after entry */
668 expb.curilt = 0;
669 iltb.callfg = 1;
670 ili = llLoadGtid();
671 if (ili)
672 chk_block(ili);
673 wrilts(bih);
674 }
675 return 0;
676 }
677
678 /* Return the uplevel argument from the current function */
679 int
ll_get_uplevel_arg(void)680 ll_get_uplevel_arg(void)
681 {
682 int uplevel;
683
684 if (!gbl.outlined && !ISTASKDUPG(GBL_CURRFUNC))
685 return 0;
686
687 uplevel = ll_get_shared_arg(GBL_CURRFUNC);
688 return uplevel;
689 }
690
691 SPTR
ll_create_task_sptr(void)692 ll_create_task_sptr(void)
693 {
694 SPTR base = getnewccsym('z', GBL_CURRFUNC, ST_VAR);
695 SCP(base, SC_AUTO);
696 DTYPEP(base, DT_CPTR);
697 return base;
698 }
699
700 int *
ll_make_sections_args(SPTR lbSym,SPTR ubSym,SPTR stSym,SPTR lastSym)701 ll_make_sections_args(SPTR lbSym, SPTR ubSym, SPTR stSym, SPTR lastSym)
702 {
703 static int args[9];
704
705 args[8] = genNullArg(); /* i32* ident */
706 args[7] = ll_get_gtid_val_ili(); /* i32 tid */
707 args[6] = ad_icon(KMP_SCH_STATIC); /* i32 schedule */
708 args[5] = ad_acon(lastSym, 0); /* i32* plastiter */
709 args[4] = ad_acon(lbSym, 0); /* i32* plower */
710 args[3] = ad_acon(ubSym, 0); /* i32* pupper */
711 args[2] = ad_acon(stSym, 0); /* i32* pstridr */
712 args[1] = ad_icon(1); /* i32 incr */
713 args[0] = ad_icon(0); /* i32 chunk */
714 ADDRTKNP(lbSym, 1);
715 ADDRTKNP(ubSym, 1);
716 ADDRTKNP(stSym, 1);
717 ADDRTKNP(lastSym, 1);
718 return args;
719 }
720
721 /* Create the prototype for an outlined function or task.
722 * An outlined function is: void (int32*, int32*, ...);
723 * An outlined task is: int32 (int32, void*);
724 *
725 * We actually treat these as:
726 * An outlined function is: void (int32*, int32*, void*);
727 * An outlined task is: void (int32, void*); Return is ignored.
728 */
729 static const KMPC_ST_TYPE funcSig[3] = {
730 {NULL, DT_INT, false},
731 {NULL, DT_CPTR, false},
732 {NULL, DT_CPTR, false} /* Pass ptr directly */
733 };
734
735 static const KMPC_ST_TYPE taskSig[2] = {
736 {NULL, DT_INT, true}, {NULL, DT_CPTR, false} /* Pass ptr directly */
737 };
738
739 static const KMPC_ST_TYPE taskdupSig[3] = {
740 {NULL, DT_CPTR, false}, {NULL, DT_CPTR, false}, {NULL, DT_INT, true}};
741
742 void
setOutlinedPragma(int func_sptr,int saved)743 setOutlinedPragma(int func_sptr, int saved)
744 {
745 }
746
747 static SPTR
makeOutlinedFunc(int stblk_sptr,int scope_sptr,bool is_task,bool istaskdup,bool isompaccel,ILM_OP opc)748 makeOutlinedFunc(int stblk_sptr, int scope_sptr, bool is_task, bool istaskdup, bool isompaccel, ILM_OP opc) {
749 char *nm;
750 LL_ABI_Info *abi;
751 SPTR func_sptr, hostfunc_uplevel = SPTR_NULL;
752 int dtype;
753 DTYPE ret_dtype;
754 int n_args, param1, param2, param3;
755 int count = 0;
756 const KMPC_ST_TYPE *args;
757
758 /* Get the proper prototype dtypes */
759 ret_dtype = DT_VOID_NONE;
760 if (is_task) {
761 args = taskSig;
762 n_args = 2;
763 } else if (istaskdup) {
764 args = taskdupSig;
765 n_args = 3;
766 } else {
767 args = funcSig;
768 n_args = 3;
769 }
770
771 if (DBGBIT(45, 0x8) && stblk_sptr)
772 dump_parsyms(stblk_sptr, FALSE);
773
774 /* Create the function sptr */
775 nm = ll_get_outlined_funcname(gbl.findex, gbl.lineno, isompaccel, opc);
776 func_sptr = getsymbol(nm);
777 TASKFNP(func_sptr, is_task);
778 ISTASKDUPP(func_sptr, istaskdup);
779 OUTLINEDP(func_sptr, scope_sptr);
780 FUNCLINEP(func_sptr, gbl.lineno);
781
782 /* Set return type and parameters for function dtype */
783 STYPEP(func_sptr, ST_ENTRY);
784 DTYPEP(func_sptr, ret_dtype);
785 DEFDP(func_sptr, 1);
786 SCP(func_sptr, SC_STATIC);
787 llMakeFtnOutlinedSignature(func_sptr, n_args, args);
788 ADDRTKNP(func_sptr, 1);
789 /* In Auto Offload mode, we generate every outlining function in the host and device code.
790 * We build single style ILI for host and device.
791 */
792 update_acc_with_fn(func_sptr);
793
794 if(DBGBIT(233,2))
795 fprintf(gbl.dbgfil, "[Outliner] #%s region is outlined for %10s \t%30s() \tin %s()\n",
796 get_opc_name(opc),
797 isompaccel ? "Device" : "Host", SYMNAME(func_sptr), SYMNAME(GBL_CURRFUNC));
798 return func_sptr;
799 }
800
801 SPTR
ll_make_outlined_func_target_device(SPTR stblk_sptr,SPTR scope_sptr,ILM_OP opc)802 ll_make_outlined_func_target_device(SPTR stblk_sptr, SPTR scope_sptr, ILM_OP opc) {
803 SPTR sptr;
804 if(!eliminate_outlining(opc)) {
805 // Create a func sptr for omp target device
806 sptr =
807 ll_make_outlined_omptarget_func(stblk_sptr, scope_sptr, opc);
808 // Create ABI for the func sptr
809 ll_load_outlined_args(scope_sptr, sptr, gbl.outlined);
810 }
811 return sptr;
812 }
813
814 SPTR
ll_make_outlined_omptarget_func(SPTR stblk_sptr,SPTR scope_sptr,ILM_OP opc)815 ll_make_outlined_omptarget_func(SPTR stblk_sptr, SPTR scope_sptr, ILM_OP opc)
816 {
817 return makeOutlinedFunc(stblk_sptr, scope_sptr, false, false, true, opc);
818 }
819
820 SPTR
ll_make_outlined_func_wopc(SPTR stblk_sptr,SPTR scope_sptr,ILM_OP opc)821 ll_make_outlined_func_wopc(SPTR stblk_sptr, SPTR scope_sptr, ILM_OP opc)
822 {
823 return makeOutlinedFunc(stblk_sptr, scope_sptr, false, false, false, opc);
824 }
825
826 SPTR
ll_make_outlined_func(SPTR stblk_sptr,SPTR scope_sptr)827 ll_make_outlined_func(SPTR stblk_sptr, SPTR scope_sptr)
828 {
829 return makeOutlinedFunc(stblk_sptr, scope_sptr, false, false, false, N_ILM);
830 }
831
832 SPTR
ll_make_outlined_task(SPTR stblk_sptr,SPTR scope_sptr)833 ll_make_outlined_task(SPTR stblk_sptr, SPTR scope_sptr)
834 {
835 return makeOutlinedFunc(stblk_sptr, scope_sptr, true, false, false, N_ILM);
836 }
837
838 static int
llMakeTaskdupRoutine(int task_sptr)839 llMakeTaskdupRoutine(int task_sptr)
840 {
841 int dupsptr;
842
843 dupsptr = makeOutlinedFunc(0, 0, false, true, false, N_ILM);
844 TASKDUPP(task_sptr, dupsptr);
845 TASKDUPP(dupsptr, task_sptr);
846 ISTASKDUPP(dupsptr, 1);
847 return dupsptr;
848 }
849
850 static outliner_states_t
outliner_nextstate()851 outliner_nextstate()
852 {
853 static FILE *orig_ilmfil = 0;
854 if(hasILMRewrite) {
855 if(outl_state == outliner_not_active)
856 set_outliner_state(outliner_active_host_par1);
857 else if(gbl.ilmfil == par_file1)
858 set_outliner_state(outliner_active_host_par2);
859 else if(gbl.ilmfil == par_file2)
860 set_outliner_state(outliner_active_switchfile);
861 }
862 else if(outl_state == outliner_not_active || outl_state == outliner_reset)
863 set_outliner_state(outliner_not_active);
864 else
865 set_outliner_state(outliner_reset);
866 return outl_state;
867 }
868
869 int
ll_reset_parfile(void)870 ll_reset_parfile(void)
871 {
872 /* Process outliner state */
873 outliner_nextstate();
874
875 if (!savedILMFil)
876 savedILMFil = gbl.ilmfil;
877 int returnflag = 1;
878
879 switch (outl_state) {
880 case outliner_not_active:
881 returnflag = 0;
882 break;
883 case outliner_active_host_par1:
884 gbl.eof_flag = 0;
885 orig_ilmfil = gbl.ilmfil;
886 set_ilmfile(par_file1);
887 par_curfile = par_file2;
888 hasILMRewrite = 0;
889 (void)fseek(gbl.ilmfil, 0L, 0);
890 (void)fseek(par_curfile, 0L, 0);
891 break;
892 case outliner_active_host_par2:
893 set_ilmfile(par_file2);
894 gbl.eof_flag = 0;
895 par_curfile = par_file1;
896 truncate(parFileNm1, 0);
897 hasILMRewrite = 0;
898 (void)fseek(gbl.ilmfil, 0L, 0);
899 (void)fseek(par_curfile, 0L, 0);
900 break;
901 case outliner_active_switchfile:
902 set_ilmfile(par_file1);
903 gbl.eof_flag = 0;
904 par_curfile = par_file2;
905 truncate(parFileNm2, 0);
906 hasILMRewrite = 0;
907 (void)fseek(gbl.ilmfil, 0L, 0);
908 (void)fseek(par_curfile, 0L, 0);
909 break;
910 case outliner_reset:
911 if (orig_ilmfil)
912 set_ilmfile(orig_ilmfil);
913 truncate(parFileNm1, 0);
914 truncate(parFileNm2, 0);
915 (void)fseek(par_file1, 0L, 0);
916 (void)fseek(par_file2, 0L, 0);
917 par_curfile = par_file1;
918 reset_kmpc_ident_dtype();
919 resetThreadprivate();
920 returnflag = 0;
921 /* Set state again */
922 outliner_nextstate();
923
924 break;
925 default:
926 assert(0, "Unknown outliner state", outl_state, ERR_Fatal);
927 }
928 return returnflag;
929 }
930
931 int
ll_reset_parfile_(void)932 ll_reset_parfile_(void)
933 {
934 static FILE *orig_ilmfil = 0;
935 if (!savedILMFil)
936 savedILMFil = gbl.ilmfil;
937 if (hasILMRewrite) {
938 int i;
939 if (gbl.ilmfil == par_file1) {
940 gbl.ilmfil = par_file2;
941 gbl.eof_flag = 0;
942 par_curfile = par_file1;
943 truncate(parFileNm1, 0);
944 hasILMRewrite = 0;
945 (void)fseek(gbl.ilmfil, 0L, 0);
946 (void)fseek(par_curfile, 0L, 0);
947 return 1;
948 } else if (gbl.ilmfil == par_file2) {
949 gbl.ilmfil = par_file1;
950 gbl.eof_flag = 0;
951 par_curfile = par_file2;
952 truncate(parFileNm2, 0);
953 hasILMRewrite = 0;
954 (void)fseek(gbl.ilmfil, 0L, 0);
955 (void)fseek(par_curfile, 0L, 0);
956 return 1;
957 } else {
958 gbl.eof_flag = 0;
959 orig_ilmfil = gbl.ilmfil;
960 gbl.ilmfil = par_file1;
961 par_curfile = par_file2;
962 hasILMRewrite = 0;
963 (void)fseek(gbl.ilmfil, 0L, 0);
964 (void)fseek(par_curfile, 0L, 0);
965 return 1;
966 }
967 } else {
968 if (orig_ilmfil)
969 gbl.ilmfil = orig_ilmfil;
970 truncate(parFileNm1, 0);
971 truncate(parFileNm2, 0);
972 (void)fseek(par_file1, 0L, 0);
973 (void)fseek(par_file2, 0L, 0);
974 par_curfile = par_file1;
975 reset_kmpc_ident_dtype();
976 resetThreadprivate();
977 return 0;
978 }
979 return 0;
980 }
981
982 static int
llGetILMLen(int ilmx)983 llGetILMLen(int ilmx)
984 {
985 int opcx, len;
986 ILM *ilmpx;
987
988 opcx = ILM_OPC(ilmpx = (ILM *)(ilmb.ilm_base + ilmx));
989 len = ilms[opcx].oprs + 1;
990 if (IM_VAR(opcx))
991 len += ILM_OPND(ilmpx, 1); /* include the number of
992 * variable operands */
993 return len;
994 }
995
996 /* collect static variable for Fortran and collect threadprivate for C/C++(need
997 * early)*/
998 static void
llCollectSymbolInfo(ILM * ilmpx)999 llCollectSymbolInfo(ILM *ilmpx)
1000 {
1001 int flen, len, opnd;
1002 SPTR sptr;
1003 int opc, tpv;
1004
1005 opc = ILM_OPC(ilmpx);
1006 flen = len = ilms[opc].oprs + 1;
1007 if (IM_VAR(opc)) {
1008 len += ILM_OPND(ilmpx, 1); /* include the variable opnds */
1009 }
1010 /* is this a variable reference */
1011 for (opnd = 1; opnd <= flen; ++opnd) {
1012 if (IM_OPRFLAG(opc, opnd) == OPR_SYM) {
1013 sptr = ILM_SymOPND(ilmpx, opnd);
1014 if (sptr > 0 && sptr < stb.stg_avail) {
1015 switch (STYPEG(sptr)) {
1016 case ST_VAR:
1017 case ST_ARRAY:
1018 case ST_STRUCT:
1019 case ST_UNION:
1020 switch (SCG(sptr)) {
1021 case SC_AUTO:
1022 if (!CCSYMG(sptr) && (DINITG(sptr) || SAVEG(sptr))) {
1023 SCP(sptr, SC_STATIC);
1024 sym_is_refd(sptr);
1025 }
1026 break;
1027 case SC_STATIC:
1028 if (!CCSYMG(sptr)) {
1029 sym_is_refd(sptr);
1030 }
1031 break;
1032 default:;
1033 }
1034 default:;
1035 }
1036 }
1037 }
1038 }
1039 }
1040
1041 int
ll_rewrite_ilms(int lineno,int ilmx,int len)1042 ll_rewrite_ilms(int lineno, int ilmx, int len)
1043 {
1044 int nw, i;
1045 ILM *ilmpx;
1046 ILM_T nop = IM_NOP;
1047
1048 if (writeTaskdup) {
1049 if (len == 0)
1050 len = llGetILMLen(ilmx);
1051 ilmpx = (ILM *)(ilmb.ilm_base + ilmx);
1052 if (ilmx == 0 || pos == 0 || pos < ilmx) {
1053 pos = ilmx;
1054 allocTaskdup(len);
1055 memcpy((TASKDUP_FILE + TASKDUP_AVL), (char *)ilmpx, len * sizeof(ILM_T));
1056 TASKDUP_AVL += len;
1057 }
1058 }
1059
1060 if (!isRewritingILM) /* only write when this flag is set */
1061 return 0;
1062
1063 /* if we are writing to taskdup routine, we are going to
1064 * write IL_NOP to outlined function. One reason is that
1065 * we don't want to evaluate and set when see BMPPG/EMPPG
1066 */
1067 if (writeTaskdup) {
1068 if (len == 0)
1069 len = llGetILMLen(ilmx);
1070 if (ilmx == 0) {
1071 ilmpx = (ILM *)(ilmb.ilm_base + ilmx);
1072 nw = fwrite((char *)ilmpx, sizeof(ILM_T), len, par_curfile);
1073 #if DEBUG
1074 #endif
1075 } else {
1076 i = ilmx;
1077 while (len) {
1078 nw = fwrite((char *)&nop, sizeof(ILM_T), 1, par_curfile);
1079 #if DEBUG
1080 assert(nw, "error write to temp file in ll_rewrite_ilms", nw,
1081 ERR_Fatal);
1082 #endif
1083 len--;
1084 };
1085 }
1086 return 1;
1087 }
1088
1089 if (len == 0) {
1090 len = llGetILMLen(ilmx);
1091 }
1092 ilmpx = (ILM *)(ilmb.ilm_base + ilmx);
1093 if (!gbl.outlined)
1094 llCollectSymbolInfo(ilmpx);
1095 {
1096 {
1097 #ifdef OMP_OFFLOAD_LLVM
1098 /* ompaccel symbol replacer */
1099 if (flg.omptarget) {
1100 if (isReplacerEnabled) {
1101 ILM_T opc = ILM_OPC(ilmpx);
1102 if (op1Pld) {
1103 if (opc == IM_ELEMENT) {
1104 ILM_OPND(ilmpx, 2) = op1Pld;
1105 }
1106 op1Pld = 0;
1107 }
1108 if (opc == IM_BCS) {
1109 ompaccel_symreplacer(true);
1110 } else if (opc == IM_BCS) {
1111 ompaccel_symreplacer(false);
1112 } else if (ILM_OPC(ilmpx) == IM_ELEMENT && gbl.ompaccel_intarget ) {
1113 /* replace dtype for allocatable arrays */
1114 ILM_OPND(ilmpx, 3) =
1115 ompaccel_tinfo_current_get_dev_dtype(DTYPE(ILM_OPND(ilmpx, 3)));
1116 } else if (ILM_OPC(ilmpx) == IM_PLD && gbl.ompaccel_intarget) {
1117 /* replace host sptr with device sptrs, PLD keeps sptr in 2nd index
1118 */
1119 op1Pld = ILM_OPND(ilmpx, 1);
1120 ILM_OPND(ilmpx, 2) =
1121 ompaccel_tinfo_current_get_devsptr(ILM_SymOPND(ilmpx, 2));
1122 } else if(gbl.ompaccel_intarget) {
1123 /* replace host sptr with device sptrs */
1124 ILM_OPND(ilmpx, 1) =
1125 ompaccel_tinfo_current_get_devsptr(ILM_SymOPND(ilmpx, 1));
1126 }
1127 }
1128 }
1129 #endif
1130
1131 nw = fwrite((char *)ilmpx, sizeof(ILM_T), len, par_curfile);
1132 #if DEBUG
1133 assert(nw, "error write to temp file in ll_rewrite_ilms", nw, ERR_Fatal);
1134 #endif
1135 }
1136 }
1137 return 1;
1138 }
1139
1140 /*
1141 * 0 BOS 4 1 6
1142 * 4 ENTRY 207 ;sub
1143 *
1144 * 0 BOS 4 1 5
1145 * 4 ENLAB
1146 */
1147
1148 void
ll_write_ilm_header(int outlined_sptr,int curilm)1149 ll_write_ilm_header(int outlined_sptr, int curilm)
1150 {
1151 int nw, len, noplen;
1152 ILM_T t[6];
1153 ILM_T t2[6];
1154 ILM_T t3[4];
1155 ILM_T tbeg[5];
1156
1157 if (!par_curfile)
1158 par_curfile = par_file1;
1159
1160 t[0] = IM_BOS;
1161 t[1] = gbl.lineno;
1162 t[2] = gbl.findex;
1163 t[3] = 6;
1164 t[4] = IM_ENTRY;
1165 t[5] = outlined_sptr;
1166
1167 t2[0] = IM_BOS;
1168 t2[1] = gbl.lineno;
1169 t2[2] = gbl.findex;
1170 t2[3] = 5;
1171 t2[4] = IM_ENLAB;
1172 t2[5] = 0;
1173
1174 t3[0] = IM_BOS;
1175 t3[1] = gbl.lineno;
1176 t3[2] = gbl.findex;
1177 t3[3] = ilmb.ilmavl;
1178
1179 setRewritingILM();
1180 hasILMRewrite = 1;
1181
1182 nw = fwrite((char *)t, sizeof(ILM_T), 6, par_curfile);
1183 nw = fwrite((char *)t2, sizeof(ILM_T), 5, par_curfile);
1184
1185 len = llGetILMLen(curilm);
1186 noplen = curilm + len;
1187 len = ilmb.ilmavl - (curilm + len);
1188 if (len) {
1189 nw = fwrite((char *)t3, sizeof(ILM_T), 4, par_curfile);
1190 llWriteNopILM(gbl.lineno, 0, noplen - 4);
1191 }
1192 #if DEBUG
1193 #endif
1194 }
1195
1196 /*
1197 * read outlined ilm header to get outlined function sptr so that we can set
1198 * gbl.currsub to it. Fortran check gbl.currsub early in the init.
1199 */
1200 static int
llReadILMHeader()1201 llReadILMHeader()
1202 {
1203 int nw, outlined_sptr = 0;
1204 ILM_T t[6];
1205
1206 if (!gbl.ilmfil)
1207 return 0;
1208
1209 nw = fread((char *)t, sizeof(ILM_T), 6, gbl.ilmfil);
1210
1211 if (nw)
1212 outlined_sptr = t[5];
1213
1214 return outlined_sptr;
1215 }
1216
1217 /*
1218 * 0 BOS 14 1 5
1219 * 4 END
1220 */
1221 void
ll_write_ilm_end(void)1222 ll_write_ilm_end(void) {
1223 int nw;
1224 ILM_T t[6];
1225 ILM_T tend[5];
1226
1227 t[0] = IM_BOS;
1228 t[1] = gbl.lineno;
1229 t[2] = gbl.findex;
1230 t[3] = 5;
1231 t[4] = IM_END;
1232
1233 #if DEBUG
1234 #endif
1235
1236 nw = fwrite((char *)t, sizeof(ILM_T), 5, par_curfile);
1237 }
1238
1239 void
llWriteNopILM(int lineno,int ilmx,int len)1240 llWriteNopILM(int lineno, int ilmx, int len)
1241 {
1242 int nw, i, tlen;
1243 ILM_T nop = IM_NOP;
1244
1245 if (writeTaskdup) {
1246 tlen = len;
1247 if (tlen == 0)
1248 tlen = llGetILMLen(ilmx);
1249 if (tlen)
1250 allocTaskdup(tlen);
1251 while (tlen) {
1252 memcpy((TASKDUP_FILE + TASKDUP_AVL), (char *)&nop, sizeof(ILM_T));
1253 TASKDUP_AVL += 1;
1254 tlen--;
1255 };
1256 }
1257
1258 if (!isRewritingILM) /* only write when this flag is set */
1259 return;
1260
1261 if (len == 0)
1262 len = llGetILMLen(ilmx);
1263 i = ilmx;
1264 while (len) {
1265 nw = fwrite((char *)&nop, sizeof(ILM_T), 1, par_curfile);
1266 #if DEBUG
1267 assert(nw, "error write to temp file in ll_rewrite_ilms", nw, ERR_Fatal);
1268 #endif
1269 len--;
1270 };
1271 }
1272
1273 void
ilm_outlined_pad_ilm(int curilm)1274 ilm_outlined_pad_ilm(int curilm)
1275 {
1276 int len;
1277 llWriteNopILM(-1, curilm, 0);
1278 len = llGetILMLen(curilm);
1279 len = ilmb.ilmavl - (curilm + len);
1280 if (len) {
1281 llWriteNopILM(-1, curilm, len);
1282 }
1283 }
1284
1285 static SPTR
createUplevelSptr(SPTR uplevel_sptr)1286 createUplevelSptr(SPTR uplevel_sptr)
1287 {
1288 static int n;
1289 LLUplevel *up;
1290 SPTR uplevelSym = getccssym("uplevelArgPack", ++n, ST_STRUCT);
1291 DTYPE uplevel_dtype = ll_make_uplevel_type(uplevel_sptr);
1292 up = llmp_get_uplevel(uplevel_sptr);
1293 llmp_uplevel_set_dtype(up, uplevel_dtype);
1294 DTYPEP(uplevelSym, uplevel_dtype);
1295 if (gbl.outlined)
1296 SCP(uplevelSym, SC_PRIVATE);
1297 else
1298 SCP(uplevelSym, SC_AUTO);
1299
1300 /* set alignment of last argument for GPU "align 8". */
1301 if (DTY(uplevel_dtype) == TY_STRUCT)
1302 DTySetAlgTyAlign(uplevel_dtype, 7);
1303
1304 if (DTY(DTYPEG(uplevelSym)) == TY_STRUCT)
1305 DTySetAlgTyAlign(DTYPEG(uplevelSym), 7);
1306
1307 return uplevelSym;
1308 }
1309
1310 /* Create a new local uplevel variable and perform a shallow copy of the
1311 * original uplevel_sptr to the new uplevel sptr.
1312 */
1313 static SPTR
cloneUplevel(SPTR fr_uplevel_sptr,SPTR to_uplevel_sptr,bool is_task)1314 cloneUplevel(SPTR fr_uplevel_sptr, SPTR to_uplevel_sptr, bool is_task)
1315 {
1316 int ilix, dest_nme, src_nme;
1317 const SPTR new_uplevel = createUplevelSptr(to_uplevel_sptr);
1318 const DTYPE uplevel_dtype = DTYPEG(new_uplevel);
1319 ISZ_T count = ll_parent_vals_count(to_uplevel_sptr);
1320
1321 if (gbl.internal >= 1)
1322 count = count + 1;
1323
1324 /* rm_smove will convert SMOVEI into SMOVE. When doing this
1325 * rm_smove will remove one ILI so we need to add an ili, so that it is
1326 * removed when rm_smove executes.
1327 */
1328 if (DTYPEG(fr_uplevel_sptr) == DT_ADDR) {
1329 src_nme = addnme(NT_VAR, fr_uplevel_sptr, 0, 0);
1330 ilix = ad2ili(IL_LDA, ad_acon(fr_uplevel_sptr, 0), src_nme);
1331 } else {
1332 int ili = mk_address(fr_uplevel_sptr);
1333 SPTR arg = mk_argasym(fr_uplevel_sptr);
1334 src_nme = addnme(NT_VAR, arg, 0, (INT)0);
1335 ilix = ad2ili(IL_LDA, ili, src_nme);
1336 }
1337
1338 /* For nested tasks: the ilix will reference the task object pointer.
1339 * So in that case we just loaded the task, and will need to next load the
1340 * uplevel stored at offset zero in that task object, that is what this load
1341 * does.
1342 * For Fortran, we store the uplevel in a temp address(more or less like homing)
1343 * so we need to make sure to have another load so that when
1344 * rm_smove remove one ILI, it gets to the correct address.
1345 */
1346 if (DTYPEG(fr_uplevel_sptr) != DT_ADDR)
1347 if (TASKFNG(GBL_CURRFUNC)) {
1348 ilix = ad2ili(IL_LDA, ilix, 0); /* task[0] */
1349 }
1350
1351 /* Copy the uplevel to the local version of the uplevel */
1352 if (is_task) {
1353 int to_ili;
1354 SPTR taskAllocSptr = llTaskAllocSptr();
1355 dest_nme = addnme(NT_VAR, taskAllocSptr, 0, 0);
1356 dest_nme = addnme(NT_IND, SPTR_NULL, dest_nme, 0);
1357 to_ili = ad2ili(IL_LDA, ad_acon(taskAllocSptr, 0), dest_nme);
1358 to_ili = ad2ili(IL_LDA, to_ili, dest_nme);
1359 ilix = ad5ili(IL_SMOVEJ, ilix, to_ili, src_nme, dest_nme, ((int)count) * TARGET_PTRSIZE);
1360 } else {
1361 dest_nme = addnme(NT_VAR, new_uplevel, 0, 0);
1362 ilix = ad5ili(IL_SMOVEJ, ilix, ad_acon(new_uplevel, 0), src_nme, dest_nme,
1363 ((int)count) * TARGET_PTRSIZE);
1364 }
1365 chk_block(ilix);
1366
1367 return new_uplevel;
1368 }
1369
1370 static int
loadCharLen(SPTR lensym)1371 loadCharLen(SPTR lensym)
1372 {
1373 int ilix = mk_address(lensym);
1374 if (DTYPEG(lensym) == DT_INT8)
1375 ilix = ad3ili(IL_LDKR, ilix, addnme(NT_VAR, lensym, 0, 0), MSZ_I8);
1376 else
1377 ilix = ad3ili(IL_LD, ilix, addnme(NT_VAR, lensym, 0, 0), MSZ_WORD);
1378 return ilix;
1379 }
1380
1381 static int
toUplevelAddr(SPTR taskAllocSptr,SPTR uplevel,int offset)1382 toUplevelAddr(SPTR taskAllocSptr, SPTR uplevel, int offset)
1383 {
1384 int ilix, nme, addr;
1385 if (taskAllocSptr != SPTR_NULL) {
1386 ilix = ad_acon(taskAllocSptr, 0);
1387 nme = addnme(NT_VAR, taskAllocSptr, 0, 0);
1388 addr = ad2ili(IL_LDA, ilix, nme);
1389 addr = ad2ili(IL_LDA, addr, addnme(NT_IND, taskAllocSptr, nme, 0));
1390 if (offset != 0)
1391 addr = ad3ili(IL_AADD, addr, ad_aconi(offset), 0);
1392 } else {
1393 if (TASKFNG(GBL_CURRFUNC) && DTYPEG(uplevel) == DT_ADDR) {
1394 ilix = ad_acon(uplevel, 0);
1395 addr = ad2ili(IL_LDA, ilix, nme);
1396 } else {
1397 addr = ad_acon(uplevel, offset);
1398 }
1399 }
1400 return addr;
1401 }
1402
1403 static void
handle_nested_threadprivate(LLUplevel * parent,SPTR uplevel,SPTR taskAllocSptr,int nme)1404 handle_nested_threadprivate(LLUplevel *parent, SPTR uplevel, SPTR taskAllocSptr,
1405 int nme)
1406 {
1407 int i, sym, ilix, addr, val;
1408 SPTR sptr;
1409 int offset;
1410 if (parent && parent->vals_count) {
1411 int count = parent->vals_count;
1412 for (i = 0; i < parent->vals_count; ++i) {
1413 sptr = (SPTR)parent->vals[i];
1414 if (THREADG(sptr)) {
1415 if (SCG(sptr) == SC_BASED && MIDNUMG(sptr)) {
1416 sptr = MIDNUMG(sptr);
1417 }
1418 offset = ll_get_uplevel_offset(sptr);
1419 sym = getThreadPrivateTp(sptr);
1420 val = llGetThreadprivateAddr(sym);
1421 addr = toUplevelAddr(taskAllocSptr, uplevel, offset);
1422 ilix = ad4ili(IL_STA, val, addr, nme, MSZ_PTR);
1423 chk_block(ilix);
1424 }
1425 }
1426 }
1427 }
1428
1429 /*
1430 * given a member of a struct datatype and an offset,
1431 * returns the sibling member with that has ADDRESSG to match the offset
1432 */
1433 static SPTR
member_with_offset(SPTR member,int offset)1434 member_with_offset(SPTR member, int offset)
1435 {
1436 for( ; member > NOSYM && ADDRESSG(member) < offset; member = SYMLKG(member)) {
1437 if (ADDRESSG(member) = offset)
1438 return member; /* found the matching member */
1439 }
1440 return SPTR_NULL; /* trouble. */
1441 } /* member_with_offset */
1442
1443 /* Generate load instructions to load just the fields of the uplevel table for
1444 * this function.
1445 * uplevel: sptr to the uplevel table for this nest of regions.
1446 * base: Base index into aux table.
1447 * count: Number of sptrs to consecutively store in uplevel.
1448 *
1449 * Returns the ili for the sequence of store ilis.
1450 */
1451 static int
loadUplevelArgsForRegion(SPTR uplevel,SPTR taskAllocSptr,int count,int uplevel_stblk_sptr)1452 loadUplevelArgsForRegion(SPTR uplevel, SPTR taskAllocSptr, int count,
1453 int uplevel_stblk_sptr)
1454 {
1455 int i, addr, ilix, offset, val, nme, encl, based;
1456 DTYPE dtype;
1457 SPTR lensptr, member;
1458 bool do_load, byval;
1459 ISZ_T addition;
1460 const LLUplevel *up = NULL;
1461 if (llmp_has_uplevel(uplevel_stblk_sptr)) {
1462 up = llmp_get_uplevel(uplevel_stblk_sptr);
1463 }
1464 offset = 0;
1465 if (taskAllocSptr != SPTR_NULL) {
1466 nme = addnme(NT_VAR, taskAllocSptr, 0, 0);
1467 nme = addnme(NT_IND, taskAllocSptr, nme, 0);
1468 } else {
1469 nme = addnme(NT_VAR, uplevel, 0, 0);
1470 }
1471 /* load display argument from host routine */
1472 if (gbl.internal >= 1) {
1473 SPTR sptr = aux.curr_entry->display;
1474 if (gbl.outlined) {
1475 ADDRTKNP(sptr, 1);
1476 val = mk_address(sptr);
1477 val = ad2ili(IL_LDA, val, addnme(NT_VAR, sptr, 0, (INT)0));
1478 } else if (gbl.internal == 1) {
1479 ADDRTKNP(sptr, 1);
1480 val = mk_address(sptr);
1481 } else {
1482 sptr = mk_argasym(sptr);
1483 val = mk_address(sptr);
1484 val = ad2ili(IL_LDA, val, addnme(NT_VAR, sptr, 0, (INT)0));
1485 }
1486 if (taskAllocSptr != SPTR_NULL) {
1487 addr = toUplevelAddr(taskAllocSptr, (SPTR)uplevel_stblk_sptr, 0);
1488 } else {
1489 addr = ad_acon(uplevel, offset);
1490 }
1491 ilix = ad4ili(IL_STA, val, addr, nme, MSZ_PTR);
1492 chk_block(ilix);
1493 offset += size_of(DT_CPTR);
1494 }
1495 addition = ll_parent_vals_count(uplevel_stblk_sptr) * size_of(DT_CPTR);
1496 offset = offset + addition;
1497 if (up)
1498 count = up->vals_count;
1499
1500 lensptr = SPTR_NULL;
1501 byval = 0;
1502 dtype = DTYPEG(uplevel);
1503 member = DTyAlgTyMember(dtype);
1504 for (i = 0; i < count; ++i) {
1505 SPTR sptr = (SPTR)up->vals[i]; // ???
1506
1507 based = 0;
1508 if (!sptr && !lensptr) {
1509 // We put a placeholder in the front end for character len.
1510 offset += size_of(DT_CPTR);
1511 continue;
1512 }
1513
1514 /* Load the uplevel pointer and get the offset where the pointer to the
1515 * member should be placed.
1516 */
1517 if (!lensptr && need_charlen(DTYPEG(sptr))) {
1518 lensptr = CLENG(sptr);
1519 }
1520 if (lensptr && !sptr) {
1521 val = loadCharLen(lensptr);
1522 byval = 1;
1523 sptr = lensptr;
1524 } else if (SCG(sptr) == SC_DUMMY) {
1525 SPTR asym = mk_argasym(sptr);
1526 int anme = addnme(NT_VAR, asym, 0, (INT)0);
1527 val = mk_address(sptr);
1528 val = ad2ili(IL_LDA, val, anme);
1529
1530 } else if (SCG(sptr) == SC_BASED && MIDNUMG(sptr)) {
1531 /* for adjustable len char the $p does not have
1532 * clen field so we need to reference it from
1533 * the SC_BASED
1534 */
1535 based = sptr;
1536 sptr = MIDNUMG(sptr);
1537 val = mk_address(sptr);
1538 #if DO_NOT_DUPLICATE_LOAD_THEN_FIX_ME
1539 offset += size_of(DT_CPTR);
1540 continue;
1541 #endif
1542 if (SCG(sptr) == SC_DUMMY) {
1543 SPTR asym = mk_argasym(sptr);
1544 int anme = addnme(NT_VAR, asym, 0, (INT)0);
1545 val = mk_address(sptr);
1546 val = ad2ili(IL_LDA, val, anme);
1547 } else if (THREADG(sptr)) {
1548 int sym = getThreadPrivateTp(sptr);
1549 val = llGetThreadprivateAddr(sym);
1550 }
1551 } else
1552 if (THREADG(sptr)) {
1553 /*
1554 * special handle for copyin threadprivate var - we put it in uplevel
1555 * structure
1556 * so that we get master threadprivate copy and pass down to its team.
1557 */
1558 int sym = getThreadPrivateTp(sptr);
1559 val = llGetThreadprivateAddr(sym);
1560 } else
1561 val = mk_address(sptr);
1562 addr = toUplevelAddr(taskAllocSptr, uplevel, offset);
1563 /* Skip non-openmp ST_BLOCKS stop at closest one (uplevel is set) */
1564 encl = ENCLFUNCG(sptr);
1565 if (STYPEG(encl) != ST_ENTRY && STYPEG(encl) != ST_PROC)
1566 while (encl && ((STYPEG(ENCLFUNCG(encl)) != ST_ENTRY) ||
1567 (STYPEG(ENCLFUNCG(encl)) != ST_PROC)))
1568 {
1569 if (PARUPLEVELG(encl)) /* Only OpenMP blocks use this */
1570 break;
1571 encl = ENCLFUNCG(encl);
1572 }
1573
1574 /* Private and encl is an omp block not expanded, then do not load */
1575 if (encl && PARUPLEVELG(encl) && SCG(sptr) == SC_PRIVATE &&
1576 (STYPEG(encl) == ST_BLOCK)) {
1577 if (!PARENCLFUNCG(encl)) {
1578 offset += size_of(DT_CPTR);
1579 continue;
1580 } else {
1581 if ((STYPEG(ENCLFUNCG(encl)) != ST_ENTRY))
1582 {
1583 offset += size_of(DT_CPTR);
1584 lensptr = SPTR_NULL;
1585 continue;
1586 }
1587 }
1588 }
1589 /* Determine if we should call a store */
1590 do_load = false;
1591 if (THREADG(sptr)) {
1592 do_load = true;
1593 } else if (!gbl.outlined && SCG(sptr) != SC_PRIVATE) {
1594 do_load = true; /* Non-private before outlined func - always load */
1595 sym_is_refd(sptr);
1596 if (SCG(sptr) == SC_STATIC) {
1597 if (based)
1598 ADDRTKNP(based, 1);
1599 else
1600 ADDRTKNP(sptr, 1);
1601 offset += size_of(DT_CPTR);
1602 continue;
1603 }
1604 } else if (gbl.outlined && is_llvm_local_private(sptr))
1605 do_load = true;
1606
1607 if (do_load) {
1608 int mnmex;
1609 if (based) {
1610 /* PARREFLOAD is set if ADDRTKN of based was false */
1611 PARREFLOADP(based, !ADDRTKNG(based));
1612 ADDRTKNP(based, 1);
1613 } else
1614 {
1615 /* PARREFLOAD is set if ADDRTKN of sptr was false */
1616 PARREFLOADP(sptr, !ADDRTKNG(sptr));
1617 /* prevent optimizer to remove store instruction */
1618 ADDRTKNP(sptr, 1);
1619 }
1620 if (!XBIT(69, 0x80000)) {
1621 mnmex = nme;
1622 } else {
1623 member = member_with_offset(member, offset);
1624 if (!member) {
1625 mnmex = nme;
1626 } else {
1627 mnmex = addnme(NT_MEM, member, nme, 0);
1628 }
1629 }
1630 if (lensptr && byval) {
1631 if (CHARLEN_64BIT) {
1632 val = sel_iconv(val, 1);
1633 ilix = ad4ili(IL_STKR, val, addr, mnmex, MSZ_I8);
1634 } else {
1635 val = sel_iconv(val, 0);
1636 ilix = ad4ili(IL_ST, val, addr, mnmex, MSZ_WORD);
1637 }
1638 lensptr = SPTR_NULL;
1639 byval = 0;
1640 } else {
1641 ilix = ad4ili(IL_STA, val, addr, nme, MSZ_PTR);
1642 }
1643 chk_block(ilix);
1644 }
1645 // //TODO ompaccel optimize load offset for team-private.
1646 offset += size_of(DT_CPTR);
1647 }
1648 /* Special handling for threadprivate copyin, we need to copy the
1649 * address of current master copy to its slaves.
1650 */
1651 if (count == 0) {
1652 handle_nested_threadprivate(
1653 llmp_outermost_uplevel((SPTR)uplevel_stblk_sptr), uplevel,
1654 taskAllocSptr, nme);
1655 }
1656 return ad_acon(uplevel, 0);
1657 }
1658
1659 /* Either:
1660 *
1661 * 1) Create an instance of the uplevel argument for the outlined call that
1662 * expects scope_blk_sptr.
1663 *
1664 * 2) Create the uplevel table and pass that as an arg.
1665 *
1666 */
1667 int
ll_load_outlined_args(int scope_blk_sptr,SPTR callee_sptr,bool clone)1668 ll_load_outlined_args(int scope_blk_sptr, SPTR callee_sptr, bool clone)
1669 {
1670 LLUplevel *up;
1671 DTYPE uplevel_dtype;
1672 SPTR uplevel, taskAllocSptr = SPTR_NULL;
1673 int base, count, addr, val, ilix, newcount;
1674 const SPTR uplevel_sptr = (SPTR)PARUPLEVELG(scope_blk_sptr); // ???
1675 static int n;
1676 bool is_task = false;
1677 bool pass_uplevel_byval = false;
1678 /* If this is not the parent for a nest of funcs just return uplevel tbl ptr
1679 * which was passed to this function as arg3.
1680 */
1681 base = 0;
1682 count =
1683 PARSYMSG(uplevel_sptr) ? llmp_get_uplevel(uplevel_sptr)->vals_count : 0;
1684 newcount = count;
1685 if (gbl.internal >= 1) {
1686 if (count == 0 && PARSYMSG(uplevel_sptr) == 0) {
1687 const int key = llmp_get_next_key();
1688 LLUplevel *up = llmp_create_uplevel_bykey(key);
1689 PARSYMSP(uplevel_sptr, key);
1690 }
1691 newcount = count + 1;
1692 }
1693
1694 is_task = TASKFNG(callee_sptr) ? true : false;
1695 if (is_task) {
1696 taskAllocSptr = llTaskAllocSptr();
1697 }
1698 if (gbl.outlined) {
1699 uplevelSym = uplevel = aux.curr_entry->uplevel;
1700 ll_process_routine_parameters(callee_sptr);
1701 sym_is_refd(callee_sptr);
1702 /* Clone: See comment in this function's description above. */
1703 if (ll_parent_vals_count(uplevel_sptr) != 0) {
1704 if(!pass_uplevel_byval)
1705 uplevel = cloneUplevel(uplevel, uplevel_sptr, is_task);
1706 uplevelSym = uplevel;
1707 } else if (newcount) {
1708 /* nothing to copy in parent */
1709 uplevelSym = uplevel = createUplevelSptr(uplevel_sptr);
1710 uplevel_dtype = DTYPEG(uplevelSym);
1711 REFP(uplevel, 1);
1712 }
1713 } else { /* Else: is the parent and we need to create an uplevel table */
1714 if (newcount == 0) { /* No items to pass via uplevel, just pass null */
1715 ll_process_routine_parameters(callee_sptr);
1716 return ad_aconi(0);
1717 }
1718 /* Create an uplevel instance and give it a custom struct type */
1719 uplevelSym = uplevel = createUplevelSptr(uplevel_sptr);
1720 uplevel_dtype = DTYPEG(uplevelSym);
1721 REFP(uplevel, 1); /* don't want it to go in sym_is_refd */
1722
1723 DTYPEP(uplevel, uplevel_dtype);
1724
1725 /* Align uplevel for GPU "align 8" */
1726 ll_process_routine_parameters(callee_sptr);
1727 sym_is_refd(callee_sptr);
1728 /* set alignment of last argument for GPU "align 8". It may not be the same
1729 * as uplevel if this is task */
1730 if (DTY(uplevel_dtype) == TY_STRUCT)
1731 DTySetAlgTyAlign(uplevel_dtype, 7);
1732
1733 if (DTY(DTYPEG(uplevel)) == TY_STRUCT)
1734 DTySetAlgTyAlign(DTYPEG(uplevel), 7);
1735
1736 /* Debug */
1737 if (DBGBIT(45, 0x8))
1738 dumpUplevel(uplevel);
1739 }
1740 if(pass_uplevel_byval) {
1741 ilix = ad3ili(IL_LDA, ad_acon(uplevel, 0), addnme(NT_VAR, uplevel, 0, 0),
1742 MSZ_PTR);
1743 } else
1744 ilix =
1745 loadUplevelArgsForRegion(uplevel, taskAllocSptr, newcount, uplevel_sptr);
1746 if (TASKFNG(GBL_CURRFUNC) && DTYPEG(uplevel) == DT_ADDR)
1747 ilix = ad2ili(IL_LDA, ilix, addnme(NT_VAR, uplevel, 0, 0));
1748
1749 return ilix;
1750 }
1751
1752 int
ll_get_uplevel_offset(int sptr)1753 ll_get_uplevel_offset(int sptr)
1754 {
1755 DTYPE dtype;
1756 SPTR mem;
1757
1758 if (gbl.outlined || ISTASKDUPG(GBL_CURRFUNC)) {
1759 int scope_sptr;
1760 int uplevel_stblk;
1761 LLUplevel *uplevel;
1762
1763 if (ISTASKDUPG(GBL_CURRFUNC)) {
1764 scope_sptr = OUTLINEDG(TASKDUPG(GBL_CURRFUNC));
1765 } else {
1766 scope_sptr = OUTLINEDG(GBL_CURRFUNC);
1767 }
1768 uplevel_stblk = PARUPLEVELG(scope_sptr);
1769 redo:
1770 uplevel = llmp_get_uplevel(uplevel_stblk);
1771
1772 dtype = uplevel->dtype;
1773 for (mem = DTyAlgTyMember(dtype); mem > 1; mem = SYMLKG(mem))
1774 if (PAROFFSETG(mem) == sptr)
1775 return ADDRESSG(mem);
1776 if (uplevel->parent) {
1777 uplevel_stblk = uplevel->parent;
1778 goto redo;
1779 }
1780 }
1781
1782 return ADDRESSG(sptr);
1783 }
1784
1785 int
ll_make_outlined_call(int func_sptr,int arg1,int arg2,int arg3)1786 ll_make_outlined_call(int func_sptr, int arg1, int arg2, int arg3)
1787 {
1788 int i, ilix, altili, argili;
1789 const int nargs = 3;
1790 char *funcname = SYMNAME(func_sptr);
1791
1792 argili = ad_aconi(0);
1793 ilix = ll_ad_outlined_func(IL_NONE, IL_JSR, funcname, nargs, argili, argili,
1794 arg3);
1795
1796 altili = ll_make_outlined_gjsr(func_sptr, nargs, argili, argili, arg3);
1797 ILI_ALT(ilix) = altili;
1798
1799 return ilix;
1800 }
1801
1802 /* whicharg starts from 1 to narg - 1 */
1803 SPTR
ll_get_hostprog_arg(int func_sptr,int whicharg)1804 ll_get_hostprog_arg(int func_sptr, int whicharg)
1805 {
1806 int paramct, dpdscp;
1807 SPTR sym;
1808 int uplevel, i, dtype;
1809
1810 paramct = PARAMCTG(func_sptr);
1811 dpdscp = DPDSCG(func_sptr);
1812
1813 sym = (SPTR)aux.dpdsc_base[dpdscp + (whicharg - 1)]; // ???
1814 return sym;
1815 }
1816
1817 int
ll_make_outlined_call2(int func_sptr,int uplevel_ili)1818 ll_make_outlined_call2(int func_sptr, int uplevel_ili)
1819 {
1820 int i, ilix, altili, argili;
1821 int nargs = 3;
1822 int arg1, arg2, arg3, args[3];
1823 static int n;
1824
1825 if (!gbl.outlined) {
1826 /* orphaned outlined function */
1827 arg1 = args[2] = ll_get_gtid_addr_ili();
1828 arg2 = args[1] = genNullArg();
1829 arg3 = args[0] = uplevel_ili;
1830 } else {
1831 /* The first and second arguments are from host program */
1832 SPTR sarg1 = ll_get_hostprog_arg(GBL_CURRFUNC, 1);
1833 SPTR sarg2 = ll_get_hostprog_arg(GBL_CURRFUNC, 2);
1834 arg3 = args[0] = uplevel_ili;
1835 arg1 = args[2] = mk_address(sarg1);
1836 arg2 = args[1] = mk_address(sarg2);
1837 }
1838 ilix = ll_ad_outlined_func2(IL_NONE, IL_JSR, func_sptr, nargs, args);
1839
1840 altili = ll_make_outlined_gjsr(func_sptr, nargs, arg1, arg2, arg3);
1841 ILI_ALT(ilix) = altili;
1842
1843 return ilix;
1844 }
1845
1846 /* Call an outlined task.
1847 * func_sptr: Outlined function representing a task.
1848 * task_sptr: Allocated kmpc task struct
1849 */
1850 int
ll_make_outlined_task_call(int func_sptr,SPTR task_sptr)1851 ll_make_outlined_task_call(int func_sptr, SPTR task_sptr)
1852 {
1853 int altili, ilix;
1854 int arg1, arg2, args[2] = {0};
1855
1856 arg1 = args[1] = ll_get_gtid_val_ili();
1857 arg2 = args[0] =
1858 ad2ili(IL_LDA, ad_acon(task_sptr, 0), addnme(NT_VAR, task_sptr, 0, 0));
1859 ilix = ll_ad_outlined_func2(IL_NONE, IL_JSR, func_sptr, 2, args);
1860
1861 altili = ll_make_outlined_gjsr(func_sptr, 2, arg1, arg2, 0);
1862 ILI_ALT(ilix) = altili;
1863
1864 return ilix;
1865 }
1866
1867 void
llvm_set_unique_sym(int sptr)1868 llvm_set_unique_sym(int sptr)
1869 {
1870 if (!llvmUniqueSym) { /* once set - don't overwrite it */
1871 llvmUniqueSym = sptr;
1872 }
1873 }
1874
1875 void
ll_set_outlined_currsub(bool isILMrecompile)1876 ll_set_outlined_currsub(bool isILMrecompile)
1877 {
1878 int scope_sptr;
1879 static long gilmpos;
1880 static SPTR prev_func_sptr;
1881 if(!isILMrecompile)
1882 gilmpos = ftell(gbl.ilmfil);
1883 gbl.currsub = (SPTR)llReadILMHeader(); // ???
1884 if(!isILMrecompile)
1885 prev_func_sptr = gbl.currsub;
1886 scope_sptr = OUTLINEDG(gbl.currsub);
1887 if (scope_sptr && gbl.currsub)
1888 ENCLFUNCP(scope_sptr, PARENCLFUNCG(scope_sptr));
1889 gbl.rutype = RU_SUBR;
1890 if(DBGBIT(233,2) && gbl.currsub) {
1891 FILE *fp = gbl.dbgfil ? gbl.dbgfil : stdout;
1892 fprintf(fp, "[Outliner] GBL_CURRFUNC is set %s\n", SYMNAME(gbl.currsub));
1893 }
1894 fseek(gbl.ilmfil, gilmpos, 0);
1895 }
1896
1897 /* should be call when the host program is done */
1898 static void
resetThreadprivate(void)1899 resetThreadprivate(void)
1900 {
1901 int sym, next_tp;
1902 for (sym = gbl.threadprivate; sym > NOSYM; sym = next_tp) {
1903 next_tp = TPLNKG(sym);
1904 TPLNKP(sym, 0);
1905 }
1906 gbl.threadprivate = NOSYM;
1907 }
1908
1909 SPTR
ll_get_gtid(void)1910 ll_get_gtid(void)
1911 {
1912 return gtid;
1913 }
1914
1915 void
ll_reset_gtid(void)1916 ll_reset_gtid(void)
1917 {
1918 gtid = SPTR_NULL;
1919 }
1920
1921 void
ll_reset_outlined_func(void)1922 ll_reset_outlined_func(void)
1923 {
1924 uplevelSym = SPTR_NULL;
1925 }
1926
1927 SPTR
ll_get_uplevel_sym(void)1928 ll_get_uplevel_sym(void)
1929 {
1930 return uplevelSym;
1931 }
1932
1933 static void
llRestoreSavedILFil()1934 llRestoreSavedILFil()
1935 {
1936 if (savedILMFil)
1937 gbl.ilmfil = savedILMFil;
1938 }
1939
1940 void
ll_open_parfiles()1941 ll_open_parfiles()
1942 {
1943 int fd1, fd2;
1944 strcpy(parFileNm1, "pgipar1XXXXXX");
1945 strcpy(parFileNm2, "pgipar2XXXXXX");
1946 fd1 = mkstemp(parFileNm1);
1947 fd2 = mkstemp(parFileNm2);
1948 par_file1 = fdopen(fd1, "w+");
1949 par_file2 = fdopen(fd2, "w+");
1950 if (!par_file1)
1951 errfatal((error_code_t)4);
1952 if (!par_file2)
1953 errfatal((error_code_t)4);
1954 }
1955
1956 void
ll_unlink_parfiles()1957 ll_unlink_parfiles()
1958 {
1959 llRestoreSavedILFil();
1960 if (par_file1)
1961 unlink(parFileNm1);
1962 if (par_file2)
1963 unlink(parFileNm2);
1964 par_file1 = NULL;
1965 par_file2 = NULL;
1966 }
1967
1968 /* START: OUTLINING MCONCUR */
1969 void
llvmSetExpbCurIlt(void)1970 llvmSetExpbCurIlt(void)
1971 {
1972 expb.curilt = ILT_PREV(0);
1973 }
1974
1975 int
llvmGetExpbCurIlt(void)1976 llvmGetExpbCurIlt(void)
1977 {
1978 return expb.curilt;
1979 }
1980
1981 SPTR
llvmAddConcurEntryBlk(int bih)1982 llvmAddConcurEntryBlk(int bih)
1983 {
1984 int newbih, arg1, arg2, arg3, symdtype;
1985 int asym, ili_uplevel, nme, ili;
1986 SPTR funcsptr = GBL_CURRFUNC;
1987 SPTR display_temp = SPTR_NULL;
1988
1989 /* add entry block */
1990 newbih = addnewbih(bih, bih, bih);
1991 rdilts(newbih);
1992 expb.curbih = newbih;
1993 BIHNUMP(GBL_CURRFUNC, expb.curbih);
1994 expb.curilt = addilt(ILT_PREV(0), ad1ili(IL_ENTRY, GBL_CURRFUNC));
1995 wrilts(newbih);
1996 BIH_LABEL(newbih) = GBL_CURRFUNC;
1997 BIH_EN(newbih) = 1;
1998
1999 gbl.outlined = 1;
2000 gbl.entbih = newbih;
2001
2002 reset_kmpc_ident_dtype();
2003
2004 reg_init(GBL_CURRFUNC);
2005
2006 aux.curr_entry->uplevel = ll_get_shared_arg(GBL_CURRFUNC);
2007 asym = mk_argasym(aux.curr_entry->uplevel);
2008 ADDRESSP(asym, ADDRESSG(aux.curr_entry->uplevel)); /* propagate ADDRESS */
2009 MEMARGP(asym, 1);
2010
2011 if (gbl.internal > 1) {
2012 rdilts(newbih);
2013 display_temp = getccsym('S', gbl.currsub, ST_VAR);
2014 SCP(display_temp, SC_PRIVATE);
2015 ENCLFUNCP(display_temp, GBL_CURRFUNC);
2016 DTYPEP(display_temp, DT_ADDR);
2017 sym_is_refd(display_temp);
2018
2019 ili = ad_acon(display_temp, 0);
2020 nme = addnme(NT_VAR, display_temp, 0, 0);
2021
2022 ili_uplevel = mk_address(aux.curr_entry->uplevel);
2023 nme = addnme(NT_VAR, aux.curr_entry->uplevel, 0, 0);
2024 ili_uplevel = ad2ili(IL_LDA, ili_uplevel, nme);
2025 ili_uplevel =
2026 ad2ili(IL_LDA, ili_uplevel, addnme(NT_IND, display_temp, nme, 0));
2027
2028 ili = ad2ili(IL_LDA, ili, addnme(NT_IND, display_temp, nme, 0));
2029 nme = addnme(NT_VAR, display_temp, 0, 0);
2030 ili = ad3ili(IL_STA, ili_uplevel, ili, nme);
2031 expb.curilt = addilt(expb.curilt, ili);
2032 wrilts(newbih);
2033
2034 flg.recursive = true;
2035 }
2036
2037 newbih = addnewbih(bih, bih,
2038 bih); /* add empty block - make entry block separate */
2039 return display_temp;
2040 }
2041
2042 void
llvmAddConcurExitBlk(int bih)2043 llvmAddConcurExitBlk(int bih)
2044 {
2045 int newbih;
2046
2047 newbih = addnewbih(BIH_PREV(bih), bih, bih);
2048 rdilts(newbih);
2049 expb.curbih = newbih;
2050 expb.curilt = addilt(ILT_PREV(0), ad1ili(IL_EXIT, GBL_CURRFUNC));
2051 wrilts(newbih);
2052 BIH_XT(newbih) = 1;
2053 BIH_LAST(newbih) = 1;
2054 BIH_FT(newbih) = 0;
2055 expb.arglist = 0;
2056 expb.flags.bits.callfg = 0;
2057 mkrtemp_end();
2058 }
2059
2060 /* END: OUTLINING MCONCUR */
2061
2062 /* START: TASKDUP(kmp_task_t* task, kmp_task_t* newtask, int lastitr)
2063 * write all ilms between IM_BTASKLOOP and IM_ETASKLOOP
2064 * to a taskdup routine. Mostly use for firstprivate and
2065 * last iteration variables copy/constructor.
2066 * writeTaskdup is set when we see IM_BTASKLOOP and unset when
2067 * we see IM_TASKLOOPREG. It then will be set again after IM_ETASKLOOPREG
2068 * until IM_ETASKLOOP(C/C++ may have firstprivate initialization
2069 * later). Currently only private data allocation & initialization
2070 * are expected in those ilms. In future, if there are other ilms
2071 * in the mix, the we may need to provide some delimits to mark
2072 * where to start write and end.
2073 */
2074
2075 void
start_taskdup(int task_fnsptr,int curilm)2076 start_taskdup(int task_fnsptr, int curilm)
2077 {
2078 int nw, len, noplen;
2079 ILM_T t[6], t2[6], t3[6];
2080 writeTaskdup = true;
2081 t3[0] = IM_BOS;
2082 t3[1] = gbl.lineno;
2083 t3[2] = gbl.findex;
2084 t3[3] = ilmb.ilmavl;
2085 if (!TASKDUPG(task_fnsptr)) {
2086 int dupsptr = llMakeTaskdupRoutine(task_fnsptr);
2087 ILM_T t[6];
2088 ILM_T t2[6];
2089 ILM_T t3[4];
2090
2091 t[0] = IM_BOS;
2092 t[1] = gbl.lineno;
2093 t[2] = gbl.findex;
2094 t[3] = 6;
2095 t[4] = IM_ENTRY;
2096 t[5] = dupsptr;
2097
2098 t2[0] = IM_BOS;
2099 t2[1] = gbl.lineno;
2100 t2[2] = gbl.findex;
2101 t2[3] = 5;
2102 t2[4] = IM_ENLAB;
2103 t2[5] = 0;
2104
2105 allocTaskdup(6);
2106 memcpy((TASKDUP_FILE + TASKDUP_AVL), (char *)t, 6 * sizeof(ILM_T));
2107 TASKDUP_AVL += 6;
2108
2109 allocTaskdup(5);
2110 memcpy((TASKDUP_FILE + TASKDUP_AVL), (char *)t2, 5 * sizeof(ILM_T));
2111 TASKDUP_AVL += 5;
2112 }
2113 pos = 0;
2114 len = llGetILMLen(curilm);
2115 noplen = curilm + len;
2116 len = ilmb.ilmavl - (curilm + len);
2117 if (len) {
2118 allocTaskdup(4);
2119 memcpy((TASKDUP_FILE + TASKDUP_AVL), (char *)t3, 4 * sizeof(ILM_T));
2120 TASKDUP_AVL += 4;
2121 llWriteNopILM(gbl.lineno, 0, noplen - 4);
2122 }
2123 }
2124
2125 void
restartRewritingILM(int curilm)2126 restartRewritingILM(int curilm)
2127 {
2128 int len, noplen, nw;
2129 ILM_T t[6];
2130
2131 t[0] = IM_BOS;
2132 t[1] = gbl.lineno;
2133 t[2] = gbl.findex;
2134 t[3] = ilmb.ilmavl;
2135 pos = 0;
2136 len = llGetILMLen(curilm);
2137 noplen = curilm + len;
2138 len = ilmb.ilmavl - (curilm + len);
2139 setRewritingILM();
2140 if (len) {
2141 nw = fwrite((char *)t, sizeof(ILM_T), 4, par_curfile);
2142 #if DEBUG
2143 #endif
2144 llWriteNopILM(gbl.lineno, 0, noplen - 4);
2145 }
2146 }
2147
2148 void
stop_taskdup(int task_fnsptr,int curilm)2149 stop_taskdup(int task_fnsptr, int curilm)
2150 {
2151 /* write IL_NOP until the end of ILM blocks */
2152 ilm_outlined_pad_ilm(curilm);
2153 writeTaskdup = false;
2154 pos = 0;
2155 }
2156
2157 static void
clearTaskdup()2158 clearTaskdup()
2159 {
2160 FREE(TASKDUP_FILE);
2161 TASKDUP_AVL = 0;
2162 TASKDUP_SZ = 0;
2163 TASKDUP_FILE = NULL;
2164 }
2165
2166 static void
copyLastItr(int fnsptr,INT offset)2167 copyLastItr(int fnsptr, INT offset)
2168 {
2169 ILM_T *ptr;
2170 int offset_sptr;
2171 int total_ilms = 0;
2172 INT tmp[2];
2173 tmp[0] = 0;
2174 tmp[1] = offset;
2175 offset_sptr = getcon(tmp, DT_INT);
2176
2177 allocTaskdup(6);
2178 ptr = (TASKDUP_FILE + TASKDUP_AVL);
2179
2180 *ptr++ = IM_BOS;
2181 *ptr++ = gbl.lineno;
2182 *ptr++ = gbl.findex;
2183 *ptr++ = 6;
2184 total_ilms = total_ilms + 4;
2185
2186 *ptr++ = IM_TASKLASTPRIV;
2187 *ptr++ = offset_sptr;
2188 total_ilms = total_ilms + 2;
2189
2190 TASKDUP_AVL += total_ilms;
2191 }
2192
2193 void
finish_taskdup_routine(int curilm,int fnsptr,INT offset)2194 finish_taskdup_routine(int curilm, int fnsptr, INT offset)
2195 {
2196 int nw, len;
2197 ILM_T t[6];
2198 ILM_T nop = IM_NOP;
2199
2200 if (!TASKDUP_AVL)
2201 return;
2202
2203 t[0] = IM_BOS;
2204 t[1] = gbl.lineno;
2205 t[2] = gbl.findex;
2206 t[3] = 5;
2207 t[4] = IM_END;
2208 if (offset) {
2209 copyLastItr(fnsptr, offset);
2210 }
2211 /* write taskdup ilms to file */
2212 if (TASKDUP_AVL) {
2213 allocTaskdup(6);
2214 memcpy((TASKDUP_FILE + TASKDUP_AVL), (char *)t, 6 * sizeof(ILM_T));
2215 TASKDUP_AVL += 6;
2216
2217 nw = fwrite((char *)TASKDUP_FILE, sizeof(ILM_T), TASKDUP_AVL, par_curfile);
2218 #ifdef DEBUG
2219 #endif
2220 }
2221 clearTaskdup();
2222 writeTaskdup = false;
2223 hasILMRewrite = 1;
2224 pos = 0;
2225 }
2226
2227 static void
allocTaskdup(int len)2228 allocTaskdup(int len)
2229 {
2230 NEED((TASKDUP_AVL + len + 20), TASKDUP_FILE, ILM_T, TASKDUP_SZ,
2231 (TASKDUP_AVL + len + 20));
2232 }
2233
2234 /* END: TASKDUP routine */
2235
2236 void
unsetRewritingILM()2237 unsetRewritingILM()
2238 {
2239 isRewritingILM = 0;
2240 }
2241
2242 void
setRewritingILM()2243 setRewritingILM()
2244 {
2245 isRewritingILM = 1;
2246 }
2247
2248 bool
ll_ilm_is_rewriting(void)2249 ll_ilm_is_rewriting(void)
2250 {
2251 return isRewritingILM;
2252 }
2253
2254 int
ll_has_more_outlined()2255 ll_has_more_outlined()
2256 {
2257 return hasILMRewrite;
2258 }
2259
2260 int
llvm_ilms_rewrite_mode(void)2261 llvm_ilms_rewrite_mode(void)
2262 {
2263 if (gbl.ilmfil == par_file1 || gbl.ilmfil == par_file2)
2264 return 1;
2265 return 0;
2266 }
2267
2268 /* used by Fortran only. If gbl.ilmfil points to tempfile, then
2269 * we are processing ILMs in that file. This function is called
2270 * after we emit we call schedule of current function and we are
2271 * trying to decide if we should continue processing the current
2272 * file or the next tempfile.
2273 */
2274 int
llProcessNextTmpfile()2275 llProcessNextTmpfile()
2276 {
2277 if (gbl.ilmfil == par_file1 || gbl.ilmfil == par_file2)
2278 return 0;
2279 return hasILMRewrite;
2280 }
2281
2282 int
mk_function_call(DTYPE ret_dtype,int n_args,DTYPE * arg_dtypes,int * arg_ilis,SPTR func_sptr)2283 mk_function_call(DTYPE ret_dtype, int n_args, DTYPE *arg_dtypes, int *arg_ilis,
2284 SPTR func_sptr)
2285 {
2286 int i, r, ilix, altilix, gargs, *garg_ilis = ALLOCA (int, n_args);
2287 DTYPE *garg_types = ALLOCA (DTYPE, n_args);
2288
2289 DTYPEP(func_sptr, ret_dtype);
2290 // SCP(outlined_func_sptr, SC_EXTERN);
2291 STYPEP(func_sptr, ST_PROC);
2292 // CCSYMP(outlined_func_sptr, 1); /* currently we make all CCSYM func varargs
2293 // in Fortran. */
2294 CFUNCP(func_sptr, 1);
2295 // ll_make_ftn_outlined_params(outlined_func_sptr, n_args, arg_dtypes);
2296 ll_process_routine_parameters(func_sptr);
2297
2298 // sym_is_refd(outlined_func_sptr);
2299
2300 ilix = ll_ad_outlined_func2((ILI_OP)0, IL_JSR, func_sptr, n_args, arg_ilis);
2301
2302 /* Create the GJSR */
2303 for (i = n_args - 1; i >= 0; --i) { /* Reverse the order */
2304 garg_ilis[i] = arg_ilis[n_args - 1 - i];
2305 garg_types[i] = arg_dtypes[n_args - 1 - i];
2306 }
2307 gargs = ll_make_outlined_garg(n_args, garg_ilis, garg_types);
2308 altilix = ad3ili(IL_GJSR, func_sptr, gargs, 0);
2309
2310 /* Add gjsr as an alt to the jsr */
2311 if (0)
2312 ILI_ALT(ILI_OPND(ilix, 1)) = altilix;
2313 else
2314 ILI_ALT(ilix) = altilix;
2315
2316 return ilix;
2317 }
2318
2319 static bool
eliminate_outlining(ILM_OP opc)2320 eliminate_outlining(ILM_OP opc)
2321 {
2322 return false;
2323 }
2324
2325 bool
outlined_is_eliminated(ILM_OP opc)2326 outlined_is_eliminated(ILM_OP opc)
2327 {
2328 return false;
2329 }
2330
2331 bool
outlined_need_recompile()2332 outlined_need_recompile() {
2333 return false;
2334 }
2335
2336 #ifdef OMP_OFFLOAD_LLVM
2337 static SPTR
llMakeFtnOutlinedSignatureTarget(SPTR func_sptr,OMPACCEL_TINFO * current_tinfo)2338 llMakeFtnOutlinedSignatureTarget(SPTR func_sptr, OMPACCEL_TINFO *current_tinfo)
2339 {
2340 SPTR sym, sptr_alloc = ((SPTR)0), ignoredsym;
2341 char name[MXIDLEN + 2];
2342 int i, count = 0, dpdscp = aux.dpdsc_avl;
2343
2344 PARAMCTP(func_sptr, current_tinfo->n_symbols);
2345 DPDSCP(func_sptr, dpdscp);
2346 aux.dpdsc_avl += current_tinfo->n_symbols;
2347 NEED(aux.dpdsc_avl, aux.dpdsc_base, int, aux.dpdsc_size,
2348 aux.dpdsc_size + current_tinfo->n_symbols + 100);
2349
2350 for (i = 0; i < current_tinfo->n_symbols; ++i) {
2351 SPTR sptr = current_tinfo->symbols[i].host_sym;
2352 sym = ompaccel_create_device_symbol(sptr, count);
2353 count++;
2354 current_tinfo->symbols[i].device_sym = sym;
2355 OMPACCDEVSYMP(sym, TRUE);
2356 aux.dpdsc_base[dpdscp++] = sym;
2357 }
2358 return ignoredsym;
2359 }
2360
2361 int
ll_make_outlined_ompaccel_call(SPTR parent_func_sptr,SPTR outlined_func)2362 ll_make_outlined_ompaccel_call(SPTR parent_func_sptr, SPTR outlined_func)
2363 {
2364
2365 int nargs, nme, ili, i;
2366 SPTR sptr;
2367 OMPACCEL_TINFO *omptinfo;
2368 omptinfo = ompaccel_tinfo_get(outlined_func);
2369 nargs = omptinfo->n_symbols;
2370 int args[nargs], garg_ilis[nargs];
2371 DTYPE arg_dtypes[nargs];
2372
2373 DTYPEP(outlined_func, DT_NONE);
2374 STYPEP(outlined_func, ST_PROC);
2375 CFUNCP(outlined_func, 1);
2376 for (i = 0; i < nargs; ++i) {
2377 sptr = omptinfo->symbols[i].host_sym;
2378 nme = addnme(NT_VAR, sptr, 0, (INT)0);
2379 ili = mk_address(sptr);
2380 if (!PASSBYVALG(sptr))
2381 args[nargs - i - 1] = ad2ili(IL_LDA, ili, nme);
2382 else {
2383 if (DTY(DTYPEG(sptr)) == TY_PTR) {
2384 args[nargs - i - 1] = ad2ili(IL_LDA, ili, nme);
2385 } else {
2386 if (DTYPEG(sptr) == DT_INT8)
2387 args[nargs - i - 1] = ad3ili(IL_LDKR, ili, nme, MSZ_I8);
2388 else if (DTYPEG(sptr) == DT_DBLE)
2389 args[nargs - i - 1] = ad3ili(IL_LDDP, ili, nme, MSZ_F8);
2390 else
2391 args[nargs - i - 1] = ad3ili(IL_LD, ili, nme, MSZ_WORD);
2392 }
2393 }
2394 arg_dtypes[nargs - i - 1] = DTYPEG(sptr);
2395 }
2396
2397 int call_ili =
2398 mk_function_call(DT_NONE, nargs, arg_dtypes, args, outlined_func);
2399
2400 return call_ili;
2401 }
2402
2403 static int ompaccel_isreductionregion = 0;
2404 void
ompaccel_notify_reduction(bool enable)2405 ompaccel_notify_reduction(bool enable)
2406 {
2407 if (XBIT(232, 4))
2408 return;
2409 if (enable)
2410 ompaccel_isreductionregion++;
2411 else
2412 ompaccel_isreductionregion--;
2413 if (DBGBIT(61, 4) && gbl.dbgfil != NULL) {
2414 if (enable)
2415 fprintf(gbl.dbgfil, "[ompaccel] Skip codegen of omp cpu reduction - ON "
2416 "################################### \n");
2417 else
2418 fprintf(gbl.dbgfil, "[ompaccel] Skip codegen of omp cpu reduction - OFF "
2419 "################################### \n");
2420 }
2421 }
2422 bool
ompaccel_is_reduction_region()2423 ompaccel_is_reduction_region()
2424 {
2425 return ompaccel_isreductionregion;
2426 }
2427
2428 void
ompaccel_symreplacer(bool enable)2429 ompaccel_symreplacer(bool enable)
2430 {
2431 if (XBIT(232, 2))
2432 return;
2433 isReplacerEnabled = enable;
2434 if (DBGBIT(61, 2) && gbl.dbgfil != NULL) {
2435 if (enable)
2436 fprintf(
2437 gbl.dbgfil,
2438 "[ompaccel] Replacer - ON ################################### \n");
2439 else
2440 fprintf(
2441 gbl.dbgfil,
2442 "[ompaccel] Replacer - OFF ################################### \n");
2443 }
2444 }
2445
2446 INLINE static SPTR
create_target_outlined_func_sptr(SPTR scope_sptr,bool iskernel)2447 create_target_outlined_func_sptr(SPTR scope_sptr, bool iskernel)
2448 {
2449 char *nm = ll_get_outlined_funcname(gbl.findex, gbl.lineno, 0, IM_BTARGET);
2450 SPTR func_sptr = getsymbol(nm);
2451 TASKFNP(func_sptr, FALSE);
2452 ISTASKDUPP(func_sptr, FALSE);
2453 OUTLINEDP(func_sptr, scope_sptr);
2454 FUNCLINEP(func_sptr, gbl.lineno);
2455 STYPEP(func_sptr, ST_ENTRY);
2456 DTYPEP(func_sptr, DT_VOID_NONE);
2457 DEFDP(func_sptr, 1);
2458 SCP(func_sptr, SC_STATIC);
2459 ADDRTKNP(func_sptr, 1);
2460 if (iskernel)
2461 OMPACCFUNCKERNELP(func_sptr, 1);
2462 else
2463 OMPACCFUNCDEVP(func_sptr, 1);
2464 return func_sptr;
2465 }
2466
2467 INLINE static SPTR
ompaccel_copy_arraydescriptors(SPTR arg_sptr)2468 ompaccel_copy_arraydescriptors(SPTR arg_sptr)
2469 {
2470 SPTR device_symbol;
2471 DTYPE dtype;
2472 char *name;
2473 NEW(name, char, MXIDLEN);
2474 sprintf(name, "Arg_%s", SYMNAME(arg_sptr));
2475 device_symbol = getsymbol(name);
2476 SCP(device_symbol, SC_DUMMY);
2477
2478 // check whether it is allocatable or not
2479 ADSC *new_ad;
2480 ADSC *org_ad = AD_DPTR(DTYPEG(arg_sptr));
2481 TY_KIND atype = DTY(DTYPE(DTYPEG(arg_sptr) + 1));
2482 int numdim = AD_NUMDIM(org_ad);
2483 dtype = get_array_dtype(numdim, (DTYPE)atype);
2484
2485 new_ad = AD_DPTR(dtype);
2486 AD_NUMDIM(new_ad) = numdim;
2487 AD_SCHECK(new_ad) = AD_SCHECK(org_ad);
2488 AD_ZBASE(new_ad) = ompaccel_tinfo_current_get_devsptr((SPTR)AD_ZBASE(org_ad));
2489 AD_NUMELM(new_ad) =
2490 ompaccel_tinfo_current_get_devsptr((SPTR)AD_NUMELM(org_ad));
2491 // todo ompaccel maybe zero, maybe an array?
2492 // check global in the module?
2493 AD_SDSC(new_ad) = ompaccel_tinfo_current_get_devsptr((SPTR)AD_SDSC(org_ad));
2494
2495 if (numdim >= 1 && numdim <= 7) {
2496 int i;
2497 for (i = 0; i < numdim; ++i) {
2498 AD_LWBD(new_ad, i) =
2499 ompaccel_tinfo_current_get_devsptr((SPTR)AD_LWBD(org_ad, i));
2500 AD_UPBD(new_ad, i) =
2501 ompaccel_tinfo_current_get_devsptr((SPTR)AD_UPBD(org_ad, i));
2502 AD_MLPYR(new_ad, i) =
2503 ompaccel_tinfo_current_get_devsptr((SPTR)AD_MLPYR(org_ad, i));
2504 }
2505 }
2506
2507 DTYPEP(device_symbol, dtype);
2508
2509 STYPEP(device_symbol, STYPEG(arg_sptr));
2510 SCP(device_symbol, SCG(arg_sptr));
2511 POINTERP(device_symbol, POINTERG(arg_sptr));
2512 ADDRTKNP(device_symbol, ADDRTKNG(arg_sptr));
2513 ALLOCATTRP(device_symbol, ALLOCATTRG(arg_sptr));
2514 NOCONFLICTP(device_symbol, NOCONFLICTG(arg_sptr));
2515 ASSNP(device_symbol, ASSNG(arg_sptr));
2516 DCLDP(device_symbol, DCLDG(arg_sptr));
2517 PARREFP(device_symbol, PARREFG(arg_sptr));
2518 ORIGDIMP(device_symbol, ORIGDIMG(arg_sptr));
2519 ORIGDUMMYP(device_symbol, ORIGDUMMYG(arg_sptr));
2520 MEMARGP(device_symbol, MEMARGG(arg_sptr));
2521 ASSUMSHPP(device_symbol, ASSUMSHPG(arg_sptr));
2522
2523 int org_midnum = MIDNUMG(arg_sptr);
2524 SPTR dev_midnum = ompaccel_tinfo_current_get_devsptr((SPTR)org_midnum);
2525 MIDNUMP(device_symbol, dev_midnum);
2526
2527 PARREFP(dev_midnum, PARREFG(org_midnum));
2528 ADDRTKNP(dev_midnum, ADDRTKNG(org_midnum));
2529 ASSNP(dev_midnum, ASSNG(org_midnum));
2530 CCSYMP(dev_midnum, CCSYMG(org_midnum));
2531 NOCONFLICTP(dev_midnum, NOCONFLICTG(org_midnum));
2532 PTRSAFEP(dev_midnum, PTRSAFEG(org_midnum));
2533 PARREFLOADP(dev_midnum, PARREFLOADG(org_midnum));
2534 PTRSAFEP(dev_midnum, PTRSAFEG(org_midnum));
2535 REFP(dev_midnum, REFG(org_midnum));
2536 VARDSCP(dev_midnum, VARDSCG(org_midnum));
2537
2538 return device_symbol;
2539 }
2540
2541 SPTR
ll_make_outlined_ompaccel_func(SPTR stblk_sptr,SPTR scope_sptr,bool iskernel)2542 ll_make_outlined_ompaccel_func(SPTR stblk_sptr, SPTR scope_sptr, bool iskernel)
2543 {
2544 const LLUplevel *uplevel;
2545 SPTR func_sptr, arg_sptr;
2546 int n_args = 0, max_nargs, i, j;
2547 OMPACCEL_TINFO *current_tinfo;
2548
2549 uplevel = llmp_has_uplevel(stblk_sptr);
2550 max_nargs = uplevel != NULL ? uplevel->vals_count : 0;
2551 /* Create function symbol for target region */
2552 func_sptr = create_target_outlined_func_sptr(scope_sptr, iskernel);
2553
2554 /* Create target info for the outlined function */
2555 current_tinfo = ompaccel_tinfo_create(func_sptr, max_nargs);
2556 for (i = 0; i < max_nargs; ++i) {
2557 arg_sptr = (SPTR)uplevel->vals[i];
2558 if (!arg_sptr && !ompaccel_tinfo_current_is_registered(arg_sptr))
2559 continue;
2560 if (SCG(arg_sptr) == SC_PRIVATE)
2561 continue;
2562 if (DESCARRAYG(arg_sptr))
2563 continue;
2564
2565 if (!iskernel && !OMPACCDEVSYMG(arg_sptr))
2566 arg_sptr = ompaccel_tinfo_parent_get_devsptr(arg_sptr);
2567 ompaccel_tinfo_current_add_sym(arg_sptr, SPTR_NULL, 0);
2568
2569 n_args++;
2570 }
2571
2572 llMakeFtnOutlinedSignatureTarget(func_sptr, current_tinfo);
2573
2574 ompaccel_symreplacer(true);
2575 if (isReplacerEnabled) {
2576 /* Data dtype replication for allocatable arrays */
2577 for (i = 0; i < ompaccel_tinfo_current_get()->n_quiet_symbols; ++i) {
2578 ompaccel_tinfo_current_get()->quiet_symbols[i].device_sym =
2579 ompaccel_copy_arraydescriptors(
2580 ompaccel_tinfo_current_get()->quiet_symbols[i].host_sym);
2581 }
2582 for (i = 0; i < ompaccel_tinfo_current_get()->n_symbols; ++i) {
2583 if (SDSCG(ompaccel_tinfo_current_get()->symbols[i].host_sym))
2584 ompaccel_tinfo_current_get()->symbols[i].device_sym =
2585 ompaccel_copy_arraydescriptors(
2586 ompaccel_tinfo_current_get()->symbols[i].host_sym);
2587 }
2588 }
2589 ompaccel_symreplacer(false);
2590
2591 return func_sptr;
2592 }
2593 #endif /* End #ifdef OMP_OFFLOAD_LLVM */
2594