1 files changed, 120 insertions, 0 deletions
diff --git a/Ganlib/src/kdrdpr.c b/Ganlib/src/kdrdpr.c
new file mode 100644
index 0000000..b911620
--- /dev/null
+++ b/Ganlib/src/kdrdpr.c
@@ -0,0 +1,120 @@
+
+/*****************************************/
+/*             CLE-2000 API              */
+/*   AUTHOR OF FORTRAN VERSION: R. Roy   */
+/*     AUTHOR: A. Hebert ; 31/07/10      */
+/*****************************************/
+
+#include <string.h>
+#include "cle2000.h"
+
+int_32 kdrdpr(lifo **my_iptrun, int_32 nentry, char (*hentry)[13])
+{
+
+/*     GAN-2000 SYSTEM: R.ROY (01/2000), VERSION 2.1 */
+
+/*             *KDRDPR* IS THE MODULE FOR *PROCEDURE   * DECLARATIONS */
+/*                      =0 IF NO ERROR */
+
+/*      INPUT: *MY_IPTRUN* IS THE EXEC STRUCTURE POINTER (ALLOCATED) */
+/*             *NENTRY* IS THE # OF LINKED LISTS AND FILES USED. */
+/*             *HENTRY* NAMES OF EACH OBJECT <- LINKED LIST OR FILE. */
+/*                      ( CHARACTER*12 HENTRY(NENTRY) ) */
+
+/*     SYNTAX: */
+/*              PROCEDURE *HENTRY(I=1,NENTRY)* ; */
+/*                (DEFAULT VALUES, CHECK EXISTENCE) */
+
+/*              PROCEDURE *HENTRY(I=1,NENTRY)* :: *DATA* ; */
+/*                (USER DEFINED VALUES, ACCESS TO CLE-2000 COMPILER) */
+
+   char *nomsub = "kdrdpr";
+   int_32 ret_val = 0;
+   int_32 ityp, nitma, lndata;
+   float_32 flott;
+   double_64 dflot;
+   char text[73], messag[133], filenm[73], filinp[77], filobj[77];
+   int_32 iloop1;
+   
+   if (nentry <= 0) goto L666;
+
+   redget_c(&ityp, &nitma, &flott, text, &dflot);
+   lndata = ityp != 10 && (ityp != 3 || strcmp(text, ";") != 0);
+   if (lndata) {
+      sprintf(messag, "%s: NOT DEVELOPED YET (RR)", nomsub);
+      printf("%-132s\n", messag);
+      ret_val = -666;
+      goto L666;
+   }
+   for (iloop1 = 0; iloop1 < nentry; ++iloop1) {
+      int_32 iparam;
+      lifo_node *my_node;
+      
+      my_node = clenode(my_iptrun, hentry[iloop1]);
+      if (my_node == NULL) {
+         printf("%s: UNABLE TO FIND NODE FOR %s\n", nomsub, hentry[iloop1]);
+         ret_val = -665;
+         goto L666;
+      }
+      iparam = my_node->type;
+      if (lndata) {
+         redget_c(&ityp, &nitma, &flott, text, &dflot);
+         if (ityp == 3) {
+            strcpy(filenm, text);
+         } else {
+            goto L8001;
+         }
+      } else {
+         strcpy(filenm, my_node->name);
+      }
+
+      sprintf(filinp, "%s.c2m",filenm);
+      sprintf(filobj, "%s.o2m",filenm);
+      if (iparam == 1) {
+/*       ONLY VERIFY IF *filobj* EXISTS */
+         FILE *file;
+         file = fopen(filobj, "r");
+         if (file == NULL) {
+            sprintf(messag, "%s: OBJECT FILE *%s* DOES NOT EXIST: MUST BE COMPILED", nomsub, filobj);
+            printf("%-132s\n", messag);
+            ret_val = -1;
+            goto L666;
+         } else {
+            fclose(file);
+         }
+      } else {
+/*       ONLY VERIFY IF *filinp* EXISTS */
+         FILE *file;
+         file = fopen(filinp, "r");
+         if (file == NULL) {
+            sprintf(messag, "%s: INPUT FILE *%s* DOES NOT EXIST",nomsub, filinp);
+            printf("%-132s\n", messag);
+            ret_val = -1;
+            goto L666;
+         } else {
+            fclose(file);
+         }
+         my_node->type = -iparam;
+         strcpy(my_node->OSname, filobj);
+      }
+   }
+
+/* CAN WE FOUND *;* AT THE END OF THE SENTENCE ? */
+   if (lndata) {
+      redget_c(&ityp, &nitma, &flott, text, &dflot);
+      if (ityp != 3 || strcmp(text, ";") != 0) goto L8002;
+   }
+L666:
+   return ret_val;
+
+L8001:
+   sprintf(messag, "%s: INVALID TYPE IN *PROCEDURE* DATA.", nomsub);
+   printf("%-132s\n", messag);
+   ret_val = 8001;
+   goto L666;
+L8002:
+   sprintf(messag, "%s: INVALID END  IN *PROCEDURE* DATA.", nomsub);
+   printf("%-132s\n", messag);
+   ret_val = 8002;
+   goto L666;
+} /* kdrdpr */