summaryrefslogtreecommitdiff
path: root/Ganlib/src/clepil.c
blob: 7aeeb54fcdd73fe8ec29e58a243b4313f86daf35 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60

/*****************************************/
/*             CLE-2000 API              */
/*   AUTHOR OF FORTRAN VERSION: R. Roy   */
/*     AUTHOR: A. Hebert ; 15/05/09      */
/*****************************************/

#include <string.h>
#include "cle2000.h"

int_32 clepil(FILE *iredin, FILE *iwrite, kdi_file *iunito,
              int_32 (*dumcst)(char *, int_32 *, int_32 *, float_32 *, char *, double_64 *))
{

/*     CLE-2000 SYSTEM: R.ROY (03/1999), VERSION 2.1 */

/*             *CLEPIL* WILL PERFORM A SYNTACTICAL ANALYSIS */
/*                      AND COMPILE THE INPUT UNIT *IREDIN*. */
/*                      RESULT IS THE OBJECT D.A. UNIT *IUNITO* */
/*                      COMPILER COMMENTS ARE WRITTEN ON UNIT *IWRITE* */
/*                      WORDS ARE SEPARATED AND CLASSIFIED BY TYPES. */
/*                      EVERYTHING IS CHECKED FOR CORRECT EXECUTION. */

/*      INPUT: *IREDIN* IS THE INPUT  UNIT */
/*             *IWRITE* IS THE OUTPUT UNIT FOR COMPILER COMMENTS */
/*             *IUNITO* IS THE DIRECT ACCESS UNIT FOR OBJECT CODE */
/*             *DUMCST* IS THE EXTERNAL FUNCTION FOR *CLE-2000* CONSTANTS */

/*       NOTE: *CLEPIL* = 0 IF NO PROBLEM WAS ENCOUNTERED WHILE COMPILING */

   char *nomsub = "clepil";
   char *clistc[] = {"clelog", "clestk", "clexrf"};
   int_32 iretcd, istepc;
   int_32 ret_val = 0;

/* CONSTRUCT OBJECT FILE AND ANALYSE LOGIC */
   istepc = 0;
   iretcd = clelog(iredin, iwrite, iunito);
   if (iretcd != 0) goto L9002;

/* ADD CLE-2000 VARIABLES */
   istepc = 1;
   iretcd = clestk(iunito, iwrite, dumcst);
   if (iretcd != 0) goto L9002;
   istepc = 3;

/* X-REF CLE-2000 VARIABLES */
   istepc = 2;
   iretcd = clexrf(iunito, iwrite);
   if (iretcd != 0) goto L9002;

L666:
   return ret_val;

L9002:
   printf("! %s: ERROR CODE IN >>%s<< ERROR NUMBER (%d)\n", nomsub, clistc[istepc], (int)iretcd);
   ret_val = iretcd;
   goto L666;

} /* clepil */