Data Mapping

  1. When mapping Windows API data types to COBOL, you can use COMP-5 or COMP-N as shown below:
    Windows COBOL Data Size
    char[n], str[n], tchar[n] PIC X(n) n bytes
    long, int PIC X(4) COMP-N

    or

    PIC S9(9) COMP-5

    4 bytes
    dword, ulong, lpxxx, float PIC X(4) COMP-N

    or

    PIC 9(9) COMP-5

    4 bytes
    short PIC X(2) COMP-N

    or

    PIC S9(5) COMP-5

    2 bytes
    word, ushort PIC X(2) COMP-N

    or

    PIC 9(5) COMP-5

    2 bytes

    We recommend using COMP-N for most cases, although COMP-N data types are HEX, unsigned, and thus difficult for negative numbers.

    If you want to use COMP-5, be sure to use the "--TruncANSI" compiler option. This causes truncation in binary to the capacity of the allocated storage for COMP-5 items. (By default, ACUCOBOL-GT truncates in decimal to the number of digits given in the PICTURE clause on arithmetic and non-arithmetic stores into COMP-5 items.) Note that the "-Dz" option overrides "--TruncANSI".

  2. When defining C data types in COBOL, remember to maintain the data size shown in the table. It is imperative to make items the same, static size.
  3. A structure is a group of data, a virtual container for many different C data items. To include a C structure (struct) in ACUCOBOL-GT, ignore the first and last line in the structure, and create a COBOL group item as shown in the following example:

C structure to include:

typedef struct _WIN32_FIND_DATA {  
  DWORD     dwFileAttributes;  
  FILETIME  ftCreationTime;  
  FILETIME  ftLastAccessTime;  
  FILETIME  ftLastWriteTime;  
  DWORD     nFileSizeHigh;  
  DWORD     nFileSizeLow;  
  DWORD     dwReserved0;  
  DWORD     dwReserved1;  
  TCHAR     cFileName[ MAX_PATH ];  
  TCHAR     cAlternateFileName[ 14 ];
} WIN32_FIND_DATA, *PWIN32_FIND_DATA;

Resulting ACUCOBOL-GT group item:

01 WIN32-FIND-DATA.  
  03 dwFileAttributes   PIC X(4) COMP-N.  
  03 ftCreationTime.    
     05 dwLowCreateDT   PIC X(4) COMP-N.    
     05 dwHighCreateDT  PIC X(4) COMP-N.  
  03 ftLastAccessTime.    
     05 dwLowAccessDT   PIC X(4) COMP-N.    
     05 dwHighAccessDT  PIC X(4) COMP-N.  
  03 ftLastWriteTime.    
     05 dwLowWriteDT    PIC X(4) COMP-N.    
     05 dwHighWriteDT   PIC X(4) COMP-N.  
  03 nFileSizeHigh      PIC X(4) COMP-N.  
  03 nFileSizeLow       PIC X(4) COMP-N.  
  03 dwReserved0        PIC X(4) COMP-N.  
  03 dwReserved1        PIC X(4) COMP-N.  
  03 cFileName          PIC X(260).  
  03 cAlternateFileName PIC X(14).