ada_wrappers_backend.c 30.1 KB
Newer Older
Maxime Perrotin's avatar
Maxime Perrotin committed
1
2
3
4
5
6
7
8
9
10
11
/* Buildsupport is (c) 2008-2015 European Space Agency
 * contact: maxime.perrotin@esa.int
 * License is LGPL, check LICENSE file */
/* ada_wrappers_backend.c

  this program generates the Ada code to interface the VM with the functional code

  update (24/11/2008) : do not discard creation of wrappers in case of Ada
                             used as implementation language

  updated 20/04/2009 to disable in case "-onlycv" flag is set
Maxime Perrotin's avatar
Maxime Perrotin committed
12

Maxime Perrotin's avatar
Maxime Perrotin committed
13
14
15
16
17
18
19
  major updated 20/07/2009 to support protected objects
 */


#include <stdio.h>
#include <string.h>
#include <stdlib.h>
Maxime Perrotin's avatar
Maxime Perrotin committed
20
#include <stdbool.h>
Maxime Perrotin's avatar
Maxime Perrotin committed
21
22
23
24
25
26
27
28
#include <sys/stat.h>
#include <assert.h>

#include "my_types.h"
#include "practical_functions.h"
#include "c_ast_construction.h"

extern void Add_Protected_Interfaces(FV * fv, FILE * ads, FILE * adb);
Maxime Perrotin's avatar
Maxime Perrotin committed
29
extern void Add_Unprotected_Interfaces(FV * fv, FILE * ads, FILE * adb);
Maxime Perrotin's avatar
Maxime Perrotin committed
30
31
32
33
34
35
36
37
38

static FILE *ads = NULL, *adb = NULL, *async_ads = NULL, *async_adb = NULL;

static int contains_sync_interface = 0;

/* Check if an async interface has input or output parameters */
void CheckForParams(Interface * i, int *result)
{
    if (asynch == i->synchronism && (NULL != i->in || NULL != i->out)) {
Maxime Perrotin's avatar
Maxime Perrotin committed
39
        *result = 1;
Maxime Perrotin's avatar
Maxime Perrotin committed
40
41
42
43
44
45
    }
}

/* For a given passive function, add "with CallingThread_wrappers;"statement */
void Add_With_AsyncRI(FV * fv, FILE ** file)
{
Maxime Perrotin's avatar
Maxime Perrotin committed
46
    bool result = false;
Maxime Perrotin's avatar
Maxime Perrotin committed
47
    FOREACH (i, Interface, fv->interfaces, {
Maxime Perrotin's avatar
Maxime Perrotin committed
48
        if (RI == i->direction && asynch == i->synchronism) result = true;
Maxime Perrotin's avatar
Maxime Perrotin committed
49
50
51
    })

    if (result)
Maxime Perrotin's avatar
Maxime Perrotin committed
52
        fprintf(*file, "with %s_async_ri_wrappers;\n", fv->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
53
54
55
56
57
58
59
60
61
62
}


/* Adds header to files */
void ada_wrappers_preamble(FV * fv)
{
    int hasparam = 0;
    int mix = 0;

    if (NULL == ads || NULL == adb)
Maxime Perrotin's avatar
Maxime Perrotin committed
63
        return;
Maxime Perrotin's avatar
Maxime Perrotin committed
64
65
66

    /*  wrappers.ads top header */
    fprintf(ads,
Maxime Perrotin's avatar
Maxime Perrotin committed
67
            "--  This file was generated automatically: DO NOT MODIFY IT !\n\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
68
69
70
71
    fprintf(ads, "pragma Style_Checks (Off);\npragma Warnings (Off);\n\n");

    /*  wrappers.adb top header */
    fprintf(adb,
Maxime Perrotin's avatar
Maxime Perrotin committed
72
            "--  This file was generated automatically: DO NOT MODIFY IT !\n\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
73
    fprintf(adb,
Maxime Perrotin's avatar
Maxime Perrotin committed
74
            "pragma Style_Checks (Off);\npragma Warnings (Off);\n\nwith PolyORB_HI_Generated.Activity;\nuse PolyORB_HI_Generated.Activity;\n\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
75
76
77
78
79


    fprintf(ads, "with Interfaces.C;\n");
    /* Generates "with PolyORB_HI.Generated.Types IF at least one async IF has a param */
    FOREACH(i, Interface, fv->interfaces, {
Maxime Perrotin's avatar
Maxime Perrotin committed
80
        CheckForParams(i, &hasparam);
Maxime Perrotin's avatar
Maxime Perrotin committed
81
82
    })
    if (hasparam) {
Maxime Perrotin's avatar
Maxime Perrotin committed
83
        fprintf(ads, "with PolyORB_HI_Generated.Types;\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
84
85
86
    }
    // In case of Ada, make an include to the user code package to execute the elaboration part (optional user-initialization code)
    if (ada == fv->language || qgenada == fv->language) {
Maxime Perrotin's avatar
Maxime Perrotin committed
87
        fprintf(ads, "with %s;\n", fv->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
    }

    fprintf(ads, "with PolyORB_HI_Generated.Deployment;\n");
    fprintf(ads, "use PolyORB_HI_Generated.Deployment;\n\n");

    /* 
     *  For each sync RI, add a "with distant_fv_wrappers;" clause in the adb file 
     *  Note: this cannot be put in the ads file because it may cause circular dependency errors 
     */
    String_list *sync_list = NULL;

    FOREACH(i, Interface, fv->interfaces, {
        if (RI == i->direction && synch == i->synchronism
            && i->distant_qgen->language == other) {
                ADD_TO_SET(String, sync_list, i->distant_fv);
        }
    })
    FOREACH(sync_callee, String, sync_list, {
Maxime Perrotin's avatar
Maxime Perrotin committed
106
        fprintf(adb, "with %s_wrappers;\n", sync_callee);
Maxime Perrotin's avatar
Maxime Perrotin committed
107
108
109
    });

    if (NULL != async_ads)
Maxime Perrotin's avatar
Maxime Perrotin committed
110
        fprintf(ads, "with %s_async_ri_wrappers;\n", fv->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135

    /* Include with and use clauses for QGenAda code if it is used */
    FOREACH(i, Interface, fv->interfaces, {
    if (qgenada == i->distant_qgen->language) {
        fprintf(ads, "with taste_dataview;\n");
        fprintf(ads, "use taste_dataview;\n");
        switch (i->direction) {
            case RI: fprintf(adb, "with %s_QGenAda_wrapper;\nuse %s_QGenAda_wrapper;\n\n",
                i->distant_name, i->distant_name); break;
            case PI: break;
            default: break;
        }
    })}

    /* 
     * Include the calling threads wrappers to the wrappers of the passive functions, to have access to their "vm_" functions
     * (only if the calling thread in question has some async RI). This is also extended to threads that contain at least 
     * one unpro function (see the C wrapper generation for more details).
     */
     if (thread_runtime == fv->runtime_nature) {
         FOREACH (i, Interface, fv->interfaces, {
             if (PI == i->direction && unprotected == i->rcm) mix = 1;
         })
     }
    if (passive_runtime == fv->runtime_nature || mix) {
Maxime Perrotin's avatar
Maxime Perrotin committed
136
137
138
        FOREACH(ct, FV, fv->calling_threads, {
                Add_With_AsyncRI(ct, &ads);
        });
Maxime Perrotin's avatar
Maxime Perrotin committed
139
140
141
142
143
144
145
146
147
148
149
150
151
152
    }

    fprintf(ads, "\npackage %s_wrappers is\n\n", fv->name);
    // To debug backdoor-related misuse of the passive functions stack:
     fprintf(adb, "with PolyORB_HI.Output;\n\n");

    fprintf(adb, "package body %s_wrappers is\n\n", fv->name);

    //char *path = NULL;
    //path = make_string ("%s/%s", OUTPUT_PATH, fv->name);
    
    //if (!file_exists(path, "_hook")) {
    if (!fv->artificial) {
        fprintf(ads, "\tprocedure C_Init_%s;\n\n", fv->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
153
154
155
156
157
158
        fprintf(adb, "\tprocedure C_Init_%s is\n", fv->name);
        fprintf(adb, "\t\tprocedure Init_%s;\n", fv->name);
        fprintf(adb, "\t\tpragma Import (C, Init_%s, \"init_%s\");\n\n",
            fv->name, fv->name);
        fprintf(adb, "\tbegin\n\t\tInit_%s;\n\tend C_Init_%s;\n\n",
            fv->name, fv->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
159
160
161
162
163
164
165
166
167
168
    }

    /* Include call to QGenAda init code if it is present */
    FOREACH(i, Interface, fv->interfaces, {
    if (qgenada == i->distant_qgen->language
        && RI == i->direction && NULL != i->distant_qgen->qgen_init) {
        fprintf(ads, "\tprocedure QGen_Init_%s;\n\n", i->distant_name);
        fprintf(ads, "\tpragma Export (C, QGen_Init_%s, \"vm_QGen_Init_%s\");\n\n", i->distant_name, i->distant_name);
        fprintf(adb, "\tprocedure QGen_Init_%s is\n", i->distant_name);
        fprintf(adb, "\tbegin\n\t\t%s.init;\n\tend QGen_Init_%s;\n\n",
Maxime Perrotin's avatar
Maxime Perrotin committed
169
            i->distant_name, i->distant_name);
Maxime Perrotin's avatar
Maxime Perrotin committed
170
171
172
173
    })}

    if (NULL != async_ads && NULL != async_adb) {

Maxime Perrotin's avatar
Maxime Perrotin committed
174
175
176
177
178
        fprintf(async_ads,
                "--  This file was generated automatically: DO NOT MODIFY IT !\n\n");
        fprintf(async_ads,
                "pragma Style_Checks (Off);\npragma Warnings (Off);\n\n");
        fprintf(async_ads, "with Interfaces.C;\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
179

Maxime Perrotin's avatar
Maxime Perrotin committed
180
181
        if (hasparam)
            fprintf(async_ads, "with PolyORB_HI_Generated.Types;\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
182

Maxime Perrotin's avatar
Maxime Perrotin committed
183
184
        fprintf(async_ads, "with PolyORB_HI_Generated.Deployment;\n");
        fprintf(async_ads, "use PolyORB_HI_Generated.Deployment;\n\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
185

Maxime Perrotin's avatar
Maxime Perrotin committed
186
187
        fprintf(async_ads, "\npackage %s_async_ri_wrappers is\n\n",
                fv->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
188

Maxime Perrotin's avatar
Maxime Perrotin committed
189
190
191
192
193
194
195
        fprintf(async_adb,
                "--  This file was generated automatically: DO NOT MODIFY IT !\n\n");
        fprintf(async_adb,
                "pragma Style_Checks (Off);\npragma Warnings (Off);\n\nwith PolyORB_HI_Generated.Activity;\nuse PolyORB_HI_Generated.Activity;\n");
        fprintf(async_adb, "with PolyORB_HI.Errors;\n\n");
        fprintf(async_adb, "package body %s_async_ri_wrappers is\n\n",
                fv->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
196
197
198
199
200
201
202

    }
}

/* Creates fv_wrappers.ads, fv_wrappers.adb, and potentially RI async wrappers  */
int Init_Ada_Wrappers_Backend(FV * fv)
{
Maxime Perrotin's avatar
Maxime Perrotin committed
203
204
    char *filename = NULL;      // to store the wrappers filename (fv_name_wrappers.ad*)
    size_t len = 0;             // length of the filename
Maxime Perrotin's avatar
Maxime Perrotin committed
205
206
207
208
209
    char *path = NULL;

    contains_sync_interface = 0;

    if (NULL != fv->system_ast->context->output)
Maxime Perrotin's avatar
Maxime Perrotin committed
210
211
        build_string(&path, fv->system_ast->context->output,
                     strlen(fv->system_ast->context->output));
Maxime Perrotin's avatar
Maxime Perrotin committed
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
    build_string(&path, fv->name, strlen(fv->name));

    // Elaborate the Wrapper file name:
    len = strlen(fv->name) + strlen("_wrappers.ads");
    filename = (char *) malloc(len + 1);

    // create .ads file
    sprintf(filename, "%s_wrappers.ads", fv->name);
    create_file(path, filename, &ads);

    // create .adb file
    sprintf(filename, "%s_wrappers.adb", fv->name);
    create_file(path, filename, &adb);

    free(filename);

    if (thread_runtime == fv->runtime_nature) {

Maxime Perrotin's avatar
Maxime Perrotin committed
230
231
232
233
        bool async_ri = 0;
        FOREACH(i, Interface, fv->interfaces, {
            if (RI == i->direction && asynch == i->synchronism) async_ri = true;
        })
Maxime Perrotin's avatar
Maxime Perrotin committed
234

Maxime Perrotin's avatar
Maxime Perrotin committed
235
        if (async_ri) {
Maxime Perrotin's avatar
Maxime Perrotin committed
236

Maxime Perrotin's avatar
Maxime Perrotin committed
237
238
            len = strlen(fv->name) + strlen("_async_ri_wrappers.ads");
            filename = (char *) malloc(len + 1);
Maxime Perrotin's avatar
Maxime Perrotin committed
239

Maxime Perrotin's avatar
Maxime Perrotin committed
240
241
242
            // create .ads file
            sprintf(filename, "%s_async_ri_wrappers.ads", fv->name);
            create_file(path, filename, &async_ads);
Maxime Perrotin's avatar
Maxime Perrotin committed
243

Maxime Perrotin's avatar
Maxime Perrotin committed
244
245
246
            // create .adb file
            sprintf(filename, "%s_async_ri_wrappers.adb", fv->name);
            create_file(path, filename, &async_adb);
Maxime Perrotin's avatar
Maxime Perrotin committed
247

Maxime Perrotin's avatar
Maxime Perrotin committed
248
            free(filename);
Maxime Perrotin's avatar
Maxime Perrotin committed
249

Maxime Perrotin's avatar
Maxime Perrotin committed
250
251
            assert(async_ads != NULL && async_adb != NULL);
        }
Maxime Perrotin's avatar
Maxime Perrotin committed
252
253
254
255
256
    }


    free(path);
    if (NULL == ads || NULL == adb)
Maxime Perrotin's avatar
Maxime Perrotin committed
257
        return -1;
Maxime Perrotin's avatar
Maxime Perrotin committed
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275

    ada_wrappers_preamble(fv);

    return 0;
}


void close_ada_wrappers()
{
    close_file(&ads);
    close_file(&adb);
    close_file(&async_ads);
    close_file(&async_adb);
}

void add_PI_to_ada_wrappers(Interface * i)
{
    if (NULL == ads || NULL == adb)
Maxime Perrotin's avatar
Maxime Perrotin committed
276
        return;
Maxime Perrotin's avatar
Maxime Perrotin committed
277
278
279
280
281

    // a. Case of Sync PI: don't do anything but recording that a sync interface exists for this function
    //    this information will be used to generate the package elaboration part once all other PI have 
    //    been processed.
    if (synch == i->synchronism) {
Maxime Perrotin's avatar
Maxime Perrotin committed
282
283
        contains_sync_interface = 1;
        return;
Maxime Perrotin's avatar
Maxime Perrotin committed
284
285
286
287
288
    }


    // b. wrappers.ads : declare the function
    fprintf(ads,
Maxime Perrotin's avatar
Maxime Perrotin committed
289
            "\t------------------------------------------------------\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
290
291
    fprintf(ads, "\t--  Provided Interface \"%s\"\n", i->name);
    fprintf(ads,
Maxime Perrotin's avatar
Maxime Perrotin committed
292
            "\t------------------------------------------------------\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
293
294
    fprintf(ads, "\tprocedure %s (Entity : PolyORB_HI_Generated.Deployment.Entity_Type", i->name);
    if (NULL != i->in) {
Maxime Perrotin's avatar
Maxime Perrotin committed
295
        fprintf(ads,";\n\t\t ");
Maxime Perrotin's avatar
Maxime Perrotin committed
296
         fprintf(ads,
Maxime Perrotin's avatar
Maxime Perrotin committed
297
298
299
            "%sBuffer:PolyORB_HI_Generated.Types.%s_Buffer_Impl",
            i->in->value->name,
            i->in->value->type);
Maxime Perrotin's avatar
Maxime Perrotin committed
300
301
302
303
304
305
    } 
    fprintf(ads,");\n\n");
    

    // c. wrappers.adb : define the function
    fprintf(adb,
Maxime Perrotin's avatar
Maxime Perrotin committed
306
            "\t------------------------------------------------------\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
307
    fprintf(adb, "\t--  Asynchronous Provided Interface \"%s\"\n",
Maxime Perrotin's avatar
Maxime Perrotin committed
308
            i->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
309
    fprintf(adb,
Maxime Perrotin's avatar
Maxime Perrotin committed
310
            "\t------------------------------------------------------\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
311
312
    fprintf(adb, "\tprocedure %s (Entity : PolyORB_HI_Generated.Deployment.Entity_Type", i->name);
    if (NULL != i->in) {
Maxime Perrotin's avatar
Maxime Perrotin committed
313
314
315
316
317
        fprintf(adb,";\n\t\t ");
        fprintf(adb,
            "%sBuffer:PolyORB_HI_Generated.Types.%s_Buffer_Impl",
            i->in->value->name,
            i->in->value->type);
Maxime Perrotin's avatar
Maxime Perrotin committed
318
319
320
321
322
323
324
    }
    fprintf(adb, ")\n\t");


    fprintf(adb, "is\n");
  // Make an Ada buffer for each input:
    if (NULL != i->in) {
Maxime Perrotin's avatar
Maxime Perrotin committed
325
326
327
328
329
330
331
332
        fprintf(adb,
            "\t\t%s_AdaBuffer: Interfaces.C.Char_Array(1..Interfaces.C.size_t (%sBuffer.Length));\n",
                i->in->value->name, i->in->value->name);
        fprintf(adb, "\t\tpragma Import (Ada, %s_AdaBuffer);\n",
                i->in->value->name);
        fprintf(adb,
            "\t\tfor %s_AdaBuffer'Address use %sBuffer.Buffer'Address;\n\n",
                i->in->value->name, i->in->value->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
333
334
335
336
337
338
339
340
341
342
   } 
 
    /* Update 26-10-2010 :  if we are in a thread created by the VT 
     * we must call directly the sync RI and NOT the function from vm_if.c
     */
    //char *path = NULL;
    //path = make_string ("%s/%s", OUTPUT_PATH, i->parent_fv->name);
    if (i->parent_fv->artificial) {
    //if (file_exists(path, "_hook")) {
        char *distant_fv = NULL;
Maxime Perrotin's avatar
Maxime Perrotin committed
343
            RCM rcm = protected;
Maxime Perrotin's avatar
Maxime Perrotin committed
344
345
346
347
348
349
350
351
352
        FOREACH (interface, Interface, i->parent_fv->interfaces, {
            if (RI == interface->direction
                    && !strcmp (interface->distant_name, i->distant_name) &&
                    synch == interface->synchronism) { 
                distant_fv = interface->distant_fv;
                rcm = interface->rcm;
            }
        });

Maxime Perrotin's avatar
Maxime Perrotin committed
353
        /* Call sync (protected) function: */   
Maxime Perrotin's avatar
Maxime Perrotin committed
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
        fprintf(adb, "\tbegin\n");
        fprintf(adb, "\t\t%s_wrappers%s%s.%s(%d%s",
                    distant_fv, 
            protected == rcm ? ".protected_" : "",
            protected == rcm ? distant_fv : "",
            i->distant_name,
            i->parent_fv->thread_id,
            NULL != i->in ? ", ": "");
        if (NULL != i->in) {
            fprintf(adb, "%s_AdaBuffer, %s_AdaBuffer'Length",
                i->in->value->name, 
                i->in->value->name);
            // ABOVE LINE TO BE CHECKED...
        }
        fprintf(adb, ");\n");
    }

    else {  /* User-defined function: call function in vm_if.c */
Maxime Perrotin's avatar
Maxime Perrotin committed
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
         fprintf(adb, "\t\tprocedure C_%s_%s", i->parent_fv->name, i->name);
         if (NULL != i->in) {
                fprintf(adb, "\n\t\t\t(");
                fprintf(adb,
                    "C_%sBuffer:Interfaces.C.char_array;\n\t\t\tC_%sMaxSize:Integer",
                    i->in->value->name,
                    i->in->value->name);
                fprintf(adb, ")");
         }
         fprintf(adb, ";\n");
        fprintf(adb, "\t\tpragma Import (C, C_%s_%s, \"%s_%s\");\n\n",
            i->parent_fv->name, i->name, i->parent_fv->name, i->name);

        // Body of the procedure: make the call to the C function
        fprintf(adb, "\tbegin\n\t\tC_%s_%s", i->parent_fv->name, i->name);
        if (NULL != i->in) {
                fprintf(adb, " (");
                fprintf(adb, "%s_AdaBuffer, %s_AdaBuffer'Length",
                        i->in->value->name, 
                        i->in->value->name);
                fprintf(adb, ")");
        }
        fprintf(adb, ";\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
    }
    fprintf(adb, "\tend %s;\n\n", i->name);

}

// Add a RI
void add_RI_to_ada_wrappers(Interface * i)
{
    Parameter_list *tmp;
    int count = 0;

    FILE *s = ads, *b = adb;

    //Print_Interface (i);

    if (thread_runtime == i->parent_fv->runtime_nature
Maxime Perrotin's avatar
Maxime Perrotin committed
411
412
413
        && asynch == i->synchronism) {
        s = async_ads;
        b = async_adb;
Maxime Perrotin's avatar
Maxime Perrotin committed
414
415
416
    }

    if (NULL == s || NULL == b)
Maxime Perrotin's avatar
Maxime Perrotin committed
417
        return;
Maxime Perrotin's avatar
Maxime Perrotin committed
418
419
420

    // b. wrappers.ads : declare the function
    fprintf(s,
Maxime Perrotin's avatar
Maxime Perrotin committed
421
            "\t------------------------------------------------------\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
422
    fprintf(s, "\t--  %s Required Interface \"%s\"\n",
Maxime Perrotin's avatar
Maxime Perrotin committed
423
424
            asynch == i->synchronism ? "Asynchronous" : "Synchronous",
            i->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
425
    fprintf(s,
Maxime Perrotin's avatar
Maxime Perrotin committed
426
            "\t------------------------------------------------------\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
427
428
429
    fprintf(s, "\tprocedure vm_%s", i->name);

    if (NULL != i->in || NULL != i->out)
Maxime Perrotin's avatar
Maxime Perrotin committed
430
        fprintf(s, "(");
Maxime Perrotin's avatar
Maxime Perrotin committed
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448

    if (qgenada == i->distant_qgen->language) {
        FOREACH(p, Parameter, i->in, {
            List_QGen_Param_Types_And_Names(p, &s);
        })
        FOREACH(p, Parameter, i->out, {
            List_QGen_Param_Types_And_Names(p, &s);
        })
    } else {
        FOREACH(p, Parameter, i->in, {
            List_Ada_Param_Types_And_Names(p, &s);
        })
        FOREACH(p, Parameter, i->out, {
            List_Ada_Param_Types_And_Names(p, &s);
        })
    }

    if (NULL != i->in || NULL != i->out)
Maxime Perrotin's avatar
Maxime Perrotin committed
449
        fprintf(s, ")");
Maxime Perrotin's avatar
Maxime Perrotin committed
450
451
452
    fprintf(s, ";\n");

    fprintf(s, "\tpragma Export (C, vm_%s, \"vm_%s%s_%s\");\n\n",
Maxime Perrotin's avatar
Maxime Perrotin committed
453
           i->name, asynch == i->synchronism?"async_":"",i->parent_fv->name, i->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
454
455
456

    // c. wrappers.b : definition of the function
    fprintf(b,
Maxime Perrotin's avatar
Maxime Perrotin committed
457
            "\t------------------------------------------------------\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
458
    fprintf(b, "\t--  %s Required Interface \"%s\"\n",
Maxime Perrotin's avatar
Maxime Perrotin committed
459
460
            asynch == i->synchronism ? "Asynchronous" : "Synchronous",
            i->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
461
    fprintf(b,
Maxime Perrotin's avatar
Maxime Perrotin committed
462
            "\t------------------------------------------------------\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
463
464
465
    fprintf(b, "\tprocedure vm_%s", i->name);

    if (NULL != i->in || NULL != i->out)
Maxime Perrotin's avatar
Maxime Perrotin committed
466
        fprintf(b, "(");
Maxime Perrotin's avatar
Maxime Perrotin committed
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484

    if (qgenada == i->distant_qgen->language) {
        FOREACH(p, Parameter, i->in, {
            List_QGen_Param_Types_And_Names(p, &b);
        })
        FOREACH(p, Parameter, i->out, {
            List_QGen_Param_Types_And_Names(p, &b);
        })
    } else {
        FOREACH(p, Parameter, i->in, {
            List_Ada_Param_Types_And_Names(p, &b);
        })
        FOREACH(p, Parameter, i->out, {
            List_Ada_Param_Types_And_Names(p, &b);
        })
    }

    if (NULL != i->in || NULL != i->out)
Maxime Perrotin's avatar
Maxime Perrotin committed
485
        fprintf(b, ")");
Maxime Perrotin's avatar
Maxime Perrotin committed
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506

    fprintf(b, " is\n");

    if (qgenada == i->distant_qgen->language) {
        char *qgen_args = NULL;

        fprintf(b, "\tbegin\n");

        fprintf(b, "\t\tExecute_%s_QGenAda(", i->distant_name);

        /* Add IN and OUT parameters */
            FOREACH(p, Parameter, i->in, {
                Create_QGenAda_Argument(p->name, &qgen_args, false);
            })
            FOREACH(p, Parameter, i->out, {
                Create_QGenAda_Argument(p->name, &qgen_args, false);
            })
        if (qgen_args != NULL)
            fprintf(b, "%s", qgen_args);
        fprintf(b, ");\n\n");

507
508
    }
    else {
Maxime Perrotin's avatar
Maxime Perrotin committed
509
        if (asynch == i->synchronism) {
510
511
512
513
514
515
516
517
518
519
520
521
522
523
            /*
             * Distant FV is a thread (asynchronous RI). This means that depending on the nature of the current FV (thread or passive)
             * we have either to call the VM (if we are in a thread) or to switch-case the caller thread to call his own access to the VM
             * We retrieve the caller thread ID using the "stack" 
             */
            if (thread_runtime == i->parent_fv->runtime_nature) {

                fprintf(b, "\t\tValue: %s%s%s_%s_others_Interface \n\t\t(%s%s%s_%s_others_Port_Type'(OUTPORT_%s));\n", (get_context()->aadlv2) ? i->parent_fv->name : "",   // AADL v2 only
                    (get_context()->aadlv2) ? "_CV_Thread_" : "",   // AADL v2 only
                    i->parent_fv->name,     // fv->name should be replaced by the namespace (not supported 15/07/2009) (used to be aplc)
                    i->parent_fv->name, (get_context()->aadlv2) ? i->parent_fv->name : "",  // AADL v2 only
                    (get_context()->aadlv2) ? "_CV_Thread_" : "",   // AADL v2 only
                    i->parent_fv->name,     // fv->name should be replaced by the namespace (not supported 15/07/2009) (used to be aplc)
                    i->parent_fv->name, i->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
524
                fprintf(b,
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
                    "\t\tErr: PolyORB_HI.Errors.Error_Kind;\n\t\tuse type PolyORB_HI.Errors.Error_Kind;\n");
                fprintf(b, "\tbegin\n");
                /* Copy the buffer(s) from C to Ada */
                if (NULL != i->in) {
                tmp = i->in;
                while (NULL != tmp) {
                    fprintf(b, "\t\tfor J in 1 .. IN_%s_size loop\n",
                        tmp->value->name);
                    fprintf(b,
                        "\t\t\tValue.OUTPORT_%s_DATA.Buffer (J) := PolyORB_HI_Generated.Types.Stream_Element%s\n",
                        i->name,
                        get_context()->aadlv2?"_Buffer":"");
                    fprintf(b,
                        "\t\t\t\t(IN_%s (Interfaces.C.size_t (J - 1)));\n",
                        tmp->value->name);
                    fprintf(b, "\t\tend loop;\n");
                    if (!(get_context()->aadlv2))
                    fprintf(b, "\t\tValue.OUTPORT_%s_DATA.Length := PolyORB_HI_Generated.Types.uint16 (IN_%s_size);\n",     // old V1
                        i->name, tmp->value->name);
                    else
545
                    fprintf(b, "\t\tValue.OUTPORT_%s_DATA.Length := PolyORB_HI_Generated.Types.Unsigned_32 (IN_%s_size);\n",        // AADL V2, should work with V1 but not supported by Ocarina yet also, otherwise put back previous line for V1
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
                        i->name, tmp->value->name);
                    tmp = tmp->next;
                }
                }


                if (NULL != i->parent_fv->process) {
                fprintf(b, "\t\tPut_Value (%s_%s_K, Value);\n",
                    i->parent_fv->process->identifier,
                    i->parent_fv->name);

                /* Following is added only for the Backdoor backend : call the Send_Output to
                   flush immediately the output buffer */
                fprintf(b, "\t\tErr:=Send_Output(%s_%s_K, %s%s%s_%s_others_Port_Type'(OUTPORT_%s));\n", i->parent_fv->process->identifier, i->parent_fv->name, (get_context()->aadlv2) ? i->parent_fv->name : "",   // AADL v2 only
                    (get_context()->aadlv2) ? "_CV_Thread_" : "",   // AADL v2 only
                    i->parent_fv->name,     // fv->name should be replaced by the namespace (not supported 15/07/2009) (used to be aplc)
                    i->parent_fv->name, i->name);
                }
Maxime Perrotin's avatar
Maxime Perrotin committed
564
            }
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
            else {                // Current FV = Passive function
                fprintf(b, "\tbegin\n");
                fprintf(b,
                    "\t\t -- This function is passive, thus not have direct access to the VM\n");
                fprintf(b,
                    "\t\t -- It must use its calling thread to invoke this asynchronous RI\n\n");

                /* Build the list of calling threads for this RI */
                FV_list *calltmp = NULL;
                if (NULL == i->calling_pis) calltmp = i->parent_fv->calling_threads;
                else {
                    FOREACH(calling_pi, Interface, i->calling_pis, {
                        FOREACH(thread_caller, FV, calling_pi->calling_threads, {
                            ADD_TO_SET(FV, calltmp, thread_caller);
                        });
                    });
                }
Maxime Perrotin's avatar
Maxime Perrotin committed
582

583
584
585
586
587
                /* Count the number of calling threads */
                FOREACH(ct, FV, calltmp, {
                    (void) ct;
                    count ++;
                });
Maxime Perrotin's avatar
Maxime Perrotin committed
588

589
590
591
592
                if (1 == count) {
                    fprintf(b, "\t\t%s_async_ri_wrappers.vm_%s_vt",
                        calltmp->value->name,
                        i->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
593

594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
                    if (NULL != i->in) {        // Add parameters
                        fprintf(b, "(");
                        FOREACH(p, Parameter, i->in, {
                            List_Ada_Param_Names(p, &b);
                        });
                        fprintf(b, ")");
                    }
                    fprintf(b, ";\n");
                }
                else if (count > 1) {
                    fprintf(b, "\t\tcase callinglist.get_top_value is\n");
                    FOREACH(caller, FV, calltmp, {
                        fprintf(b,
                            "\t\t\twhen %d => %s_async_ri_wrappers.vm_%s_vt",
                            caller->thread_id,
                            caller->name, i->name);

                        if (NULL != i->in) {    // Add parameters
                            fprintf(b, "(");
                            FOREACH(p, Parameter, i->in, {
                                List_Ada_Param_Names(p, &b);
                            });
                            fprintf(b, ")");
                        }
                        fprintf(b, ";\n");
                    });
                    fprintf(b, "\t\t\twhen others => null;\n");
                    fprintf(b, "\t\tend case;\n");
                }
Maxime Perrotin's avatar
Maxime Perrotin committed
623
            }
624
        }
625
        else {
Maxime Perrotin's avatar
Maxime Perrotin committed
626
627
            /* Build the list of calling threads for this RI */
            FV_list *calltmp = NULL;
628
629
630
631
632
633
634
            if (NULL == i->calling_pis) calltmp = i->parent_fv->calling_threads;
            else {
                FOREACH(calling_pi, Interface, i->calling_pis, {
                    FOREACH(thread_caller, FV, calling_pi->calling_threads, {
                        ADD_TO_SET(FV, calltmp, thread_caller);
                    });
                });
Maxime Perrotin's avatar
Maxime Perrotin committed
635
            }
Maxime Perrotin's avatar
Maxime Perrotin committed
636
637

            /* Count the number of calling threads */
638
639
640
641
            FOREACH(ct, FV, calltmp, {
                (void) ct;
                count ++;
            });
Maxime Perrotin's avatar
Maxime Perrotin committed
642
643
644
645
646
647
648
649
650
651
652

            fprintf(b, "\tbegin\n");

            if (protected == i->rcm) {
                fprintf(b, "\t\t%s_wrappers.protected_%s.%s(",
                    i->distant_fv, i->distant_fv, NULL != i->distant_name? i->distant_name: i->name);
            } else if (unprotected == i->rcm) {
                fprintf(b, "\t\t%s_wrappers.%s(", i->distant_fv, NULL != i->distant_name? i->distant_name:i->name);
            }

            if (passive_runtime == i->parent_fv->runtime_nature) {
653
                if (count > 1) {
Maxime Perrotin's avatar
Maxime Perrotin committed
654
655
                fprintf(b, "callinglist.get_top_value");
                }
656
657
                else if (1 == count) {
                fprintf(b, "%d", calltmp->value->thread_id);
Maxime Perrotin's avatar
Maxime Perrotin committed
658
                }
659
                else if (0 == count) {
Maxime Perrotin's avatar
Maxime Perrotin committed
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
                ERROR ("** Error: function \"%s\" is not called by anyone (dead code)!\n", i->parent_fv->name);
                        ERROR ("** This is not supported by the Ada runtime. You may have to change two things:\n");
                        ERROR ("**    1) (In any case) use the -p flag when calling the TASTE orchestrator, and\n");
                        ERROR ("**    2) In your deployment view, if applicable, choose a non-Ada runtime\n");
                        ERROR ("**       (do not use \"LEON_ORK\" ; \"Native\" or \"LEON_RTEMS\" are OK)\n\n");
                        exit(-1);
                }
            }
            else
                fprintf(b, "%d", i->parent_fv->thread_id);

            if (NULL != i->in || NULL != i->out)
                fprintf(b, ",");

            /* Add IN and OUT parameters */
            FOREACH(p, Parameter, i->in, {
                List_Ada_Param_Names(p, &b);
            })
            FOREACH(p, Parameter, i->out, {
                List_Ada_Param_Names(p, &b);
            })

            fprintf(b, ");\n");
        }
    }

    fprintf(b, "\tend vm_%s;\n\n", i->name);
}


void End_Ada_Wrappers_Backend(FV * fv)
{
    /* If necessary, add a protected object to the wrapper files */
Maxime Perrotin's avatar
Maxime Perrotin committed
693
                                           
Maxime Perrotin's avatar
Maxime Perrotin committed
694
695
696
697
698
    Add_Protected_Interfaces(fv, ads, adb);
    Add_Unprotected_Interfaces(fv, ads, adb);

    /* Postamble to wrappers.ads/adb */
    if (contains_sync_interface && NULL != adb) {
Maxime Perrotin's avatar
Maxime Perrotin committed
699
        fprintf(adb, "begin\n\tC_Init_%s;\n\n", fv->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
700
701
702
    }

    if (NULL != ads)
Maxime Perrotin's avatar
Maxime Perrotin committed
703
        fprintf(ads, "end %s_wrappers;\n", fv->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
704
    if (NULL != adb)
Maxime Perrotin's avatar
Maxime Perrotin committed
705
        fprintf(adb, "end %s_wrappers;\n", fv->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
706
707

    if (NULL != async_ads)
Maxime Perrotin's avatar
Maxime Perrotin committed
708
        fprintf(async_ads, "end %s_async_ri_wrappers;\n", fv->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
709
    if (NULL != async_adb)
Maxime Perrotin's avatar
Maxime Perrotin committed
710
        fprintf(async_adb, "end %s_async_ri_wrappers;\n", fv->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
711
712
713
714
715
716
717
718
719
720
721
722

    close_ada_wrappers();
}

/* 
 * Generate the code of a stack that handle the calling thread list needed to transparently make sure that
 * when a sync PI has to call a RI, it does it through its calling thread.
 */
void Generate_Ada_CallingStack(FV * fv)
{
    int count = 0;
    if (NULL == ads || NULL == adb)
Maxime Perrotin's avatar
Maxime Perrotin committed
723
        return;
Maxime Perrotin's avatar
Maxime Perrotin committed
724
725

    FOREACH(ct, FV, fv->calling_threads, {
Maxime Perrotin's avatar
Maxime Perrotin committed
726
727
        (void) ct;
        count ++;
Maxime Perrotin's avatar
Maxime Perrotin committed
728
729
730
    })

    if (2 > count)
Maxime Perrotin's avatar
Maxime Perrotin committed
731
        return;
Maxime Perrotin's avatar
Maxime Perrotin committed
732
733
734
735
736
737
738
739
740
741
742

    fprintf(ads, "\ttype t_stack is array (1..%d) of integer;\n\n", count);
    fprintf(ads, "\tprotected callinglist is\n");
    fprintf(ads, "\t\tprocedure push (value: integer);\n");
    fprintf(ads, "\t\tprocedure pop;\n");
    fprintf(ads, "\t\tfunction get_top_value return integer;\n");
    fprintf(ads, "\t\tprivate\n\t\t\tstack: t_stack := (others=>0);\n");
    fprintf(ads, "\tend callinglist;\n\n");

    fprintf(adb, "\tprotected body callinglist is\n");
    fprintf(adb, "\t\tprocedure push(value: integer) is\n\t\tbegin\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
743
    fprintf(adb, "\t\t\tif stack(1) /= 0 then\n\tPolyORB_HI.Output.Put_Line(\"### STACK ERROR (OVERFLOW), in %s\"); end if;\n", fv->name);      // Added for debug
Maxime Perrotin's avatar
Maxime Perrotin committed
744
745
    fprintf(adb, "\t\t\tfor i in 1..%d loop\n", count);
    fprintf(adb,
Maxime Perrotin's avatar
Maxime Perrotin committed
746
            "\t\t\t\tif stack(i) /= 0 then if stack (i-1) = 0 then stack (i-1) := value; return; end if; end if;\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
747
748
749
750
751
752
753
    fprintf(adb, "\t\t\tend loop;\n");
    fprintf(adb, "\t\t\tstack(%d) := value;\n", count);
    fprintf(adb, "\t\tend push;\n\n");

    fprintf(adb, "\t\tprocedure pop is\n\t\tbegin\n");
    fprintf(adb, "\t\t\tif stack(1) /= 0 then stack(1) := 0; return;\n");
    fprintf(adb,
Maxime Perrotin's avatar
Maxime Perrotin committed
754
755
            "\t\t\telsif stack(%d) = 0 then\n\tPolyORB_HI.Output.Put_Line(\"### STACK ERROR (POP EMPTY STACK) in %s\"); return;\n",
            count, fv->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
756
757
758
    fprintf(adb, "\t\t\telse\n");
    fprintf(adb, "\t\t\t\tfor i in 1..%d loop\n", count);
    fprintf(adb,
Maxime Perrotin's avatar
Maxime Perrotin committed
759
            "\t\t\t\t\tif stack(i) /= 0 then if stack (i-1) = 0 then stack (i) := 0; return; end if; end if;\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
760
761
762
763
764
    fprintf(adb, "\t\t\t\tend loop;\n");
    fprintf(adb, "\t\t\tend if;\n");
    fprintf(adb, "\t\tend pop;\n\n");

    fprintf(adb,
Maxime Perrotin's avatar
Maxime Perrotin committed
765
            "\t\tfunction get_top_value return integer is\n\t\tbegin\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
766
767
    fprintf(adb, "\t\t\tif stack(1) /= 0 then return stack(1);\n");
    fprintf(adb,
Maxime Perrotin's avatar
Maxime Perrotin committed
768
769
            "\t\t\telsif stack(%d) = 0 then\n\tPolyORB_HI.Output.Put_Line(\"### STACK ERROR (GET_TOP EMPTY STACK) in %s. Check that your startup/init function does not call any RIs.\"); return 0;\n",
            count, fv->name);
Maxime Perrotin's avatar
Maxime Perrotin committed
770
771
772
    fprintf(adb, "\t\t\telse\n");
    fprintf(adb, "\t\t\t\tfor i in 1..%d loop\n", count);
    fprintf(adb,
Maxime Perrotin's avatar
Maxime Perrotin committed
773
            "\t\t\t\t\tif stack(i) /= 0 then if stack (i-1) = 0 then return stack (i); end if; end if;\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
774
775
    fprintf(adb, "\t\t\t\tend loop;\n");
    fprintf(adb, "\t\t\tend if;\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
776
    fprintf(adb, "\t\t\treturn(-1);\n");
Maxime Perrotin's avatar
Maxime Perrotin committed
777
778
779
780
781
782
783
784
785
786
    fprintf(adb, "\t\tend get_top_value;\n\n");

    fprintf(adb, "\tend callinglist;\n\n");
}

/* Function to process one interface of the FV */
void GLUE_Ada_Wrappers_Interface(Interface * i)
{

    if (PI == i->direction) {
Maxime Perrotin's avatar
Maxime Perrotin committed
787
        add_PI_to_ada_wrappers(i);
Maxime Perrotin's avatar
Maxime Perrotin committed
788
    } else if (RI == i->direction) {
Maxime Perrotin's avatar
Maxime Perrotin committed
789
        add_RI_to_ada_wrappers(i);
Maxime Perrotin's avatar
Maxime Perrotin committed
790
791
792
793
794
795
796
    }
}

// External interface for the Ada wrappers backend
void GLUE_Ada_Wrappers_Backend(FV * fv)
{
    if (fv->system_ast->context->onlycv)
Maxime Perrotin's avatar
Maxime Perrotin committed
797
        return;
Maxime Perrotin's avatar
Maxime Perrotin committed
798
799

    if (fv->system_ast->context->polyorb_hi_c)
Maxime Perrotin's avatar
Maxime Perrotin committed
800
        return;
Maxime Perrotin's avatar
Maxime Perrotin committed
801
802
803
804
805
806
807

    FOREACH(i, Interface, fv->interfaces, {
        if (PI == i->direction && (qgenc == fv->language)) {
            return;
        }
    })

Maxime Perrotin's avatar
Maxime Perrotin committed
808
        Init_Ada_Wrappers_Backend(fv);
Maxime Perrotin's avatar
Maxime Perrotin committed
809

Maxime Perrotin's avatar
Maxime Perrotin committed
810
811
812
        if (passive_runtime == fv->runtime_nature) {
            Generate_Ada_CallingStack(fv);
        }
Maxime Perrotin's avatar
Maxime Perrotin committed
813

Maxime Perrotin's avatar
Maxime Perrotin committed
814
815
        /*ForEach(fv->interfaces, GLUE_Ada_Wrappers_Interface);*/
        FOREACH(i, Interface, fv->interfaces, {
Maxime Perrotin's avatar
Maxime Perrotin committed
816
817
818
819
820
        if (!(qgenc == fv->language ||
            qgenada == fv->language ||
            qgenc == i->distant_qgen->language)) {
            GLUE_Ada_Wrappers_Interface(i);
        }
Maxime Perrotin's avatar
Maxime Perrotin committed
821
        })
Maxime Perrotin's avatar
Maxime Perrotin committed
822

Maxime Perrotin's avatar
Maxime Perrotin committed
823
        End_Ada_Wrappers_Backend(fv);
Maxime Perrotin's avatar
Maxime Perrotin committed
824
825

}