gnucobol-users
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[open-cobol-list] Suggested corrections


From: Roger While
Subject: [open-cobol-list] Suggested corrections
Date: Mon Mar 8 03:06:10 2004

        Comments -
        codegen.c
                We must exit in default error handler.
                A file error that is not handled by the program must
                terminate the program.
        typeck.c
                Really move high/low values.
                Possible false move (still checking)
                Activate error handling for open.
        byteswap.h
                Always generate fast code (i486 and above)
                Reasoning - (a)The code will not generate fast
                swap for eg -march=pentium3 etc.
                (b) Even if Open Cobol can be compiled for i386, the
                   prerequisite software cannot.
        common.c/common.h
                Handle the sign nibble in unsigned COMP-3 fields.
                Flush stderr.
        fileio.c/fileio.h
                Handle sort files correctly. ( I am not completely
                satisfied with this, I think we should generate our own
                file name and not take it from the assign) It is anyway
                an improvement.
                Clean up message text.
                Activate file error 35 (Why was/is this not being done?)
        numeric.c
                Correctly handle no-trunc.
        termio.c
                For non-pretty display of binary fields, put the sign at the 
front.
                This is more natural (and agrees with what MF/ACU do - makes
                diffs much easier :-) )

Comments welcome.

Roger While

diff -Naur open-cobol/cobc/codegen.c openkei/cobc/codegen.c
--- open-cobol/cobc/codegen.c   2004-03-06 01:57:04.000000000 +0100
+++ openkei/cobc/codegen.c      2004-03-06 12:33:33.000000000 +0100
@@ -2161,7 +2161,8 @@
       }
   output_line ("  default:");
   output_line ("    cob_default_error_handle ();");
-  output_line ("    break;");
+/* RXW */
+  output_line ("    exit(1);");
   output_line ("  }");
   output_perform_exit (CB_LABEL (cb_standard_error_handler));
   output_newline ();
diff -Naur open-cobol/cobc/typeck.c openkei/cobc/typeck.c
--- open-cobol/cobc/typeck.c    2004-03-05 18:10:17.000000000 +0100
+++ openkei/cobc/typeck.c       2004-03-06 12:44:35.000000000 +0100
@@ -2273,7 +2273,9 @@
   switch (CB_TREE_CATEGORY (x))
     {
     case CB_CATEGORY_NUMERIC:
+/* RXW Really move high-vals to numeric
       return cb_build_move_num (x, 9);
+*/
     case CB_CATEGORY_ALPHABETIC:
     case CB_CATEGORY_ALPHANUMERIC:
       return cb_build_memset (x, 255);
@@ -2288,7 +2290,9 @@
   switch (CB_TREE_CATEGORY (x))
     {
     case CB_CATEGORY_NUMERIC:
+/* RXW Really move low-vals to numeric
       return cb_build_move_num (x, 0);
+*/
     case CB_CATEGORY_ALPHABETIC:
     case CB_CATEGORY_ALPHANUMERIC:
       return cb_build_memset (x, 0);
@@ -2434,8 +2438,13 @@
        break;
       case CB_CATEGORY_NUMERIC:
        if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC
+/* RXW
            && src_f->usage == CB_USAGE_DISPLAY
            && dst_f->usage == CB_USAGE_DISPLAY
+*/
+           && src_f->usage == dst_f->usage
+/* RXW */
+           && src_f->flag_blank_zero == dst_f->flag_blank_zero
            && src_f->pic->size == dst_f->pic->size
            && src_f->pic->digits == dst_f->pic->digits
            && src_f->pic->scale == dst_f->pic->scale
@@ -2547,6 +2556,8 @@
     sharing = cb_int1;

   cb_emit (cb_build_funcall_3 ("cob_open", file, mode, sharing));
+ /* RXW */
+  CB_EXCEPTION_ENABLE (COB_EC_I_O) = 1;
 }


diff -Naur open-cobol/libcob/byteswap.h openkei/libcob/byteswap.h
--- open-cobol/libcob/byteswap.h        2003-08-12 00:18:07.000000000 +0200
+++ openkei/libcob/byteswap.h   2004-03-06 12:32:05.000000000 +0100
@@ -68,23 +68,6 @@
                      : "0" (__x)                                       \
                      : "cc");                                          \
            __v; }))
-#    if !defined (__i486__) && !defined (__i586__) \
-       && !defined (__pentium__) && !defined (__i686__) \
-       && !defined (__pentiumpro__)
-#       define COB_BSWAP_32_IA32(val)                                   \
-         (__extension__                                                 \
-          ({ register unsigned long __v, __x = ((unsigned long) (val)); \
-             if (__builtin_constant_p (__x))                            \
-               __v = COB_BSWAP_32_CONSTANT (__x);                       \
-             else                                                       \
-               __asm__ ("rorw $8, %w0\n\t"                              \
-                        "rorl $16, %0\n\t"                              \
-                        "rorw $8, %w0"                                  \
-                        : "=r" (__v)                                    \
-                        : "0" (__x)                                     \
-                        : "cc");                                        \
-             __v; }))
-#    else /* 486 and higherwap bs */
 #       define COB_BSWAP_32_IA32(val)                                   \
          (__extension__                                                 \
           ({ register unsigned long __v, __x = ((unsigned long) (val)); \
@@ -95,7 +78,6 @@
                         : "=r" (__v)                                    \
                         : "0" (__x));                                   \
              __v; }))
-#    endif /* processor specific 32-bit stuff */
 #    define COB_BSWAP_64_IA32(val)                             \
        (__extension__                                          \
        ({ union { unsigned long long __ll;                     \
diff -Naur open-cobol/libcob/common.c openkei/libcob/common.c
--- open-cobol/libcob/common.c  2003-10-21 06:35:21.000000000 +0200
+++ openkei/libcob/common.c     2004-03-06 12:32:05.000000000 +0100
@@ -289,6 +289,16 @@
 void
 cob_real_put_sign (cob_field *f, int sign)
 {
+  if ( ! COB_FIELD_HAVE_SIGN (f))
+  {
+        if (COB_FIELD_TYPE (f) == COB_TYPE_NUMERIC_PACKED)
+        {
+                unsigned char *p = f->data + f->attr->digits / 2;
+                *p = (*p & 0xf0) | 0x0f;
+        }
+        return;
+  }
+
   switch (COB_FIELD_TYPE (f))
     {
     case COB_TYPE_NUMERIC_DISPLAY:
@@ -621,6 +631,8 @@

   /* postfix */
   fputs ("\n", stderr);
+/* RXW */
+  fflush(stderr);
 }

 void
diff -Naur open-cobol/libcob/common.h openkei/libcob/common.h
--- open-cobol/libcob/common.h  2004-03-06 00:24:10.000000000 +0100
+++ openkei/libcob/common.h     2004-03-06 12:32:05.000000000 +0100
@@ -192,7 +192,7 @@
 /* Utilities */

#define cob_get_sign(f) (COB_FIELD_HAVE_SIGN (f) ? cob_real_get_sign (f) : 0) -#define cob_put_sign(f,s) if (COB_FIELD_HAVE_SIGN (f)) cob_real_put_sign (f, s)
+#define cob_put_sign(f,s) cob_real_put_sign (f, s)

 extern int cob_real_get_sign (cob_field *f);
 extern void cob_real_put_sign (cob_field *f, int sign);
diff -Naur open-cobol/libcob/fileio.c openkei/libcob/fileio.c
--- open-cobol/libcob/fileio.c  2004-03-06 02:20:24.000000000 +0100
+++ openkei/libcob/fileio.c     2004-03-06 12:46:32.000000000 +0100
@@ -37,6 +37,9 @@
 #include <errno.h>
 #include <ctype.h>
 #include <sys/stat.h>
+/* RXW */
+#include <sys/types.h>
+#include <unistd.h>

 #if HAVE_FCNTL_H
 #include <fcntl.h>
@@ -879,7 +882,8 @@
   memset (&info, 0, sizeof (info));
   info.flags = R_DUP;
   info.compare = sort_compare;
-  p->db = dbopen (filename, flags, COB_FILE_MODE, DB_BTREE, &info);
+/* RXW */
+ p->db = dbopen (f->sort_filename, flags, COB_FILE_MODE, DB_BTREE, &info);
   if (p->db == NULL)
     return errno;

@@ -987,6 +991,9 @@

   /* obtain the file name */
   cob_field_to_string (f->assign, filename);
+/* RXW */
+ if ( f->organization != COB_ORG_SORT )
+ {
   if (cob_current_module->flag_filename_mapping)
     {
       char buff[FILENAME_MAX];
@@ -1046,6 +1053,8 @@
       if (mode != COB_OPEN_OUTPUT && f->flag_optional == 0)
        RETURN_STATUS (COB_STATUS_35_NOT_EXISTS);
     }
+/* RXW */
+ }

   /* open the file */
switch (fileio_funcs[(int) f->organization]->open (f, filename, mode, opt))
@@ -1292,6 +1301,28 @@
 void
cob_sort_init (cob_file *f, int nkeys, const unsigned char *collating_sequence)
 {
+/* RXW */
+  char *s, *p;
+  char name[FILENAME_MAX];
+  char filename[FILENAME_MAX];
+
+  cob_field_to_string(f->assign, filename);
+  if ( (p = strrchr(filename, '/')) == NULL )
+       p = filename;
+  else
+       p++;
+
+  if ( (s = getenv("TMPDIR")) == (char *)0 )
+  {
+    if ( (s = getenv("TMP")) == (char *)0 )
+    {
+        s = "/tmp";
+    }
+  }
+  sprintf(name, "%s/%s%d", s, p, getpid());
+  f->sort_filename = malloc(strlen(name) + 4);
+  strcpy(f->sort_filename, name);
+
   f->file = malloc (sizeof (struct sort_file));
   f->keys = malloc (sizeof (cob_file_key) * nkeys);
   f->nkeys = 0;
@@ -1306,6 +1337,10 @@
 {
   free (f->file);
   free (f->keys);
+/* RXW */
+  unlink(f->sort_filename);
+  free (f->sort_filename);
+
   cob_current_module->collating_sequence = old_sequence;
 }

@@ -1363,55 +1398,56 @@
   switch (status)
     {
     case COB_STATUS_10_END_OF_FILE:
-      msg = N_("end of file");
+      msg = N_("End of file");
       break;
     case COB_STATUS_14_OUT_OF_KEY_RANGE:
-      msg = N_("out of key range");
+      msg = N_("Out of key range");
       break;
     case COB_STATUS_21_KEY_INVALID:
-      msg = N_("key order not ascending");
+      msg = N_("Key order not ascending");
       break;
     case COB_STATUS_22_KEY_EXISTS:
-      msg = N_("record key already exists");
+      msg = N_("Record key already exists");
       break;
     case COB_STATUS_23_KEY_NOT_EXISTS:
-      msg = N_("record key not exists");
+      msg = N_("Record key does not exist");
       break;
     case COB_STATUS_30_PERMANENT_ERROR:
-      msg = N_("permanent file error");
+      msg = N_("Permanent file error");
       break;
     case COB_STATUS_35_NOT_EXISTS:
-      /* no message */
+      /* RXW */
+      msg = N_("File does not exist");
       break;
     case COB_STATUS_37_PERMISSION_DENIED:
-      msg = N_("permission denied");
+      msg = N_("Permission denied");
       break;
     case COB_STATUS_41_ALREADY_OPEN:
-      msg = N_("file already open");
+      msg = N_("File already open");
       break;
     case COB_STATUS_42_NOT_OPEN:
-      msg = N_("file not open");
+      msg = N_("File not open");
       break;
     case COB_STATUS_43_READ_NOT_DONE:
       msg = N_("READ must be executed first");
       break;
     case COB_STATUS_44_RECORD_OVERFLOW:
-      msg = N_("record overflow");
+      msg = N_("Record overflow");
       break;
     case COB_STATUS_46_READ_ERROR:
-      msg = N_("failed to read");
+      msg = N_("Failed to read");
       break;
     case COB_STATUS_47_INPUT_DENIED:
-      msg = N_("READ and START not allowed");
+      msg = N_("READ/START not allowed");
       break;
     case COB_STATUS_48_OUTPUT_DENIED:
       msg = N_("WRITE not allowed");
       break;
     case COB_STATUS_49_I_O_DENIED:
-      msg = N_("DELETE and REWRITE not allowed");
+      msg = N_("DELETE/REWRITE not allowed");
       break;
     default:
-      msg = N_("unknown file error");
+      msg = N_("Unknown file error");
       break;
     }

diff -Naur open-cobol/libcob/fileio.h openkei/libcob/fileio.h
--- open-cobol/libcob/fileio.h  2003-08-24 21:30:02.000000000 +0200
+++ openkei/libcob/fileio.h     2004-03-06 12:32:05.000000000 +0100
@@ -131,6 +131,7 @@
char flag_first_read; /* first READ after OPEN or START */
   char flag_read_done;         /* last READ successfully done */
   void *file;                  /* file type specific data pointer */
+  char *sort_filename;         /* SORT temp filename */
 } cob_file;

 /* File I-O functions */
diff -Naur open-cobol/libcob/numeric.c openkei/libcob/numeric.c
--- open-cobol/libcob/numeric.c 2004-02-10 00:35:34.000000000 +0100
+++ openkei/libcob/numeric.c    2004-03-06 12:32:05.000000000 +0100
@@ -223,7 +223,12 @@
   if (diff < 0)
     {
       COB_SET_EXCEPTION (COB_EC_SIZE_OVERFLOW);
-      return cob_exception_code;
+      if (cob_current_module->flag_binary_truncate)
+       return cob_exception_code;
+
+      p += -diff;
+      diff = 0;
+      size = COB_FIELD_SIZE (f);
     }

   /* store number */
@@ -573,6 +578,9 @@
          /* check for overflow */
          if (--sp < data)
            {
+/* RXW */
+              if ( ! cob_current_module->flag_binary_truncate )
+                return 0;
              for (; i >= 0; i--)
                carry += dp[i];
              return carry;
@@ -595,6 +603,9 @@
        return 0;
       *sp = '0';
     }
+/* RXW */
+  if ( ! cob_current_module->flag_binary_truncate )
+      return 0;
   return 1;
 }

@@ -618,6 +629,9 @@
          /* check for overflow */
          if (--sp < data)
            {
+/* RXW */
+              if ( ! cob_current_module->flag_binary_truncate )
+               return 0;
              for (; i >= 0; i--)
                carry += dp[i];
              return carry;
@@ -640,6 +654,9 @@
        return 0;
       *sp = '9';
     }
+/* RXW */
+  if ( ! cob_current_module->flag_binary_truncate )
+       return 0;
   return 1;
 }

@@ -674,7 +691,8 @@
   if (n > 0)
     {
       /* add n to the field */
-      if (display_add_int (data, size, n))
+      if (display_add_int (data, size, n) != 0
+         && cob_current_module->flag_binary_truncate)
        {
          /* if there wes an overflow, recover the last value */
          display_sub_int (data, size, n);
diff -Naur open-cobol/libcob/termio.c openkei/libcob/termio.c
--- open-cobol/libcob/termio.c  2004-03-05 14:31:50.000000000 +0100
+++ openkei/libcob/termio.c     2004-03-06 13:04:37.000000000 +0100
@@ -49,6 +49,8 @@
       attr.flags = COB_FLAG_HAVE_SIGN | COB_FLAG_SIGN_SEPARATE;
       if (COB_FIELD_SIGN_LEADING (f))
        attr.flags |= COB_FLAG_SIGN_LEADING;
+      if (f->attr->type == COB_TYPE_NUMERIC_BINARY)
+       attr.flags |= COB_FLAG_SIGN_LEADING;
     }

   cob_move (f, &temp);




reply via email to

[Prev in Thread] Current Thread [Next in Thread]