GnuCOBOL  2.0
A free COBOL compiler
Data Structures | Macros | Typedefs | Enumerations | Functions
common.h File Reference
#include <setjmp.h>
#include <libcob/exception.def>
Include dependency graph for common.h:
This graph shows which files directly or indirectly include this file:

Go to the source code of this file.

Data Structures

struct  cob_field_attr
 
struct  cob_field
 
struct  cob_fp_128
 
struct  cob_decimal
 
struct  cob_frame
 
union  cob_content
 
union  cob_call_union
 
struct  cob_call_struct
 
struct  __cob_screen
 
struct  __cob_module
 
struct  cob_func_loc
 
struct  cob_file_key
 
struct  cob_file
 
struct  cob_linage
 
struct  cob_report
 
struct  __cob_global
 
struct  cob_fileio_funcs
 
struct  cobjmp_buf
 
struct  longoption_def
 

Macros

#define cob_c8_t   char
 
#define cob_s8_t   signed char
 
#define cob_u8_t   unsigned char
 
#define cob_s16_t   short
 
#define cob_u16_t   unsigned short
 
#define cob_s32_t   int
 
#define cob_u32_t   unsigned int
 
#define cob_sli_t   long int
 
#define cob_uli_t   unsigned long int
 
#define cob_s64_t   long long
 
#define cob_u64_t   unsigned long long
 
#define COB_S64_C(x)   x ## LL
 
#define COB_U64_C(x)   x ## ULL
 
#define CB_FMT_LLD   "%lld"
 
#define CB_FMT_LLU   "%llu"
 
#define CB_FMT_PLLD   "%+*.*lld"
 
#define CB_FMT_PLLU   "%*.*llu"
 
#define CB_FMT_LLD_F   "%lldLL"
 
#define CB_FMT_LLU_F   "%lluULL"
 
#define cob_c8_ptr   cob_c8_t *
 
#define cob_u8_ptr   cob_u8_t *
 
#define cob_s8_ptr   cob_s8_t *
 
#define cob_u16_ptr   cob_u16_t *
 
#define cob_s16_ptr   cob_s16_t *
 
#define cob_u32_ptr   cob_u32_t *
 
#define cob_s32_ptr   cob_s32_t *
 
#define cob_u64_ptr   cob_u64_t *
 
#define cob_s64_ptr   cob_s64_t *
 
#define cob_void_ptr   void *
 
#define cob_field_ptr   cob_field *
 
#define cob_file_ptr   cob_file *
 
#define cob_module_ptr   cob_module *
 
#define cob_screen_ptr   cob_screen *
 
#define cob_file_key_ptr   cob_file_key *
 
#define COB_BSWAP_16_CONSTANT(val)
 
#define COB_BSWAP_32_CONSTANT(val)
 
#define COB_BSWAP_64_CONSTANT(val)
 
#define COB_BSWAP_16(val)   (COB_BSWAP_16_CONSTANT (val))
 
#define COB_BSWAP_32(val)   (COB_BSWAP_32_CONSTANT (val))
 
#define COB_BSWAP_64(val)   (COB_BSWAP_64_CONSTANT (val))
 
#define COB_EXPIMP   extern
 
#define COB_INLINE
 
#define COB_A_NORETURN
 
#define COB_A_FORMAT12
 
#define COB_A_FORMAT23
 
#define COB_A_FORMAT34
 
#define COB_A_FORMAT45
 
#define DECLNORET
 
#define optim_memcpy(x, y, z)   memcpy (x, y, z)
 
#define likely(x)   (x)
 
#define unlikely(x)   (x)
 
#define COB_A_MALLOC
 
#define COB_NOINLINE
 
#define COB_A_INLINE
 
#define COB_A_COLD
 
#define COB_NON_ALIGNED
 
#define __unaligned
 
#define PATHSEP_CHAR   (char) ':'
 
#define PATHSEP_STR   (char *) ":"
 
#define SLASH_CHAR   (char) '/'
 
#define SLASH_STR   (char *) "/"
 
#define ONCE_COB   while (0)
 
#define COB_UNUSED(z)   do { (void)(z); } ONCE_COB
 
#define COB_MINI_BUFF   256
 
#define COB_SMALL_BUFF   1024
 
#define COB_NORMAL_BUFF   2048
 
#define COB_FILE_BUFF   4096
 
#define COB_MEDIUM_BUFF   8192
 
#define COB_LARGE_BUFF   16384
 
#define COB_MINI_MAX   (COB_MINI_BUFF - 1)
 
#define COB_SMALL_MAX   (COB_SMALL_BUFF - 1)
 
#define COB_NORMAL_MAX   (COB_NORMAL_BUFF - 1)
 
#define COB_FILE_MAX   (COB_FILE_BUFF - 1)
 
#define COB_MEDIUM_MAX   (COB_MEDIUM_BUFF - 1)
 
#define COB_LARGE_MAX   (COB_LARGE_BUFF - 1)
 
#define COB_STACK_SIZE   255
 
#define MAX_FD_RECORD   65535
 
#define COB_MAX_FIELD_PARAMS   36 /* ToDo: move to config.h */
 
#define COB_MAX_DIGITS   38
 
#define COB_MAX_BINARY   39
 
#define COB_MAX_FIELD_SIZE   268435456
 
#define COB_MAX_DEC_STRUCT   32
 
#define COB_MAX_WORDLEN   61
 
#define COB_SORT_MEMORY   128 * 1024 * 1024
 
#define COB_SORT_CHUNK   256 * 1024
 
#define COB_RET_TYPE_INT   0
 
#define COB_RET_TYPE_PTR   1
 
#define COB_RET_TYPE_VOID   2
 
#define COB_FOLD_UPPER   1
 
#define COB_FOLD_LOWER   2
 
#define COB_LC_COLLATE   0
 
#define COB_LC_CTYPE   1
 
#define COB_LC_MESSAGES   2
 
#define COB_LC_MONETARY   3
 
#define COB_LC_NUMERIC   4
 
#define COB_LC_TIME   5
 
#define COB_LC_ALL   6
 
#define COB_LC_USER   7
 
#define COB_LC_CLASS   8
 
#define COB_TYPE_UNKNOWN   0x00
 
#define COB_TYPE_GROUP   0x01U
 
#define COB_TYPE_BOOLEAN   0x02U
 
#define COB_TYPE_NUMERIC   0x10U
 
#define COB_TYPE_NUMERIC_DISPLAY   0x10U
 
#define COB_TYPE_NUMERIC_BINARY   0x11U
 
#define COB_TYPE_NUMERIC_PACKED   0x12U
 
#define COB_TYPE_NUMERIC_FLOAT   0x13U
 
#define COB_TYPE_NUMERIC_DOUBLE   0x14U
 
#define COB_TYPE_NUMERIC_L_DOUBLE   0x15U
 
#define COB_TYPE_NUMERIC_FP_DEC64   0x16U
 
#define COB_TYPE_NUMERIC_FP_DEC128   0x17U
 
#define COB_TYPE_NUMERIC_FP_BIN32   0x18U
 
#define COB_TYPE_NUMERIC_FP_BIN64   0x19U
 
#define COB_TYPE_NUMERIC_FP_BIN128   0x1AU
 
#define COB_TYPE_NUMERIC_EDITED   0x24U
 
#define COB_TYPE_ALPHANUMERIC   0x21U
 
#define COB_TYPE_ALPHANUMERIC_ALL   0x22U
 
#define COB_TYPE_ALPHANUMERIC_EDITED   0x23U
 
#define COB_TYPE_NATIONAL   0x40U
 
#define COB_TYPE_NATIONAL_EDITED   0x41U
 
#define COB_FLAG_HAVE_SIGN   (1U << 0) /* 0x0001 */
 
#define COB_FLAG_SIGN_SEPARATE   (1U << 1) /* 0x0002 */
 
#define COB_FLAG_SIGN_LEADING   (1U << 2) /* 0x0004 */
 
#define COB_FLAG_BLANK_ZERO   (1U << 3) /* 0x0008 */
 
#define COB_FLAG_JUSTIFIED   (1U << 4) /* 0x0010 */
 
#define COB_FLAG_BINARY_SWAP   (1U << 5) /* 0x0020 */
 
#define COB_FLAG_REAL_BINARY   (1U << 6) /* 0x0040 */
 
#define COB_FLAG_IS_POINTER   (1U << 7) /* 0x0080 */
 
#define COB_FLAG_NO_SIGN_NIBBLE   (1U << 8) /* 0x0100 */
 
#define COB_FLAG_IS_FP   (1U << 9) /* 0x0200 */
 
#define COB_FLAG_REAL_SIGN   (1U << 10) /* 0x0400 */
 
#define COB_FLAG_BINARY_TRUNC   (1U << 11) /* 0x0800 */
 
#define COB_FIELD_HAVE_SIGN(f)   ((f)->attr->flags & COB_FLAG_HAVE_SIGN)
 
#define COB_FIELD_SIGN_SEPARATE(f)   ((f)->attr->flags & COB_FLAG_SIGN_SEPARATE)
 
#define COB_FIELD_SIGN_LEADING(f)   ((f)->attr->flags & COB_FLAG_SIGN_LEADING)
 
#define COB_FIELD_BLANK_ZERO(f)   ((f)->attr->flags & COB_FLAG_BLANK_ZERO)
 
#define COB_FIELD_JUSTIFIED(f)   ((f)->attr->flags & COB_FLAG_JUSTIFIED)
 
#define COB_FIELD_BINARY_SWAP(f)   ((f)->attr->flags & COB_FLAG_BINARY_SWAP)
 
#define COB_FIELD_REAL_BINARY(f)   ((f)->attr->flags & COB_FLAG_REAL_BINARY)
 
#define COB_FIELD_IS_POINTER(f)   ((f)->attr->flags & COB_FLAG_IS_POINTER)
 
#define COB_FIELD_NO_SIGN_NIBBLE(f)   ((f)->attr->flags & COB_FLAG_NO_SIGN_NIBBLE)
 
#define COB_FIELD_IS_FP(f)   ((f)->attr->flags & COB_FLAG_IS_FP)
 
#define COB_FIELD_REAL_SIGN(f)   ((f)->attr->flags & COB_FLAG_REAL_SIGN)
 
#define COB_FIELD_BINARY_TRUNC(f)   ((f)->attr->flags & COB_FLAG_BINARY_TRUNC)
 
#define COB_FLAG_LEADSEP   (COB_FLAG_SIGN_SEPARATE | COB_FLAG_SIGN_LEADING)
 
#define COB_FIELD_SIGN_LEADSEP(f)   (((f)->attr->flags & COB_FLAG_LEADSEP) == COB_FLAG_LEADSEP)
 
#define COB_FIELD_TYPE(f)   ((f)->attr->type)
 
#define COB_FIELD_DIGITS(f)   ((f)->attr->digits)
 
#define COB_FIELD_SCALE(f)   ((f)->attr->scale)
 
#define COB_FIELD_FLAGS(f)   ((f)->attr->flags)
 
#define COB_FIELD_PIC(f)   ((f)->attr->pic)
 
#define COB_FIELD_DATA(f)   ((f)->data + (COB_FIELD_SIGN_LEADSEP (f) ? 1 : 0))
 
#define COB_FIELD_SIZE(f)   (COB_FIELD_SIGN_SEPARATE (f) ? f->size - 1 : f->size)
 
#define COB_FIELD_IS_NUMERIC(f)   (COB_FIELD_TYPE (f) & COB_TYPE_NUMERIC)
 
#define COB_FIELD_IS_NUMDISP(f)   (COB_FIELD_TYPE (f) == COB_TYPE_NUMERIC_DISPLAY)
 
#define COB_FIELD_IS_ALNUM(f)   (COB_FIELD_TYPE (f) == COB_TYPE_ALPHANUMERIC)
 
#define COB_FIELD_IS_NATIONAL(f)   (COB_FIELD_TYPE (f) & COB_TYPE_NATIONAL)
 
#define COB_DISPLAY_SIGN_ASCII   0
 
#define COB_DISPLAY_SIGN_EBCDIC   1
 
#define COB_NATIONAL_SIZE   2
 
#define COB_SET_FLD(v, x, y, z)   (v.size = x, v.data = y, v.attr = z, &v)
 
#define COB_SET_DATA(x, z)   (x.data = z, &x)
 
#define COB_FERROR_NONE   0
 
#define COB_FERROR_CANCEL   1
 
#define COB_FERROR_INITIALIZED   2
 
#define COB_FERROR_CODEGEN   3
 
#define COB_FERROR_CHAINING   4
 
#define COB_FERROR_STACK   5
 
#define COB_FERROR_GLOBAL   6
 
#define COB_FERROR_MEMORY   7
 
#define COB_FERROR_MODULE   8
 
#define COB_FERROR_RECURSIVE   9
 
#define COB_FERROR_SCR_INP   10
 
#define COB_FERROR_FILE   11
 
#define COB_FERROR_FUNCTION   12
 
#define COB_FERROR_FREE   13
 
#define COB_EXCEPTION(code, tag, name, critical)   tag,
 
#define COB_FILE_VERSION   1
 
#define COB_EQ   1 /* x == y */
 
#define COB_LT   2 /* x < y */
 
#define COB_LE   3 /* x <= y */
 
#define COB_GT   4 /* x > y */
 
#define COB_GE   5 /* x >= y */
 
#define COB_NE   6 /* x != y */
 
#define COB_FI   7 /* First */
 
#define COB_LA   8 /* Last */
 
#define COB_ASCENDING   0
 
#define COB_DESCENDING   1
 
#define COB_FILE_MODE   0666
 
#define COB_ORG_SEQUENTIAL   0
 
#define COB_ORG_LINE_SEQUENTIAL   1
 
#define COB_ORG_RELATIVE   2
 
#define COB_ORG_INDEXED   3
 
#define COB_ORG_SORT   4
 
#define COB_ORG_MAX   5
 
#define COB_ACCESS_SEQUENTIAL   1
 
#define COB_ACCESS_DYNAMIC   2
 
#define COB_ACCESS_RANDOM   3
 
#define COB_SELECT_FILE_STATUS   (1U << 0)
 
#define COB_SELECT_EXTERNAL   (1U << 1)
 
#define COB_SELECT_LINAGE   (1U << 2)
 
#define COB_SELECT_SPLITKEY   (1U << 3)
 
#define COB_SELECT_STDIN   (1U << 4)
 
#define COB_SELECT_STDOUT   (1U << 5)
 
#define COB_SELECT_TEMPORARY   (1U << 6)
 
#define COB_FILE_SPECIAL(x)   ((x)->flag_select_features & (COB_SELECT_STDIN | COB_SELECT_STDOUT))
 
#define COB_FILE_STDIN(x)   ((x)->flag_select_features & COB_SELECT_STDIN)
 
#define COB_FILE_STDOUT(x)   ((x)->flag_select_features & COB_SELECT_STDOUT)
 
#define COB_FILE_TEMPORARY(x)   ((x)->flag_select_features & COB_SELECT_TEMPORARY)
 
#define COB_LOCK_EXCLUSIVE   (1U << 0)
 
#define COB_LOCK_MANUAL   (1U << 1)
 
#define COB_LOCK_AUTOMATIC   (1U << 2)
 
#define COB_LOCK_MULTIPLE   (1U << 3)
 
#define COB_LOCK_OPEN_EXCLUSIVE   (1U << 4)
 
#define COB_FILE_EXCLUSIVE   (COB_LOCK_EXCLUSIVE | COB_LOCK_OPEN_EXCLUSIVE)
 
#define COB_OPEN_CLOSED   0
 
#define COB_OPEN_INPUT   1
 
#define COB_OPEN_OUTPUT   2
 
#define COB_OPEN_I_O   3
 
#define COB_OPEN_EXTEND   4
 
#define COB_OPEN_LOCKED   5
 
#define COB_CLOSE_NORMAL   0
 
#define COB_CLOSE_LOCK   1
 
#define COB_CLOSE_NO_REWIND   2
 
#define COB_CLOSE_UNIT   3
 
#define COB_CLOSE_UNIT_REMOVAL   4
 
#define COB_WRITE_MASK   0x0000FFFF
 
#define COB_WRITE_LINES   0x00010000
 
#define COB_WRITE_PAGE   0x00020000
 
#define COB_WRITE_CHANNEL   0x00040000
 
#define COB_WRITE_AFTER   0x00100000
 
#define COB_WRITE_BEFORE   0x00200000
 
#define COB_WRITE_EOP   0x00400000
 
#define COB_WRITE_LOCK   0x00800000
 
#define COB_WRITE_NO_LOCK   0x01000000
 
#define COB_READ_NEXT   (1 << 0)
 
#define COB_READ_PREVIOUS   (1 << 1)
 
#define COB_READ_FIRST   (1 << 2)
 
#define COB_READ_LAST   (1 << 3)
 
#define COB_READ_LOCK   (1 << 4)
 
#define COB_READ_NO_LOCK   (1 << 5)
 
#define COB_READ_KEPT_LOCK   (1 << 6)
 
#define COB_READ_WAIT_LOCK   (1 << 7)
 
#define COB_READ_IGNORE_LOCK   (1 << 8)
 
#define COB_READ_MASK   (COB_READ_NEXT | COB_READ_PREVIOUS | COB_READ_FIRST | COB_READ_LAST)
 
#define COB_STATUS_00_SUCCESS   00
 
#define COB_STATUS_02_SUCCESS_DUPLICATE   02
 
#define COB_STATUS_04_SUCCESS_INCOMPLETE   04
 
#define COB_STATUS_05_SUCCESS_OPTIONAL   05
 
#define COB_STATUS_07_SUCCESS_NO_UNIT   07
 
#define COB_STATUS_10_END_OF_FILE   10
 
#define COB_STATUS_14_OUT_OF_KEY_RANGE   14
 
#define COB_STATUS_21_KEY_INVALID   21
 
#define COB_STATUS_22_KEY_EXISTS   22
 
#define COB_STATUS_23_KEY_NOT_EXISTS   23
 
#define COB_STATUS_24_KEY_BOUNDARY   24
 
#define COB_STATUS_30_PERMANENT_ERROR   30
 
#define COB_STATUS_31_INCONSISTENT_FILENAME   31
 
#define COB_STATUS_34_BOUNDARY_VIOLATION   34
 
#define COB_STATUS_35_NOT_EXISTS   35
 
#define COB_STATUS_37_PERMISSION_DENIED   37
 
#define COB_STATUS_38_CLOSED_WITH_LOCK   38
 
#define COB_STATUS_39_CONFLICT_ATTRIBUTE   39
 
#define COB_STATUS_41_ALREADY_OPEN   41
 
#define COB_STATUS_42_NOT_OPEN   42
 
#define COB_STATUS_43_READ_NOT_DONE   43
 
#define COB_STATUS_44_RECORD_OVERFLOW   44
 
#define COB_STATUS_46_READ_ERROR   46
 
#define COB_STATUS_47_INPUT_DENIED   47
 
#define COB_STATUS_48_OUTPUT_DENIED   48
 
#define COB_STATUS_49_I_O_DENIED   49
 
#define COB_STATUS_51_RECORD_LOCKED   51
 
#define COB_STATUS_57_I_O_LINAGE   57
 
#define COB_STATUS_61_FILE_SHARING   61
 
#define COB_STATUS_91_NOT_AVAILABLE   91
 
#define COB_NOT_CONFIGURED   32768
 
#define COB_STORE_ROUND   (1 << 0)
 
#define COB_STORE_KEEP_ON_OVERFLOW   (1 << 1)
 
#define COB_STORE_TRUNC_ON_OVERFLOW   (1 << 2)
 
#define COB_STORE_AWAY_FROM_ZERO   (1 << 4)
 
#define COB_STORE_NEAR_AWAY_FROM_ZERO   (1 << 5)
 
#define COB_STORE_NEAR_EVEN   (1 << 6)
 
#define COB_STORE_NEAR_TOWARD_ZERO   (1 << 7)
 
#define COB_STORE_PROHIBITED   (1 << 8)
 
#define COB_STORE_TOWARD_GREATER   (1 << 9)
 
#define COB_STORE_TOWARD_LESSER   (1 << 10)
 
#define COB_STORE_TRUNCATION   (1 << 11)
 
#define COB_STORE_MASK
 
#define COB_SCREEN_BLACK   0
 
#define COB_SCREEN_BLUE   1
 
#define COB_SCREEN_GREEN   2
 
#define COB_SCREEN_CYAN   3
 
#define COB_SCREEN_RED   4
 
#define COB_SCREEN_MAGENTA   5
 
#define COB_SCREEN_YELLOW   6
 
#define COB_SCREEN_WHITE   7
 
#define COB_SCREEN_LINE_PLUS   (1 << 0)
 
#define COB_SCREEN_LINE_MINUS   (1 << 1)
 
#define COB_SCREEN_COLUMN_PLUS   (1 << 2)
 
#define COB_SCREEN_COLUMN_MINUS   (1 << 3)
 
#define COB_SCREEN_AUTO   (1 << 4)
 
#define COB_SCREEN_BELL   (1 << 5)
 
#define COB_SCREEN_BLANK_LINE   (1 << 6)
 
#define COB_SCREEN_BLANK_SCREEN   (1 << 7)
 
#define COB_SCREEN_BLINK   (1 << 8)
 
#define COB_SCREEN_ERASE_EOL   (1 << 9)
 
#define COB_SCREEN_ERASE_EOS   (1 << 10)
 
#define COB_SCREEN_FULL   (1 << 11)
 
#define COB_SCREEN_HIGHLIGHT   (1 << 12)
 
#define COB_SCREEN_LOWLIGHT   (1 << 13)
 
#define COB_SCREEN_REQUIRED   (1 << 14)
 
#define COB_SCREEN_REVERSE   (1 << 15)
 
#define COB_SCREEN_SECURE   (1 << 16)
 
#define COB_SCREEN_UNDERLINE   (1 << 17)
 
#define COB_SCREEN_OVERLINE   (1 << 18)
 
#define COB_SCREEN_PROMPT   (1 << 19)
 
#define COB_SCREEN_UPDATE   (1 << 20)
 
#define COB_SCREEN_INPUT   (1 << 21)
 
#define COB_SCREEN_SCROLL_DOWN   (1 << 22)
 
#define COB_SCREEN_INITIAL   (1 << 23)
 
#define COB_SCREEN_NO_ECHO   (1 << 24)
 
#define COB_SCREEN_LEFTLINE   (1 << 25)
 
#define COB_SCREEN_NO_DISP   (1 << 26)
 
#define COB_SCREEN_EMULATE_NL   (1 << 27)
 
#define COB_SCREEN_UPPER   (1 << 28)
 
#define COB_SCREEN_LOWER   (1 << 29)
 
#define COB_SCREEN_GRID   (1 << 30)
 
#define COB_SCREEN_TYPE_GROUP   0
 
#define COB_SCREEN_TYPE_FIELD   1
 
#define COB_SCREEN_TYPE_VALUE   2
 
#define COB_SCREEN_TYPE_ATTRIBUTE   3
 
#define cobgetenv(x)   cob_getenv (x)
 
#define cobputenv(x)   cob_putenv (x)
 
#define cobtidy()   cob_tidy ()
 
#define cobinit()   cob_extern_init ()
 
#define cobexit(x)   cob_stop_run (x)
 
#define cobcommandline(v, w, x, y, z)   cob_command_line (v,w,x,y,z)
 
#define cobsetjmp(x)   setjmp (cob_savenv (x))
 
#define coblongjmp(x)   cob_longjmp (x)
 
#define cobsavenv(x)   cob_savenv (x)
 
#define cobsavenv2(x, z)   cob_savenv2 (x, z)
 
#define cobfunc(x, y, z)   cob_func (x, y, z)
 
#define cobcall(x, y, z)   cob_call (x, y, z)
 
#define cobcancel(x)   cob_cancel (x)
 

Typedefs

typedef struct __cob_screen cob_screen
 
typedef struct __cob_module cob_module
 
typedef struct __cob_global cob_global
 
typedef struct longoption_def longoption_def
 

Enumerations

enum  cob_exception_id {
  COB_EC_ZERO = 0, COB_EC_ARGUMENT, COB_EC_ARGUMENT_FUNCTION, COB_EC_ARGUMENT_IMP,
  COB_EC_BOUND, COB_EC_BOUND_IMP, COB_EC_BOUND_ODO, COB_EC_BOUND_OVERFLOW,
  COB_EC_BOUND_PTR, COB_EC_BOUND_REF_MOD, COB_EC_BOUND_SET, COB_EC_BOUND_SUBSCRIPT,
  COB_EC_BOUND_TABLE_LIMIT, COB_EC_DATA, COB_EC_DATA_CONVERSION, COB_EC_DATA_IMP,
  COB_EC_DATA_INCOMPATIBLE, COB_EC_DATA_INTEGRITY, COB_EC_DATA_PTR_NULL, COB_EC_DATA_NOT_DECIMAL_ENCODING,
  COB_EC_DATA_NOT_FINITE, COB_EC_FLOW, COB_EC_FLOW_GLOBAL_EXIT, COB_EC_FLOW_GLOBAL_GOBACK,
  COB_EC_FLOW_IMP, COB_EC_FLOW_RELEASE, COB_EC_FLOW_REPORT, COB_EC_FLOW_RETURN,
  COB_EC_FLOW_SEARCH, COB_EC_FLOW_USE, COB_EC_I_O, COB_EC_I_O_AT_END,
  COB_EC_I_O_EOP, COB_EC_I_O_EOP_OVERFLOW, COB_EC_I_O_FILE_SHARING, COB_EC_I_O_IMP,
  COB_EC_I_O_INVALID_KEY, COB_EC_I_O_LINAGE, COB_EC_I_O_LOGIC_ERROR, COB_EC_I_O_PERMANENT_ERROR,
  COB_EC_I_O_RECORD_OPERATION, COB_EC_IMP, COB_EC_IMP_ACCEPT, COB_EC_IMP_DISPLAY,
  COB_EC_IMP_UTC_UNKNOWN, COB_EC_LOCALE, COB_EC_LOCALE_IMP, COB_EC_LOCALE_INCOMPATIBLE,
  COB_EC_LOCALE_INVALID, COB_EC_LOCALE_INVALID_PTR, COB_EC_LOCALE_MISSING, COB_EC_LOCALE_SIZE,
  COB_EC_OO, COB_EC_OO_CONFORMANCE, COB_EC_OO_EXCEPTION, COB_EC_OO_IMP,
  COB_EC_OO_METHOD, COB_EC_OO_NULL, COB_EC_OO_RESOURCE, COB_EC_OO_UNIVERSAL,
  COB_EC_OO_ARG_OMITTED, COB_EC_ORDER, COB_EC_ORDER_IMP, COB_EC_ORDER_NOT_SUPPORTED,
  COB_EC_SIZE, COB_EC_SIZE_ADDRESS, COB_EC_SIZE_EXPONENTIATION, COB_EC_SIZE_IMP,
  COB_EC_SIZE_OVERFLOW, COB_EC_SIZE_TRUNCATION, COB_EC_SIZE_UNDERFLOW, COB_EC_SIZE_ZERO_DIVIDE,
  COB_EC_SORT_MERGE, COB_EC_SORT_MERGE_ACTIVE, COB_EC_SORT_MERGE_FILE_OPEN, COB_EC_SORT_MERGE_IMP,
  COB_EC_SORT_MERGE_RELEASE, COB_EC_SORT_MERGE_RETURN, COB_EC_SORT_MERGE_SEQUENCE, COB_EC_STORAGE,
  COB_EC_STORAGE_IMP, COB_EC_STORAGE_NOT_ALLOC, COB_EC_STORAGE_NOT_AVAIL, COB_EC_USER,
  COB_EC_VALIDATE, COB_EC_VALIDATE_CONTENT, COB_EC_VALIDATE_FORMAT, COB_EC_VALIDATE_IMP,
  COB_EC_VALIDATE_RELATION, COB_EC_VALIDATE_VARYING, COB_EC_FUNCTION, COB_EC_FUNCTION_NOT_FOUND,
  COB_EC_FUNCTION_PTR_INVALID, COB_EC_FUNCTION_PTR_NULL, COB_EC_FUNCTION_ARG_OMITTED, COB_EC_XML,
  COB_EC_XML_CODESET, COB_EC_XML_CODESET_CONVERSION, COB_EC_XML_COUNT, COB_EC_XML_DOCUMENT_TYPE,
  COB_EC_XML_IMPLICIT_CLOSE, COB_EC_XML_INVALID, COB_EC_XML_NAMESPACE, COB_EC_XML_STACKED_OPEN,
  COB_EC_XML_RANGE, COB_EC_OVERFLOW, COB_EC_OVERFLOW_IMP, COB_EC_OVERFLOW_STRING,
  COB_EC_OVERFLOW_UNSTRING, COB_EC_PROGRAM, COB_EC_PROGRAM_ARG_MISMATCH, COB_EC_PROGRAM_ARG_OMITTED,
  COB_EC_PROGRAM_CANCEL_ACTIVE, COB_EC_PROGRAM_IMP, COB_EC_PROGRAM_NOT_FOUND, COB_EC_PROGRAM_PTR_NULL,
  COB_EC_PROGRAM_RECURSIVE_CALL, COB_EC_PROGRAM_RESOURCES, COB_EC_RAISING, COB_EC_RAISING_IMP,
  COB_EC_RAISING_NOT_SPECIFIED, COB_EC_RANGE, COB_EC_RANGE_IMP, COB_EC_RANGE_INDEX,
  COB_EC_RANGE_INSPECT_SIZE, COB_EC_RANGE_INVALID, COB_EC_RANGE_PERFORM_VARYING, COB_EC_RANGE_PTR,
  COB_EC_RANGE_SEARCH_INDEX, COB_EC_RANGE_SEARCH_NO_MATCH, COB_EC_REPORT, COB_EC_REPORT_ACTIVE,
  COB_EC_REPORT_COLUMN_OVERLAP, COB_EC_REPORT_FILE_MODE, COB_EC_REPORT_IMP, COB_EC_REPORT_INACTIVE,
  COB_EC_REPORT_LINE_OVERLAP, COB_EC_REPORT_NOT_TERMINATED, COB_EC_REPORT_PAGE_LIMIT, COB_EC_REPORT_PAGE_WIDTH,
  COB_EC_REPORT_SUM_SIZE, COB_EC_REPORT_VARYING, COB_EC_SCREEN, COB_EC_SCREEN_FIELD_OVERLAP,
  COB_EC_SCREEN_IMP, COB_EC_SCREEN_ITEM_TRUNCATED, COB_EC_SCREEN_LINE_NUMBER, COB_EC_SCREEN_STARTING_COLUMN,
  COB_EC_ALL, COB_EC_MAX
}
 

Functions

void print_info (void)
 
void print_version (void)
 
int cob_load_config (void)
 
void print_runtime_env (void)
 
void cob_set_exception (const int)
 
char * cob_int_to_string (int, char *)
 
char * cob_int_to_formatted_bytestring (int, char *)
 
char * cob_strcat (char *, char *)
 
char * cob_strjoin (char **, int, char *)
 
cob_global * cob_get_global_ptr (void)
 
void cob_init (const int, char **)
 
void cob_module_enter (cob_module **, cob_global **, const int)
 
void cob_module_leave (cob_module *)
 
void cob_stop_run (const int)
 
void cob_fatal_error (const int)
 
void * cob_malloc (const size_t)
 
void * cob_realloc (void *, const size_t, const size_t)
 
void cob_free (void *)
 
void * cob_fast_malloc (const size_t)
 
void * cob_cache_malloc (const size_t)
 
void * cob_cache_realloc (void *, const size_t)
 
void cob_cache_free (void *)
 
void cob_set_locale (cob_field *, const int)
 
char * cob_expand_env_string (char *)
 
void cob_check_version (const char *, const char *, const int)
 
void * cob_save_func (cob_field **, const int, const int,...)
 
void cob_restore_func (struct cob_func_loc *)
 
void cob_accept_arg_number (cob_field *)
 
void cob_accept_arg_value (cob_field *)
 
void cob_accept_command_line (cob_field *)
 
void cob_accept_date (cob_field *)
 
void cob_accept_date_yyyymmdd (cob_field *)
 
void cob_accept_day (cob_field *)
 
void cob_accept_day_yyyyddd (cob_field *)
 
void cob_accept_day_of_week (cob_field *)
 
void cob_accept_environment (cob_field *)
 
void cob_accept_exception_status (cob_field *)
 
void cob_accept_time (cob_field *)
 
void cob_accept_user_name (cob_field *)
 
void cob_display_command_line (cob_field *)
 
void cob_display_environment (const cob_field *)
 
void cob_display_env_value (const cob_field *)
 
void cob_display_arg_number (cob_field *)
 
void cob_get_environment (const cob_field *, cob_field *)
 
void cob_set_environment (const cob_field *, const cob_field *)
 
void cob_chain_setup (void *, const size_t, const size_t)
 
void cob_allocate (unsigned char **, cob_field *, cob_field *, cob_field *)
 
void cob_free_alloc (unsigned char **, unsigned char *)
 
int cob_extern_init (void)
 
int cob_tidy (void)
 
void * cob_command_line (int, int *, char ***, char ***, char **)
 
char * cob_getenv (const char *)
 
int cob_putenv (char *)
 
void cob_incr_temp_iteration (void)
 
void cob_temp_name (char *, const char *)
 
int cob_sys_exit_proc (const void *, const void *)
 
int cob_sys_error_proc (const void *, const void *)
 
int cob_sys_system (const void *)
 
int cob_sys_hosted (void *, const void *)
 Return some hosted C variables, argc, argv, stdin, stdout, stderr. More...
 
int cob_sys_and (const void *, void *, const int)
 
int cob_sys_or (const void *, void *, const int)
 
int cob_sys_nor (const void *, void *, const int)
 
int cob_sys_xor (const void *, void *, const int)
 
int cob_sys_imp (const void *, void *, const int)
 
int cob_sys_nimp (const void *, void *, const int)
 
int cob_sys_eq (const void *, void *, const int)
 
int cob_sys_not (void *, const int)
 
int cob_sys_xf4 (void *, const void *)
 
int cob_sys_xf5 (const void *, void *)
 
int cob_sys_x91 (void *, const void *, void *)
 
int cob_sys_toupper (void *, const int)
 
int cob_sys_tolower (void *, const int)
 
int cob_sys_oc_nanosleep (const void *)
 
int cob_sys_getpid (void)
 
int cob_sys_return_args (void *)
 
int cob_sys_parameter_size (void *)
 
int cob_sys_getopt_long_long (void *, void *, void *, const int, void *, void *)
 
int cob_sys_sleep (const void *)
 
int cob_sys_calledby (void *)
 
int cob_sys_justify (void *,...)
 
int cob_sys_printable (void *,...)
 
void cob_set_location (const char *, const unsigned int, const char *, const char *, const char *)
 
void cob_trace_section (const char *, const char *, const int)
 
void * cob_external_addr (const char *, const int)
 
unsigned char * cob_get_pointer (const void *)
 
void * cob_get_prog_pointer (const void *)
 
void cob_ready_trace (void)
 
void cob_reset_trace (void)
 
void cob_reg_sighnd (void(*sighnd)(int))
 
int cob_get_switch (const int)
 
void cob_set_switch (const int, const int)
 
int cob_cmp (cob_field *, cob_field *)
 
int cob_is_omitted (const cob_field *)
 
int cob_is_numeric (const cob_field *)
 
int cob_is_alpha (const cob_field *)
 
int cob_is_upper (const cob_field *)
 
int cob_is_lower (const cob_field *)
 
void cob_table_sort_init (const size_t, const unsigned char *)
 
void cob_table_sort_init_key (cob_field *, const int, const unsigned int)
 
void cob_table_sort (cob_field *, const int)
 
void cob_check_numeric (const cob_field *, const char *)
 
void cob_correct_numeric (cob_field *)
 
void cob_check_based (const unsigned char *, const char *)
 
void cob_check_linkage (const unsigned char *, const char *, const int)
 
void cob_check_odo (const int, const int, const int, const char *)
 
void cob_check_subscript (const int, const int, const int, const char *)
 
void cob_check_ref_mod (const int, const int, const int, const char *)
 
int cob_numeric_cmp (cob_field *, cob_field *)
 
void cob_inspect_init (cob_field *, const unsigned int)
 
void cob_inspect_start (void)
 
void cob_inspect_before (const cob_field *)
 
void cob_inspect_after (const cob_field *)
 
void cob_inspect_characters (cob_field *)
 
void cob_inspect_all (cob_field *, cob_field *)
 
void cob_inspect_leading (cob_field *, cob_field *)
 
void cob_inspect_first (cob_field *, cob_field *)
 
void cob_inspect_trailing (cob_field *, cob_field *)
 
void cob_inspect_converting (const cob_field *, const cob_field *)
 
void cob_inspect_finish (void)
 
void cob_string_init (cob_field *, cob_field *)
 
void cob_string_delimited (cob_field *)
 
void cob_string_append (cob_field *)
 
void cob_string_finish (void)
 
void cob_unstring_init (cob_field *, cob_field *, const size_t)
 
void cob_unstring_delimited (cob_field *, const unsigned int)
 
void cob_unstring_into (cob_field *, cob_field *, cob_field *)
 
void cob_unstring_tallying (cob_field *)
 
void cob_unstring_finish (void)
 
void cob_move (cob_field *, cob_field *)
 
void cob_set_int (cob_field *, const int)
 
int cob_get_int (cob_field *)
 
long long cob_get_llint (cob_field *)
 
void cob_decimal_init (cob_decimal *)
 
void cob_decimal_set_llint (cob_decimal *, const long long)
 
void cob_decimal_set_field (cob_decimal *, cob_field *)
 
int cob_decimal_get_field (cob_decimal *, cob_field *, const int)
 
void cob_decimal_add (cob_decimal *, cob_decimal *)
 
void cob_decimal_sub (cob_decimal *, cob_decimal *)
 
void cob_decimal_mul (cob_decimal *, cob_decimal *)
 
void cob_decimal_div (cob_decimal *, cob_decimal *)
 
void cob_decimal_pow (cob_decimal *, cob_decimal *)
 
int cob_decimal_cmp (cob_decimal *, cob_decimal *)
 
void cob_add (cob_field *, cob_field *, const int)
 
void cob_sub (cob_field *, cob_field *, const int)
 
void cob_mul (cob_field *, cob_field *, const int)
 
void cob_div (cob_field *, cob_field *, const int)
 
int cob_add_int (cob_field *, const int, const int)
 
int cob_sub_int (cob_field *, const int, const int)
 
void cob_div_quotient (cob_field *, cob_field *, cob_field *, const int)
 
void cob_div_remainder (cob_field *, const int)
 
int cob_cmp_int (cob_field *, const int)
 
int cob_cmp_uint (cob_field *, const unsigned int)
 
int cob_cmp_llint (cob_field *, const long long)
 
int cob_cmp_packed (cob_field *, const long long)
 
int cob_cmp_numdisp (const unsigned char *, const size_t, const long long, const unsigned int)
 
int cob_cmp_float (cob_field *, cob_field *)
 
void cob_set_packed_zero (cob_field *)
 
void cob_set_packed_int (cob_field *, const int)
 
void cob_decimal_alloc (const unsigned int,...)
 
void cob_decimal_push (const unsigned int,...)
 
void cob_decimal_pop (const unsigned int,...)
 
void cob_gmp_free (void *)
 
void cob_call_error (void)
 
void cob_set_cancel (cob_module *)
 
void * cob_resolve (const char *)
 
void * cob_resolve_cobol (const char *, const int, const int)
 
void * cob_resolve_func (const char *)
 
const char * cob_resolve_error (void)
 
void * cob_call_field (const cob_field *, const struct cob_call_struct *, const unsigned int, const int)
 
void cob_cancel_field (const cob_field *, const struct cob_call_struct *)
 
void cob_cancel (const char *)
 
int cob_call (const char *, const int, void **)
 
int cob_func (const char *, const int, void **)
 
void * cob_savenv (struct cobjmp_buf *)
 
void * cob_savenv2 (struct cobjmp_buf *, const int)
 
void cob_longjmp (struct cobjmp_buf *)
 
void cob_screen_line_col (cob_field *, const int)
 
void cob_screen_display (cob_screen *, cob_field *, cob_field *)
 
void cob_screen_accept (cob_screen *, cob_field *, cob_field *, cob_field *)
 
void cob_field_display (cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, const int)
 
void cob_field_accept (cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, const int)
 
void cob_accept_escape_key (cob_field *)
 
int cob_sys_clear_screen (void)
 
int cob_sys_sound_bell (void)
 
int cob_sys_get_csr_pos (unsigned char *)
 
int cob_sys_get_scr_size (unsigned char *, unsigned char *)
 
void cob_display (const int, const int, const int,...)
 
void cob_accept (cob_field *)
 
void cob_open (cob_file *, const int, const int, cob_field *)
 
void cob_close (cob_file *, cob_field *, const int, const int)
 
void cob_read (cob_file *, cob_field *, cob_field *, const int)
 
void cob_read_next (cob_file *, cob_field *, const int)
 
void cob_rewrite (cob_file *, cob_field *, const int, cob_field *)
 
void cob_delete (cob_file *, cob_field *)
 
void cob_start (cob_file *, const int, cob_field *, cob_field *, cob_field *)
 
void cob_write (cob_file *, cob_field *, const int, cob_field *, const unsigned int)
 
void cob_delete_file (cob_file *, cob_field *)
 
void cob_unlock_file (cob_file *, cob_field *)
 
void cob_commit (void)
 
void cob_rollback (void)
 
int cob_sys_open_file (unsigned char *, unsigned char *, unsigned char *, unsigned char *, unsigned char *)
 
int cob_sys_create_file (unsigned char *, unsigned char *, unsigned char *, unsigned char *, unsigned char *)
 
int cob_sys_read_file (unsigned char *, unsigned char *, unsigned char *, unsigned char *, unsigned char *)
 
int cob_sys_write_file (unsigned char *, unsigned char *, unsigned char *, unsigned char *, unsigned char *)
 
int cob_sys_close_file (unsigned char *)
 
int cob_sys_flush_file (unsigned char *)
 
int cob_sys_delete_file (unsigned char *)
 
int cob_sys_copy_file (unsigned char *, unsigned char *)
 
int cob_sys_check_file_exist (unsigned char *, unsigned char *)
 
int cob_sys_rename_file (unsigned char *, unsigned char *)
 
int cob_sys_get_current_dir (const int, const int, unsigned char *)
 
int cob_sys_change_dir (unsigned char *)
 
int cob_sys_create_dir (unsigned char *)
 
int cob_sys_delete_dir (unsigned char *)
 
int cob_sys_chdir (unsigned char *, unsigned char *)
 
int cob_sys_mkdir (unsigned char *)
 
int cob_sys_copyfile (unsigned char *, unsigned char *, unsigned char *)
 
int cob_sys_file_info (unsigned char *, unsigned char *)
 
int cob_sys_file_delete (unsigned char *, unsigned char *)
 
void cob_file_sort_init (cob_file *, const unsigned int, const unsigned char *, void *, cob_field *)
 
void cob_file_sort_init_key (cob_file *, cob_field *, const int, const unsigned int)
 
void cob_file_sort_close (cob_file *)
 
void cob_file_sort_using (cob_file *, cob_file *)
 
void cob_file_sort_giving (cob_file *, const size_t,...)
 
void cob_file_release (cob_file *)
 
void cob_file_return (cob_file *)
 
void cob_put_indirect_field (cob_field *)
 
void cob_get_indirect_field (cob_field *)
 
cob_field * cob_switch_value (const int)
 
cob_field * cob_intr_binop (cob_field *, const int, cob_field *)
 
int cob_check_numval (const cob_field *, const cob_field *, const int, const int)
 
int cob_valid_date_format (const char *)
 
int cob_valid_datetime_format (const char *, const char)
 
int cob_valid_time_format (const char *, const char)
 
cob_field * cob_intr_current_date (const int, const int)
 
cob_field * cob_intr_when_compiled (const int, const int, cob_field *)
 
cob_field * cob_intr_module_date (void)
 
cob_field * cob_intr_module_time (void)
 
cob_field * cob_intr_module_id (void)
 
cob_field * cob_intr_module_caller_id (void)
 
cob_field * cob_intr_module_source (void)
 
cob_field * cob_intr_module_formatted_date (void)
 
cob_field * cob_intr_module_path (void)
 
cob_field * cob_intr_exception_file (void)
 
cob_field * cob_intr_exception_location (void)
 
cob_field * cob_intr_exception_status (void)
 
cob_field * cob_intr_exception_statement (void)
 
cob_field * cob_intr_mon_decimal_point (void)
 
cob_field * cob_intr_num_decimal_point (void)
 
cob_field * cob_intr_mon_thousands_sep (void)
 
cob_field * cob_intr_num_thousands_sep (void)
 
cob_field * cob_intr_currency_symbol (void)
 
cob_field * cob_intr_char (cob_field *)
 
cob_field * cob_intr_ord (cob_field *)
 
cob_field * cob_intr_stored_char_length (cob_field *)
 
cob_field * cob_intr_combined_datetime (cob_field *, cob_field *)
 
cob_field * cob_intr_date_of_integer (cob_field *)
 
cob_field * cob_intr_day_of_integer (cob_field *)
 
cob_field * cob_intr_integer_of_date (cob_field *)
 
cob_field * cob_intr_integer_of_day (cob_field *)
 
cob_field * cob_intr_test_date_yyyymmdd (cob_field *)
 
cob_field * cob_intr_test_day_yyyyddd (cob_field *)
 
cob_field * cob_intr_test_numval (cob_field *)
 
cob_field * cob_intr_test_numval_c (cob_field *, cob_field *)
 
cob_field * cob_intr_test_numval_f (cob_field *)
 
cob_field * cob_intr_factorial (cob_field *)
 
cob_field * cob_intr_pi (void)
 
cob_field * cob_intr_e (void)
 
cob_field * cob_intr_exp (cob_field *)
 
cob_field * cob_intr_exp10 (cob_field *)
 
cob_field * cob_intr_abs (cob_field *)
 
cob_field * cob_intr_acos (cob_field *)
 
cob_field * cob_intr_asin (cob_field *)
 
cob_field * cob_intr_atan (cob_field *)
 
cob_field * cob_intr_cos (cob_field *)
 
cob_field * cob_intr_log (cob_field *)
 
cob_field * cob_intr_log10 (cob_field *)
 
cob_field * cob_intr_sin (cob_field *)
 
cob_field * cob_intr_sqrt (cob_field *)
 
cob_field * cob_intr_tan (cob_field *)
 
cob_field * cob_intr_upper_case (const int, const int, cob_field *)
 
cob_field * cob_intr_lower_case (const int, const int, cob_field *)
 
cob_field * cob_intr_reverse (const int, const int, cob_field *)
 
cob_field * cob_intr_concatenate (const int, const int, const int,...)
 
cob_field * cob_intr_substitute (const int, const int, const int,...)
 
cob_field * cob_intr_substitute_case (const int, const int, const int,...)
 
cob_field * cob_intr_trim (const int, const int, cob_field *, const int)
 
cob_field * cob_intr_length (cob_field *)
 
cob_field * cob_intr_byte_length (cob_field *)
 
cob_field * cob_intr_integer (cob_field *)
 
cob_field * cob_intr_integer_part (cob_field *)
 
cob_field * cob_intr_fraction_part (cob_field *)
 
cob_field * cob_intr_sign (cob_field *)
 
cob_field * cob_intr_lowest_algebraic (cob_field *)
 
cob_field * cob_intr_highest_algebraic (cob_field *)
 
cob_field * cob_intr_numval (cob_field *)
 
cob_field * cob_intr_numval_c (cob_field *, cob_field *)
 
cob_field * cob_intr_numval_f (cob_field *)
 
cob_field * cob_intr_annuity (cob_field *, cob_field *)
 
cob_field * cob_intr_mod (cob_field *, cob_field *)
 
cob_field * cob_intr_rem (cob_field *, cob_field *)
 
cob_field * cob_intr_sum (const int,...)
 
cob_field * cob_intr_ord_min (const int,...)
 
cob_field * cob_intr_ord_max (const int,...)
 
cob_field * cob_intr_min (const int,...)
 
cob_field * cob_intr_max (const int,...)
 
cob_field * cob_intr_midrange (const int,...)
 
cob_field * cob_intr_median (const int,...)
 
cob_field * cob_intr_mean (const int,...)
 
cob_field * cob_intr_range (const int,...)
 
cob_field * cob_intr_random (const int,...)
 
cob_field * cob_intr_variance (const int,...)
 
cob_field * cob_intr_standard_deviation (const int,...)
 
cob_field * cob_intr_present_value (const int,...)
 
cob_field * cob_intr_year_to_yyyy (const int,...)
 
cob_field * cob_intr_date_to_yyyymmdd (const int,...)
 
cob_field * cob_intr_day_to_yyyyddd (const int,...)
 
cob_field * cob_intr_locale_compare (const int,...)
 
cob_field * cob_intr_locale_date (const int, const int, cob_field *, cob_field *)
 
cob_field * cob_intr_locale_time (const int, const int, cob_field *, cob_field *)
 
cob_field * cob_intr_seconds_past_midnight (void)
 
cob_field * cob_intr_lcl_time_from_secs (const int, const int, cob_field *, cob_field *)
 
cob_field * cob_intr_seconds_from_formatted_time (cob_field *, cob_field *)
 
cob_field * cob_intr_boolean_of_integer (cob_field *, cob_field *)
 
cob_field * cob_intr_char_national (cob_field *)
 
cob_field * cob_intr_display_of (const int, const int, const int,...)
 
cob_field * cob_intr_exception_file_n (void)
 
cob_field * cob_intr_exception_location_n (void)
 
cob_field * cob_intr_formatted_current_date (const int, const int, cob_field *)
 
cob_field * cob_intr_formatted_date (const int, const int, cob_field *, cob_field *)
 
cob_field * cob_intr_formatted_datetime (const int, const int, const int,...)
 
cob_field * cob_intr_formatted_time (const int, const int, const int,...)
 
cob_field * cob_intr_integer_of_boolean (cob_field *)
 
cob_field * cob_intr_national_of (const int, const int, const int,...)
 
cob_field * cob_intr_standard_compare (const int,...)
 
cob_field * cob_intr_test_formatted_datetime (cob_field *, cob_field *)
 
cob_field * cob_intr_integer_of_formatted_date (cob_field *, cob_field *)
 

Macro Definition Documentation

#define __unaligned

Definition at line 487 of file common.h.

Referenced by cob_cmp_s32(), cob_cmpswp_s32(), and cob_setswp_s32().

#define CB_FMT_LLD   "%lld"

Definition at line 56 of file common.h.

#define CB_FMT_LLD_F   "%lldLL"

Definition at line 60 of file common.h.

Referenced by output_call(), output_call_by_value_args(), and output_long_integer().

#define CB_FMT_LLU   "%llu"

Definition at line 57 of file common.h.

Referenced by scan_b(), scan_h(), and scan_o().

#define CB_FMT_LLU_F   "%lluULL"

Definition at line 61 of file common.h.

Referenced by output_call(), and output_call_by_value_args().

#define CB_FMT_PLLD   "%+*.*lld"

Definition at line 58 of file common.h.

Referenced by cob_print_realbin().

#define CB_FMT_PLLU   "%*.*llu"

Definition at line 59 of file common.h.

Referenced by cob_print_realbin().

#define COB_A_COLD

Definition at line 441 of file common.h.

#define COB_A_FORMAT12

Definition at line 367 of file common.h.

#define COB_A_FORMAT23

Definition at line 368 of file common.h.

#define COB_A_FORMAT34

Definition at line 369 of file common.h.

#define COB_A_FORMAT45

Definition at line 370 of file common.h.

#define COB_A_INLINE

Definition at line 440 of file common.h.

#define COB_A_MALLOC

Definition at line 438 of file common.h.

#define COB_A_NORETURN

Definition at line 366 of file common.h.

#define COB_ACCESS_DYNAMIC   2

Definition at line 752 of file common.h.

Referenced by cb_emit_read(), validate_file(), and yyparse().

#define COB_ACCESS_RANDOM   3

Definition at line 753 of file common.h.

Referenced by cb_emit_start(), cob_start(), validate_file(), and yyparse().

#define COB_ACCESS_SEQUENTIAL   1

Definition at line 751 of file common.h.

Referenced by build_file(), build_report(), cb_emit_read(), cob_delete(), cob_rewrite(), cob_write(), indexed_rewrite(), indexed_write(), relative_rewrite(), relative_write(), validate_file(), and yyparse().

#define COB_ASCENDING   0

Definition at line 735 of file common.h.

Referenced by cb_build_search_all(), cob_file_sort_compare(), sort_compare(), and yyparse().

#define COB_BSWAP_16 (   val)    (COB_BSWAP_16_CONSTANT (val))

Definition at line 256 of file common.h.

Referenced by cob_sys_check_file_exist().

#define COB_BSWAP_16_CONSTANT (   val)
Value:
((cob_u16_t) ( \
(((cob_u16_t)(val) & (cob_u16_t) 0x00FFU) << 8) | \
(((cob_u16_t)(val) & (cob_u16_t) 0xFF00U) >> 8)))
cob_u16_t
#define cob_u16_t
Definition: common.h:29

Definition at line 121 of file common.h.

#define COB_BSWAP_32 (   val)    (COB_BSWAP_32_CONSTANT (val))

Definition at line 257 of file common.h.

Referenced by cob_cmpswp_s32(), cob_setswp_s32(), cob_sys_file_info(), cob_sys_read_file(), cob_sys_write_file(), cobxref_(), and get__reserved__lists_().

#define COB_BSWAP_32_CONSTANT (   val)
Value:
((cob_u32_t) ( \
(((cob_u32_t) (val) & (cob_u32_t) 0x000000FFU) << 24) | \
(((cob_u32_t) (val) & (cob_u32_t) 0x0000FF00U) << 8) | \
(((cob_u32_t) (val) & (cob_u32_t) 0x00FF0000U) >> 8) | \
(((cob_u32_t) (val) & (cob_u32_t) 0xFF000000U) >> 24)))
cob_u32_t
#define cob_u32_t
Definition: common.h:31

Definition at line 125 of file common.h.

#define COB_BSWAP_64 (   val)    (COB_BSWAP_64_CONSTANT (val))

Definition at line 258 of file common.h.

Referenced by cob_binary_get_sint64(), cob_binary_get_uint64(), cob_binary_mget_sint64(), cob_binary_mget_uint64(), cob_binary_mset_sint64(), cob_binary_mset_uint64(), cob_binary_set_int64(), cob_binary_set_uint64(), cob_sys_check_file_exist(), cob_sys_file_info(), cob_sys_read_file(), and cob_sys_write_file().

#define COB_BSWAP_64_CONSTANT (   val)
Value:
((cob_u64_t) ( \
(((cob_u64_t) (val) & \
(cob_u64_t) COB_U64_C(0x00000000000000FF)) << 56) | \
(((cob_u64_t) (val) & \
(cob_u64_t) COB_U64_C(0x000000000000FF00)) << 40) | \
(((cob_u64_t) (val) & \
(cob_u64_t) COB_U64_C(0x0000000000FF0000)) << 24) | \
(((cob_u64_t) (val) & \
(cob_u64_t) COB_U64_C(0x00000000FF000000)) << 8) | \
(((cob_u64_t) (val) & \
(cob_u64_t) COB_U64_C(0x000000FF00000000)) >> 8) | \
(((cob_u64_t) (val) & \
(cob_u64_t) COB_U64_C(0x0000FF0000000000)) >> 24) | \
(((cob_u64_t) (val) & \
(cob_u64_t) COB_U64_C(0x00FF000000000000)) >> 40) | \
(((cob_u64_t) (val) & \
(cob_u64_t) COB_U64_C(0xFF00000000000000)) >> 56)))
COB_U64_C
#define COB_U64_C(x)
Definition: common.h:55
cob_u64_t
#define cob_u64_t
Definition: common.h:52

Definition at line 131 of file common.h.

#define cob_c8_ptr   cob_c8_t *

Definition at line 65 of file common.h.

#define cob_c8_t   char

Definition at line 25 of file common.h.

#define COB_CLOSE_LOCK   1

Definition at line 793 of file common.h.

Referenced by cob_close(), cob_file_close(), and yyparse().

#define COB_CLOSE_NO_REWIND   2

Definition at line 794 of file common.h.

Referenced by cob_file_close(), and yyparse().

#define COB_CLOSE_NORMAL   0

Definition at line 792 of file common.h.

Referenced by cob_exit_fileio(), cob_file_close(), cob_file_sort_giving(), cob_file_sort_using(), get__reserved__lists_(), LISTING_(), and yyparse().

#define COB_CLOSE_UNIT   3

Definition at line 795 of file common.h.

Referenced by yyparse().

#define COB_CLOSE_UNIT_REMOVAL   4

Definition at line 796 of file common.h.

Referenced by yyparse().

#define COB_DESCENDING   1

Definition at line 736 of file common.h.

Referenced by yyparse().

#define COB_DISPLAY_SIGN_ASCII   0

Definition at line 680 of file common.h.

#define COB_DISPLAY_SIGN_EBCDIC   1

Definition at line 681 of file common.h.

#define COB_EQ   1 /* x == y */

Definition at line 726 of file common.h.

Referenced by indexed_read(), indexed_start(), relative_start(), and yyparse().

#define COB_EXCEPTION (   code,
  tag,
  name,
  critical 
)    tag,

Definition at line 708 of file common.h.

#define COB_EXPIMP   extern

Definition at line 336 of file common.h.

#define COB_FERROR_CANCEL   1

Definition at line 691 of file common.h.

Referenced by CHECKSRC_(), cob_fatal_error(), cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

#define COB_FERROR_CHAINING   4

Definition at line 694 of file common.h.

Referenced by cob_fatal_error().

#define COB_FERROR_CODEGEN   3

Definition at line 693 of file common.h.

Referenced by cob_fatal_error(), cob_file_open(), cobxref_(), field_display(), GCic_(), get__reserved__lists_(), integer_of_ddd(), integer_of_formatted_date(), integer_of_mmdd(), integer_of_wwwd(), LISTING_(), and seconds_from_formatted_time().

#define COB_FERROR_FILE   11

Definition at line 701 of file common.h.

Referenced by cob_fatal_error(), cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

#define COB_FERROR_FREE   13

Definition at line 703 of file common.h.

Referenced by cob_fatal_error(), cob_free(), and cob_realloc().

#define COB_FERROR_FUNCTION   12

Definition at line 702 of file common.h.

Referenced by cob_fatal_error(), cob_intr_boolean_of_integer(), cob_intr_char_national(), cob_intr_display_of(), cob_intr_exception_file_n(), cob_intr_exception_location_n(), cob_intr_integer_of_boolean(), cob_intr_national_of(), and cob_intr_standard_compare().

#define COB_FERROR_GLOBAL   6

Definition at line 696 of file common.h.

Referenced by cob_fatal_error(), and GCic_().

#define COB_FERROR_INITIALIZED   2

Definition at line 692 of file common.h.

Referenced by cob_call(), cob_call_field(), cob_cancel(), cob_cancel_field(), cob_fatal_error(), cob_get_global_ptr(), cob_longjmp(), cob_module_enter(), cob_resolve_internal(), and cob_savenv().

#define COB_FERROR_MEMORY   7

Definition at line 697 of file common.h.

Referenced by cob_fast_malloc(), cob_fatal_error(), cob_malloc(), and cob_realloc().

#define COB_FERROR_MODULE   8

Definition at line 698 of file common.h.

Referenced by cob_fatal_error().

#define COB_FERROR_NONE   0

Definition at line 690 of file common.h.

Referenced by cob_fatal_error().

#define COB_FERROR_RECURSIVE   9

Definition at line 699 of file common.h.

Referenced by cob_fatal_error().

#define COB_FERROR_SCR_INP   10

Definition at line 700 of file common.h.

#define COB_FERROR_STACK   5

Definition at line 695 of file common.h.

Referenced by cob_fatal_error(), cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

#define COB_FI   7 /* First */

Definition at line 732 of file common.h.

Referenced by indexed_read_next(), indexed_start(), relative_start(), and yyparse().

#define COB_FIELD_BINARY_SWAP (   f)    ((f)->attr->flags & COB_FLAG_BINARY_SWAP)

Definition at line 648 of file common.h.

Referenced by cob_binary_get_sint64(), cob_binary_get_uint64(), cob_binary_mget_sint64(), cob_binary_mget_uint64(), cob_binary_mset_sint64(), cob_binary_mset_uint64(), cob_binary_set_int64(), cob_binary_set_uint64(), and cob_decimal_set_binary().

#define COB_FIELD_BINARY_TRUNC (   f)    ((f)->attr->flags & COB_FLAG_BINARY_TRUNC)

Definition at line 654 of file common.h.

Referenced by cob_decimal_get_binary(), cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), cob_move(), and cob_move_display_to_binary().

#define COB_FIELD_BLANK_ZERO (   f)    ((f)->attr->flags & COB_FLAG_BLANK_ZERO)

Definition at line 646 of file common.h.

Referenced by cob_move_display_to_edited().

#define COB_FIELD_DATA (   f)    ((f)->data + (COB_FIELD_SIGN_LEADSEP (f) ? 1 : 0))

Definition at line 668 of file common.h.

Referenced by cob_decimal_get_display(), cob_decimal_set_display(), cob_display_get_int(), cob_display_get_long_long(), cob_inspect_init(), cob_move_alphanum_to_display(), cob_move_alphanum_to_edited(), cob_move_display_to_alphanum(), cob_move_display_to_binary(), cob_move_display_to_display(), cob_move_display_to_edited(), cob_move_display_to_packed(), field_is_zero_or_no_zero_suppression(), and store_common_region().

#define COB_FIELD_DIGITS (   f)    ((f)->attr->digits)

Definition at line 663 of file common.h.

Referenced by cob_cmp(), cob_cmp_packed(), cob_decimal_get_binary(), cob_decimal_get_field(), cob_decimal_get_packed(), cob_decimal_set_packed(), cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), cob_move(), cob_move_display_to_binary(), cob_move_display_to_packed(), cob_move_packed_to_display(), cob_packed_get_int(), cob_packed_get_long_long(), cob_set_packed_int(), display_numeric(), and pretty_display_numeric().

#define COB_FIELD_FLAGS (   f)    ((f)->attr->flags)

Definition at line 665 of file common.h.

#define COB_FIELD_HAVE_SIGN (   f)    ((f)->attr->flags & COB_FLAG_HAVE_SIGN)

Definition at line 643 of file common.h.

Referenced by cob_binary_mget_sint64(), cob_check_numdisp(), cob_cmp_llint(), cob_correct_numeric(), cob_decimal_get_binary(), cob_decimal_get_packed(), cob_decimal_set_binary(), cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), cob_is_numeric(), cob_move_binary_to_binary(), cob_move_binary_to_display(), cob_move_display_to_binary(), cob_move_display_to_packed(), cob_packed_get_sign(), cob_print_realbin(), cob_set_packed_int(), cob_set_packed_zero(), display_numeric(), and pretty_display_numeric().

#define COB_FIELD_IS_ALNUM (   f)    (COB_FIELD_TYPE (f) == COB_TYPE_ALPHANUMERIC)

Definition at line 676 of file common.h.

Referenced by cob_move_all().

#define COB_FIELD_IS_FP (   f)    ((f)->attr->flags & COB_FLAG_IS_FP)

Definition at line 652 of file common.h.

Referenced by cob_decimal_get_field().

#define COB_FIELD_IS_NATIONAL (   f)    (COB_FIELD_TYPE (f) & COB_TYPE_NATIONAL)

Definition at line 677 of file common.h.

Referenced by cob_intr_length().

#define COB_FIELD_IS_NUMDISP (   f)    (COB_FIELD_TYPE (f) == COB_TYPE_NUMERIC_DISPLAY)

Definition at line 675 of file common.h.

Referenced by cob_correct_numeric(), and cob_inspect_init().

#define COB_FIELD_IS_NUMERIC (   f)    (COB_FIELD_TYPE (f) & COB_TYPE_NUMERIC)

Definition at line 674 of file common.h.

Referenced by cob_accept(), cob_check_pos_status(), cob_cmp(), cob_field_is_numeric_or_numeric_edited(), cob_file_sort_compare(), cob_intr_lcl_time_from_secs(), cob_intr_locale_date(), cob_intr_locale_time(), cob_move_all(), cob_unstring_into(), display_common(), field_accept(), format_field(), satisfied_full_clause(), sort_compare(), and valid_field_data().

#define COB_FIELD_IS_POINTER (   f)    ((f)->attr->flags & COB_FLAG_IS_POINTER)

Definition at line 650 of file common.h.

Referenced by display_common().

#define COB_FIELD_JUSTIFIED (   f)    ((f)->attr->flags & COB_FLAG_JUSTIFIED)

Definition at line 647 of file common.h.

Referenced by cob_move_alphanum_to_alphanum(), and cob_move_display_to_alphanum().

#define COB_FIELD_NO_SIGN_NIBBLE (   f)    ((f)->attr->flags & COB_FLAG_NO_SIGN_NIBBLE)

Definition at line 651 of file common.h.

Referenced by cob_cmp_packed(), cob_decimal_get_packed(), cob_decimal_set_packed(), cob_is_numeric(), cob_move_display_to_packed(), cob_move_packed_to_display(), cob_packed_get_int(), cob_packed_get_long_long(), cob_packed_get_sign(), cob_real_get_sign(), cob_real_put_sign(), cob_set_packed_int(), and cob_set_packed_zero().

#define COB_FIELD_PIC (   f)    ((f)->attr->pic)

Definition at line 666 of file common.h.

Referenced by cob_move_alphanum_to_edited(), cob_move_display_to_edited(), cob_move_edited_to_display(), and field_is_zero_or_no_zero_suppression().

#define cob_field_ptr   cob_field *

Definition at line 76 of file common.h.

#define COB_FIELD_REAL_BINARY (   f)    ((f)->attr->flags & COB_FLAG_REAL_BINARY)

Definition at line 649 of file common.h.

Referenced by cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), cob_move(), cob_move_display_to_binary(), and display_common().

#define COB_FIELD_REAL_SIGN (   f)    ((f)->attr->flags & COB_FLAG_REAL_SIGN)

Definition at line 653 of file common.h.

#define COB_FIELD_SCALE (   f)    ((f)->attr->scale)

Definition at line 664 of file common.h.

Referenced by cob_add_int(), cob_decimal_do_round(), cob_decimal_get_field(), cob_decimal_set_binary(), cob_decimal_set_display(), cob_decimal_set_packed(), cob_display_get_int(), cob_display_get_long_long(), cob_div_quotient(), cob_get_int(), cob_get_llint(), cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), cob_move(), cob_move_alphanum_to_display(), cob_move_binary_to_display(), cob_move_display_to_alphanum(), cob_move_display_to_binary(), cob_move_display_to_display(), cob_move_display_to_edited(), cob_move_display_to_packed(), cob_move_packed_to_display(), cob_packed_get_int(), cob_packed_get_long_long(), display_numeric(), pretty_display_numeric(), and store_common_region().

#define COB_FIELD_SIGN_LEADING (   f)    ((f)->attr->flags & COB_FLAG_SIGN_LEADING)

Definition at line 645 of file common.h.

Referenced by cob_check_numdisp(), cob_correct_numeric(), cob_real_get_sign(), cob_real_put_sign(), and display_numeric().

#define COB_FIELD_SIGN_LEADSEP (   f)    (((f)->attr->flags & COB_FLAG_LEADSEP) == COB_FLAG_LEADSEP)

Definition at line 659 of file common.h.

#define COB_FIELD_SIGN_SEPARATE (   f)    ((f)->attr->flags & COB_FLAG_SIGN_SEPARATE)

Definition at line 644 of file common.h.

Referenced by cob_check_numdisp(), cob_correct_numeric(), cob_real_get_sign(), and cob_real_put_sign().

#define COB_FIELD_SIZE (   f)    (COB_FIELD_SIGN_SEPARATE (f) ? f->size - 1 : f->size)

Definition at line 671 of file common.h.

Referenced by cob_decimal_get_display(), cob_decimal_set_display(), cob_display_get_int(), cob_display_get_long_long(), cob_inspect_init(), cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), cob_move_alphanum_to_display(), cob_move_alphanum_to_edited(), cob_move_display_to_alphanum(), cob_move_display_to_binary(), cob_move_display_to_display(), cob_move_display_to_edited(), cob_unstring_into(), field_is_zero_or_no_zero_suppression(), and store_common_region().

#define COB_FIELD_TYPE (   f)    ((f)->attr->type)

Definition at line 662 of file common.h.

Referenced by cob_accept(), cob_add_int(), cob_check_pos_status(), cob_cmp(), cob_cmp_all(), cob_cmp_alnum(), cob_cmp_float(), cob_decimal_get_field(), cob_decimal_set_field(), cob_field_is_numeric_or_numeric_edited(), cob_get_int(), cob_get_llint(), cob_inspect_converting(), cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), cob_is_numeric(), cob_move(), cob_move_fp_to_fp(), cob_numeric_cmp(), cob_print_ieeedec(), cob_real_get_sign(), cob_real_put_sign(), display_common(), display_numeric(), inspect_common(), and satisfied_full_clause().

#define COB_FILE_BUFF   4096

Definition at line 542 of file common.h.

Referenced by cob_fatal_error(), cob_init_fileio(), cob_load_config_file(), cob_srttmpfile(), and cob_sys_copy_file().

#define COB_FILE_EXCLUSIVE   (COB_LOCK_EXCLUSIVE | COB_LOCK_OPEN_EXCLUSIVE)

Definition at line 779 of file common.h.

Referenced by cob_file_unlock(), indexed_open(), indexed_read(), and indexed_read_next().

#define cob_file_key_ptr   cob_file_key *

Definition at line 80 of file common.h.

#define COB_FILE_MAX   (COB_FILE_BUFF - 1)

Definition at line 548 of file common.h.

Referenced by cob_chk_file_env(), cob_chk_file_mapping(), cob_delete_file(), cob_exit_fileio(), cob_fatal_error(), cob_load_config_file(), cob_open(), cob_temp_name(), indexed_file_delete(), indexed_open(), and process_filename().

#define COB_FILE_MODE   0666

Definition at line 738 of file common.h.

Referenced by cob_fd_file_open(), cob_srttmpfile(), cob_sys_copy_file(), indexed_open(), and open_cbl_file().

#define cob_file_ptr   cob_file *

Definition at line 77 of file common.h.

#define COB_FILE_SPECIAL (   x)    ((x)->flag_select_features & (COB_SELECT_STDIN | COB_SELECT_STDOUT))

Definition at line 765 of file common.h.

Referenced by cob_close(), cob_exit_fileio(), cob_file_sort_giving(), and cob_file_unlock().

#define COB_FILE_STDIN (   x)    ((x)->flag_select_features & COB_SELECT_STDIN)

Definition at line 767 of file common.h.

Referenced by cob_delete_file(), and cob_open().

#define COB_FILE_STDOUT (   x)    ((x)->flag_select_features & COB_SELECT_STDOUT)

Definition at line 768 of file common.h.

Referenced by cob_delete_file(), and cob_open().

#define COB_FILE_TEMPORARY (   x)    ((x)->flag_select_features & COB_SELECT_TEMPORARY)

Definition at line 769 of file common.h.

#define COB_FILE_VERSION   1

Definition at line 722 of file common.h.

Referenced by output_file_initialization().

#define COB_FLAG_BINARY_SWAP   (1U << 5) /* 0x0020 */

Definition at line 635 of file common.h.

Referenced by output_attr().

#define COB_FLAG_BINARY_TRUNC   (1U << 11) /* 0x0800 */

Definition at line 641 of file common.h.

Referenced by output_attr().

#define COB_FLAG_BLANK_ZERO   (1U << 3) /* 0x0008 */

Definition at line 633 of file common.h.

Referenced by output_attr().

#define COB_FLAG_HAVE_SIGN   (1U << 0) /* 0x0001 */

Definition at line 630 of file common.h.

Referenced by cob_alloc_field(), cob_alloc_set_field_int(), cob_cmp(), cob_decimal_get_field(), cob_decimal_move_temp(), cob_get_int(), cob_intr_random(), cob_set_int(), display_numeric(), indirect_move(), output_attr(), and output_bin_field().

#define COB_FLAG_IS_FP   (1U << 9) /* 0x0200 */

Definition at line 639 of file common.h.

Referenced by output_attr().

#define COB_FLAG_IS_POINTER   (1U << 7) /* 0x0080 */

Definition at line 637 of file common.h.

Referenced by output_attr().

#define COB_FLAG_JUSTIFIED   (1U << 4) /* 0x0010 */

Definition at line 634 of file common.h.

Referenced by output_attr().

#define COB_FLAG_LEADSEP   (COB_FLAG_SIGN_SEPARATE | COB_FLAG_SIGN_LEADING)

Definition at line 656 of file common.h.

#define COB_FLAG_NO_SIGN_NIBBLE   (1U << 8) /* 0x0100 */

Definition at line 638 of file common.h.

Referenced by output_attr().

#define COB_FLAG_REAL_BINARY   (1U << 6) /* 0x0040 */

Definition at line 636 of file common.h.

Referenced by cob_set_int(), output_attr(), and output_bin_field().

#define COB_FLAG_REAL_SIGN   (1U << 10) /* 0x0400 */

Definition at line 640 of file common.h.

#define COB_FLAG_SIGN_LEADING   (1U << 2) /* 0x0004 */

Definition at line 632 of file common.h.

Referenced by display_numeric(), and output_attr().

#define COB_FLAG_SIGN_SEPARATE   (1U << 1) /* 0x0002 */

Definition at line 631 of file common.h.

Referenced by display_numeric(), and output_attr().

#define COB_FOLD_LOWER   2

Definition at line 587 of file common.h.

Referenced by cb_encode_program_id(), cob_resolve_internal(), ppparse(), and process_command_line().

#define COB_FOLD_UPPER   1

Definition at line 586 of file common.h.

Referenced by cb_encode_program_id(), cob_resolve_internal(), ppparse(), and process_command_line().

#define COB_GE   5 /* x >= y */

Definition at line 730 of file common.h.

Referenced by indexed_read_next(), indexed_start(), relative_start(), and yyparse().

#define COB_GT   4 /* x > y */

Definition at line 729 of file common.h.

Referenced by indexed_read_next(), indexed_start(), relative_start(), and yyparse().

#define COB_INLINE

Definition at line 354 of file common.h.

#define COB_LA   8 /* Last */

Definition at line 733 of file common.h.

Referenced by indexed_read_next(), indexed_start(), relative_start(), and yyparse().

#define COB_LARGE_BUFF   16384

Definition at line 544 of file common.h.

Referenced by cob_init(), main(), process_assemble(), and process_module_direct().

#define COB_LARGE_MAX   (COB_LARGE_BUFF - 1)

Definition at line 550 of file common.h.

Referenced by cob_init(), and main().

#define COB_LC_ALL   6

Definition at line 596 of file common.h.

Referenced by cob_set_locale().

#define COB_LC_CLASS   8

Definition at line 598 of file common.h.

Referenced by cob_set_locale().

#define COB_LC_COLLATE   0

Definition at line 590 of file common.h.

Referenced by cob_set_locale().

#define COB_LC_CTYPE   1

Definition at line 591 of file common.h.

Referenced by cob_set_locale().

#define COB_LC_MESSAGES   2

Definition at line 592 of file common.h.

Referenced by cob_set_locale().

#define COB_LC_MONETARY   3

Definition at line 593 of file common.h.

Referenced by cob_set_locale().

#define COB_LC_NUMERIC   4

Definition at line 594 of file common.h.

Referenced by cob_set_locale().

#define COB_LC_TIME   5

Definition at line 595 of file common.h.

Referenced by cob_set_locale().

#define COB_LC_USER   7

Definition at line 597 of file common.h.

Referenced by cob_set_locale().

#define COB_LE   3 /* x <= y */

Definition at line 728 of file common.h.

Referenced by indexed_read_next(), indexed_start(), relative_start(), and yyparse().

#define COB_LOCK_AUTOMATIC   (1U << 2)

Definition at line 775 of file common.h.

Referenced by cb_emit_rewrite(), cb_emit_write(), indexed_open(), indexed_read(), indexed_read_next(), indexed_rewrite(), and yyparse().

#define COB_LOCK_EXCLUSIVE   (1U << 0)

Definition at line 773 of file common.h.

Referenced by yyparse().

#define COB_LOCK_MANUAL   (1U << 1)

Definition at line 774 of file common.h.

Referenced by yyparse().

#define COB_LOCK_MULTIPLE   (1U << 3)

Definition at line 776 of file common.h.

Referenced by indexed_read(), indexed_read_next(), indexed_rewrite(), and yyparse().

#define COB_LOCK_OPEN_EXCLUSIVE   (1U << 4)

Definition at line 777 of file common.h.

Referenced by cob_close(), cob_open(), and yyparse().

#define COB_LT   2 /* x < y */

Definition at line 727 of file common.h.

Referenced by indexed_read_next(), indexed_start(), relative_start(), and yyparse().

#define COB_MAX_BINARY   39

Definition at line 565 of file common.h.

Referenced by cob_decimal_set_binary(), cob_exit_numeric(), cob_init_numeric(), and compute_size().

#define COB_MAX_DEC_STRUCT   32

Definition at line 571 of file common.h.

Referenced by cob_exit_numeric(), cob_init_numeric(), and decimal_alloc().

#define COB_MAX_DIGITS   38

Definition at line 562 of file common.h.

Referenced by cb_build_picture(), check_lit_length(), cob_check_numval(), cob_check_numval_f(), cob_decimal_div(), cob_move(), cob_move_all(), numval(), scan_define_options(), and scan_numeric().

#define COB_MAX_FIELD_PARAMS   36 /* ToDo: move to config.h */

Definition at line 559 of file common.h.

Referenced by cob_call(), output_call(), output_entry_function(), and yyparse().

#define COB_MAX_FIELD_SIZE   268435456

Definition at line 568 of file common.h.

Referenced by compute_size().

#define COB_MAX_WORDLEN   61

Definition at line 574 of file common.h.

Referenced by cb_build_identifier(), cb_config_entry(), and yylex().

#define COB_MEDIUM_BUFF   8192

Definition at line 543 of file common.h.

Referenced by cob_init(), cob_init_call(), cob_load_config(), cobc_check_action(), and print_runtime_env().

#define COB_MEDIUM_MAX   (COB_MEDIUM_BUFF - 1)

Definition at line 549 of file common.h.

Referenced by cob_accept(), cob_init_call(), cob_load_config(), cob_sys_system(), cobc_check_action(), display_numeric(), field_accept(), and pretty_display_numeric().

#define COB_MINI_BUFF   256

Definition at line 539 of file common.h.

Referenced by cb_build_class_name(), cb_check_field_debug(), cb_config_entry(), cb_encode_program_id(), cb_validate_program_data(), cobcrun_print_version(), codegen(), emit_entry(), finalize_file(), main(), print_runtime_env(), print_version(), and process_command_line().

#define COB_MINI_MAX   (COB_MINI_BUFF - 1)

Definition at line 545 of file common.h.

Referenced by cb_build_class_name(), cb_validate_program_data(), check_lit_length(), cobcrun_print_version(), codegen(), emit_entry(), finalize_file(), main(), print_version(), process_command_line(), read_literal(), scan_b(), scan_floating_numeric(), scan_h(), scan_numeric(), scan_o(), scan_x(), and scan_z().

#define cob_module_ptr   cob_module *

Definition at line 78 of file common.h.

#define COB_NATIONAL_SIZE   2

Definition at line 683 of file common.h.

Referenced by cb_build_picture(), and cob_intr_length().

#define COB_NE   6 /* x != y */

Definition at line 731 of file common.h.

Referenced by yyparse().

#define COB_NOINLINE

Definition at line 439 of file common.h.

#define COB_NON_ALIGNED

Definition at line 479 of file common.h.

#define COB_NORMAL_BUFF   2048

Definition at line 541 of file common.h.

Referenced by ambiguous_error(), cb_load_conf(), cb_load_conf_file(), cb_name(), cob_init_call(), cob_init_strings(), insert(), and undefined_error().

#define COB_NORMAL_MAX   (COB_NORMAL_BUFF - 1)

Definition at line 547 of file common.h.

Referenced by ambiguous_error(), cb_load_conf(), cb_load_conf_file(), cob_resolve_internal(), process_filename(), and undefined_error().

#define COB_NOT_CONFIGURED   32768

Definition at line 861 of file common.h.

Referenced by cob_file_open(), indexed_open(), lineseq_read(), lineseq_write(), relative_delete(), relative_read(), relative_read_next(), relative_rewrite(), relative_start(), relative_write(), sequential_read(), sequential_rewrite(), and sequential_write().

#define COB_OPEN_CLOSED   0

Definition at line 783 of file common.h.

Referenced by cob_close(), cob_delete_file(), cob_exit_fileio(), cob_file_close(), cob_file_unlock(), and cob_open().

#define COB_OPEN_EXTEND   4

Definition at line 787 of file common.h.

Referenced by cob_fd_file_open(), cob_file_open(), cob_write(), indexed_open(), output_error_handler(), process_translate(), and yyparse().

#define COB_OPEN_I_O   3

Definition at line 786 of file common.h.

Referenced by cb_emit_open(), cob_delete(), cob_fd_file_open(), cob_file_open(), cob_read(), cob_read_next(), cob_rewrite(), cob_start(), cob_write(), indexed_open(), indexed_read(), indexed_read_next(), and yyparse().

#define COB_OPEN_INPUT   1

Definition at line 784 of file common.h.

Referenced by cob_fd_file_open(), cob_file_close(), cob_file_open(), cob_file_sort_using(), cob_open(), cob_read(), cob_read_next(), cob_start(), indexed_open(), indexed_read(), indexed_read_next(), output_error_handler(), process_translate(), and yyparse().

#define COB_OPEN_LOCKED   5

Definition at line 788 of file common.h.

Referenced by cob_close(), cob_delete_file(), cob_exit_fileio(), cob_file_unlock(), and cob_open().

#define COB_OPEN_OUTPUT   2

Definition at line 785 of file common.h.

Referenced by cob_fd_file_open(), cob_file_open(), cob_file_sort_giving(), cob_open(), cob_write(), indexed_open(), and yyparse().

#define COB_ORG_INDEXED   3

Definition at line 745 of file common.h.

Referenced by cb_emit_read(), cb_emit_rewrite(), cb_emit_start(), cb_emit_write(), check_valid_key(), cob_delete_file(), cob_file_unlock(), cob_sync(), finalize_file(), output_file_allocation(), output_file_initialization(), output_internal_function(), validate_file(), and yyparse().

#define COB_ORG_LINE_SEQUENTIAL   1

Definition at line 743 of file common.h.

Referenced by cb_emit_delete(), cb_emit_open(), cb_emit_rewrite(), cb_emit_write(), cob_file_close(), cob_file_open(), cob_file_sort_giving(), cob_sync(), finalize_file(), and yyparse().

#define COB_ORG_MAX   5

Definition at line 747 of file common.h.

#define COB_ORG_RELATIVE   2

Definition at line 744 of file common.h.

Referenced by cb_emit_read(), cb_emit_rewrite(), cb_emit_start(), cb_emit_write(), cob_fd_file_open(), output_file_allocation(), output_file_initialization(), output_internal_function(), validate_file(), and yyparse().

#define COB_ORG_SEQUENTIAL   0

Definition at line 742 of file common.h.

Referenced by build_file(), build_report(), cob_rewrite(), and yyparse().

#define COB_ORG_SORT   4

Definition at line 746 of file common.h.

Referenced by cb_emit_close(), cb_emit_delete(), cb_emit_delete_file(), cb_emit_open(), cb_emit_read(), cb_emit_release(), cb_emit_rewrite(), cb_emit_sort_giving(), cb_emit_sort_init(), cb_emit_sort_using(), cb_emit_write(), cob_delete_file(), cob_file_unlock(), cob_sync(), output_internal_function(), set_up_use_file(), validate_file(), and yyparse().

#define COB_READ_FIRST   (1 << 2)

Definition at line 815 of file common.h.

Referenced by indexed_read_next(), and relative_read_next().

#define COB_READ_IGNORE_LOCK   (1 << 8)

Definition at line 821 of file common.h.

Referenced by cb_emit_read().

#define COB_READ_KEPT_LOCK   (1 << 6)

Definition at line 819 of file common.h.

#define COB_READ_LAST   (1 << 3)

Definition at line 816 of file common.h.

Referenced by indexed_read_next(), and relative_read_next().

#define COB_READ_LOCK   (1 << 4)

Definition at line 817 of file common.h.

Referenced by cb_emit_read(), indexed_read(), and indexed_read_next().

#define COB_READ_MASK   (COB_READ_NEXT | COB_READ_PREVIOUS | COB_READ_FIRST | COB_READ_LAST)

Definition at line 823 of file common.h.

Referenced by indexed_read_next(), and relative_read_next().

#define COB_READ_NEXT   (1 << 0)

Definition at line 813 of file common.h.

Referenced by cb_emit_read(), cob_file_sort_using(), indexed_read_next(), and relative_read_next().

#define COB_READ_NO_LOCK   (1 << 5)

Definition at line 818 of file common.h.

Referenced by cb_emit_read(), indexed_read(), and indexed_read_next().

#define COB_READ_PREVIOUS   (1 << 1)

Definition at line 814 of file common.h.

Referenced by cb_emit_read(), cob_read(), cob_read_next(), indexed_read_next(), and relative_read_next().

#define COB_READ_WAIT_LOCK   (1 << 7)

Definition at line 820 of file common.h.

Referenced by cb_emit_read(), indexed_read(), and indexed_read_next().

#define COB_RET_TYPE_INT   0

Definition at line 581 of file common.h.

#define COB_RET_TYPE_PTR   1

Definition at line 582 of file common.h.

#define COB_RET_TYPE_VOID   2

Definition at line 583 of file common.h.

#define cob_s16_ptr   cob_s16_t *

Definition at line 69 of file common.h.

#define cob_s16_t   short

Definition at line 28 of file common.h.

#define cob_s32_ptr   cob_s32_t *

Definition at line 71 of file common.h.

#define cob_s32_t   int

Definition at line 30 of file common.h.

#define COB_S64_C (   x)    x ## LL

Definition at line 54 of file common.h.

Referenced by validate_move().

#define cob_s64_ptr   cob_s64_t *

Definition at line 73 of file common.h.

#define cob_s64_t   long long

Definition at line 51 of file common.h.

Referenced by cb_emit_call(), cb_fits_long_long(), cb_get_long_long(), cob_binary_get_sint64(), cob_binary_mget_sint64(), cob_cmp_numdisp(), cob_decimal_get_binary(), cob_decimal_set_binary(), cob_display_get_long_long(), cob_get_int(), cob_get_llint(), cob_move_binary_to_binary(), cob_move_binary_to_display(), cob_move_display_to_binary(), cob_packed_get_long_long(), cob_print_realbin(), cob_sys_check_file_exist(), cob_sys_oc_nanosleep(), cob_sys_read_file(), cob_sys_write_file(), GCic_(), output_call_by_value_args(), relative_read_next(), and validate_move().

#define cob_s8_ptr   cob_s8_t *

Definition at line 67 of file common.h.

Referenced by CHECKSRC_(), cobxref_(), and get__reserved__lists_().

#define cob_s8_t   signed char

Definition at line 26 of file common.h.

#define COB_SCREEN_AUTO   (1 << 4)

Definition at line 899 of file common.h.

Referenced by cob_screen_get_all(), field_accept(), and yyparse().

#define COB_SCREEN_BELL   (1 << 5)

Definition at line 900 of file common.h.

Referenced by cb_emit_display(), cob_screen_attr(), and yyparse().

#define COB_SCREEN_BLACK   0

Definition at line 886 of file common.h.

Referenced by cob_screen_attr().

#define COB_SCREEN_BLANK_LINE   (1 << 6)

Definition at line 901 of file common.h.

Referenced by cob_screen_attr(), yyparse(), and zero_conflicting_flags().

#define COB_SCREEN_BLANK_SCREEN   (1 << 7)

Definition at line 902 of file common.h.

Referenced by cob_screen_attr(), yyparse(), and zero_conflicting_flags().

#define COB_SCREEN_BLINK   (1 << 8)

Definition at line 903 of file common.h.

Referenced by cob_screen_attr(), and yyparse().

#define COB_SCREEN_BLUE   1

Definition at line 887 of file common.h.

Referenced by cob_screen_attr().

#define COB_SCREEN_COLUMN_MINUS   (1 << 3)

Definition at line 898 of file common.h.

Referenced by cob_screen_moveyx(), has_relative_pos(), and yyparse().

#define COB_SCREEN_COLUMN_PLUS   (1 << 2)

Definition at line 897 of file common.h.

Referenced by cob_screen_moveyx(), has_relative_pos(), and yyparse().

#define COB_SCREEN_CYAN   3

Definition at line 889 of file common.h.

Referenced by cob_screen_attr().

#define COB_SCREEN_EMULATE_NL   (1 << 27)

Definition at line 922 of file common.h.

Referenced by cob_display(), and field_display().

#define COB_SCREEN_ERASE_EOL   (1 << 9)

Definition at line 904 of file common.h.

Referenced by cb_emit_display(), cob_screen_attr(), yyparse(), and zero_conflicting_flags().

#define COB_SCREEN_ERASE_EOS   (1 << 10)

Definition at line 905 of file common.h.

Referenced by cb_emit_display(), cob_screen_attr(), yyparse(), and zero_conflicting_flags().

#define COB_SCREEN_FULL   (1 << 11)

Definition at line 906 of file common.h.

Referenced by satisfied_full_clause(), and yyparse().

#define COB_SCREEN_GREEN   2

Definition at line 888 of file common.h.

Referenced by cob_screen_attr().

#define COB_SCREEN_GRID   (1 << 30)

Definition at line 925 of file common.h.

Referenced by yyparse().

#define COB_SCREEN_HIGHLIGHT   (1 << 12)

Definition at line 907 of file common.h.

Referenced by check_not_highlight_and_lowlight(), cob_screen_attr(), output_set_attribute(), yyparse(), and zero_conflicting_flags().

#define COB_SCREEN_INITIAL   (1 << 23)

Definition at line 918 of file common.h.

Referenced by screen_accept(), and yyparse().

#define COB_SCREEN_INPUT   (1 << 21)

Definition at line 916 of file common.h.

Referenced by cob_prep_input(), cob_screen_puts(), and yyparse().

#define COB_SCREEN_LEFTLINE   (1 << 25)

Definition at line 920 of file common.h.

Referenced by yyparse().

#define COB_SCREEN_LINE_MINUS   (1 << 1)

Definition at line 896 of file common.h.

Referenced by cob_screen_moveyx(), has_relative_pos(), and yyparse().

#define COB_SCREEN_LINE_PLUS   (1 << 0)

Definition at line 895 of file common.h.

Referenced by cob_screen_moveyx(), has_relative_pos(), and yyparse().

#define COB_SCREEN_LOWER   (1 << 29)

Definition at line 924 of file common.h.

Referenced by cob_screen_get_all(), field_accept(), and yyparse().

#define COB_SCREEN_LOWLIGHT   (1 << 13)

Definition at line 908 of file common.h.

Referenced by check_not_highlight_and_lowlight(), cob_screen_attr(), output_set_attribute(), yyparse(), and zero_conflicting_flags().

#define COB_SCREEN_MAGENTA   5

Definition at line 891 of file common.h.

Referenced by cob_screen_attr().

#define COB_SCREEN_NO_DISP   (1 << 26)

Definition at line 921 of file common.h.

Referenced by cb_emit_display(), and field_display().

#define COB_SCREEN_NO_ECHO   (1 << 24)

Definition at line 919 of file common.h.

Referenced by cob_screen_get_all(), field_accept(), and yyparse().

#define COB_SCREEN_OVERLINE   (1 << 18)

Definition at line 913 of file common.h.

Referenced by yyparse().

#define COB_SCREEN_PROMPT   (1 << 19)

Definition at line 914 of file common.h.

Referenced by cob_accept(), field_accept(), and yyparse().

#define cob_screen_ptr   cob_screen *

Definition at line 79 of file common.h.

#define COB_SCREEN_RED   4

Definition at line 890 of file common.h.

Referenced by cob_screen_attr().

#define COB_SCREEN_REQUIRED   (1 << 14)

Definition at line 909 of file common.h.

Referenced by satisfied_required_clause(), and yyparse().

#define COB_SCREEN_REVERSE   (1 << 15)

Definition at line 910 of file common.h.

Referenced by cob_screen_attr(), and yyparse().

#define COB_SCREEN_SCROLL_DOWN   (1 << 22)

Definition at line 917 of file common.h.

Referenced by field_accept(), field_display(), and yyparse().

#define COB_SCREEN_SECURE   (1 << 16)

Definition at line 911 of file common.h.

Referenced by cob_screen_get_all(), cob_screen_puts(), field_accept(), and yyparse().

#define COB_SCREEN_TYPE_ATTRIBUTE   3

Definition at line 930 of file common.h.

Referenced by cob_prep_input(), cob_screen_iterate(), output_screen_definition(), output_screen_from(), output_screen_init(), and output_screen_to().

#define COB_SCREEN_TYPE_FIELD   1

Definition at line 928 of file common.h.

Referenced by cob_prep_input(), cob_screen_iterate(), output_screen_definition(), output_screen_from(), output_screen_init(), and output_screen_to().

#define COB_SCREEN_TYPE_GROUP   0

Definition at line 927 of file common.h.

Referenced by cob_prep_input(), cob_screen_iterate(), output_screen_definition(), output_screen_from(), output_screen_init(), and output_screen_to().

#define COB_SCREEN_TYPE_VALUE   2

Definition at line 929 of file common.h.

Referenced by cob_prep_input(), cob_screen_iterate(), output_screen_definition(), output_screen_from(), output_screen_init(), and output_screen_to().

#define COB_SCREEN_UNDERLINE   (1 << 17)

Definition at line 912 of file common.h.

Referenced by cob_screen_attr(), and yyparse().

#define COB_SCREEN_UPDATE   (1 << 20)

Definition at line 915 of file common.h.

Referenced by field_accept(), and yyparse().

#define COB_SCREEN_UPPER   (1 << 28)

Definition at line 923 of file common.h.

Referenced by cob_screen_get_all(), field_accept(), and yyparse().

#define COB_SCREEN_WHITE   7

Definition at line 893 of file common.h.

Referenced by cob_screen_attr().

#define COB_SCREEN_YELLOW   6

Definition at line 892 of file common.h.

Referenced by cob_screen_attr().

#define COB_SELECT_EXTERNAL   (1U << 1)

Definition at line 758 of file common.h.

Referenced by output_file_initialization().

#define COB_SELECT_FILE_STATUS   (1U << 0)

Definition at line 757 of file common.h.

Referenced by cobxref_(), GCic_(), get__reserved__lists_(), LISTING_(), and output_file_initialization().

#define COB_SELECT_LINAGE   (1U << 2)

Definition at line 759 of file common.h.

Referenced by cob_file_close(), cob_file_open(), cob_file_write_opt(), lineseq_write(), and output_file_initialization().

#define COB_SELECT_SPLITKEY   (1U << 3)

Definition at line 760 of file common.h.

#define COB_SELECT_STDIN   (1U << 4)

Definition at line 761 of file common.h.

Referenced by yyparse().

#define COB_SELECT_STDOUT   (1U << 5)

Definition at line 762 of file common.h.

Referenced by yyparse().

#define COB_SELECT_TEMPORARY   (1U << 6)

Definition at line 763 of file common.h.

#define COB_SET_DATA (   x,
  z 
)    (x.data = z, &x)

Definition at line 686 of file common.h.

Referenced by get__reserved__lists_(), and LISTING_().

#define COB_SET_FLD (   v,
  x,
  y,
  z 
)    (v.size = x, v.data = y, v.attr = z, &v)

Definition at line 685 of file common.h.

Referenced by CHECKSRC_(), cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

#define cob_sli_t   long int

Definition at line 32 of file common.h.

Referenced by cob_add_int(), cob_cmp_int(), cob_cmp_llint(), cob_decimal_get_double(), cob_decimal_get_mpf(), cob_decimal_set_binary(), cob_decimal_set_double(), cob_decimal_set_llint(), cob_decimal_set_mpf(), cob_mpf_exp(), and cob_mpf_log().

#define COB_SMALL_BUFF   1024

Definition at line 540 of file common.h.

Referenced by cb_build_picture(), cb_config_entry(), cb_load_conf_file(), cb_validate_program_data(), cob_check_numeric(), cob_init_call(), cob_init_fileio(), cob_intr_exception_location(), cob_intr_locale_date(), cob_load_config_file(), cob_resolve_internal(), and main().

#define COB_SMALL_MAX   (COB_SMALL_BUFF - 1)

Definition at line 546 of file common.h.

Referenced by cob_intr_exception_location(), cob_intr_locale_date(), main(), ppcopy(), and process_command_line().

#define COB_SORT_CHUNK   256 * 1024

Definition at line 578 of file common.h.

#define COB_SORT_MEMORY   128 * 1024 * 1024

Definition at line 577 of file common.h.

#define COB_STACK_SIZE   255

Definition at line 553 of file common.h.

#define COB_STATUS_00_SUCCESS   00

Definition at line 828 of file common.h.

Referenced by cob_close(), cob_delete_file(), cob_file_close(), cob_file_open(), cob_file_release(), cob_file_return(), cob_file_sort_close(), cob_file_sort_init(), cob_open(), cob_read(), cob_read_next(), cob_start(), cob_unlock_file(), indexed_close(), indexed_delete(), indexed_open(), indexed_read(), indexed_read_next(), indexed_rewrite(), indexed_start(), lineseq_read(), lineseq_write(), relative_delete(), relative_read(), relative_read_next(), relative_rewrite(), relative_start(), relative_write(), sequential_read(), sequential_rewrite(), and sequential_write().

#define COB_STATUS_02_SUCCESS_DUPLICATE   02

Definition at line 829 of file common.h.

Referenced by cob_read(), cob_read_next(), indexed_read_next(), indexed_rewrite(), and indexed_write().

#define COB_STATUS_04_SUCCESS_INCOMPLETE   04

Definition at line 830 of file common.h.

Referenced by sequential_read().

#define COB_STATUS_05_SUCCESS_OPTIONAL   05

Definition at line 831 of file common.h.

Referenced by cob_fd_file_open(), cob_file_open(), and indexed_open().

#define COB_STATUS_07_SUCCESS_NO_UNIT   07

Definition at line 832 of file common.h.

Referenced by cob_file_close().

#define COB_STATUS_10_END_OF_FILE   10

Definition at line 833 of file common.h.

Referenced by cob_fatal_error(), cob_file_return(), cob_read(), cob_read_next(), indexed_read_next(), lineseq_read(), relative_read_next(), and sequential_read().

#define COB_STATUS_14_OUT_OF_KEY_RANGE   14

Definition at line 834 of file common.h.

Referenced by cob_fatal_error(), and relative_read_next().

#define COB_STATUS_21_KEY_INVALID   21

Definition at line 835 of file common.h.

Referenced by cob_fatal_error(), indexed_delete(), indexed_read(), indexed_rewrite(), indexed_start(), and indexed_write().

#define COB_STATUS_22_KEY_EXISTS   22

Definition at line 836 of file common.h.

Referenced by cob_fatal_error(), indexed_rewrite(), and relative_write().

#define COB_STATUS_23_KEY_NOT_EXISTS   23

Definition at line 837 of file common.h.

Referenced by cob_fatal_error(), cob_read(), cob_read_next(), cob_start(), indexed_read(), indexed_read_next(), indexed_start(), relative_delete(), relative_read(), relative_rewrite(), and relative_start().

#define COB_STATUS_24_KEY_BOUNDARY   24

Definition at line 838 of file common.h.

Referenced by relative_delete(), relative_rewrite(), and relative_write().

#define COB_STATUS_30_PERMANENT_ERROR   30

Definition at line 839 of file common.h.

Referenced by cob_delete_file(), cob_fatal_error(), cob_fd_file_open(), cob_file_open(), cob_file_release(), cob_file_return(), cob_open(), indexed_open(), lineseq_read(), lineseq_write(), relative_delete(), relative_read(), relative_read_next(), relative_rewrite(), relative_write(), sequential_read(), sequential_rewrite(), and sequential_write().

#define COB_STATUS_31_INCONSISTENT_FILENAME   31

Definition at line 840 of file common.h.

#define COB_STATUS_34_BOUNDARY_VIOLATION   34

Definition at line 841 of file common.h.

#define COB_STATUS_35_NOT_EXISTS   35

Definition at line 842 of file common.h.

Referenced by cob_fatal_error(), cob_fd_file_open(), cob_file_open(), and indexed_open().

#define COB_STATUS_37_PERMISSION_DENIED   37

Definition at line 843 of file common.h.

Referenced by cob_fatal_error(), cob_fd_file_open(), cob_file_open(), and indexed_open().

#define COB_STATUS_38_CLOSED_WITH_LOCK   38

Definition at line 844 of file common.h.

Referenced by cob_delete_file(), and cob_open().

#define COB_STATUS_39_CONFLICT_ATTRIBUTE   39

Definition at line 845 of file common.h.

Referenced by indexed_open().

#define COB_STATUS_41_ALREADY_OPEN   41

Definition at line 846 of file common.h.

Referenced by cob_delete_file(), cob_fatal_error(), and cob_open().

#define COB_STATUS_42_NOT_OPEN   42

Definition at line 847 of file common.h.

Referenced by cob_close(), and cob_fatal_error().

#define COB_STATUS_43_READ_NOT_DONE   43

Definition at line 848 of file common.h.

Referenced by cob_delete(), cob_fatal_error(), and cob_rewrite().

#define COB_STATUS_44_RECORD_OVERFLOW   44

Definition at line 849 of file common.h.

Referenced by cob_fatal_error(), cob_rewrite(), and cob_write().

#define COB_STATUS_46_READ_ERROR   46

Definition at line 850 of file common.h.

Referenced by cob_fatal_error(), cob_read(), and cob_read_next().

#define COB_STATUS_47_INPUT_DENIED   47

Definition at line 851 of file common.h.

Referenced by cob_fatal_error(), cob_read(), cob_read_next(), and cob_start().

#define COB_STATUS_48_OUTPUT_DENIED   48

Definition at line 852 of file common.h.

Referenced by cob_fatal_error(), cob_write(), and indexed_write().

#define COB_STATUS_49_I_O_DENIED   49

Definition at line 853 of file common.h.

Referenced by cob_delete(), cob_fatal_error(), cob_rewrite(), indexed_delete(), indexed_rewrite(), and indexed_write().

#define COB_STATUS_51_RECORD_LOCKED   51

Definition at line 854 of file common.h.

Referenced by cob_fatal_error(), and indexed_read_next().

#define COB_STATUS_57_I_O_LINAGE   57

Definition at line 855 of file common.h.

Referenced by cob_fatal_error(), cob_file_open(), and cob_linage_write_opt().

#define COB_STATUS_61_FILE_SHARING   61

Definition at line 856 of file common.h.

Referenced by cob_fatal_error(), cob_fd_file_open(), cob_file_open(), and indexed_open().

#define COB_STATUS_91_NOT_AVAILABLE   91

Definition at line 857 of file common.h.

Referenced by cob_delete_file(), cob_fatal_error(), dummy_delete(), dummy_read(), dummy_rnxt_rewrite(), dummy_start(), indexed_close(), indexed_delete(), indexed_open(), indexed_read(), indexed_read_next(), indexed_rewrite(), indexed_start(), and indexed_write().

#define COB_STORE_AWAY_FROM_ZERO   (1 << 4)

Definition at line 871 of file common.h.

Referenced by cob_decimal_do_round(), and yyparse().

#define COB_STORE_KEEP_ON_OVERFLOW   (1 << 1)

Definition at line 868 of file common.h.

Referenced by build_store_option(), cob_decimal_get_ieee128dec(), cob_decimal_get_ieee64dec(), and relative_read_next().

#define COB_STORE_MASK
Value:
(COB_STORE_ROUND | COB_STORE_KEEP_ON_OVERFLOW | \
COB_STORE_TRUNC_ON_OVERFLOW)
COB_STORE_ROUND
#define COB_STORE_ROUND
Definition: common.h:867
COB_STORE_KEEP_ON_OVERFLOW
#define COB_STORE_KEEP_ON_OVERFLOW
Definition: common.h:868
COB_STORE_TRUNC_ON_OVERFLOW
#define COB_STORE_TRUNC_ON_OVERFLOW
Definition: common.h:869

Definition at line 880 of file common.h.

Referenced by cob_decimal_do_round().

#define COB_STORE_NEAR_AWAY_FROM_ZERO   (1 << 5)

Definition at line 872 of file common.h.

Referenced by cob_decimal_do_round(), and yyparse().

#define COB_STORE_NEAR_EVEN   (1 << 6)

Definition at line 873 of file common.h.

Referenced by cob_decimal_do_round(), and yyparse().

#define COB_STORE_NEAR_TOWARD_ZERO   (1 << 7)

Definition at line 874 of file common.h.

Referenced by cob_decimal_do_round(), and yyparse().

#define COB_STORE_PROHIBITED   (1 << 8)

Definition at line 875 of file common.h.

Referenced by cob_decimal_do_round(), and yyparse().

#define COB_STORE_ROUND   (1 << 0)

Definition at line 867 of file common.h.

Referenced by cob_decimal_get_field(), and yyparse().

#define COB_STORE_TOWARD_GREATER   (1 << 9)

Definition at line 876 of file common.h.

Referenced by cob_decimal_do_round(), and yyparse().

#define COB_STORE_TOWARD_LESSER   (1 << 10)

Definition at line 877 of file common.h.

Referenced by cob_decimal_do_round(), and yyparse().

#define COB_STORE_TRUNC_ON_OVERFLOW   (1 << 2)

Definition at line 869 of file common.h.

Referenced by build_store_option(), cob_decimal_get_binary(), and cob_move().

#define COB_STORE_TRUNCATION   (1 << 11)

Definition at line 878 of file common.h.

Referenced by cob_decimal_do_round(), and yyparse().

#define COB_TYPE_ALPHANUMERIC   0x21U

Definition at line 621 of file common.h.

Referenced by cb_tree_type(), cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), cob_move_all(), codegen(), initialize_uniform_char(), output_alphabet_name_definition(), and output_attr().

#define COB_TYPE_ALPHANUMERIC_ALL   0x22U

Definition at line 622 of file common.h.

Referenced by cob_cmp(), cob_inspect_converting(), cob_move(), codegen(), field_display(), inspect_common(), and output_attr().

#define COB_TYPE_ALPHANUMERIC_EDITED   0x23U

Definition at line 623 of file common.h.

Referenced by cb_tree_type(), cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), and cob_move().

#define COB_TYPE_BOOLEAN   0x02U

Definition at line 604 of file common.h.

#define COB_TYPE_GROUP   0x01U

Definition at line 603 of file common.h.

Referenced by cb_tree_type(), cob_move(), and output_attr().

#define COB_TYPE_NATIONAL   0x40U

Definition at line 625 of file common.h.

Referenced by cob_intr_highest_algebraic(), and cob_intr_lowest_algebraic().

#define COB_TYPE_NATIONAL_EDITED   0x41U

Definition at line 626 of file common.h.

Referenced by cob_intr_highest_algebraic(), and cob_intr_lowest_algebraic().

#define COB_TYPE_NUMERIC   0x10U

Definition at line 606 of file common.h.

#define COB_TYPE_NUMERIC_BINARY   0x11U

Definition at line 608 of file common.h.

Referenced by cb_tree_type(), cob_accept_arg_number(), cob_alloc_field(), cob_alloc_set_field_int(), cob_alloc_set_field_uint(), cob_decimal_get_field(), cob_decimal_set_field(), cob_display_arg_number(), cob_get_int(), cob_get_llint(), cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), cob_is_numeric(), cob_move(), cob_set_int(), display_common(), initialize_uniform_char(), and output_bin_field().

#define COB_TYPE_NUMERIC_DISPLAY   0x10U

Definition at line 607 of file common.h.

Referenced by cb_tree_type(), cob_accept(), cob_add_int(), cob_alloc_field(), cob_check_pos_status(), cob_cmp(), cob_decimal_get_field(), cob_decimal_move_temp(), cob_get_int(), cob_get_llint(), cob_intr_date_of_integer(), cob_intr_day_of_integer(), cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), cob_intr_module_date(), cob_intr_module_time(), cob_is_numeric(), cob_move(), cob_move_all(), cob_real_get_sign(), cob_real_put_sign(), display_numeric(), indirect_move(), initialize_uniform_char(), and output_attr().

#define COB_TYPE_NUMERIC_DOUBLE   0x14U

Definition at line 611 of file common.h.

Referenced by cb_tree_type(), cob_cmp_float(), cob_decimal_get_field(), cob_decimal_set_field(), cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), cob_intr_random(), cob_is_numeric(), cob_move(), cob_numeric_cmp(), cob_print_ieeedec(), and display_common().

#define COB_TYPE_NUMERIC_EDITED   0x24U

Definition at line 619 of file common.h.

Referenced by cb_tree_type(), cob_field_is_numeric_or_numeric_edited(), cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), cob_move(), format_field(), pretty_display_numeric(), satisfied_full_clause(), and valid_field_data().

#define COB_TYPE_NUMERIC_FLOAT   0x13U

Definition at line 610 of file common.h.

Referenced by cb_tree_type(), cob_add_int(), cob_cmp_float(), cob_decimal_get_field(), cob_decimal_set_field(), cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), cob_is_numeric(), cob_move(), cob_move_fp_to_fp(), cob_numeric_cmp(), cob_print_ieeedec(), and display_common().

#define COB_TYPE_NUMERIC_FP_BIN128   0x1AU

Definition at line 617 of file common.h.

Referenced by cb_tree_type(), cob_add_int(), and cob_move().

#define COB_TYPE_NUMERIC_FP_BIN32   0x18U

Definition at line 615 of file common.h.

Referenced by cb_tree_type(), and cob_move().

#define COB_TYPE_NUMERIC_FP_BIN64   0x19U

Definition at line 616 of file common.h.

Referenced by cb_tree_type(), and cob_move().

#define COB_TYPE_NUMERIC_FP_DEC128   0x17U

Definition at line 614 of file common.h.

Referenced by cb_tree_type(), cob_decimal_get_field(), cob_decimal_set_field(), cob_is_numeric(), cob_move(), cob_print_ieeedec(), and display_common().

#define COB_TYPE_NUMERIC_FP_DEC64   0x16U

Definition at line 613 of file common.h.

Referenced by cb_tree_type(), cob_decimal_get_field(), cob_decimal_set_field(), cob_is_numeric(), cob_move(), cob_print_ieeedec(), and display_common().

#define COB_TYPE_NUMERIC_L_DOUBLE   0x15U

Definition at line 612 of file common.h.

Referenced by cb_tree_type(), and cob_move().

#define COB_TYPE_NUMERIC_PACKED   0x12U

Definition at line 609 of file common.h.

Referenced by cb_tree_type(), cob_add_int(), cob_cmp_all(), cob_cmp_alnum(), cob_decimal_get_field(), cob_decimal_set_field(), cob_get_int(), cob_get_llint(), cob_intr_highest_algebraic(), cob_intr_lowest_algebraic(), cob_is_numeric(), cob_move(), cob_real_get_sign(), cob_real_put_sign(), and initialize_type().

#define COB_TYPE_UNKNOWN   0x00

Definition at line 602 of file common.h.

#define cob_u16_ptr   cob_u16_t *

Definition at line 68 of file common.h.

#define cob_u16_t   unsigned short

Definition at line 29 of file common.h.

Referenced by cob_alloc_set_field_int().

#define cob_u32_ptr   cob_u32_t *

Definition at line 70 of file common.h.

#define cob_u32_t   unsigned int

Definition at line 31 of file common.h.

Referenced by cb_add_78(), cb_add_const_var(), cb_build_picture(), cb_emit_call(), cb_validate_78_item(), cob_alloc_set_field_uint(), cob_cmp_llint(), cob_decimal_alloc(), cob_decimal_pop(), cob_decimal_push(), cob_decimal_set_llint(), cob_display(), cob_exit_intrinsic(), cob_init_intrinsic(), cob_init_numeric(), cob_intr_byte_length(), cob_intr_length(), cob_intr_ord(), cob_intr_ord_max(), cob_intr_ord_min(), cob_intr_stored_char_length(), cob_mpf_exp(), cob_set_packed_int(), cobc_clean_up(), codegen(), days_up_to_year(), indexed_open(), indexed_read_next(), indexed_rewrite(), integer_of_date(), integer_of_day(), integer_of_wwwd(), output_attr(), output_bin_field(), output_call(), output_entry_function(), output_initialize_one(), output_internal_function(), and relative_read_next().

#define COB_U64_C (   x)    x ## ULL

Definition at line 55 of file common.h.

Referenced by cob_decimal_set_ieee64dec().

#define cob_u64_ptr   cob_u64_t *

Definition at line 72 of file common.h.

#define cob_u64_t   unsigned long long

Definition at line 52 of file common.h.

Referenced by cb_get_u_long_long(), cob_binary_get_uint64(), cob_binary_mget_uint64(), cob_cmp_llint(), cob_cmp_packed(), cob_decimal_get_binary(), cob_decimal_get_ieee128dec(), cob_decimal_get_ieee64dec(), cob_decimal_set_binary(), cob_decimal_set_double(), cob_decimal_set_ieee128dec(), cob_decimal_set_ieee64dec(), cob_decimal_set_llint(), cob_move_binary_to_binary(), cob_move_binary_to_display(), cob_move_display_to_binary(), cob_print_realbin(), cob_sys_file_info(), compute_size(), GCic_(), output_call_by_value_args(), scan_b(), scan_h(), and scan_o().

#define cob_u8_ptr   cob_u8_t *

Definition at line 66 of file common.h.

Referenced by CHECKSRC_(), cob_get_pointer(), cob_init_strings(), cob_memcpy(), cob_move_binary_to_display(), cob_sys_and(), cob_sys_eq(), cob_sys_hosted(), cob_sys_imp(), cob_sys_justify(), cob_sys_nimp(), cob_sys_nor(), cob_sys_not(), cob_sys_or(), cob_sys_printable(), cob_sys_tolower(), cob_sys_toupper(), cob_sys_x91(), cob_sys_xf4(), cob_sys_xf5(), cob_sys_xor(), cobxref_(), GCic_(), get__reserved__lists_(), indexed_read_next(), LISTING_(), and output_attr().

#define cob_u8_t   unsigned char

Definition at line 27 of file common.h.

Referenced by cb_build_initialize(), cb_build_program_id(), cb_encode_program_id(), cb_to_cname(), cob_intr_lower_case(), cob_intr_upper_case(), cob_real_put_sign(), cob_resolve_internal(), cob_sys_tolower(), cob_sys_toupper(), fold_lower(), fold_upper(), read_literal(), scan_x(), and user_func_upper().

#define cob_uli_t   unsigned long int

Definition at line 33 of file common.h.

Referenced by calc_mean_of_args(), calc_variance_of_args(), cob_add_int(), cob_cmp_llint(), cob_cmp_uint(), cob_decimal_do_round(), cob_decimal_get_double(), cob_decimal_get_mpf(), cob_decimal_pow(), cob_decimal_set_binary(), cob_decimal_set_display(), cob_decimal_set_double(), cob_decimal_set_ieee128dec(), cob_decimal_set_ieee64dec(), cob_decimal_set_llint(), cob_decimal_set_mpf(), cob_decimal_set_packed(), cob_init_numeric(), cob_intr_factorial(), cob_intr_fraction_part(), cob_intr_highest_algebraic(), cob_intr_integer(), cob_intr_integer_part(), cob_intr_lowest_algebraic(), cob_intr_mean(), cob_intr_numval_f(), cob_intr_present_value(), cob_mod_or_rem(), cob_mpf_atan(), cob_mpf_exp(), cob_mpf_log(), cob_mpf_sin(), and shift_decimal().

#define COB_UNUSED (   z)    do { (void)(z); } ONCE_COB

Definition at line 535 of file common.h.

Referenced by cob_command_line(), cob_fd_file_open(), cob_intr_boolean_of_integer(), cob_intr_char_national(), cob_intr_display_of(), cob_intr_integer_of_boolean(), cob_intr_national_of(), cob_intr_standard_compare(), cob_module_leave(), cob_move_to_beg_of_last_line(), cob_new_item(), cob_savenv2(), cob_sys_change_dir(), cob_sys_chdir(), cob_sys_check_file_exist(), cob_sys_copy_file(), cob_sys_copyfile(), cob_sys_create_dir(), cob_sys_delete_dir(), cob_sys_delete_file(), cob_sys_file_delete(), cob_sys_file_info(), cob_sys_flush_file(), cob_sys_getopt_long_long(), cob_sys_oc_nanosleep(), cob_sys_open_file(), cob_sys_parameter_size(), cob_sys_rename_file(), cob_sys_return_args(), cob_sys_sleep(), cob_sys_write_file(), dummy_delete(), dummy_read(), dummy_rnxt_rewrite(), dummy_start(), indexed_close(), indexed_file_delete(), indexed_open(), indexed_rewrite(), indexed_write(), lineseq_read(), open_cbl_file(), raise_ec_on_truncation(), relative_read(), relative_rewrite(), relative_write(), scan_options(), sequential_read(), and sequential_rewrite().

#define cob_void_ptr   void *

Definition at line 75 of file common.h.

#define COB_WRITE_AFTER   0x00100000

Definition at line 805 of file common.h.

Referenced by cb_build_write_advancing_lines(), cb_build_write_advancing_mnemonic(), cb_build_write_advancing_page(), cb_emit_write(), lineseq_write(), and sequential_write().

#define COB_WRITE_BEFORE   0x00200000

Definition at line 806 of file common.h.

Referenced by cb_build_write_advancing_lines(), cb_build_write_advancing_mnemonic(), cb_build_write_advancing_page(), cb_emit_write(), cob_file_sort_giving(), lineseq_write(), and sequential_write().

#define COB_WRITE_CHANNEL   0x00040000

Definition at line 804 of file common.h.

Referenced by cb_build_write_advancing_mnemonic().

#define COB_WRITE_EOP   0x00400000

Definition at line 807 of file common.h.

#define COB_WRITE_LINES   0x00010000

Definition at line 802 of file common.h.

Referenced by cb_build_write_advancing_lines(), cb_emit_write(), cob_file_sort_giving(), cob_file_write_opt(), cob_linage_write_opt(), and cob_seq_write_opt().

#define COB_WRITE_LOCK   0x00800000

Definition at line 808 of file common.h.

Referenced by cb_emit_rewrite(), and cb_emit_write().

#define COB_WRITE_MASK   0x0000FFFF

Definition at line 800 of file common.h.

Referenced by cob_file_write_opt(), cob_linage_write_opt(), and cob_seq_write_opt().

#define COB_WRITE_NO_LOCK   0x01000000

Definition at line 809 of file common.h.

#define COB_WRITE_PAGE   0x00020000

Definition at line 803 of file common.h.

Referenced by cb_build_write_advancing_mnemonic(), cb_build_write_advancing_page(), cob_file_write_opt(), cob_linage_write_opt(), cob_seq_write_opt(), and lineseq_write().

#define cobcall (   x,
  y,
  z 
)    cob_call (x, y, z)

Definition at line 1538 of file common.h.

#define cobcancel (   x)    cob_cancel (x)

Definition at line 1539 of file common.h.

#define cobcommandline (   v,
  w,
  x,
  y,
  z 
)    cob_command_line (v,w,x,y,z)

Definition at line 1329 of file common.h.

#define cobexit (   x)    cob_stop_run (x)

Definition at line 1328 of file common.h.

#define cobfunc (   x,
  y,
  z 
)    cob_func (x, y, z)

Definition at line 1537 of file common.h.

#define cobgetenv (   x)    cob_getenv (x)

Definition at line 1324 of file common.h.

#define cobinit ( )    cob_extern_init ()

Definition at line 1327 of file common.h.

#define coblongjmp (   x)    cob_longjmp (x)

Definition at line 1534 of file common.h.

#define cobputenv (   x)    cob_putenv (x)

Definition at line 1325 of file common.h.

#define cobsavenv (   x)    cob_savenv (x)

Definition at line 1535 of file common.h.

#define cobsavenv2 (   x,
  z 
)    cob_savenv2 (x, z)

Definition at line 1536 of file common.h.

#define cobsetjmp (   x)    setjmp (cob_savenv (x))

Definition at line 1533 of file common.h.

#define cobtidy ( )    cob_tidy ()

Definition at line 1326 of file common.h.

#define DECLNORET

Definition at line 376 of file common.h.

#define likely (   x)    (x)

Definition at line 436 of file common.h.

Referenced by cb_encode_program_id(), cb_ref(), cob_chk_file_mapping(), cob_file_release(), cob_file_return(), cob_file_sort_close(), cob_file_sort_process(), cob_move_all(), cob_resolve_internal(), initialize_user_res_list_if_needed(), lineseq_read(), lookup_word(), output(), ppinput(), process(), save_status(), scan_x(), yylex(), and yyparse().

#define MAX_FD_RECORD   65535

Definition at line 556 of file common.h.

Referenced by finalize_file(), and yyparse().

#define ONCE_COB   while (0)

Definition at line 530 of file common.h.

#define optim_memcpy (   x,
  y,
  z 
)    memcpy (x, y, z)

Definition at line 382 of file common.h.

#define PATHSEP_CHAR   (char) ':'

Definition at line 500 of file common.h.

Referenced by cob_init_call(), and cob_set_library_path().

#define PATHSEP_STR   (char *) ":"

Definition at line 501 of file common.h.

Referenced by cache_preload(), cob_init_call(), cob_set_library_path(), and process_env_copy_path().

#define SLASH_CHAR   (char) '/'

Definition at line 505 of file common.h.

Referenced by cb_load_conf(), cb_load_conf_file(), cob_chk_file_mapping(), cob_init_call(), cob_load_config_file(), cob_resolve_internal(), cob_temp_name(), process_filename(), and process_run().

#define SLASH_STR   (char *) "/"

Definition at line 506 of file common.h.

Referenced by cob_chk_file_mapping(), cob_load_config(), cob_load_config_file(), and cobc_check_action().

#define unlikely (   x)    (x)

Definition at line 437 of file common.h.

Referenced by cb_build_identifier(), cb_build_intrinsic(), cb_encode_program_id(), cb_get_int(), cb_get_long_long(), cb_get_u_long_long(), cb_load_conf(), check_lit_length(), CHECKSRC_(), cob_accept(), cob_add_int(), cob_alloc_field(), cob_alloc_set_field_str(), cob_call(), cob_call_field(), cob_cancel(), cob_cancel_field(), cob_check_numdisp(), cob_chk_file_env(), cob_chk_file_mapping(), cob_close(), cob_cmp_numdisp(), cob_copy_check(), cob_correct_numeric(), cob_decimal_div(), cob_decimal_get_binary(), cob_decimal_get_display(), cob_decimal_get_double(), cob_decimal_get_field(), cob_decimal_get_packed(), cob_decimal_pow(), cob_decimal_print(), cob_decimal_set_display(), cob_decimal_set_packed(), cob_delete(), cob_delete_file(), cob_display(), cob_display_environment(), cob_fast_malloc(), cob_field_to_string(), cob_file_open(), cob_file_sort_compare(), cob_file_sort_process(), cob_file_sort_retrieve(), cob_file_sort_submit(), cob_file_write_opt(), cob_free(), cob_get_environment(), cob_get_global_ptr(), cob_init(), cob_inspect_converting(), cob_inspect_finish(), cob_inspect_init(), cob_intr_concatenate(), cob_intr_current_date(), cob_intr_formatted_current_date(), cob_intr_formatted_date(), cob_intr_formatted_datetime(), cob_intr_formatted_time(), cob_intr_lower_case(), cob_intr_reverse(), cob_intr_trim(), cob_intr_upper_case(), cob_intr_when_compiled(), cob_linage_write_opt(), cob_longjmp(), cob_malloc(), cob_module_enter(), cob_move(), cob_move_display_to_alphanum(), cob_new_item(), cob_open(), cob_read(), cob_read_item(), cob_read_next(), cob_real_get_sign(), cob_real_put_sign(), cob_realloc(), cob_resolve_cobol(), cob_resolve_func(), cob_resolve_internal(), cob_rewrite(), cob_save_func(), cob_savenv(), cob_start(), cob_sys_system(), cob_write(), cob_write_block(), cobc_check_string(), cobc_clean_up(), cobc_free(), cobc_main_free(), cobc_main_malloc(), cobc_main_realloc(), cobc_main_strdup(), cobc_malloc(), cobc_parse_free(), cobc_parse_malloc(), cobc_parse_realloc(), cobc_parse_strdup(), cobc_plex_malloc(), cobc_plex_strdup(), cobc_realloc(), cobc_stradd_dup(), cobc_strdup(), cobxref_(), common_cmpc(), common_cmps(), field_accept(), field_display(), GCic_(), get__reserved__lists_(), indexed_read(), indexed_read_next(), indexed_write(), inspect_common(), integer_of_ddd(), integer_of_formatted_date(), integer_of_mmdd(), integer_of_wwwd(), isclose(), isdi_curidx(), isdi_datfd(), isdi_datlen(), isdi_idxfd(), isdi_kdsc(), isdi_name(), isfullclose(), isindexinfo(), issetcollate(), istartrownumber(), isunlock(), ivbdatalock(), ivbdataread(), ivbdatawrite(), ivbenter(), ivbfileopenlock(), lineseq_read(), lineseq_write(), LISTING_(), lookup_reserved_word(), output(), output_base(), output_data(), output_entry_function(), output_stmt(), ppinput(), preprocess(), process(), process_translate(), pvvbmalloc(), read_literal(), relative_read(), relative_read_next(), relative_write(), save_status(), scan_b(), scan_h(), scan_numeric(), scan_o(), scan_x(), scan_z(), seconds_from_formatted_time(), sequential_read(), sequential_write(), sort_cmps(), store_common_region(), substitute(), tvblseek(), tvbread(), tvbwrite(), and yylex().

Typedef Documentation

typedef struct __cob_global cob_global
typedef struct __cob_module cob_module
typedef struct __cob_screen cob_screen
typedef struct longoption_def longoption_def

Enumeration Type Documentation

enum cob_exception_id
Enumerator
COB_EC_ZERO 
COB_EC_ARGUMENT 
COB_EC_ARGUMENT_FUNCTION 
COB_EC_ARGUMENT_IMP 
COB_EC_BOUND 
COB_EC_BOUND_IMP 
COB_EC_BOUND_ODO 
COB_EC_BOUND_OVERFLOW 
COB_EC_BOUND_PTR 
COB_EC_BOUND_REF_MOD 
COB_EC_BOUND_SET 
COB_EC_BOUND_SUBSCRIPT 
COB_EC_BOUND_TABLE_LIMIT 
COB_EC_DATA 
COB_EC_DATA_CONVERSION 
COB_EC_DATA_IMP 
COB_EC_DATA_INCOMPATIBLE 
COB_EC_DATA_INTEGRITY 
COB_EC_DATA_PTR_NULL 
COB_EC_DATA_NOT_DECIMAL_ENCODING 
COB_EC_DATA_NOT_FINITE 
COB_EC_FLOW 
COB_EC_FLOW_GLOBAL_EXIT 
COB_EC_FLOW_GLOBAL_GOBACK 
COB_EC_FLOW_IMP 
COB_EC_FLOW_RELEASE 
COB_EC_FLOW_REPORT 
COB_EC_FLOW_RETURN 
COB_EC_FLOW_SEARCH 
COB_EC_FLOW_USE 
COB_EC_I_O 
COB_EC_I_O_AT_END 
COB_EC_I_O_EOP 
COB_EC_I_O_EOP_OVERFLOW 
COB_EC_I_O_FILE_SHARING 
COB_EC_I_O_IMP 
COB_EC_I_O_INVALID_KEY 
COB_EC_I_O_LINAGE 
COB_EC_I_O_LOGIC_ERROR 
COB_EC_I_O_PERMANENT_ERROR 
COB_EC_I_O_RECORD_OPERATION 
COB_EC_IMP 
COB_EC_IMP_ACCEPT 
COB_EC_IMP_DISPLAY 
COB_EC_IMP_UTC_UNKNOWN 
COB_EC_LOCALE 
COB_EC_LOCALE_IMP 
COB_EC_LOCALE_INCOMPATIBLE 
COB_EC_LOCALE_INVALID 
COB_EC_LOCALE_INVALID_PTR 
COB_EC_LOCALE_MISSING 
COB_EC_LOCALE_SIZE 
COB_EC_OO 
COB_EC_OO_CONFORMANCE 
COB_EC_OO_EXCEPTION 
COB_EC_OO_IMP 
COB_EC_OO_METHOD 
COB_EC_OO_NULL 
COB_EC_OO_RESOURCE 
COB_EC_OO_UNIVERSAL 
COB_EC_OO_ARG_OMITTED 
COB_EC_ORDER 
COB_EC_ORDER_IMP 
COB_EC_ORDER_NOT_SUPPORTED 
COB_EC_SIZE 
COB_EC_SIZE_ADDRESS 
COB_EC_SIZE_EXPONENTIATION 
COB_EC_SIZE_IMP 
COB_EC_SIZE_OVERFLOW 
COB_EC_SIZE_TRUNCATION 
COB_EC_SIZE_UNDERFLOW 
COB_EC_SIZE_ZERO_DIVIDE 
COB_EC_SORT_MERGE 
COB_EC_SORT_MERGE_ACTIVE 
COB_EC_SORT_MERGE_FILE_OPEN 
COB_EC_SORT_MERGE_IMP 
COB_EC_SORT_MERGE_RELEASE 
COB_EC_SORT_MERGE_RETURN 
COB_EC_SORT_MERGE_SEQUENCE 
COB_EC_STORAGE 
COB_EC_STORAGE_IMP 
COB_EC_STORAGE_NOT_ALLOC 
COB_EC_STORAGE_NOT_AVAIL 
COB_EC_USER 
COB_EC_VALIDATE 
COB_EC_VALIDATE_CONTENT 
COB_EC_VALIDATE_FORMAT 
COB_EC_VALIDATE_IMP 
COB_EC_VALIDATE_RELATION 
COB_EC_VALIDATE_VARYING 
COB_EC_FUNCTION 
COB_EC_FUNCTION_NOT_FOUND 
COB_EC_FUNCTION_PTR_INVALID 
COB_EC_FUNCTION_PTR_NULL 
COB_EC_FUNCTION_ARG_OMITTED 
COB_EC_XML 
COB_EC_XML_CODESET 
COB_EC_XML_CODESET_CONVERSION 
COB_EC_XML_COUNT 
COB_EC_XML_DOCUMENT_TYPE 
COB_EC_XML_IMPLICIT_CLOSE 
COB_EC_XML_INVALID 
COB_EC_XML_NAMESPACE 
COB_EC_XML_STACKED_OPEN 
COB_EC_XML_RANGE 
COB_EC_OVERFLOW 
COB_EC_OVERFLOW_IMP 
COB_EC_OVERFLOW_STRING 
COB_EC_OVERFLOW_UNSTRING 
COB_EC_PROGRAM 
COB_EC_PROGRAM_ARG_MISMATCH 
COB_EC_PROGRAM_ARG_OMITTED 
COB_EC_PROGRAM_CANCEL_ACTIVE 
COB_EC_PROGRAM_IMP 
COB_EC_PROGRAM_NOT_FOUND 
COB_EC_PROGRAM_PTR_NULL 
COB_EC_PROGRAM_RECURSIVE_CALL 
COB_EC_PROGRAM_RESOURCES 
COB_EC_RAISING 
COB_EC_RAISING_IMP 
COB_EC_RAISING_NOT_SPECIFIED 
COB_EC_RANGE 
COB_EC_RANGE_IMP 
COB_EC_RANGE_INDEX 
COB_EC_RANGE_INSPECT_SIZE 
COB_EC_RANGE_INVALID 
COB_EC_RANGE_PERFORM_VARYING 
COB_EC_RANGE_PTR 
COB_EC_RANGE_SEARCH_INDEX 
COB_EC_RANGE_SEARCH_NO_MATCH 
COB_EC_REPORT 
COB_EC_REPORT_ACTIVE 
COB_EC_REPORT_COLUMN_OVERLAP 
COB_EC_REPORT_FILE_MODE 
COB_EC_REPORT_IMP 
COB_EC_REPORT_INACTIVE 
COB_EC_REPORT_LINE_OVERLAP 
COB_EC_REPORT_NOT_TERMINATED 
COB_EC_REPORT_PAGE_LIMIT 
COB_EC_REPORT_PAGE_WIDTH 
COB_EC_REPORT_SUM_SIZE 
COB_EC_REPORT_VARYING 
COB_EC_SCREEN 
COB_EC_SCREEN_FIELD_OVERLAP 
COB_EC_SCREEN_IMP 
COB_EC_SCREEN_ITEM_TRUNCATED 
COB_EC_SCREEN_LINE_NUMBER 
COB_EC_SCREEN_STARTING_COLUMN 
COB_EC_ALL 
COB_EC_MAX 

Definition at line 710 of file common.h.

710  {
711  COB_EC_ZERO = 0,
712 #include <libcob/exception.def>
713  COB_EC_MAX
714 };

Function Documentation

void cob_accept ( cob_field *  )

Definition at line 283 of file termio.c.

References cob_field::attr, COB_EC_IMP_ACCEPT, cob_field_accept(), COB_FIELD_IS_NUMERIC, COB_FIELD_TYPE, COB_MEDIUM_MAX, COB_MODULE_PTR, cob_move(), __cob_global::cob_screen_initialized, COB_SCREEN_PROMPT, cob_set_exception(), cob_set_int(), COB_TERM_BUFF, COB_TYPE_NUMERIC_DISPLAY, const_alpha_attr, cob_field::data, NULL, cob_field::size, and unlikely.

284 {
285  unsigned char *p;
286  size_t size;
287  int ipchr;
288  cob_field temp;
289 
290  if (cobglobptr->cob_screen_initialized) {
291  cob_field_accept (f, NULL, NULL, NULL, NULL,
292  NULL, NULL, NULL, NULL,
293  COB_SCREEN_PROMPT);
294  return;
295  }
296  if (COB_MODULE_PTR->crt_status) {
297  if (COB_FIELD_IS_NUMERIC (COB_MODULE_PTR->crt_status)) {
298  cob_set_int (COB_MODULE_PTR->crt_status, 0);
299  } else {
300  memset (COB_MODULE_PTR->crt_status->data, '0', (size_t)4);
301  }
302  }
303  /* extension: ACCEPT OMITTED */
304  if (unlikely(!f)) {
305  for (; ; ) {
306  ipchr = getchar ();
307  if (ipchr == '\n' || ipchr == EOF) {
308  break;
309  }
310  }
311  return;
312  }
313  p = COB_TERM_BUFF;
314  temp.data = p;
315  temp.attr = &const_alpha_attr;
316  size = 0;
317  /* Read a line */
318  for (; size < COB_MEDIUM_MAX; ) {
319  ipchr = getchar ();
320  if (unlikely(ipchr == EOF)) {
321  cob_set_exception (COB_EC_IMP_ACCEPT);
322  if (!size) {
323  size = 1;
324  p[0] = ' ';
325  p[1] = 0;
326  }
327  break;
328  } else if (ipchr == '\n') {
329  break;
330  }
331  p[size++] = (char) ipchr;
332  }
333  temp.size = size;
334  if (COB_FIELD_TYPE(f) == COB_TYPE_NUMERIC_DISPLAY) {
335  if (temp.size > f->size) {
336  temp.size = f->size;
337  }
338  }
339  cob_move (&temp, f);
340 }
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: termio.c:49
COB_TERM_BUFF
#define COB_TERM_BUFF
Definition: coblocal.h:186
COB_FIELD_IS_NUMERIC
#define COB_FIELD_IS_NUMERIC(f)
Definition: common.h:674
cob_move
void cob_move(cob_field *, cob_field *)
Definition: move.c:1170
COB_FIELD_TYPE
#define COB_FIELD_TYPE(f)
Definition: common.h:662
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
cob_field_accept
void cob_field_accept(cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, const int)
Definition: screenio.c:2353
unlikely
#define unlikely(x)
Definition: common.h:437
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_TYPE_NUMERIC_DISPLAY
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
cob_set_int
void cob_set_int(cob_field *, const int)
Definition: move.c:1612
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cobglobptr
static cob_global * cobglobptr
Definition: termio.c:43
COB_SCREEN_PROMPT
#define COB_SCREEN_PROMPT
Definition: common.h:914
__cob_global::cob_screen_initialized
unsigned int cob_screen_initialized
Definition: common.h:1208
cob_field::size
size_t size
Definition: common.h:951
cob_field::attr
const cob_field_attr * attr
Definition: common.h:953
COB_MEDIUM_MAX
#define COB_MEDIUM_MAX
Definition: common.h:549

Here is the call graph for this function:

void cob_accept_arg_number ( cob_field *  )

Definition at line 2930 of file common.c.

References cob_field::attr, cob_argc, COB_ATTR_INIT, cob_move(), COB_TYPE_NUMERIC_BINARY, cob_field::data, NULL, and cob_field::size.

Referenced by cobxref_().

2931 {
2932  int n;
2933  cob_field_attr attr;
2934  cob_field temp;
2935 
2936  n = cob_argc - 1;
2937  temp.size = 4;
2938  temp.data = (unsigned char *)&n;
2939  temp.attr = &attr;
2940  COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, 0, 0, NULL);
2941  cob_move (&temp, f);
2942 }
cob_move
void cob_move(cob_field *, cob_field *)
Definition: move.c:1170
cob_field
Definition: common.h:950
cob_argc
static int cob_argc
Definition: common.c:125
COB_ATTR_INIT
#define COB_ATTR_INIT(u, v, x, y, z)
Definition: coblocal.h:150
cob_field::data
unsigned char * data
Definition: common.h:952
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_TYPE_NUMERIC_BINARY
#define COB_TYPE_NUMERIC_BINARY
Definition: common.h:608
cob_field_attr
Definition: common.h:940
cob_field::size
size_t size
Definition: common.h:951
cob_field::attr
const cob_field_attr * attr
Definition: common.h:953

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_accept_arg_value ( cob_field *  )

Definition at line 2945 of file common.c.

References cob_argc, cob_argv, COB_EC_IMP_ACCEPT, cob_memcpy(), cob_set_exception(), and current_arg.

Referenced by cobxref_().

2946 {
2947  if (current_arg >= cob_argc) {
2948  cob_set_exception (COB_EC_IMP_ACCEPT);
2949  return;
2950  }
2951  cob_memcpy (f, cob_argv[current_arg],
2952  strlen (cob_argv[current_arg]));
2953  current_arg++;
2954 }
cob_memcpy
static void cob_memcpy(cob_field *dst, const void *src, const size_t size)
Definition: common.c:1042
cob_argc
static int cob_argc
Definition: common.c:125
cob_argv
static char ** cob_argv
Definition: common.c:126
current_arg
static int current_arg
Definition: common.c:139
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_accept_command_line ( cob_field *  )

Definition at line 2866 of file common.c.

References cob_argc, cob_argv, cob_free(), cob_malloc(), cob_memcpy(), commlncnt, commlnptr, and cob_field::size.

Referenced by GCic_().

2867 {
2868  char *buff;
2869  size_t i;
2870  size_t size;
2871  size_t len;
2872 
2873  if (commlncnt) {
2874  cob_memcpy (f, commlnptr, commlncnt);
2875  return;
2876  }
2877 
2878  if (cob_argc <= 1) {
2879  cob_memcpy (f, " ", (size_t)1);
2880  return;
2881  }
2882 
2883  size = 0;
2884  for (i = 1; i < (size_t)cob_argc; ++i) {
2885  size += (strlen (cob_argv[i]) + 1);
2886  if (size > f->size) {
2887  break;
2888  }
2889  }
2890  buff = cob_malloc (size);
2891  buff[0] = ' ';
2892  size = 0;
2893  for (i = 1; i < (size_t)cob_argc; ++i) {
2894  len = strlen (cob_argv[i]);
2895  memcpy (buff + size, cob_argv[i], len);
2896  size += len;
2897  if (i != (size_t)cob_argc - 1U) {
2898  buff[size++] = ' ';
2899  }
2900  if (size > f->size) {
2901  break;
2902  }
2903  }
2904  cob_memcpy (f, buff, size);
2905  cob_free (buff);
2906 }
cob_memcpy
static void cob_memcpy(cob_field *dst, const void *src, const size_t size)
Definition: common.c:1042
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_argc
static int cob_argc
Definition: common.c:125
cob_argv
static char ** cob_argv
Definition: common.c:126
commlnptr
static unsigned char * commlnptr
Definition: common.c:140
commlncnt
static size_t commlncnt
Definition: common.c:141
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_accept_date ( cob_field *  )

Definition at line 2781 of file common.c.

References cob_memcpy(), and NULL.

Referenced by cobxref_().

2782 {
2783  time_t t;
2784  char s[8];
2785 
2786  t = time (NULL);
2787  strftime (s, (size_t)7, "%y%m%d", localtime (&t));
2788  cob_memcpy (f, s, (size_t)6);
2789 }
cob_memcpy
static void cob_memcpy(cob_field *dst, const void *src, const size_t size)
Definition: common.c:1042
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_accept_date_yyyymmdd ( cob_field *  )

Definition at line 2792 of file common.c.

References cob_memcpy(), and NULL.

Referenced by LISTING_().

2793 {
2794  time_t t;
2795  char s[12];
2796 
2797  t = time (NULL);
2798  strftime (s, (size_t)9, "%Y%m%d", localtime (&t));
2799  cob_memcpy (f, s, (size_t)8);
2800 }
cob_memcpy
static void cob_memcpy(cob_field *dst, const void *src, const size_t size)
Definition: common.c:1042
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_accept_day ( cob_field *  )

Definition at line 2803 of file common.c.

References cob_memcpy(), and NULL.

2804 {
2805  time_t t;
2806  char s[8];
2807 
2808  t = time (NULL);
2809  strftime (s, (size_t)6, "%y%j", localtime (&t));
2810  cob_memcpy (f, s, (size_t)5);
2811 }
cob_memcpy
static void cob_memcpy(cob_field *dst, const void *src, const size_t size)
Definition: common.c:1042
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the call graph for this function:

void cob_accept_day_of_week ( cob_field *  )

Definition at line 2825 of file common.c.

References cob_memcpy(), and NULL.

2826 {
2827  struct tm *tm;
2828  time_t t;
2829  unsigned char s[4];
2830 
2831  t = time (NULL);
2832  tm = localtime (&t);
2833  if (tm->tm_wday == 0) {
2834  s[0] = (unsigned char)'7';
2835  } else {
2836  s[0] = (unsigned char)(tm->tm_wday + '0');
2837  }
2838  cob_memcpy (f, s, (size_t)1);
2839 }
cob_memcpy
static void cob_memcpy(cob_field *dst, const void *src, const size_t size)
Definition: common.c:1042
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the call graph for this function:

void cob_accept_day_yyyyddd ( cob_field *  )

Definition at line 2814 of file common.c.

References cob_memcpy(), and NULL.

2815 {
2816  time_t t;
2817  char s[12];
2818 
2819  t = time (NULL);
2820  strftime (s, (size_t)8, "%Y%j", localtime (&t));
2821  cob_memcpy (f, s, (size_t)7);
2822 }
cob_memcpy
static void cob_memcpy(cob_field *dst, const void *src, const size_t size)
Definition: common.c:1042
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the call graph for this function:

void cob_accept_environment ( cob_field *  )

Definition at line 3055 of file common.c.

References COB_EC_IMP_ACCEPT, cob_local_env, cob_memcpy(), cob_set_exception(), and NULL.

3056 {
3057  const char *p = NULL;
3058 
3059  if (cob_local_env) {
3060  p = getenv (cob_local_env);
3061  }
3062  if (!p) {
3063  cob_set_exception (COB_EC_IMP_ACCEPT);
3064  p = " ";
3065  }
3066  cob_memcpy (f, p, strlen (p));
3067 }
cob_memcpy
static void cob_memcpy(cob_field *dst, const void *src, const size_t size)
Definition: common.c:1042
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_local_env
static char * cob_local_env
Definition: common.c:138

Here is the call graph for this function:

void cob_accept_escape_key ( cob_field *  )

Definition at line 2524 of file screenio.c.

References COB_ACCEPT_STATUS, and cob_set_int().

2525 {
2526  cob_set_int (f, COB_ACCEPT_STATUS);
2527 }
COB_ACCEPT_STATUS
#define COB_ACCEPT_STATUS
Definition: coblocal.h:187
cob_set_int
void cob_set_int(cob_field *, const int)
Definition: move.c:1612

Here is the call graph for this function:

void cob_accept_exception_status ( cob_field *  )

Definition at line 1233 of file common.c.

References __cob_global::cob_exception_code, and cob_set_int().

1234 {
1235  cob_set_int (f, cobglobptr->cob_exception_code);
1236 }
cob_set_int
void cob_set_int(cob_field *, const int)
Definition: move.c:1612
__cob_global::cob_exception_code
int cob_exception_code
Definition: common.h:1203
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130

Here is the call graph for this function:

void cob_accept_time ( cob_field *  )

Definition at line 2842 of file common.c.

References cob_get_current_date_and_time(), cob_memcpy(), cob_time::hour, cob_time::minute, cob_time::nanosecond, and cob_time::second.

Referenced by cobxref_().

2843 {
2844  struct cob_time time;
2845  char str[9] = { '\0' };
2846 
2847  time = cob_get_current_date_and_time ();
2848  snprintf (str, 9, "%2.2d%2.2d%2.2d%2.2d", time.hour, time.minute,
2849  time.second, time.nanosecond / 10000000);
2850 
2851  cob_memcpy (field, str, (size_t)8);
2852 }
cob_get_current_date_and_time
struct cob_time cob_get_current_date_and_time(void)
Definition: common.c:2699
cob_memcpy
static void cob_memcpy(cob_field *dst, const void *src, const size_t size)
Definition: common.c:1042
cob_time
Definition: coblocal.h:261

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_accept_user_name ( cob_field *  )

Definition at line 1239 of file common.c.

References cob_memcpy(), and __cob_settings::cob_user_name.

1240 {
1241  if (cobsetptr->cob_user_name) {
1242  cob_memcpy (f, cobsetptr->cob_user_name,
1243  strlen (cobsetptr->cob_user_name));
1244  } else {
1245  cob_memcpy (f, " ", (size_t)1);
1246  }
1247 }
cob_memcpy
static void cob_memcpy(cob_field *dst, const void *src, const size_t size)
Definition: common.c:1042
__cob_settings::cob_user_name
char * cob_user_name
Definition: coblocal.h:211
cobsetptr
static cob_settings * cobsetptr
Definition: common.c:131

Here is the call graph for this function:

void cob_add ( cob_field *  ,
cob_field *  ,
const int   
)

Definition at line 1931 of file numeric.c.

References cob_decimal_add(), cob_decimal_get_field(), and cob_decimal_set_field().

Referenced by get__reserved__lists_().

1932 {
1933  cob_decimal_set_field (&cob_d1, f1);
1934  cob_decimal_set_field (&cob_d2, f2);
1935  cob_decimal_add (&cob_d1, &cob_d2);
1936  (void)cob_decimal_get_field (&cob_d1, f1, opt);
1937 }
f2
cob_field f2
Definition: cobxref.c.l.h:55
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *d, cob_field *f)
Definition: numeric.c:1612
cob_decimal_add
void cob_decimal_add(cob_decimal *d1, cob_decimal *d2)
Definition: numeric.c:1875
f1
cob_field f1
Definition: cobxref.c.l.h:54
cob_d2
static cob_decimal cob_d2
Definition: numeric.c:109
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *d, cob_field *f, const int opt)
Definition: numeric.c:1801
cob_d1
static cob_decimal cob_d1
Definition: numeric.c:108

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_add_int ( cob_field *  ,
const int  ,
const int   
)

Definition at line 2195 of file numeric.c.

References cob_decimal_get_field(), cob_decimal_set_field(), COB_FIELD_SCALE, COB_FIELD_TYPE, cob_mexp, cob_sli_t, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_FLOAT, COB_TYPE_NUMERIC_FP_BIN128, COB_TYPE_NUMERIC_PACKED, cob_uli_t, cob_decimal::scale, unlikely, and cob_decimal::value.

Referenced by cob_inspect_characters(), cob_linage_write_opt(), cob_sub_int(), cob_unstring_tallying(), cobxref_(), GCic_(), inspect_common(), LISTING_(), and relative_read_next().

2196 {
2197  int scale;
2198  int val;
2199 
2200  if (unlikely(n == 0)) {
2201  return 0;
2202  }
2203 #if 0 /* RXWRXW - Buggy */
2204  if (COB_FIELD_TYPE (f) == COB_TYPE_NUMERIC_PACKED) {
2205  return cob_add_packed (f, n, opt);
2206  } else if (COB_FIELD_TYPE (f) == COB_TYPE_NUMERIC_DISPLAY) {
2207  return cob_display_add_int (f, n, opt);
2208  }
2209 #endif
2210 
2211  /* Not optimized */
2212  cob_decimal_set_field (&cob_d1, f);
2213 
2214  if (COB_FIELD_TYPE (f) >= COB_TYPE_NUMERIC_FLOAT
2215  && COB_FIELD_TYPE (f) <= COB_TYPE_NUMERIC_FP_BIN128) {
2216  mpz_set_si (cob_d2.value, (cob_sli_t) n);
2217  cob_d2.scale = 0;
2218  mpz_add (cob_d1.value, cob_d1.value, cob_d2.value);
2219  return cob_decimal_get_field (&cob_d1, f, opt);
2220  }
2221  else {
2222  scale = COB_FIELD_SCALE (f);
2223  val = n;
2224  if (unlikely(scale < 0)) {
2225  /* PIC 9(n)P(m) */
2226  if (-scale < 10) {
2227  while (scale++) {
2228  val /= 10;
2229  }
2230  } else {
2231  val = 0;
2232  }
2233  scale = 0;
2234  if (!val) {
2235  return 0;
2236  }
2237  }
2238  mpz_set_si (cob_d2.value, (cob_sli_t)val);
2239  cob_d2.scale = 0;
2240  if (scale > 0) {
2241  mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)scale);
2242  mpz_mul (cob_d2.value, cob_d2.value, cob_mexp);
2243  cob_d2.scale = cob_d1.scale;
2244  }
2245  mpz_add (cob_d1.value, cob_d1.value, cob_d2.value);
2246  return cob_decimal_get_field (&cob_d1, f, opt);
2247  }
2248 }
COB_FIELD_SCALE
#define COB_FIELD_SCALE(f)
Definition: common.h:664
COB_TYPE_NUMERIC_PACKED
#define COB_TYPE_NUMERIC_PACKED
Definition: common.h:609
cob_mexp
static mpz_t cob_mexp
Definition: numeric.c:115
COB_FIELD_TYPE
#define COB_FIELD_TYPE(f)
Definition: common.h:662
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *d, cob_field *f)
Definition: numeric.c:1612
cob_uli_t
#define cob_uli_t
Definition: common.h:33
COB_TYPE_NUMERIC_FLOAT
#define COB_TYPE_NUMERIC_FLOAT
Definition: common.h:610
unlikely
#define unlikely(x)
Definition: common.h:437
COB_TYPE_NUMERIC_DISPLAY
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
cob_sli_t
#define cob_sli_t
Definition: common.h:32
COB_TYPE_NUMERIC_FP_BIN128
#define COB_TYPE_NUMERIC_FP_BIN128
Definition: common.h:617
cob_d2
static cob_decimal cob_d2
Definition: numeric.c:109
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *d, cob_field *f, const int opt)
Definition: numeric.c:1801
cob_d1
static cob_decimal cob_d1
Definition: numeric.c:108
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_allocate ( unsigned char **  ,
cob_field *  ,
cob_field *  ,
cob_field *   
)

Definition at line 3089 of file common.c.

References cob_field::attr, cob_alloc_base, COB_EC_STORAGE_NOT_AVAIL, __cob_global::cob_exception_code, cob_free(), cob_get_int(), cob_malloc(), cob_move(), cob_alloc_cache::cob_pointer, cob_set_exception(), const_alpha_attr, cob_field::data, cob_alloc_cache::next, NULL, cob_alloc_cache::size, and cob_field::size.

3091 {
3092  void *mptr;
3093  struct cob_alloc_cache *cache_ptr;
3094  int fsize;
3095  cob_field temp;
3096 
3097  /* ALLOCATE */
3098  cobglobptr->cob_exception_code = 0;
3099  mptr = NULL;
3100  fsize = cob_get_int (sizefld);
3101  if (fsize > 0) {
3102  cache_ptr = cob_malloc (sizeof (struct cob_alloc_cache));
3103  mptr = malloc ((size_t)fsize);
3104  if (!mptr) {
3105  cob_set_exception (COB_EC_STORAGE_NOT_AVAIL);
3106  cob_free (cache_ptr);
3107  } else {
3108  if (initialize) {
3109  temp.size = (size_t)fsize;
3110  temp.data = mptr;
3111  temp.attr = &const_alpha_attr;
3112  cob_move (initialize, &temp);
3113  } else {
3114  memset (mptr, 0, (size_t)fsize);
3115  }
3116  cache_ptr->cob_pointer = mptr;
3117  cache_ptr->size = (size_t)fsize;
3118  cache_ptr->next = cob_alloc_base;
3119  cob_alloc_base = cache_ptr;
3120  }
3121  }
3122  if (dataptr) {
3123  *dataptr = mptr;
3124  }
3125  if (retptr) {
3126  *(void **)(retptr->data) = mptr;
3127  }
3128 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_alloc_base
static struct cob_alloc_cache * cob_alloc_base
Definition: common.c:127
cob_alloc_cache::size
size_t size
Definition: common.c:108
cob_move
void cob_move(cob_field *, cob_field *)
Definition: move.c:1170
cob_field
Definition: common.h:950
cob_alloc_cache::cob_pointer
void * cob_pointer
Definition: common.c:107
cob_field::data
unsigned char * data
Definition: common.h:952
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
cob_alloc_cache::next
struct cob_alloc_cache * next
Definition: common.c:106
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_field::size
size_t size
Definition: common.h:951
cob_field::attr
const cob_field_attr * attr
Definition: common.h:953
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
__cob_global::cob_exception_code
int cob_exception_code
Definition: common.h:1203
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130
cob_alloc_cache
Definition: common.c:105
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: common.c:135

Here is the call graph for this function:

void cob_cache_free ( void *  )

Definition at line 1362 of file common.c.

References cob_alloc_base, cob_free(), cob_alloc_cache::cob_pointer, and cob_alloc_cache::next.

Referenced by CHECKSRC_(), get__reserved__lists_(), and LISTING_().

1363 {
1364  struct cob_alloc_cache *cache_ptr;
1365  struct cob_alloc_cache *prev_ptr;
1366 
1367  if (!ptr) {
1368  return;
1369  }
1370  cache_ptr = cob_alloc_base;
1371  prev_ptr = cob_alloc_base;
1372  for (; cache_ptr; cache_ptr = cache_ptr->next) {
1373  if (ptr == cache_ptr->cob_pointer) {
1374  cob_free (cache_ptr->cob_pointer);
1375  if (cache_ptr == cob_alloc_base) {
1376  cob_alloc_base = cache_ptr->next;
1377  } else {
1378  prev_ptr->next = cache_ptr->next;
1379  }
1380  cob_free (cache_ptr);
1381  return;
1382  }
1383  prev_ptr = cache_ptr;
1384  }
1385 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_alloc_base
static struct cob_alloc_cache * cob_alloc_base
Definition: common.c:127
cob_alloc_cache::cob_pointer
void * cob_pointer
Definition: common.c:107
cob_alloc_cache::next
struct cob_alloc_cache * next
Definition: common.c:106
cob_alloc_cache
Definition: common.c:105

Here is the call graph for this function:

Here is the caller graph for this function:

void* cob_cache_malloc ( const size_t  )

Definition at line 1321 of file common.c.

References cob_alloc_base, cob_malloc(), cob_alloc_cache::cob_pointer, cob_alloc_cache::next, and cob_alloc_cache::size.

Referenced by cob_cache_realloc(), cob_module_enter(), cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

1322 {
1323  struct cob_alloc_cache *cache_ptr;
1324  void *mptr;
1325 
1326  cache_ptr = cob_malloc (sizeof (struct cob_alloc_cache));
1327  mptr = cob_malloc (size);
1328  cache_ptr->cob_pointer = mptr;
1329  cache_ptr->size = size;
1330  cache_ptr->next = cob_alloc_base;
1331  cob_alloc_base = cache_ptr;
1332  return mptr;
1333 }
cob_alloc_base
static struct cob_alloc_cache * cob_alloc_base
Definition: common.c:127
cob_alloc_cache::size
size_t size
Definition: common.c:108
cob_alloc_cache::cob_pointer
void * cob_pointer
Definition: common.c:107
cob_alloc_cache::next
struct cob_alloc_cache * next
Definition: common.c:106
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
cob_alloc_cache
Definition: common.c:105

Here is the call graph for this function:

Here is the caller graph for this function:

void* cob_cache_realloc ( void *  ,
const size_t   
)

Definition at line 1336 of file common.c.

References cob_alloc_base, cob_cache_malloc(), cob_free(), cob_malloc(), cob_alloc_cache::cob_pointer, cob_alloc_cache::next, and cob_alloc_cache::size.

1337 {
1338  struct cob_alloc_cache *cache_ptr;
1339  void *mptr;
1340 
1341  if (!ptr) {
1342  return cob_cache_malloc (size);
1343  }
1344  cache_ptr = cob_alloc_base;
1345  for (; cache_ptr; cache_ptr = cache_ptr->next) {
1346  if (ptr == cache_ptr->cob_pointer) {
1347  if (size <= cache_ptr->size) {
1348  return ptr;
1349  }
1350  mptr = cob_malloc (size);
1351  memcpy (mptr, cache_ptr->cob_pointer, cache_ptr->size);
1352  cob_free (cache_ptr->cob_pointer);
1353  cache_ptr->cob_pointer = mptr;
1354  cache_ptr->size = size;
1355  return mptr;
1356  }
1357  }
1358  return ptr;
1359 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_alloc_base
static struct cob_alloc_cache * cob_alloc_base
Definition: common.c:127
cob_alloc_cache::size
size_t size
Definition: common.c:108
cob_alloc_cache::cob_pointer
void * cob_pointer
Definition: common.c:107
cob_alloc_cache::next
struct cob_alloc_cache * next
Definition: common.c:106
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
cob_alloc_cache
Definition: common.c:105
cob_cache_malloc
void * cob_cache_malloc(const size_t size)
Definition: common.c:1321

Here is the call graph for this function:

int cob_call ( const char *  ,
const int  ,
void **   
)

Definition at line 1080 of file call.c.

References _, __cob_global::cob_call_params, cob_fatal_error(), COB_FERROR_INITIALIZED, cob_free(), cob_malloc(), COB_MAX_FIELD_PARAMS, cob_resolve_cobol(), cob_runtime_error(), cob_stop_run(), cob_call_union::funcint, cob_call_union::funcvoid, and unlikely.

Referenced by cob_func().

1081 {
1082  void **pargv;
1083  cob_call_union unifunc;
1084  int i;
1085 
1086  if (unlikely(!cobglobptr)) {
1087  cob_fatal_error (COB_FERROR_INITIALIZED);
1088  }
1089  if (argc < 0 || argc > COB_MAX_FIELD_PARAMS) {
1090  cob_runtime_error (_("Invalid number of arguments to '%s'"), "cob_call");
1091  cob_stop_run (1);
1092  }
1093  if (unlikely(!name)) {
1094  cob_runtime_error (_("NULL parameter passed to '%s'"), "cob_call");
1095  cob_stop_run (1);
1096  }
1097  unifunc.funcvoid = cob_resolve_cobol (name, 0, 1);
1098  pargv = cob_malloc (COB_MAX_FIELD_PARAMS * sizeof(void *));
1099  /* Set number of parameters */
1100  cobglobptr->cob_call_params = argc;
1101  for (i = 0; i < argc; ++i) {
1102  pargv[i] = argv[i];
1103  }
1104 #if COB_MAX_FIELD_PARAMS == 16 || \
1105  COB_MAX_FIELD_PARAMS == 36 || \
1106  COB_MAX_FIELD_PARAMS == 56 || \
1107  COB_MAX_FIELD_PARAMS == 76 || \
1108  COB_MAX_FIELD_PARAMS == 96
1109 #else
1110 #error "Invalid COB_MAX_FIELD_PARAMS value"
1111 #endif
1112  i = unifunc.funcint (pargv[0], pargv[1], pargv[2], pargv[3]
1113  ,pargv[4], pargv[5], pargv[6], pargv[7]
1114  ,pargv[8], pargv[9], pargv[10], pargv[11]
1115  ,pargv[12], pargv[13], pargv[14], pargv[15]
1116 #if COB_MAX_FIELD_PARAMS > 16
1117  ,pargv[16], pargv[17], pargv[18], pargv[19]
1118  ,pargv[20], pargv[21], pargv[22], pargv[23]
1119  ,pargv[24], pargv[25], pargv[26], pargv[27]
1120  ,pargv[28], pargv[29], pargv[30], pargv[31]
1121  ,pargv[32], pargv[33], pargv[34], pargv[35]
1122 #if COB_MAX_FIELD_PARAMS > 36
1123  ,pargv[36], pargv[37], pargv[38], pargv[39]
1124  ,pargv[40], pargv[41], pargv[42], pargv[43]
1125  ,pargv[44], pargv[45], pargv[46], pargv[47]
1126  ,pargv[48], pargv[49], pargv[50], pargv[51]
1127  ,pargv[52], pargv[53], pargv[54], pargv[55]
1128 #if COB_MAX_FIELD_PARAMS > 56
1129  ,pargv[56], pargv[57], pargv[58], pargv[59]
1130  ,pargv[60], pargv[61], pargv[62], pargv[63]
1131  ,pargv[64], pargv[65], pargv[66], pargv[67]
1132  ,pargv[68], pargv[69], pargv[70], pargv[71]
1133  ,pargv[72], pargv[73], pargv[74], pargv[75]
1134 #if COB_MAX_FIELD_PARAMS > 76
1135  ,pargv[76], pargv[77], pargv[78], pargv[79]
1136  ,pargv[80], pargv[81], pargv[82], pargv[83]
1137  ,pargv[84], pargv[85], pargv[86], pargv[87]
1138  ,pargv[88], pargv[89], pargv[90], pargv[91]
1139  ,pargv[92], pargv[93], pargv[94], pargv[95]
1140 #endif
1141 #endif
1142 #endif
1143 #endif
1144  );
1145  cob_free (pargv);
1146  return i;
1147 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_resolve_cobol
void * cob_resolve_cobol(const char *name, const int fold_case, const int errind)
Definition: call.c:923
__cob_global::cob_call_params
int cob_call_params
Definition: common.h:1204
cob_call_union::funcvoid
void * funcvoid
Definition: common.h:1010
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
cob_runtime_error
void cob_runtime_error(const char *,...) COB_A_FORMAT12
Definition: common.c:1543
_
#define _(s)
Definition: cobcrun.c:59
unlikely
#define unlikely(x)
Definition: common.h:437
cob_call_union::funcint
int(* funcint)()
Definition: common.h:1009
cobglobptr
static cob_global * cobglobptr
Definition: call.c:161
COB_FERROR_INITIALIZED
#define COB_FERROR_INITIALIZED
Definition: common.h:692
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
COB_MAX_FIELD_PARAMS
#define COB_MAX_FIELD_PARAMS
Definition: common.h:559
cob_call_union
Definition: common.h:1005
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_call_error ( void  )

Definition at line 878 of file call.c.

References cob_resolve_error(), cob_runtime_error(), and cob_stop_run().

Referenced by cob_call_field(), cob_resolve_cobol(), and main().

879 {
880  cob_runtime_error ("%s", cob_resolve_error ());
881  cob_stop_run (1);
882 }
cob_resolve_error
const char * cob_resolve_error(void)
Definition: call.c:864
cob_runtime_error
void cob_runtime_error(const char *,...) COB_A_FORMAT12
Definition: common.c:1543
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

Here is the caller graph for this function:

void* cob_call_field ( const cob_field *  ,
const struct cob_call_struct *  ,
const unsigned  int,
const int   
)

Definition at line 957 of file call.c.

References cob_call_error(), cob_chk_call_path(), cob_call_struct::cob_cstr_call, cob_call_struct::cob_cstr_name, COB_EC_PROGRAM_NOT_FOUND, cob_fatal_error(), COB_FERROR_INITIALIZED, cob_field_to_string(), cob_free(), cob_get_buff(), cob_resolve_internal(), cob_set_exception(), cob_call_union::funcvoid, NULL, cob_field::size, system_table::syst_call, system_table::syst_name, and unlikely.

959 {
960  void *p;
961  const struct cob_call_struct *s;
962  const struct system_table *psyst;
963  char *buff;
964  char *entry;
965  char *dirent;
966 
967  if (unlikely(!cobglobptr)) {
968  cob_fatal_error (COB_FERROR_INITIALIZED);
969  }
970 
971  buff = cob_get_buff (f->size + 1);
972  cob_field_to_string (f, buff, f->size);
973 
974  entry = cob_chk_call_path (buff, &dirent);
975 
976  /* Check if system routine */
977  for (psyst = system_tab; psyst->syst_name; ++psyst) {
978  if (!strcmp (entry, psyst->syst_name)) {
979  if (dirent) {
980  cob_free (dirent);
981  }
982  return psyst->syst_call.funcvoid;
983  }
984  }
985 
986 
987  /* Check if contained program */
988  for (s = cs; s && s->cob_cstr_name; s++) {
989  if (!strcmp (entry, s->cob_cstr_name)) {
990  if (dirent) {
991  cob_free (dirent);
992  }
993  return s->cob_cstr_call.funcvoid;
994  }
995  }
996 
997  p = cob_resolve_internal (entry, dirent, fold_case);
998  if (dirent) {
999  cob_free (dirent);
1000  }
1001  if (unlikely(!p)) {
1002  if (errind) {
1003  cob_call_error ();
1004  } else {
1005  cob_set_exception (COB_EC_PROGRAM_NOT_FOUND);
1006  return NULL;
1007  }
1008  }
1009  return p;
1010 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_get_buff
static void * cob_get_buff(const size_t buffsize)
Definition: call.c:420
system_tab
static const struct system_table system_tab[]
Definition: call.c:186
cob_call_struct::cob_cstr_name
const char * cob_cstr_name
Definition: common.h:1021
cob_call_union::funcvoid
void * funcvoid
Definition: common.h:1010
cob_field_to_string
void cob_field_to_string(const cob_field *, void *, const size_t)
Definition: common.c:1492
cob_call_struct
Definition: common.h:1020
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
unlikely
#define unlikely(x)
Definition: common.h:437
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
system_table
Definition: codegen.c:65
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cobglobptr
static cob_global * cobglobptr
Definition: call.c:161
COB_FERROR_INITIALIZED
#define COB_FERROR_INITIALIZED
Definition: common.h:692
cob_call_error
void cob_call_error(void)
Definition: call.c:878
cob_chk_call_path
static char * cob_chk_call_path(const char *name, char **dirent)
Definition: call.c:825
system_table::syst_call
const char * syst_call
Definition: codegen.c:67
cob_resolve_internal
static void * cob_resolve_internal(const char *name, const char *dirent, const int fold_case)
Definition: call.c:599
system_table::syst_name
const char * syst_name
Definition: codegen.c:66
cob_call_struct::cob_cstr_call
cob_call_union cob_cstr_call
Definition: common.h:1022

Here is the call graph for this function:

void cob_cancel ( const char *  )

Definition at line 1013 of file call.c.

References _, call_table, cob_chk_dirp(), cob_fatal_error(), COB_FERROR_INITIALIZED, cob_runtime_error(), cob_stop_run(), do_cancel_module(), hash(), call_hash::name, call_hash::next, NULL, and unlikely.

Referenced by cob_cancel_field(), and cob_func().

1014 {
1015  const char *entry;
1016  struct call_hash *p;
1017  struct call_hash **q;
1018  struct call_hash *r;
1019 
1020  if (unlikely(!cobglobptr)) {
1021  cob_fatal_error (COB_FERROR_INITIALIZED);
1022  }
1023  if (unlikely(!name)) {
1024  cob_runtime_error (_("NULL parameter passed to '%s'"), "cob_cancel");
1025  cob_stop_run (1);
1026  }
1027  entry = cob_chk_dirp (name);
1028 
1029 #ifdef COB_ALT_HASH
1030  q = &call_table;
1031  p = *q;
1032 #else
1033  q = &call_table[hash ((const unsigned char *)entry)];
1034  p = *q;
1035 #endif
1036  r = NULL;
1037  for (; p; p = p->next) {
1038  if (strcmp (entry, p->name) == 0) {
1039  do_cancel_module (p, q, r);
1040  return;
1041  }
1042  r = p;
1043  }
1044 }
call_table
static struct call_hash ** call_table
Definition: call.c:155
hash
static COB_INLINE unsigned int hash(const unsigned char *s)
Definition: call.c:523
cob_chk_dirp
static const char * cob_chk_dirp(const char *name)
Definition: call.c:807
do_cancel_module
static void do_cancel_module(struct call_hash *p, struct call_hash **base_hash, struct call_hash *prev)
Definition: call.c:354
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
cob_runtime_error
void cob_runtime_error(const char *,...) COB_A_FORMAT12
Definition: common.c:1543
_
#define _(s)
Definition: cobcrun.c:59
call_hash::name
const char * name
Definition: call.c:131
unlikely
#define unlikely(x)
Definition: common.h:437
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
call_hash::next
struct call_hash * next
Definition: call.c:130
cobglobptr
static cob_global * cobglobptr
Definition: call.c:161
COB_FERROR_INITIALIZED
#define COB_FERROR_INITIALIZED
Definition: common.h:692
call_hash
Definition: call.c:129
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_cancel_field ( const cob_field *  ,
const struct cob_call_struct *   
)

Definition at line 1047 of file call.c.

References cob_cancel(), cob_chk_dirp(), cob_call_struct::cob_cstr_cancel, cob_call_struct::cob_cstr_name, cob_fatal_error(), COB_FERROR_INITIALIZED, cob_field_to_string(), cob_get_buff(), cob_call_union::funcint, cob_call_union::funcvoid, call_hash::name, NULL, cob_field::size, and unlikely.

1048 {
1049  char *name;
1050  const char *entry;
1051  const struct cob_call_struct *s;
1052 
1053  int (*cancel_func)(const int, void *, void *, void *, void *);
1054 
1055  if (unlikely(!cobglobptr)) {
1056  cob_fatal_error (COB_FERROR_INITIALIZED);
1057  }
1058  if (!f || f->size == 0) {
1059  return;
1060  }
1061  name = cob_get_buff (f->size + 1);
1062  cob_field_to_string (f, name, f->size);
1063  entry = cob_chk_dirp (name);
1064 
1065  /* Check if contained program */
1066  for (s = cs; s && s->cob_cstr_name; s++) {
1067  if (!strcmp (entry, s->cob_cstr_name)) {
1068  if (s->cob_cstr_cancel.funcvoid) {
1069  cancel_func = s->cob_cstr_cancel.funcint;
1070  (void)cancel_func (-1, NULL, NULL, NULL,
1071  NULL);
1072  }
1073  return;
1074  }
1075  }
1076  cob_cancel (entry);
1077 }
cob_get_buff
static void * cob_get_buff(const size_t buffsize)
Definition: call.c:420
cob_chk_dirp
static const char * cob_chk_dirp(const char *name)
Definition: call.c:807
cob_call_struct::cob_cstr_name
const char * cob_cstr_name
Definition: common.h:1021
cob_cancel
void cob_cancel(const char *name)
Definition: call.c:1013
cob_call_union::funcvoid
void * funcvoid
Definition: common.h:1010
cob_field_to_string
void cob_field_to_string(const cob_field *, void *, const size_t)
Definition: common.c:1492
cob_call_struct
Definition: common.h:1020
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
call_hash::name
const char * name
Definition: call.c:131
unlikely
#define unlikely(x)
Definition: common.h:437
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_call_union::funcint
int(* funcint)()
Definition: common.h:1009
cobglobptr
static cob_global * cobglobptr
Definition: call.c:161
COB_FERROR_INITIALIZED
#define COB_FERROR_INITIALIZED
Definition: common.h:692
cob_call_struct::cob_cstr_cancel
cob_call_union cob_cstr_cancel
Definition: common.h:1023

Here is the call graph for this function:

void cob_chain_setup ( void *  ,
const size_t  ,
const size_t   
)

Definition at line 3070 of file common.c.

References cob_argc, cob_argv, and __cob_global::cob_call_params.

3071 {
3072  size_t len;
3073 
3074  memset (data, ' ', size);
3075  if (parm <= (size_t)cob_argc - 1) {
3076  len = strlen (cob_argv[parm]);
3077  if (len <= size) {
3078  memcpy (data, cob_argv[parm], len);
3079  } else {
3080  memcpy (data, cob_argv[parm], size);
3081  }
3082  } else {
3083  memset (data, ' ', size);
3084  }
3085  cobglobptr->cob_call_params = cob_argc - 1;
3086 }
cob_argc
static int cob_argc
Definition: common.c:125
cob_argv
static char ** cob_argv
Definition: common.c:126
__cob_global::cob_call_params
int cob_call_params
Definition: common.h:1204
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130
void cob_check_based ( const unsigned char *  ,
const char *   
)

Definition at line 2525 of file common.c.

References _, cob_runtime_error(), and cob_stop_run().

2526 {
2527  if (!x) {
2528  /* name includes '' already and can be ... 'x' (addressed by 'y'= */
2529  cob_runtime_error (_("BASED/LINKAGE item %s has NULL address"), name);
2530  cob_stop_run (1);
2531  }
2532 }
_
#define _(s)
Definition: cobcrun.c:59
cob_runtime_error
void cob_runtime_error(const char *fmt,...)
Definition: common.c:1543
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

void cob_check_linkage ( const unsigned char *  ,
const char *  ,
const int   
)

Definition at line 2535 of file common.c.

References _, cob_runtime_error(), and cob_stop_run().

2536 {
2537  if (!x) {
2538  /* name includes '' already and can be ... 'x' of 'y' */
2539  switch(check_type) {
2540  case 0: /* check for passed items and size on module entry */
2541  cob_runtime_error (_("LINKAGE item %s not passed by caller"), name);
2542  break;
2543  case 1: /* check for passed OPTIONAL items on item use */
2544  cob_runtime_error (_("LINKAGE item %s not passed by caller"), name);
2545  break;
2546  }
2547  cob_stop_run (1);
2548  }
2549 }
_
#define _(s)
Definition: cobcrun.c:59
cob_runtime_error
void cob_runtime_error(const char *fmt,...)
Definition: common.c:1543
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

void cob_check_numeric ( const cob_field *  ,
const char *   
)

Definition at line 2552 of file common.c.

References _, cob_fast_malloc(), cob_free(), cob_is_numeric(), cob_runtime_error(), COB_SMALL_BUFF, cob_stop_run(), cob_field::data, and cob_field::size.

2553 {
2554  unsigned char *data;
2555  char *p;
2556  char *buff;
2557  size_t i;
2558 
2559  if (!cob_is_numeric (f)) {
2560  buff = cob_fast_malloc ((size_t)COB_SMALL_BUFF);
2561  p = buff;
2562  data = f->data;
2563  for (i = 0; i < f->size; ++i) {
2564  if (isprint (data[i])) {
2565  *p++ = data[i];
2566  } else {
2567  p += sprintf (p, "\\%03o", data[i]);
2568  }
2569  }
2570  *p = '\0';
2571  cob_runtime_error (_("'%s' not numeric: '%s'"), name, buff);
2572  cob_free (buff);
2573  cob_stop_run (1);
2574  }
2575 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_SMALL_BUFF
#define COB_SMALL_BUFF
Definition: common.h:540
_
#define _(s)
Definition: cobcrun.c:59
cob_fast_malloc
void * cob_fast_malloc(const size_t size)
Definition: common.c:1296
cob_runtime_error
void cob_runtime_error(const char *fmt,...)
Definition: common.c:1543
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524
cob_is_numeric
int cob_is_numeric(const cob_field *f)
Definition: common.c:2375

Here is the call graph for this function:

int cob_check_numval ( const cob_field *  ,
const cob_field *  ,
const int  ,
const int   
)

Definition at line 3132 of file intrinsic.c.

References COB_MAX_DIGITS, COB_MODULE_PTR, cob_field::data, NULL, and cob_field::size.

Referenced by cob_intr_test_numval(), cob_intr_test_numval_c(), numval(), and valid_field_data().

3134 {
3135  unsigned char *p;
3136  unsigned char *begp;
3137  unsigned char *endp;
3138  size_t pos;
3139  size_t plus_minus;
3140  size_t digits;
3141  size_t dec_seen;
3142  size_t space_seen;
3143  size_t break_needed;
3144  size_t currcy_size;
3145  int n;
3146  unsigned char dec_pt;
3147  unsigned char cur_symb;
3148 
3149  begp = NULL;
3150  currcy_size = 0;
3151  if (currency) {
3152  endp = NULL;
3153  p = currency->data;
3154  for (pos = 0; pos < currency->size; pos++, p++) {
3155  switch (*p) {
3156  case '0':
3157  case '1':
3158  case '2':
3159  case '3':
3160  case '4':
3161  case '5':
3162  case '6':
3163  case '7':
3164  case '8':
3165  case '9':
3166  case '+':
3167  case '-':
3168  case '.':
3169  case ',':
3170  case '*':
3171  return 1;
3172  case ' ':
3173  break;
3174  default:
3175  if (pos < currency->size - 1) {
3176  if (!memcmp (p, "CR", (size_t)2)) {
3177  return 1;
3178  }
3179  if (!memcmp (p, "DB", (size_t)2)) {
3180  return 1;
3181  }
3182  }
3183  if (!begp) {
3184  begp = p;
3185  }
3186  endp = p;
3187  break;
3188  }
3189  }
3190  if (!begp) {
3191  return 1;
3192  }
3193  currcy_size = endp - begp;
3194  currcy_size++;
3195  if (currcy_size >= srcfield->size) {
3196  begp = NULL;
3197  currcy_size = 0;
3198  }
3199  } else if (chkcurr) {
3200  cur_symb = COB_MODULE_PTR->currency_symbol;
3201  begp = &cur_symb;
3202  currcy_size = 1;
3203  }
3204 
3205  if (!srcfield->size) {
3206  return 1;
3207  }
3208 
3209  p = srcfield->data;
3210  plus_minus = 0;
3211  digits = 0;
3212  dec_seen = 0;
3213  space_seen = 0;
3214  break_needed = 0;
3215  dec_pt = COB_MODULE_PTR->decimal_point;
3216 
3217  /* Check leading positions */
3218  for (n = 0; n < (int)srcfield->size; ++n, ++p) {
3219  switch (*p) {
3220  case '0':
3221  case '1':
3222  case '2':
3223  case '3':
3224  case '4':
3225  case '5':
3226  case '6':
3227  case '7':
3228  case '8':
3229  case '9':
3230  break_needed = 1;
3231  break;
3232  case ' ':
3233  continue;
3234  case '+':
3235  case '-':
3236  if (plus_minus) {
3237  return n + 1;
3238  }
3239  plus_minus = 1;
3240  continue;
3241  case ',':
3242  case '.':
3243  if (*p != dec_pt) {
3244  return n + 1;
3245  }
3246  break_needed = 1;
3247  break;
3248  default:
3249  if (begp && n < (int)(srcfield->size - currcy_size)) {
3250  if (!memcmp (p, begp, currcy_size)) {
3251  break;
3252  }
3253  }
3254  return n + 1;
3255  }
3256  if (break_needed) {
3257  break;
3258  }
3259  }
3260 
3261  if (n == (int)srcfield->size) {
3262  return n + 1;
3263  }
3264 
3265  for (; n < (int)srcfield->size; ++n, ++p) {
3266  switch (*p) {
3267  case '0':
3268  case '1':
3269  case '2':
3270  case '3':
3271  case '4':
3272  case '5':
3273  case '6':
3274  case '7':
3275  case '8':
3276  case '9':
3277  if (++digits > COB_MAX_DIGITS || space_seen) {
3278  return n + 1;
3279  }
3280  continue;
3281  case ',':
3282  case '.':
3283  if (dec_seen || space_seen) {
3284  return n + 1;
3285  }
3286  if (*p == dec_pt) {
3287  dec_seen = 1;
3288  } else if (!chkcurr) {
3289  return n + 1;
3290  }
3291  continue;
3292  case ' ':
3293  space_seen = 1;
3294  continue;
3295  case '+':
3296  case '-':
3297  if (plus_minus) {
3298  return n + 1;
3299  }
3300  plus_minus = 1;
3301  continue;
3302  case 'c':
3303  if (!anycase) {
3304  return n + 1;
3305  }
3306  /* Fall through */
3307  case 'C':
3308  if (plus_minus) {
3309  return n + 1;
3310  }
3311  if (n < (int)srcfield->size - 1) {
3312  if (*(p + 1) == 'R' ||
3313  (anycase && *(p + 1) == 'r')) {
3314  plus_minus = 1;
3315  p++;
3316  n++;
3317  continue;
3318  }
3319  }
3320  return n + 2;
3321  case 'd':
3322  if (!anycase) {
3323  return n + 1;
3324  }
3325  /* Fall through */
3326  case 'D':
3327  if (plus_minus) {
3328  return n + 1;
3329  }
3330  if (n < (int)srcfield->size - 1) {
3331  if (*(p + 1) == 'B' ||
3332  (anycase && *(p + 1) == 'b')) {
3333  plus_minus = 1;
3334  p++;
3335  n++;
3336  continue;
3337  }
3338  }
3339  return n + 2;
3340  default:
3341  return n + 1;
3342  }
3343  }
3344 
3345  if (!digits) {
3346  return n + 1;
3347  }
3348 
3349  return 0;
3350 }
COB_MAX_DIGITS
#define COB_MAX_DIGITS
Definition: common.h:562
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185

Here is the caller graph for this function:

void cob_check_odo ( const int  ,
const int  ,
const int  ,
const char *   
)

Definition at line 2578 of file common.c.

References _, COB_EC_BOUND_ODO, cob_runtime_error(), cob_set_exception(), and cob_stop_run().

2580 {
2581  /* Check OCCURS DEPENDING ON item */
2582  if (i < min || max < i) {
2583  cob_set_exception (COB_EC_BOUND_ODO);
2584  cob_runtime_error (_("OCCURS DEPENDING ON '%s' out of bounds: %d"), name, i);
2585  cob_stop_run (1);
2586  }
2587 }
_
#define _(s)
Definition: cobcrun.c:59
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_runtime_error
void cob_runtime_error(const char *fmt,...)
Definition: common.c:1543
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

void cob_check_ref_mod ( const int  ,
const int  ,
const int  ,
const char *   
)

Definition at line 2602 of file common.c.

References _, COB_EC_BOUND_REF_MOD, cob_runtime_error(), cob_set_exception(), and cob_stop_run().

2604 {
2605  /* Check offset */
2606  if (offset < 1 || offset > size) {
2607  cob_set_exception (COB_EC_BOUND_REF_MOD);
2608  cob_runtime_error (_("Offset of '%s' out of bounds: %d"), name, offset);
2609  cob_stop_run (1);
2610  }
2611 
2612  /* Check length */
2613  if (length < 1 || offset + length - 1 > size) {
2614  cob_set_exception (COB_EC_BOUND_REF_MOD);
2615  cob_runtime_error (_("Length of '%s' out of bounds: %d"), name, length);
2616  cob_stop_run (1);
2617  }
2618 }
_
#define _(s)
Definition: cobcrun.c:59
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_runtime_error
void cob_runtime_error(const char *fmt,...)
Definition: common.c:1543
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

void cob_check_subscript ( const int  ,
const int  ,
const int  ,
const char *   
)

Definition at line 2590 of file common.c.

References _, COB_EC_BOUND_SUBSCRIPT, cob_runtime_error(), cob_set_exception(), and cob_stop_run().

2592 {
2593  /* Check subscript */
2594  if (i < min || max < i) {
2595  cob_set_exception (COB_EC_BOUND_SUBSCRIPT);
2596  cob_runtime_error (_("Subscript of '%s' out of bounds: %d"), name, i);
2597  cob_stop_run (1);
2598  }
2599 }
_
#define _(s)
Definition: cobcrun.c:59
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_runtime_error
void cob_runtime_error(const char *fmt,...)
Definition: common.c:1543
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

void cob_check_version ( const char *  ,
const char *  ,
const int   
)

Definition at line 1894 of file common.c.

References _, cob_runtime_error(), cob_stop_run(), PACKAGE_VERSION, and PATCH_LEVEL.

Referenced by CHECKSRC_(), cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

1895 {
1896  if (strcmp (packver, PACKAGE_VERSION) || patchlev != PATCH_LEVEL) {
1897  cob_runtime_error (_("Error - Version mismatch"));
1898  cob_runtime_error (_("%s has version/patch level %s/%d"), prog,
1899  packver, patchlev);
1900  cob_runtime_error (_("Library has version/patch level %s/%d"),
1901  PACKAGE_VERSION, PATCH_LEVEL);
1902  cob_stop_run (1);
1903  }
1904 }
_
#define _(s)
Definition: cobcrun.c:59
PACKAGE_VERSION
#define PACKAGE_VERSION
Definition: config.h:312
PATCH_LEVEL
#define PATCH_LEVEL
Definition: config.h:315
cob_runtime_error
void cob_runtime_error(const char *fmt,...)
Definition: common.c:1543
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_close ( cob_file *  ,
cob_field *  ,
const int  ,
const int   
)

Definition at line 4498 of file fileio.c.

References cob_fileio_funcs::close, COB_CLOSE_LOCK, COB_FILE_SPECIAL, cob_free(), COB_LOCK_OPEN_EXCLUSIVE, COB_OPEN_CLOSED, COB_OPEN_LOCKED, COB_STATUS_00_SUCCESS, COB_STATUS_42_NOT_OPEN, cob_file::fd, file_list::file, cob_file::file, file_cache, cob_file::flag_nonexistent, cob_file::flag_operation, cob_file::flag_read_done, cob_file::lock_mode, file_list::next, NULL, cob_file::open_mode, cob_file::organization, save_status(), and unlikely.

Referenced by cob_exit_fileio(), cob_file_sort_giving(), cob_file_sort_using(), cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

4499 {
4500  struct file_list *l;
4501  struct file_list *m;
4502  int ret;
4503 
4504  f->flag_read_done = 0;
4505  f->flag_operation = 0;
4506 
4507  f->lock_mode &= ~COB_LOCK_OPEN_EXCLUSIVE;
4508 
4509  if (COB_FILE_SPECIAL (f)) {
4510  f->open_mode = COB_OPEN_CLOSED;
4511  f->file = NULL;
4512  f->fd = -1;
4513  save_status (f, fnstatus, COB_STATUS_00_SUCCESS);
4514  return;
4515  }
4516 
4517  if (unlikely(remfil)) {
4518  /* Remove from cache - Needed for CANCEL */
4519  /* Setting m silences false compiler warning */
4520  m = file_cache;
4521  for (l = file_cache; l; l = l->next) {
4522  if (f == l->file) {
4523  if (l == file_cache) {
4524  file_cache = l->next;
4525  } else {
4526  m->next = l->next;
4527  }
4528  cob_free (l);
4529  break;
4530  }
4531  m = l;
4532  }
4533  }
4534 
4535  if (f->open_mode == COB_OPEN_CLOSED) {
4536  save_status (f, fnstatus, COB_STATUS_42_NOT_OPEN);
4537  return;
4538  }
4539 
4540  if (f->flag_nonexistent) {
4541  ret = COB_STATUS_00_SUCCESS;
4542  } else {
4543  ret = fileio_funcs[(int)f->organization]->close (f, opt);
4544  }
4545 
4546  if (ret == COB_STATUS_00_SUCCESS) {
4547  switch (opt) {
4548  case COB_CLOSE_LOCK:
4549  f->open_mode = COB_OPEN_LOCKED;
4550  break;
4551  default:
4552  f->open_mode = COB_OPEN_CLOSED;
4553  break;
4554  }
4555  }
4556 
4557  save_status (f, fnstatus, ret);
4558 }
COB_STATUS_42_NOT_OPEN
#define COB_STATUS_42_NOT_OPEN
Definition: common.h:847
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
file_cache
static struct file_list * file_cache
Definition: fileio.c:241
COB_FILE_SPECIAL
#define COB_FILE_SPECIAL(x)
Definition: common.h:765
COB_STATUS_00_SUCCESS
#define COB_STATUS_00_SUCCESS
Definition: common.h:828
COB_OPEN_CLOSED
#define COB_OPEN_CLOSED
Definition: common.h:783
file_list
Definition: fileio.c:155
unlikely
#define unlikely(x)
Definition: common.h:437
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
save_status
static void save_status(cob_file *f, cob_field *fnstatus, const int status)
Definition: fileio.c:668
COB_OPEN_LOCKED
#define COB_OPEN_LOCKED
Definition: common.h:788
COB_CLOSE_LOCK
#define COB_CLOSE_LOCK
Definition: common.h:793
cob_fileio_funcs::close
int(* close)(cob_file *, const int)
Definition: common.h:1225
file_list::next
struct file_list * next
Definition: fileio.c:156
fileio_funcs
static const struct cob_fileio_funcs * fileio_funcs[COB_ORG_MAX]
Definition: fileio.c:339
file_list::file
cob_file * file
Definition: fileio.c:157
COB_LOCK_OPEN_EXCLUSIVE
#define COB_LOCK_OPEN_EXCLUSIVE
Definition: common.h:777

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_cmp ( cob_field *  ,
cob_field *   
)

Definition at line 2318 of file common.c.

References cob_field::attr, cob_cmp_all(), cob_cmp_alnum(), cob_cmp_int(), COB_FIELD_DIGITS, COB_FIELD_IS_NUMERIC, COB_FIELD_TYPE, COB_FLAG_HAVE_SIGN, cob_move(), cob_numeric_cmp(), COB_TYPE_ALPHANUMERIC_ALL, COB_TYPE_NUMERIC_DISPLAY, cob_field::data, cob_field_attr::flags, cob_field::size, and cob_field_attr::type.

Referenced by cob_intr_max(), cob_intr_min(), cob_intr_ord_max(), cob_intr_ord_min(), cobxref_(), comp_field(), GCic_(), get__reserved__lists_(), get_min_and_max_of_args(), and LISTING_().

2319 {
2320  cob_field temp;
2321  cob_field_attr attr;
2322  unsigned char buff[256];
2323 
2324  if (COB_FIELD_IS_NUMERIC (f1) && COB_FIELD_IS_NUMERIC (f2)) {
2325  return cob_numeric_cmp (f1, f2);
2326  }
2327  if (COB_FIELD_TYPE (f2) == COB_TYPE_ALPHANUMERIC_ALL) {
2328  if (f2->size == 1 && f2->data[0] == '0' &&
2329  COB_FIELD_IS_NUMERIC (f1)) {
2330  return cob_cmp_int (f1, 0);
2331  }
2332  return cob_cmp_all (f1, f2);
2333  }
2334  if (COB_FIELD_TYPE (f1) == COB_TYPE_ALPHANUMERIC_ALL) {
2335  if (f1->size == 1 && f1->data[0] == '0' &&
2336  COB_FIELD_IS_NUMERIC (f2)) {
2337  return -cob_cmp_int (f2, 0);
2338  }
2339  return -cob_cmp_all (f2, f1);
2340  }
2341  if (COB_FIELD_IS_NUMERIC (f1) &&
2342  COB_FIELD_TYPE (f1) != COB_TYPE_NUMERIC_DISPLAY) {
2343  temp.size = COB_FIELD_DIGITS(f1);
2344  temp.data = buff;
2345  temp.attr = &attr;
2346  attr = *f1->attr;
2347  attr.type = COB_TYPE_NUMERIC_DISPLAY;
2348  attr.flags &= ~COB_FLAG_HAVE_SIGN;
2349  cob_move (f1, &temp);
2350  f1 = &temp;
2351  }
2352  if (COB_FIELD_IS_NUMERIC (f2) &&
2353  COB_FIELD_TYPE (f2) != COB_TYPE_NUMERIC_DISPLAY) {
2354  temp.size = COB_FIELD_DIGITS(f2);
2355  temp.data = buff;
2356  temp.attr = &attr;
2357  attr = *f2->attr;
2358  attr.type = COB_TYPE_NUMERIC_DISPLAY;
2359  attr.flags &= ~COB_FLAG_HAVE_SIGN;
2360  cob_move (f2, &temp);
2361  f2 = &temp;
2362  }
2363  return cob_cmp_alnum (f1, f2);
2364 }
COB_FIELD_IS_NUMERIC
#define COB_FIELD_IS_NUMERIC(f)
Definition: common.h:674
cob_move
void cob_move(cob_field *, cob_field *)
Definition: move.c:1170
COB_FIELD_TYPE
#define COB_FIELD_TYPE(f)
Definition: common.h:662
f2
cob_field f2
Definition: cobxref.c.l.h:55
cob_field
Definition: common.h:950
cob_field_attr::flags
unsigned short flags
Definition: common.h:944
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FLAG_HAVE_SIGN
#define COB_FLAG_HAVE_SIGN
Definition: common.h:630
cob_cmp_int
int cob_cmp_int(cob_field *, const int)
Definition: numeric.c:2257
cob_numeric_cmp
int cob_numeric_cmp(cob_field *, cob_field *)
Definition: numeric.c:2348
f1
cob_field f1
Definition: cobxref.c.l.h:54
COB_TYPE_NUMERIC_DISPLAY
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
COB_TYPE_ALPHANUMERIC_ALL
#define COB_TYPE_ALPHANUMERIC_ALL
Definition: common.h:622
cob_field_attr
Definition: common.h:940
cob_field::size
size_t size
Definition: common.h:951
cob_field::attr
const cob_field_attr * attr
Definition: common.h:953
cob_cmp_alnum
static int cob_cmp_alnum(cob_field *f1, cob_field *f2)
Definition: common.c:982
cob_field_attr::type
unsigned short type
Definition: common.h:941
cob_cmp_all
static int cob_cmp_all(cob_field *f1, cob_field *f2)
Definition: common.c:946
COB_FIELD_DIGITS
#define COB_FIELD_DIGITS(f)
Definition: common.h:663

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_cmp_float ( cob_field *  ,
cob_field *   
)

Definition at line 2315 of file numeric.c.

References cob_decimal_get_double(), cob_decimal_set_field(), COB_FIELD_TYPE, COB_TYPE_NUMERIC_DOUBLE, COB_TYPE_NUMERIC_FLOAT, d1, d2, cob_field::data, FLOAT_EQ, and TOLERANCE.

Referenced by cob_numeric_cmp().

2316 {
2317  double d1,d2;
2318  float flt;
2319  if(COB_FIELD_TYPE (f1) == COB_TYPE_NUMERIC_FLOAT) {
2320  memcpy(&flt,f1->data,sizeof(float));
2321  d1 = flt;
2322  } else if(COB_FIELD_TYPE (f1) == COB_TYPE_NUMERIC_DOUBLE) {
2323  memcpy(&d1,f1->data,sizeof(double));
2324  } else {
2325  cob_decimal_set_field (&cob_d1, f1);
2326  d1 = cob_decimal_get_double(&cob_d1);
2327  }
2328  if(COB_FIELD_TYPE (f2) == COB_TYPE_NUMERIC_FLOAT) {
2329  memcpy(&flt,f2->data,sizeof(float));
2330  d2 = flt;
2331  } else if(COB_FIELD_TYPE (f2) == COB_TYPE_NUMERIC_DOUBLE) {
2332  memcpy(&d2,f2->data,sizeof(double));
2333  } else {
2334  cob_decimal_set_field (&cob_d1, f2);
2335  d2 = cob_decimal_get_double(&cob_d1);
2336  }
2337  if(d1 == d2)
2338  return 0;
2339  if(d1 != 0.0
2340  && FLOAT_EQ(d1,d2,TOLERANCE))
2341  return 0;
2342  if(d1 < d2)
2343  return -1;
2344  return 1;
2345 }
d2
static cob_decimal d2
Definition: intrinsic.c:80
COB_FIELD_TYPE
#define COB_FIELD_TYPE(f)
Definition: common.h:662
cob_decimal_get_double
static double cob_decimal_get_double(cob_decimal *d)
Definition: numeric.c:877
f2
cob_field f2
Definition: cobxref.c.l.h:55
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *d, cob_field *f)
Definition: numeric.c:1612
d1
cob_decimal * d1
Definition: cobxref.c.l.h:21
cob_field::data
unsigned char * data
Definition: common.h:952
TOLERANCE
#define TOLERANCE
Definition: numeric.c:2310
COB_TYPE_NUMERIC_FLOAT
#define COB_TYPE_NUMERIC_FLOAT
Definition: common.h:610
FLOAT_EQ
#define FLOAT_EQ(x, y, t)
Definition: numeric.c:2312
f1
cob_field f1
Definition: cobxref.c.l.h:54
COB_TYPE_NUMERIC_DOUBLE
#define COB_TYPE_NUMERIC_DOUBLE
Definition: common.h:611
cob_d1
static cob_decimal cob_d1
Definition: numeric.c:108

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_cmp_int ( cob_field *  ,
const int   
)

Definition at line 2257 of file numeric.c.

References cob_decimal_cmp(), cob_decimal_set_field(), cob_sli_t, cob_decimal::scale, and cob_decimal::value.

Referenced by cob_cmp().

2258 {
2259  cob_decimal_set_field (&cob_d1, f1);
2260  mpz_set_si (cob_d2.value, (cob_sli_t)n);
2261  cob_d2.scale = 0;
2262  return cob_decimal_cmp (&cob_d1, &cob_d2);
2263 }
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *d, cob_field *f)
Definition: numeric.c:1612
cob_decimal_cmp
int cob_decimal_cmp(cob_decimal *d1, cob_decimal *d2)
Definition: numeric.c:1922
f1
cob_field f1
Definition: cobxref.c.l.h:54
cob_sli_t
#define cob_sli_t
Definition: common.h:32
cob_d2
static cob_decimal cob_d2
Definition: numeric.c:109
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_d1
static cob_decimal cob_d1
Definition: numeric.c:108
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_cmp_llint ( cob_field *  ,
const long  long 
)
int cob_cmp_numdisp ( const unsigned char *  ,
const size_t  ,
const long  long,
const unsigned  int 
)

Referenced by cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

Here is the caller graph for this function:

int cob_cmp_packed ( cob_field *  ,
const long  long 
)
int cob_cmp_uint ( cob_field *  ,
const unsigned  int 
)

Definition at line 2266 of file numeric.c.

References cob_decimal_cmp(), cob_decimal_set_field(), cob_uli_t, cob_decimal::scale, and cob_decimal::value.

2267 {
2268  cob_decimal_set_field (&cob_d1, f1);
2269  mpz_set_ui (cob_d2.value, (cob_uli_t)n);
2270  cob_d2.scale = 0;
2271  return cob_decimal_cmp (&cob_d1, &cob_d2);
2272 }
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *d, cob_field *f)
Definition: numeric.c:1612
cob_decimal_cmp
int cob_decimal_cmp(cob_decimal *d1, cob_decimal *d2)
Definition: numeric.c:1922
cob_uli_t
#define cob_uli_t
Definition: common.h:33
f1
cob_field f1
Definition: cobxref.c.l.h:54
cob_d2
static cob_decimal cob_d2
Definition: numeric.c:109
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_d1
static cob_decimal cob_d1
Definition: numeric.c:108
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

void* cob_command_line ( int  ,
int *  ,
char ***  ,
char ***  ,
char **   
)

Definition at line 3279 of file common.c.

References _, cob_argc, cob_argv, cob_initialized, cob_runtime_error(), cob_stop_run(), COB_UNUSED, and NULL.

3281 {
3282 #if 0 /* RXWRXW cob_command_line */
3283  char **spenvp;
3284  char *spname;
3285 #else
3286  COB_UNUSED (penvp);
3287  COB_UNUSED (pname);
3288 #endif
3289 
3290  COB_UNUSED (flags);
3291 
3292  if (!cob_initialized) {
3293  cob_runtime_error (_("'cobcommandline' - Runtime has not been initialized"));
3294  cob_stop_run (1);
3295  }
3296  if (pargc && pargv) {
3297  cob_argc = *pargc;
3298  cob_argv = *pargv;
3299  }
3300 
3301 #if 0 /* RXWRXW cob_command_line */
3302  if (penvp) {
3303  spenvp = *penvp;
3304  }
3305  if (pname) {
3306  spname = *pname;
3307  }
3308 #endif
3309 
3310  /* What are we supposed to return here? */
3311  return NULL;
3312 }
cob_argc
static int cob_argc
Definition: common.c:125
cob_argv
static char ** cob_argv
Definition: common.c:126
_
#define _(s)
Definition: cobcrun.c:59
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_initialized
static int cob_initialized
Definition: common.c:124
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535
cob_runtime_error
void cob_runtime_error(const char *fmt,...)
Definition: common.c:1543
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

void cob_commit ( void  )

Definition at line 4851 of file fileio.c.

References cob_file_unlock(), file_list::file, and file_list::next.

4852 {
4853  struct file_list *l;
4854 
4855  for (l = file_cache; l; l = l->next) {
4856  if (l->file) {
4857  cob_file_unlock (l->file);
4858  }
4859  }
4860 }
file_cache
static struct file_list * file_cache
Definition: fileio.c:241
file_list
Definition: fileio.c:155
file_list::next
struct file_list * next
Definition: fileio.c:156
file_list::file
cob_file * file
Definition: fileio.c:157
cob_file_unlock
static void cob_file_unlock(cob_file *f)
Definition: fileio.c:4366

Here is the call graph for this function:

void cob_correct_numeric ( cob_field *  )

Definition at line 1917 of file common.c.

References COB_FIELD_HAVE_SIGN, COB_FIELD_IS_NUMDISP, COB_FIELD_SIGN_LEADING, COB_FIELD_SIGN_SEPARATE, COB_MODULE_PTR, cob_field::data, cob_func_loc::data, cob_field::size, and unlikely.

1918 {
1919  unsigned char *p;
1920  unsigned char *data;
1921  size_t size;
1922  size_t i;
1923 
1924  if (!COB_FIELD_IS_NUMDISP(f)) {
1925  return;
1926  }
1927  size = f->size;
1928  data = f->data;
1929  if (COB_FIELD_HAVE_SIGN (f)) {
1930  /* Adjust for sign byte */
1931  size--;
1932  if (unlikely(COB_FIELD_SIGN_LEADING (f))) {
1933  p = f->data;
1934  data = p + 1;
1935  } else {
1936  p = f->data + f->size - 1;
1937  }
1938  if (unlikely(COB_FIELD_SIGN_SEPARATE (f))) {
1939  if (*p != '+' && *p != '-') {
1940  *p = '+';
1941  }
1942  } else if (unlikely(COB_MODULE_PTR->ebcdic_sign)) {
1943  switch (*p) {
1944  case '{':
1945  case 'A':
1946  case 'B':
1947  case 'C':
1948  case 'D':
1949  case 'E':
1950  case 'F':
1951  case 'G':
1952  case 'H':
1953  case 'I':
1954  case '}':
1955  case 'J':
1956  case 'K':
1957  case 'L':
1958  case 'M':
1959  case 'N':
1960  case 'O':
1961  case 'P':
1962  case 'Q':
1963  case 'R':
1964  break;
1965  case '0':
1966  *p = '{';
1967  break;
1968  case '1':
1969  *p = 'A';
1970  break;
1971  case '2':
1972  *p = 'B';
1973  break;
1974  case '3':
1975  *p = 'C';
1976  break;
1977  case '4':
1978  *p = 'D';
1979  break;
1980  case '5':
1981  *p = 'E';
1982  break;
1983  case '6':
1984  *p = 'F';
1985  break;
1986  case '7':
1987  *p = 'G';
1988  break;
1989  case '8':
1990  *p = 'H';
1991  break;
1992  case '9':
1993  *p = 'I';
1994  break;
1995  case 0:
1996  case ' ':
1997  *p = '{';
1998  break;
1999  default:
2000  break;
2001  }
2002  } else {
2003  if(!*p || *p == ' ') {
2004  *p = '0';
2005  }
2006  }
2007  } else {
2008  p = f->data + f->size - 1;
2009  if (unlikely(COB_MODULE_PTR->ebcdic_sign)) {
2010  switch (*p) {
2011  case 0:
2012  case ' ':
2013  case '{':
2014  case '}':
2015  *p = '0';
2016  break;
2017  case 'A':
2018  case 'B':
2019  case 'C':
2020  case 'D':
2021  case 'E':
2022  case 'F':
2023  case 'G':
2024  case 'H':
2025  case 'I':
2026  *p = '1' + (*p - 'A');
2027  break;
2028  case 'J':
2029  case 'K':
2030  case 'L':
2031  case 'M':
2032  case 'N':
2033  case 'O':
2034  case 'P':
2035  case 'Q':
2036  case 'R':
2037  *p = '1' + (*p - 'J');
2038  break;
2039  default:
2040  break;
2041  }
2042  } else {
2043  switch (*p) {
2044  case 0:
2045  case ' ':
2046  case 'p':
2047  *p = '0';
2048  break;
2049  case 'q':
2050  *p = '1';
2051  break;
2052  case 'r':
2053  *p = '2';
2054  break;
2055  case 's':
2056  *p = '3';
2057  break;
2058  case 't':
2059  *p = '4';
2060  break;
2061  case 'u':
2062  *p = '5';
2063  break;
2064  case 'v':
2065  *p = '6';
2066  break;
2067  case 'w':
2068  *p = '7';
2069  break;
2070  case 'x':
2071  *p = '8';
2072  break;
2073  case 'y':
2074  *p = '9';
2075  break;
2076  default:
2077  break;
2078  }
2079  }
2080  }
2081  for (i = 0, p = data; i < size; ++i, ++p) {
2082  switch (*p) {
2083  case '0':
2084  case '1':
2085  case '2':
2086  case '3':
2087  case '4':
2088  case '5':
2089  case '6':
2090  case '7':
2091  case '8':
2092  case '9':
2093  break;
2094  case 0:
2095  case ' ':
2096  *p = '0';
2097  break;
2098  default:
2099  if ((*p & 0x0F) <= 9) {
2100  *p = (*p & 0x0F) + '0';
2101  }
2102  break;
2103  }
2104  }
2105 }
COB_FIELD_IS_NUMDISP
#define COB_FIELD_IS_NUMDISP(f)
Definition: common.h:675
COB_FIELD_SIGN_SEPARATE
#define COB_FIELD_SIGN_SEPARATE(f)
Definition: common.h:644
unlikely
#define unlikely(x)
Definition: common.h:437
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_FIELD_HAVE_SIGN
#define COB_FIELD_HAVE_SIGN(f)
Definition: common.h:643
COB_FIELD_SIGN_LEADING
#define COB_FIELD_SIGN_LEADING(f)
Definition: common.h:645
void cob_decimal_add ( cob_decimal *  ,
cob_decimal *   
)

Definition at line 1875 of file numeric.c.

References align_decimal(), DECIMAL_CHECK, and cob_decimal::value.

Referenced by calc_mean_of_args(), calc_variance_of_args(), cob_add(), cob_intr_annuity(), cob_intr_binop(), cob_intr_combined_datetime(), cob_intr_mean(), cob_intr_median(), cob_intr_midrange(), cob_intr_present_value(), cob_intr_sum(), cobxref_(), and seconds_from_formatted_time().

1876 {
1877  DECIMAL_CHECK (d1, d2);
1878  align_decimal (d1, d2);
1879  mpz_add (d1->value, d1->value, d2->value);
1880 }
d2
static cob_decimal d2
Definition: intrinsic.c:80
d1
cob_decimal * d1
Definition: cobxref.c.l.h:21
DECIMAL_CHECK
#define DECIMAL_CHECK(d1, d2)
Definition: numeric.c:47
align_decimal
static void align_decimal(cob_decimal *d1, cob_decimal *d2)
Definition: numeric.c:411
cob_decimal::value
mpz_t value
Definition: common.h:985

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_decimal_alloc ( const unsigned  int,
  ... 
)

Referenced by cobxref_(), and LISTING_().

Here is the caller graph for this function:

int cob_decimal_cmp ( cob_decimal *  ,
cob_decimal *   
)

Definition at line 1922 of file numeric.c.

References align_decimal(), and cob_decimal::value.

Referenced by cob_cmp_int(), cob_cmp_llint(), cob_cmp_uint(), cob_intr_acos(), cob_intr_asin(), cob_numeric_cmp(), and valid_decimal_time().

1923 {
1924  align_decimal (d1, d2);
1925  return mpz_cmp (d1->value, d2->value);
1926 }
d2
static cob_decimal d2
Definition: intrinsic.c:80
d1
cob_decimal * d1
Definition: cobxref.c.l.h:21
align_decimal
static void align_decimal(cob_decimal *d1, cob_decimal *d2)
Definition: numeric.c:411
cob_decimal::value
mpz_t value
Definition: common.h:985

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_decimal_div ( cob_decimal *  ,
cob_decimal *   
)

Definition at line 1899 of file numeric.c.

References COB_DECIMAL_NAN, COB_EC_SIZE_ZERO_DIVIDE, COB_MAX_DIGITS, cob_set_exception(), DECIMAL_CHECK, cob_decimal::scale, shift_decimal(), unlikely, and cob_decimal::value.

Referenced by calc_mean_of_args(), calc_variance_of_args(), cob_decimal_pow(), cob_div(), cob_div_quotient(), cob_intr_annuity(), cob_intr_binop(), cob_intr_combined_datetime(), cob_intr_mean(), cob_intr_median(), cob_intr_midrange(), cob_intr_present_value(), and cob_mod_or_rem().

1900 {
1901  DECIMAL_CHECK (d1, d2);
1902 
1903  /* Check for division by zero */
1904  if (unlikely(mpz_sgn (d2->value) == 0)) {
1905  d1->scale = COB_DECIMAL_NAN;
1906  cob_set_exception (COB_EC_SIZE_ZERO_DIVIDE);
1907  return;
1908  }
1909  if (unlikely(mpz_sgn (d1->value) == 0)) {
1910  d1->scale = 0;
1911  return;
1912  }
1913  d1->scale -= d2->scale;
1914  shift_decimal (d1, COB_MAX_DIGITS + ((d1->scale < 0) ? -d1->scale : 0));
1915 #if 0 /* RXWRXW - cdiv */
1916  mpz_cdiv_q (d1->value, d1->value, d2->value);
1917 #endif
1918  mpz_tdiv_q (d1->value, d1->value, d2->value);
1919 }
COB_DECIMAL_NAN
#define COB_DECIMAL_NAN
Definition: coblocal.h:80
d2
static cob_decimal d2
Definition: intrinsic.c:80
shift_decimal
static void shift_decimal(cob_decimal *d, const int n)
Definition: numeric.c:394
d1
cob_decimal * d1
Definition: cobxref.c.l.h:21
COB_MAX_DIGITS
#define COB_MAX_DIGITS
Definition: common.h:562
unlikely
#define unlikely(x)
Definition: common.h:437
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
DECIMAL_CHECK
#define DECIMAL_CHECK(d1, d2)
Definition: numeric.c:47
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_decimal_get_field ( cob_decimal *  ,
cob_field *  ,
const int   
)

Definition at line 1801 of file numeric.c.

References cob_field::attr, COB_ATTR_INIT, cob_d1, cob_decimal_do_round(), cob_decimal_get_binary(), cob_decimal_get_display(), cob_decimal_get_double(), cob_decimal_get_ieee128dec(), cob_decimal_get_ieee64dec(), cob_decimal_get_packed(), COB_DECIMAL_NAN, COB_EC_SIZE_OVERFLOW, __cob_global::cob_exception_code, COB_FIELD_DIGITS, COB_FIELD_IS_FP, COB_FIELD_SCALE, COB_FIELD_TYPE, COB_FLAG_HAVE_SIGN, cob_free(), cob_malloc(), cob_move(), cob_set_exception(), COB_STORE_ROUND, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_DOUBLE, COB_TYPE_NUMERIC_FLOAT, COB_TYPE_NUMERIC_FP_DEC128, COB_TYPE_NUMERIC_FP_DEC64, COB_TYPE_NUMERIC_PACKED, cob_field::data, NULL, cob_decimal::scale, shift_decimal(), cob_field::size, unlikely, and cob_decimal::value.

Referenced by cob_add(), cob_add_int(), cob_decimal_move_temp(), cob_decimal_setget_fld(), cob_div(), cob_div_quotient(), cob_div_remainder(), cob_intr_abs(), cob_intr_acos(), cob_intr_annuity(), cob_intr_asin(), cob_intr_atan(), cob_intr_binop(), cob_intr_combined_datetime(), cob_intr_cos(), cob_intr_e(), cob_intr_exp(), cob_intr_exp10(), cob_intr_factorial(), cob_intr_fraction_part(), cob_intr_highest_algebraic(), cob_intr_integer(), cob_intr_integer_part(), cob_intr_log(), cob_intr_log10(), cob_intr_lowest_algebraic(), cob_intr_mean(), cob_intr_median(), cob_intr_midrange(), cob_intr_numval_f(), cob_intr_pi(), cob_intr_present_value(), cob_intr_range(), cob_intr_seconds_from_formatted_time(), cob_intr_sin(), cob_intr_sqrt(), cob_intr_standard_deviation(), cob_intr_sum(), cob_intr_tan(), cob_intr_variance(), cob_mod_or_rem(), cob_mul(), cob_sub(), cobxref_(), LISTING_(), and numval().

1802 {
1803  cob_field temp;
1804  cob_field_attr attr;
1805  union {
1806  double val;
1807  float fval;
1808  } uval;
1809 
1810  if (unlikely(d->scale == COB_DECIMAL_NAN)) {
1811  cob_set_exception (COB_EC_SIZE_OVERFLOW);
1812  return cobglobptr->cob_exception_code;
1813  }
1814 
1815  /* work copy */
1816  if (d != &cob_d1) {
1817  mpz_set (cob_d1.value, d->value);
1818  cob_d1.scale = d->scale;
1819  d = &cob_d1;
1820  }
1821 
1822 #if 0 /* RXWRXW - Round FP */
1823  if (!COB_FIELD_IS_FP(f)) {
1824 #endif
1825  /* Rounding */
1826  if ((opt & COB_STORE_ROUND)) {
1827  cob_decimal_do_round (d, f, opt);
1828  }
1829  /* Append or truncate decimal digits */
1830  shift_decimal (d, COB_FIELD_SCALE(f) - d->scale);
1831 #if 0 /* RXWRXW - Round FP */
1832  }
1833 #endif
1834 
1835  /* Store number */
1836  switch (COB_FIELD_TYPE (f)) {
1837  case COB_TYPE_NUMERIC_BINARY:
1838  return cob_decimal_get_binary (d, f, opt);
1839  case COB_TYPE_NUMERIC_DISPLAY:
1840  return cob_decimal_get_display (d, f, opt);
1841  case COB_TYPE_NUMERIC_PACKED:
1842  return cob_decimal_get_packed (d, f, opt);
1843  case COB_TYPE_NUMERIC_FLOAT:
1844  uval.fval = (float) cob_decimal_get_double (d);
1845  memcpy (f->data, &uval.fval, sizeof (float));
1846  return 0;
1847  case COB_TYPE_NUMERIC_DOUBLE:
1848  uval.val = cob_decimal_get_double (d);
1849  memcpy (f->data, &uval.val, sizeof (double));
1850  return 0;
1851  case COB_TYPE_NUMERIC_FP_DEC64:
1852  return cob_decimal_get_ieee64dec (d, f, opt);
1853  case COB_TYPE_NUMERIC_FP_DEC128:
1854  return cob_decimal_get_ieee128dec (d, f, opt);
1855  default:
1856  break;
1857  }
1858  COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, COB_FIELD_DIGITS(f),
1859  COB_FIELD_SCALE(f), COB_FLAG_HAVE_SIGN, NULL);
1860  temp.size = COB_FIELD_DIGITS(f);
1861  temp.data = cob_malloc (COB_FIELD_DIGITS(f));
1862  temp.attr = &attr;
1863  if (cob_decimal_get_display (d, &temp, opt) == 0) {
1864  cob_move (&temp, f);
1865  cob_free (temp.data);
1866  return 0;
1867  }
1868  cob_free (temp.data);
1869  return cobglobptr->cob_exception_code;
1870 }
COB_DECIMAL_NAN
#define COB_DECIMAL_NAN
Definition: coblocal.h:80
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_FIELD_SCALE
#define COB_FIELD_SCALE(f)
Definition: common.h:664
shift_decimal
static void shift_decimal(cob_decimal *d, const int n)
Definition: numeric.c:394
cob_decimal_get_ieee128dec
static int cob_decimal_get_ieee128dec(cob_decimal *d, cob_field *f, const int opt)
Definition: numeric.c:612
cobglobptr
static cob_global * cobglobptr
Definition: numeric.c:56
COB_TYPE_NUMERIC_PACKED
#define COB_TYPE_NUMERIC_PACKED
Definition: common.h:609
cob_decimal_do_round
static void cob_decimal_do_round(cob_decimal *d, cob_field *f, const int opt)
Definition: numeric.c:1693
cob_move
void cob_move(cob_field *, cob_field *)
Definition: move.c:1170
COB_FIELD_TYPE
#define COB_FIELD_TYPE(f)
Definition: common.h:662
COB_STORE_ROUND
#define COB_STORE_ROUND
Definition: common.h:867
cob_decimal_get_double
static double cob_decimal_get_double(cob_decimal *d)
Definition: numeric.c:877
COB_FIELD_IS_FP
#define COB_FIELD_IS_FP(f)
Definition: common.h:652
cob_field
Definition: common.h:950
COB_ATTR_INIT
#define COB_ATTR_INIT(u, v, x, y, z)
Definition: coblocal.h:150
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FLAG_HAVE_SIGN
#define COB_FLAG_HAVE_SIGN
Definition: common.h:630
COB_TYPE_NUMERIC_FP_DEC64
#define COB_TYPE_NUMERIC_FP_DEC64
Definition: common.h:613
COB_TYPE_NUMERIC_FLOAT
#define COB_TYPE_NUMERIC_FLOAT
Definition: common.h:610
unlikely
#define unlikely(x)
Definition: common.h:437
cob_decimal_get_ieee64dec
static int cob_decimal_get_ieee64dec(cob_decimal *d, cob_field *f, const int opt)
Definition: numeric.c:481
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_decimal_get_packed
static int cob_decimal_get_packed(cob_decimal *d, cob_field *f, const int opt)
Definition: numeric.c:1147
COB_TYPE_NUMERIC_BINARY
#define COB_TYPE_NUMERIC_BINARY
Definition: common.h:608
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_TYPE_NUMERIC_DISPLAY
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
cob_decimal_get_binary
static int cob_decimal_get_binary(cob_decimal *d, cob_field *f, const int opt)
Definition: numeric.c:1507
cob_field_attr
Definition: common.h:940
cob_field::size
size_t size
Definition: common.h:951
COB_TYPE_NUMERIC_DOUBLE
#define COB_TYPE_NUMERIC_DOUBLE
Definition: common.h:611
cob_field::attr
const cob_field_attr * attr
Definition: common.h:953
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
__cob_global::cob_exception_code
int cob_exception_code
Definition: common.h:1203
cob_decimal::value
mpz_t value
Definition: common.h:985
COB_TYPE_NUMERIC_FP_DEC128
#define COB_TYPE_NUMERIC_FP_DEC128
Definition: common.h:614
COB_FIELD_DIGITS
#define COB_FIELD_DIGITS(f)
Definition: common.h:663
cob_d1
static cob_decimal cob_d1
Definition: numeric.c:108
cob_decimal_get_display
static int cob_decimal_get_display(cob_decimal *d, cob_field *f, const int opt)
Definition: numeric.c:1371
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_decimal_init ( cob_decimal *  )

Definition at line 321 of file numeric.c.

References COB_MPZ_DEF, cob_decimal::scale, and cob_decimal::value.

Referenced by cob_decimal_push(), and cob_init_numeric().

322 {
323  mpz_init2 (d->value, COB_MPZ_DEF);
324  d->scale = 0;
325 }
COB_MPZ_DEF
#define COB_MPZ_DEF
Definition: coblocal.h:86

Here is the caller graph for this function:

void cob_decimal_mul ( cob_decimal *  ,
cob_decimal *   
)

Definition at line 1891 of file numeric.c.

References DECIMAL_CHECK, cob_decimal::scale, and cob_decimal::value.

Referenced by calc_variance_of_args(), cob_div_quotient(), cob_intr_binop(), cob_mod_or_rem(), cob_mul(), and cobxref_().

1892 {
1893  DECIMAL_CHECK (d1, d2);
1894  d1->scale += d2->scale;
1895  mpz_mul (d1->value, d1->value, d2->value);
1896 }
d2
static cob_decimal d2
Definition: intrinsic.c:80
d1
cob_decimal * d1
Definition: cobxref.c.l.h:21
DECIMAL_CHECK
#define DECIMAL_CHECK(d1, d2)
Definition: numeric.c:47
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal::scale
int scale
Definition: common.h:986

Here is the caller graph for this function:

void cob_decimal_pop ( const unsigned  int,
  ... 
)
void cob_decimal_pow ( cob_decimal *  ,
cob_decimal *   
)

Definition at line 2990 of file intrinsic.c.

References cob_decimal_div(), cob_decimal_get_mpf(), COB_DECIMAL_NAN, cob_decimal_set(), cob_decimal_set_mpf(), COB_EC_SIZE_EXPONENTIATION, cob_mpf_exp(), cob_mpf_log(), cob_mpft, cob_mpft2, cob_set_exception(), cob_trim_decimal(), cob_uli_t, cob_decimal::scale, sign, unlikely, and cob_decimal::value.

Referenced by cob_intr_annuity(), cob_intr_binop(), cob_intr_exp10(), cob_intr_sqrt(), and cob_intr_standard_deviation().

2991 {
2992  cob_uli_t n;
2993  int sign;
2994 
2995  if (unlikely(pd1->scale == COB_DECIMAL_NAN)) {
2996  return;
2997  }
2998  if (unlikely(pd2->scale == COB_DECIMAL_NAN)) {
2999  pd1->scale = COB_DECIMAL_NAN;
3000  return;
3001  }
3002 
3003  sign = mpz_sgn (pd1->value);
3004 
3005  if (!mpz_sgn (pd2->value)) {
3006  /* Exponent is zero */
3007  if (!sign) {
3008  /* 0 ^ 0 */
3009  cob_set_exception (COB_EC_SIZE_EXPONENTIATION);
3010  }
3011  mpz_set_ui (pd1->value, 1UL);
3012  pd1->scale = 0;
3013  return;
3014  }
3015  if (!sign) {
3016  /* Value is zero */
3017  pd1->scale = 0;
3018  return;
3019  }
3020 
3021  cob_trim_decimal (pd2);
3022 
3023  if (sign < 0 && pd2->scale) {
3024  /* Negative exponent and non-integer power */
3025  pd1->scale = COB_DECIMAL_NAN;
3026  cob_set_exception (COB_EC_SIZE_EXPONENTIATION);
3027  return;
3028  }
3029 
3030  cob_trim_decimal (pd1);
3031 
3032  if (!pd2->scale) {
3033  /* Integer power */
3034  if (!mpz_cmp_ui (pd2->value, 1UL)) {
3035  /* Power is 1 */
3036  return;
3037  }
3038  if (mpz_sgn (pd2->value) < 0 && mpz_fits_slong_p (pd2->value)) {
3039  /* Negative power */
3040  mpz_abs (pd2->value, pd2->value);
3041  n = mpz_get_ui (pd2->value);
3042  mpz_pow_ui (pd1->value, pd1->value, n);
3043  if (pd1->scale) {
3044  pd1->scale *= n;
3045  cob_trim_decimal (pd1);
3046  }
3047  cob_decimal_set (pd2, pd1);
3048  mpz_set_ui (pd1->value, 1UL),
3049  pd1->scale = 0;
3050  cob_decimal_div (pd1, pd2);
3051  cob_trim_decimal (pd1);
3052  return;
3053  }
3054  if (mpz_fits_ulong_p (pd2->value)) {
3055  /* Positive power */
3056  n = mpz_get_ui (pd2->value);
3057  mpz_pow_ui (pd1->value, pd1->value, n);
3058  if (pd1->scale) {
3059  pd1->scale *= n;
3060  cob_trim_decimal (pd1);
3061  }
3062  return;
3063  }
3064  }
3065 
3066  if (sign < 0) {
3067  mpz_abs (pd1->value, pd1->value);
3068  }
3069  cob_decimal_get_mpf (cob_mpft, pd1);
3070  if (pd2->scale == 1 && !mpz_cmp_ui (pd2->value, 5UL)) {
3071  /* Square root short cut */
3072  mpf_sqrt (cob_mpft2, cob_mpft);
3073  } else {
3074  cob_decimal_get_mpf (cob_mpft2, pd2);
3075  cob_mpf_log (cob_mpft, cob_mpft);
3076  mpf_mul (cob_mpft, cob_mpft, cob_mpft2);
3077  cob_mpf_exp (cob_mpft2, cob_mpft);
3078  }
3079  cob_decimal_set_mpf (pd1, cob_mpft2);
3080  if (sign < 0) {
3081  mpz_neg (pd1->value, pd1->value);
3082  }
3083 }
COB_DECIMAL_NAN
#define COB_DECIMAL_NAN
Definition: coblocal.h:80
cob_mpf_log
static void cob_mpf_log(mpf_t dst_val, const mpf_t src_val)
Definition: intrinsic.c:931
cob_mpft2
static mpf_t cob_mpft2
Definition: intrinsic.c:89
cob_mpft
static mpf_t cob_mpft
Definition: intrinsic.c:88
cob_uli_t
#define cob_uli_t
Definition: common.h:33
unlikely
#define unlikely(x)
Definition: common.h:437
cob_decimal_get_mpf
static void cob_decimal_get_mpf(mpf_t dst, const cob_decimal *d)
Definition: intrinsic.c:847
sign
if sign
Definition: flag.def:42
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_trim_decimal
static void cob_trim_decimal(cob_decimal *d)
Definition: intrinsic.c:517
cob_decimal_div
void cob_decimal_div(cob_decimal *, cob_decimal *)
Definition: numeric.c:1899
cob_decimal_set
static COB_INLINE COB_A_INLINE void cob_decimal_set(cob_decimal *dst, const cob_decimal *src)
Definition: intrinsic.c:509
cob_decimal_set_mpf
static void cob_decimal_set_mpf(cob_decimal *d, const mpf_t src)
Definition: intrinsic.c:816
cob_mpf_exp
static void cob_mpf_exp(mpf_t dst_val, const mpf_t src_val)
Definition: intrinsic.c:871

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_decimal_push ( const unsigned  int,
  ... 
)
void cob_decimal_set_field ( cob_decimal *  ,
cob_field *   
)

Definition at line 1612 of file numeric.c.

References cob_decimal_set_binary(), cob_decimal_set_display(), cob_decimal_set_double(), cob_decimal_set_ieee128dec(), cob_decimal_set_ieee64dec(), cob_decimal_set_packed(), COB_FIELD_TYPE, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DOUBLE, COB_TYPE_NUMERIC_FLOAT, COB_TYPE_NUMERIC_FP_DEC128, COB_TYPE_NUMERIC_FP_DEC64, COB_TYPE_NUMERIC_PACKED, and cob_field::data.

Referenced by calc_mean_of_args(), calc_variance_of_args(), cob_add(), cob_add_int(), cob_cmp_float(), cob_cmp_int(), cob_cmp_llint(), cob_cmp_uint(), cob_decimal_move_temp(), cob_decimal_setget_fld(), cob_div(), cob_div_quotient(), cob_intr_abs(), cob_intr_acos(), cob_intr_annuity(), cob_intr_asin(), cob_intr_atan(), cob_intr_binop(), cob_intr_combined_datetime(), cob_intr_cos(), cob_intr_exp(), cob_intr_exp10(), cob_intr_fraction_part(), cob_intr_integer(), cob_intr_integer_part(), cob_intr_log(), cob_intr_log10(), cob_intr_mean(), cob_intr_median(), cob_intr_midrange(), cob_intr_present_value(), cob_intr_range(), cob_intr_sign(), cob_intr_sin(), cob_intr_sqrt(), cob_intr_sum(), cob_intr_tan(), cob_mod_or_rem(), cob_mul(), cob_numeric_cmp(), cob_sub(), cobxref_(), get_fractional_seconds(), and LISTING_().

1613 {
1614  union {
1615  double dval;
1616  float fval;
1617  } uval;
1618 
1619  switch (COB_FIELD_TYPE (f)) {
1620  case COB_TYPE_NUMERIC_BINARY:
1621  cob_decimal_set_binary (d, f);
1622  break;
1623  case COB_TYPE_NUMERIC_PACKED:
1624  cob_decimal_set_packed (d, f);
1625  break;
1626  case COB_TYPE_NUMERIC_FLOAT:
1627  memcpy ((void *)&uval.fval, f->data, sizeof(float));
1628  cob_decimal_set_double (d, (double)uval.fval);
1629  break;
1630  case COB_TYPE_NUMERIC_DOUBLE:
1631  memcpy ((void *)&uval.dval, f->data, sizeof(double));
1632  cob_decimal_set_double (d, uval.dval);
1633  break;
1634  case COB_TYPE_NUMERIC_FP_DEC64:
1635  cob_decimal_set_ieee64dec (d, f);
1636  break;
1637  case COB_TYPE_NUMERIC_FP_DEC128:
1638  cob_decimal_set_ieee128dec (d, f);
1639  break;
1640  default:
1641  cob_decimal_set_display (d, f);
1642  break;
1643  }
1644 }
cob_decimal_set_double
static void cob_decimal_set_double(cob_decimal *d, const double v)
Definition: numeric.c:821
COB_TYPE_NUMERIC_PACKED
#define COB_TYPE_NUMERIC_PACKED
Definition: common.h:609
COB_FIELD_TYPE
#define COB_FIELD_TYPE(f)
Definition: common.h:662
cob_decimal_set_ieee64dec
static void cob_decimal_set_ieee64dec(cob_decimal *d, const cob_field *f)
Definition: numeric.c:551
COB_TYPE_NUMERIC_FP_DEC64
#define COB_TYPE_NUMERIC_FP_DEC64
Definition: common.h:613
COB_TYPE_NUMERIC_FLOAT
#define COB_TYPE_NUMERIC_FLOAT
Definition: common.h:610
cob_decimal_set_binary
static void cob_decimal_set_binary(cob_decimal *d, cob_field *f)
Definition: numeric.c:1424
COB_TYPE_NUMERIC_BINARY
#define COB_TYPE_NUMERIC_BINARY
Definition: common.h:608
cob_decimal_set_display
static void cob_decimal_set_display(cob_decimal *d, cob_field *f)
Definition: numeric.c:1308
COB_TYPE_NUMERIC_DOUBLE
#define COB_TYPE_NUMERIC_DOUBLE
Definition: common.h:611
cob_decimal_set_packed
static void cob_decimal_set_packed(cob_decimal *d, cob_field *f)
Definition: numeric.c:1087
COB_TYPE_NUMERIC_FP_DEC128
#define COB_TYPE_NUMERIC_FP_DEC128
Definition: common.h:614
cob_decimal_set_ieee128dec
static void cob_decimal_set_ieee128dec(cob_decimal *d, const cob_field *f)
Definition: numeric.c:688

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_decimal_set_llint ( cob_decimal *  ,
const long  long 
)

Referenced by cobxref_(), and LISTING_().

Here is the caller graph for this function:

void cob_decimal_sub ( cob_decimal *  ,
cob_decimal *   
)

Definition at line 1883 of file numeric.c.

References align_decimal(), DECIMAL_CHECK, and cob_decimal::value.

Referenced by calc_variance_of_args(), cob_div_quotient(), cob_intr_annuity(), cob_intr_binop(), cob_intr_range(), cob_mod_or_rem(), cob_sub(), cobxref_(), get_fractional_seconds(), and LISTING_().

1884 {
1885  DECIMAL_CHECK (d1, d2);
1886  align_decimal (d1, d2);
1887  mpz_sub (d1->value, d1->value, d2->value);
1888 }
d2
static cob_decimal d2
Definition: intrinsic.c:80
d1
cob_decimal * d1
Definition: cobxref.c.l.h:21
DECIMAL_CHECK
#define DECIMAL_CHECK(d1, d2)
Definition: numeric.c:47
align_decimal
static void align_decimal(cob_decimal *d1, cob_decimal *d2)
Definition: numeric.c:411
cob_decimal::value
mpz_t value
Definition: common.h:985

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_delete ( cob_file *  ,
cob_field *   
)

Definition at line 4829 of file fileio.c.

References cob_file::access_mode, COB_ACCESS_SEQUENTIAL, COB_OPEN_I_O, COB_STATUS_43_READ_NOT_DONE, COB_STATUS_49_I_O_DENIED, cob_fileio_funcs::fdelete, cob_file::flag_read_done, cob_file::open_mode, cob_file::organization, save_status(), and unlikely.

4830 {
4831  int read_done;
4832 
4833  read_done = f->flag_read_done;
4834  f->flag_read_done = 0;
4835 
4836  if (unlikely(f->open_mode != COB_OPEN_I_O)) {
4837  save_status (f, fnstatus, COB_STATUS_49_I_O_DENIED);
4838  return;
4839  }
4840 
4841  if (f->access_mode == COB_ACCESS_SEQUENTIAL && !read_done) {
4842  save_status (f, fnstatus, COB_STATUS_43_READ_NOT_DONE);
4843  return;
4844  }
4845 
4846  save_status (f, fnstatus,
4847  fileio_funcs[(int)f->organization]->fdelete (f));
4848 }
unlikely
#define unlikely(x)
Definition: common.h:437
save_status
static void save_status(cob_file *f, cob_field *fnstatus, const int status)
Definition: fileio.c:668
COB_ACCESS_SEQUENTIAL
#define COB_ACCESS_SEQUENTIAL
Definition: common.h:751
COB_OPEN_I_O
#define COB_OPEN_I_O
Definition: common.h:786
COB_STATUS_43_READ_NOT_DONE
#define COB_STATUS_43_READ_NOT_DONE
Definition: common.h:848
COB_STATUS_49_I_O_DENIED
#define COB_STATUS_49_I_O_DENIED
Definition: common.h:853
fileio_funcs
static const struct cob_fileio_funcs * fileio_funcs[COB_ORG_MAX]
Definition: fileio.c:339
cob_fileio_funcs::fdelete
int(* fdelete)(cob_file *)
Definition: common.h:1231

Here is the call graph for this function:

void cob_delete_file ( cob_file *  ,
cob_field *   
)

Definition at line 4875 of file fileio.c.

References cob_file::assign, cob_chk_file_mapping(), cob_field_to_string(), COB_FILE_MAX, COB_FILE_STDIN, COB_FILE_STDOUT, COB_OPEN_CLOSED, COB_OPEN_LOCKED, COB_ORG_INDEXED, COB_ORG_SORT, COB_STATUS_00_SUCCESS, COB_STATUS_30_PERMANENT_ERROR, COB_STATUS_38_CLOSED_WITH_LOCK, COB_STATUS_41_ALREADY_OPEN, COB_STATUS_91_NOT_AVAILABLE, file_open_name, indexed_file_delete(), cob_file::open_mode, cob_file::organization, save_status(), and unlikely.

4876 {
4877  if (f->organization == COB_ORG_SORT) {
4878  save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR);
4879  return;
4880  }
4881 
4882  /* File was previously closed with lock */
4883  if (f->open_mode == COB_OPEN_LOCKED) {
4884  save_status (f, fnstatus, COB_STATUS_38_CLOSED_WITH_LOCK);
4885  return;
4886  }
4887 
4888  /* File is open */
4889  if (f->open_mode != COB_OPEN_CLOSED) {
4890  save_status (f, fnstatus, COB_STATUS_41_ALREADY_OPEN);
4891  return;
4892  }
4893 
4894  if (unlikely(COB_FILE_STDIN (f))) {
4895  save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR);
4896  return;
4897  }
4898  if (unlikely(COB_FILE_STDOUT (f))) {
4899  save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR);
4900  return;
4901  }
4902 
4903  /* Obtain the file name */
4904  cob_field_to_string (f->assign, file_open_name, (size_t)COB_FILE_MAX);
4905  cob_chk_file_mapping ();
4906 
4907  if (f->organization != COB_ORG_INDEXED) {
4908 #ifdef WITH_SEQRA_EXTFH
4909  save_status (f, fnstatus, COB_STATUS_91_NOT_AVAILABLE);
4910  return;
4911 #else
4912  unlink (file_open_name);
4913 #endif
4914  } else {
4915 #ifdef WITH_INDEX_EXTFH
4916  save_status (f, fnstatus, COB_STATUS_91_NOT_AVAILABLE);
4917  return;
4918 #else
4919  indexed_file_delete (f, file_open_name);
4920 #endif
4921  }
4922  save_status (f, fnstatus, COB_STATUS_00_SUCCESS);
4923 }
COB_STATUS_41_ALREADY_OPEN
#define COB_STATUS_41_ALREADY_OPEN
Definition: common.h:846
cob_chk_file_mapping
static void cob_chk_file_mapping(void)
Definition: fileio.c:504
COB_STATUS_00_SUCCESS
#define COB_STATUS_00_SUCCESS
Definition: common.h:828
COB_ORG_INDEXED
#define COB_ORG_INDEXED
Definition: common.h:745
COB_OPEN_CLOSED
#define COB_OPEN_CLOSED
Definition: common.h:783
file_open_name
static char * file_open_name
Definition: fileio.c:244
cob_field_to_string
void cob_field_to_string(const cob_field *, void *, const size_t)
Definition: common.c:1492
unlikely
#define unlikely(x)
Definition: common.h:437
COB_FILE_STDOUT
#define COB_FILE_STDOUT(x)
Definition: common.h:768
COB_STATUS_30_PERMANENT_ERROR
#define COB_STATUS_30_PERMANENT_ERROR
Definition: common.h:839
save_status
static void save_status(cob_file *f, cob_field *fnstatus, const int status)
Definition: fileio.c:668
COB_OPEN_LOCKED
#define COB_OPEN_LOCKED
Definition: common.h:788
indexed_file_delete
static void indexed_file_delete(cob_file *f, const char *filename)
Definition: fileio.c:2695
COB_FILE_STDIN
#define COB_FILE_STDIN(x)
Definition: common.h:767
COB_STATUS_38_CLOSED_WITH_LOCK
#define COB_STATUS_38_CLOSED_WITH_LOCK
Definition: common.h:844
COB_ORG_SORT
#define COB_ORG_SORT
Definition: common.h:746
COB_FILE_MAX
#define COB_FILE_MAX
Definition: common.h:548
COB_STATUS_91_NOT_AVAILABLE
#define COB_STATUS_91_NOT_AVAILABLE
Definition: common.h:857

Here is the call graph for this function:

void cob_display ( const int  ,
const int  ,
const int  ,
  ... 
)

Definition at line 238 of file termio.c.

References COB_DISP_TO_STDERR, cob_field_display(), COB_SCREEN_EMULATE_NL, __cob_global::cob_screen_initialized, cob_u32_t, display_common(), NULL, and unlikely.

Referenced by cobxref_(), GCic_(), and get__reserved__lists_().

239 {
240  FILE *fp;
241  cob_field *f;
242  int i;
243  int nlattr;
244  cob_u32_t disp_redirect;
245  va_list args;
246 
247  disp_redirect = 0;
248  if (to_stderr) {
249  fp = stderr;
250  } else {
251  fp = stdout;
252  if (cobglobptr->cob_screen_initialized) {
253  if (!COB_DISP_TO_STDERR) {
254  disp_redirect = 1;
255  } else {
256  fp = stderr;
257  }
258  }
259  }
260 
261  nlattr = newline ? COB_SCREEN_EMULATE_NL : 0;
262  va_start (args, varcnt);
263  for (i = 0; i < varcnt; ++i) {
264  f = va_arg (args, cob_field *);
265  if (unlikely(disp_redirect)) {
266  cob_field_display (f, NULL, NULL, NULL, NULL,
267  NULL, NULL, nlattr);
268  } else {
269  display_common (f, fp);
270  }
271  }
272  va_end (args);
273 
274  if (newline && !disp_redirect) {
275  putc ('\n', fp);
276  fflush (fp);
277  }
278 }
cob_u32_t
#define cob_u32_t
Definition: common.h:31
cob_field
Definition: common.h:950
COB_SCREEN_EMULATE_NL
#define COB_SCREEN_EMULATE_NL
Definition: common.h:922
unlikely
#define unlikely(x)
Definition: common.h:437
cob_field_display
void cob_field_display(cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, const int)
Definition: screenio.c:2341
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
display_common
static void display_common(cob_field *f, FILE *fp)
Definition: termio.c:167
cobglobptr
static cob_global * cobglobptr
Definition: termio.c:43
__cob_global::cob_screen_initialized
unsigned int cob_screen_initialized
Definition: common.h:1208
COB_DISP_TO_STDERR
#define COB_DISP_TO_STDERR
Definition: coblocal.h:191

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_display_arg_number ( cob_field *  )

Definition at line 2911 of file common.c.

References cob_field::attr, cob_argc, COB_ATTR_INIT, COB_EC_IMP_DISPLAY, cob_move(), cob_set_exception(), COB_TYPE_NUMERIC_BINARY, current_arg, cob_field::data, NULL, and cob_field::size.

2912 {
2913  int n;
2914  cob_field_attr attr;
2915  cob_field temp;
2916 
2917  temp.size = 4;
2918  temp.data = (unsigned char *)&n;
2919  temp.attr = &attr;
2920  COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, 0, 0, NULL);
2921  cob_move (f, &temp);
2922  if (n < 0 || n >= cob_argc) {
2923  cob_set_exception (COB_EC_IMP_DISPLAY);
2924  return;
2925  }
2926  current_arg = n;
2927 }
cob_move
void cob_move(cob_field *, cob_field *)
Definition: move.c:1170
cob_field
Definition: common.h:950
cob_argc
static int cob_argc
Definition: common.c:125
COB_ATTR_INIT
#define COB_ATTR_INIT(u, v, x, y, z)
Definition: coblocal.h:150
cob_field::data
unsigned char * data
Definition: common.h:952
current_arg
static int current_arg
Definition: common.c:139
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_TYPE_NUMERIC_BINARY
#define COB_TYPE_NUMERIC_BINARY
Definition: common.h:608
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_field_attr
Definition: common.h:940
cob_field::size
size_t size
Definition: common.h:951
cob_field::attr
const cob_field_attr * attr
Definition: common.h:953

Here is the call graph for this function:

void cob_display_command_line ( cob_field *  )

Definition at line 2855 of file common.c.

References cob_free(), cob_malloc(), commlncnt, commlnptr, cob_field::data, and cob_field::size.

2856 {
2857  if (commlnptr) {
2858  cob_free (commlnptr);
2859  }
2860  commlnptr = cob_malloc (f->size + 1U);
2861  commlncnt = f->size;
2862  memcpy (commlnptr, f->data, commlncnt);
2863 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
commlnptr
static unsigned char * commlnptr
Definition: common.c:140
commlncnt
static size_t commlncnt
Definition: common.c:141
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250

Here is the call graph for this function:

void cob_display_env_value ( const cob_field *  )

Definition at line 2981 of file common.c.

References COB_EC_IMP_DISPLAY, cob_fast_malloc(), cob_field_to_string(), cob_free(), cob_local_env, cob_malloc(), cob_rescan_env_vals(), cob_set_exception(), and cob_field::size.

Referenced by cob_set_environment().

2982 {
2983  char *env2;
2984 #if !HAVE_SETENV
2985  char *p;
2986  size_t len;
2987 #endif
2988  int ret;
2989 
2990  if (!cob_local_env) {
2991  cob_set_exception (COB_EC_IMP_DISPLAY);
2992  return;
2993  }
2994  if (!*cob_local_env) {
2995  cob_set_exception (COB_EC_IMP_DISPLAY);
2996  return;
2997  }
2998  env2 = cob_malloc (f->size + 1U);
2999  cob_field_to_string (f, env2, f->size);
3000 #if HAVE_SETENV
3001  ret = setenv(cob_local_env, env2, 1);
3002 #else
3003  len = strlen (cob_local_env) + strlen (env2) + 3U;
3004  p = cob_fast_malloc (len);
3005  sprintf (p, "%s=%s", cob_local_env, env2);
3006  ret = putenv (p);
3007 #endif
3008  cob_free (env2);
3009  if (ret != 0) {
3010  cob_set_exception (COB_EC_IMP_DISPLAY);
3011  return;
3012  }
3013  /* Rescan term/screen variables */
3014  cob_rescan_env_vals ();
3015 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_rescan_env_vals
static void cob_rescan_env_vals(void)
Definition: common.c:1099
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_field_to_string
void cob_field_to_string(const cob_field *f, void *str, const size_t maxsize)
Definition: common.c:1492
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
cob_fast_malloc
void * cob_fast_malloc(const size_t size)
Definition: common.c:1296
cob_local_env
static char * cob_local_env
Definition: common.c:138

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_display_environment ( const cob_field *  )

Definition at line 2959 of file common.c.

References __cob_settings::cob_env_mangle, cob_field_to_string(), cob_free(), cob_local_env, cob_local_env_size, cob_malloc(), cob_field::size, and unlikely.

Referenced by cob_set_environment().

2960 {
2961  size_t i;
2962 
2963  if (cob_local_env_size < f->size) {
2964  cob_local_env_size = f->size;
2965  if (cob_local_env) {
2966  cob_free (cob_local_env);
2967  }
2968  cob_local_env = cob_malloc (cob_local_env_size + 1U);
2969  }
2970  cob_field_to_string (f, cob_local_env, cob_local_env_size);
2971  if (unlikely(cobsetptr->cob_env_mangle)) {
2972  for (i = 0; i < strlen (cob_local_env); ++i) {
2973  if (!isalnum ((int)cob_local_env[i])) {
2974  cob_local_env[i] = '_';
2975  }
2976  }
2977  }
2978 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cobsetptr
static cob_settings * cobsetptr
Definition: common.c:131
unlikely
#define unlikely(x)
Definition: common.h:437
cob_local_env_size
static size_t cob_local_env_size
Definition: common.c:142
cob_field_to_string
void cob_field_to_string(const cob_field *f, void *str, const size_t maxsize)
Definition: common.c:1492
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
__cob_settings::cob_env_mangle
unsigned int cob_env_mangle
Definition: coblocal.h:205
cob_local_env
static char * cob_local_env
Definition: common.c:138

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_div ( cob_field *  ,
cob_field *  ,
const int   
)

Definition at line 1958 of file numeric.c.

References cob_decimal_div(), cob_decimal_get_field(), and cob_decimal_set_field().

1959 {
1960  cob_decimal_set_field (&cob_d1, f1);
1961  cob_decimal_set_field (&cob_d2, f2);
1962  cob_decimal_div (&cob_d1, &cob_d2);
1963  (void)cob_decimal_get_field (&cob_d1, f1, opt);
1964 }
f2
cob_field f2
Definition: cobxref.c.l.h:55
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *d, cob_field *f)
Definition: numeric.c:1612
f1
cob_field f1
Definition: cobxref.c.l.h:54
cob_decimal_div
void cob_decimal_div(cob_decimal *d1, cob_decimal *d2)
Definition: numeric.c:1899
cob_d2
static cob_decimal cob_d2
Definition: numeric.c:109
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *d, cob_field *f, const int opt)
Definition: numeric.c:1801
cob_d1
static cob_decimal cob_d1
Definition: numeric.c:108

Here is the call graph for this function:

void cob_div_quotient ( cob_field *  ,
cob_field *  ,
cob_field *  ,
const int   
)

Definition at line 1967 of file numeric.c.

References cob_decimal_div(), cob_decimal_get_field(), cob_decimal_mul(), COB_DECIMAL_NAN, cob_decimal_set(), cob_decimal_set_field(), cob_decimal_sub(), COB_FIELD_SCALE, cob_decimal::scale, and shift_decimal().

1969 {
1970  /* Note that cob_div_quotient and cob_div_remainder must remain */
1971  /* separate because of COBOL rules. The quotient must be fully */
1972  /* evaluated before the remainder item is evaluated */
1973  /* eg. DIVIDE A BY B GIVING Z REMAINDER FLD (Z). */
1974 
1975  cob_decimal_set_field (&cob_d1, dividend);
1976  cob_decimal_set_field (&cob_d2, divisor);
1977  cob_decimal_set (&cob_d_remainder, &cob_d1);
1978 
1979  /* Compute quotient */
1980  cob_decimal_div (&cob_d1, &cob_d2);
1981  /* Check divide by zero - Exception is set in cob_decimal_div */
1982  if (cob_d1.scale == COB_DECIMAL_NAN) {
1983  /* Forces an early return from cob_div_remainder */
1984  cob_d_remainder.scale = COB_DECIMAL_NAN;
1985  return;
1986  }
1987 
1988  /* Set quotient */
1989  cob_decimal_set (&cob_d3, &cob_d1);
1990  (void)cob_decimal_get_field (&cob_d1, quotient, opt);
1991 
1992  /* Truncate digits from the quotient */
1993  shift_decimal (&cob_d3, COB_FIELD_SCALE(quotient) - cob_d3.scale);
1994 
1995  /* Compute remainder */
1996  cob_decimal_mul (&cob_d3, &cob_d2);
1997  cob_decimal_sub (&cob_d_remainder, &cob_d3);
1998 }
COB_DECIMAL_NAN
#define COB_DECIMAL_NAN
Definition: coblocal.h:80
COB_FIELD_SCALE
#define COB_FIELD_SCALE(f)
Definition: common.h:664
shift_decimal
static void shift_decimal(cob_decimal *d, const int n)
Definition: numeric.c:394
cob_decimal_set
static COB_INLINE COB_A_INLINE void cob_decimal_set(cob_decimal *dst, const cob_decimal *src)
Definition: numeric.c:356
cob_decimal_mul
void cob_decimal_mul(cob_decimal *d1, cob_decimal *d2)
Definition: numeric.c:1891
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *d, cob_field *f)
Definition: numeric.c:1612
cob_d_remainder
static cob_decimal cob_d_remainder
Definition: numeric.c:111
cob_decimal_sub
void cob_decimal_sub(cob_decimal *d1, cob_decimal *d2)
Definition: numeric.c:1883
cob_d3
static cob_decimal cob_d3
Definition: numeric.c:110
cob_decimal_div
void cob_decimal_div(cob_decimal *d1, cob_decimal *d2)
Definition: numeric.c:1899
cob_d2
static cob_decimal cob_d2
Definition: numeric.c:109
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *d, cob_field *f, const int opt)
Definition: numeric.c:1801
cob_d1
static cob_decimal cob_d1
Definition: numeric.c:108
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

void cob_div_remainder ( cob_field *  ,
const int   
)

Definition at line 2001 of file numeric.c.

References cob_decimal_get_field().

2002 {
2003  (void)cob_decimal_get_field (&cob_d_remainder, fld_remainder, opt);
2004 }
cob_d_remainder
static cob_decimal cob_d_remainder
Definition: numeric.c:111
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *d, cob_field *f, const int opt)
Definition: numeric.c:1801

Here is the call graph for this function:

char* cob_expand_env_string ( char *  )

Definition at line 4406 of file common.c.

References COB_CONFIG_DIR, COB_COPY_DIR, cob_free(), cob_malloc(), cob_realloc(), cob_strdup(), and NULL.

Referenced by cb_config_entry(), and set_config_val().

4407 {
4408  unsigned int i,j,k,envlen = 1280;
4409  char *env,*str = strval;
4410  char ename[128],*penv;
4411  env = cob_malloc(envlen);
4412  if (env) {
4413  for (j=k=0; strval[k] != 0; k++) {
4414  if(j >= (envlen-128)) { /* String almost full?; Expand it */
4415  env = cob_realloc(env,envlen,envlen+256);
4416  envlen += 256;
4417  }
4418  if (strval[k] == '$'
4419  && strval[k+1] == '{') { /* ${envname:default} */
4420  k += 2;
4421  for (i=0; strval[k] != '}'
4422  && strval[k] != 0
4423  && strval[k] != ':'; k++) {
4424  ename[i++] = strval[k];
4425  }
4426  ename[i++] = 0;
4427  penv = getenv(ename);
4428  if (penv == NULL) {
4429  if(strval[k] == ':') { /* Copy 'default' value */
4430  k++;
4431  if (strval[k] == '-') k++; /* ${name:-default} */
4432  while (strval[k] != '}' && strval[k] != 0) {
4433  if(j >= (envlen-50)) {
4434  env = cob_realloc(env,envlen,envlen+128);
4435  envlen += 128;
4436  }
4437  env[j++] = strval[k++];
4438  }
4439  } else if(strcmp(ename,"COB_CONFIG_DIR") == 0) {
4440  penv = (char*)COB_CONFIG_DIR;
4441  } else if(strcmp(ename,"COB_COPY_DIR") == 0) {
4442  penv = (char*)COB_COPY_DIR;
4443  }
4444  }
4445  if(penv != NULL) {
4446  if((j + strlen(penv)) > (unsigned int)(envlen - 128)) {
4447  env = cob_realloc(env,envlen, strlen(penv) + 256);
4448  envlen = (unsigned int)strlen(penv) + 256;
4449  }
4450  j += sprintf(&env[j],"%s",penv);
4451  penv = NULL;
4452  }
4453  while(strval[k] != '}' && strval[k] != 0)
4454  k++;
4455  if(strval[k] == '}')
4456  k++;
4457  k--;
4458  } else if (!isspace ((unsigned char)strval[k])) {
4459  env[j++] = strval[k];
4460  } else {
4461  env[j++] = ' ';
4462  }
4463  }
4464  env[j] = 0;
4465  str = cob_strdup(env);
4466  cob_free(env);
4467  }
4468  return str;
4469 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_realloc
void * cob_realloc(void *optr, const size_t osize, const size_t nsize)
Definition: common.c:1262
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_CONFIG_DIR
#define COB_CONFIG_DIR
Definition: defaults.h:6
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
COB_COPY_DIR
#define COB_COPY_DIR
Definition: defaults.h:7
cob_strdup
char * cob_strdup(const char *p)
Definition: common.c:1308

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_extern_init ( void  )

Definition at line 3272 of file common.c.

References cob_init(), and NULL.

3273 {
3274  cob_init (0, NULL);
3275  return 0;
3276 }
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_init
void cob_init(const int argc, char **argv)
Definition: common.c:5390

Here is the call graph for this function:

void* cob_external_addr ( const char *  ,
const int   
)

Definition at line 2621 of file common.c.

References _, basext, __cob_global::cob_initial_external, cob_malloc(), cob_runtime_error(), cob_stop_run(), cob_external::ename, cob_external::esize, cob_external::ext_alloc, and cob_external::next.

2622 {
2623  struct cob_external *eptr;
2624 
2625  /* Locate or allocate EXTERNAL item */
2626  for (eptr = basext; eptr; eptr = eptr->next) {
2627  if (!strcmp (exname, eptr->ename)) {
2628  if (exlength > eptr->esize) {
2629  cob_runtime_error (_("EXTERNAL item '%s' previously allocated with size %d, requested size is %d"),
2630  exname, eptr->esize, exlength);
2631  cob_stop_run (1);
2632  }
2633  cobglobptr->cob_initial_external = 0;
2634  return eptr->ext_alloc;
2635  }
2636  }
2637  eptr = cob_malloc (sizeof (struct cob_external));
2638  eptr->next = basext;
2639  eptr->esize = exlength;
2640  eptr->ename = cob_malloc (strlen (exname) + 1U);
2641  strcpy (eptr->ename, exname);
2642  eptr->ext_alloc = cob_malloc ((size_t)exlength);
2643  basext = eptr;
2644  cobglobptr->cob_initial_external = 1;
2645  return eptr->ext_alloc;
2646 }
basext
static struct cob_external * basext
Definition: common.c:144
cob_external::next
struct cob_external * next
Definition: common.c:114
cob_external::ename
char * ename
Definition: common.c:116
_
#define _(s)
Definition: cobcrun.c:59
__cob_global::cob_initial_external
int cob_initial_external
Definition: common.h:1205
cob_external::ext_alloc
void * ext_alloc
Definition: common.c:115
cob_external::esize
int esize
Definition: common.c:117
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
cob_external
Definition: common.c:113
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130
cob_runtime_error
void cob_runtime_error(const char *fmt,...)
Definition: common.c:1543
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

void* cob_fast_malloc ( const size_t  )

Definition at line 1296 of file common.c.

References cob_fatal_error(), COB_FERROR_MEMORY, and unlikely.

Referenced by cob_check_numeric(), cob_decimal_set_display(), cob_display_env_value(), cob_file_sort_init(), cob_get_buff(), cob_getopt_long_long(), cob_gettmpdir(), cob_init(), cob_init_call(), cob_init_fileio(), cob_inspect_init(), cob_int_to_formatted_bytestring(), cob_new_item(), cob_save_env_value(), cob_strcat(), and cobcrun_setenv().

1297 {
1298  void *mptr;
1299 
1300  mptr = malloc (size);
1301  if (unlikely(!mptr)) {
1302  cob_fatal_error (COB_FERROR_MEMORY);
1303  }
1304  return mptr;
1305 }
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
unlikely
#define unlikely(x)
Definition: common.h:437
COB_FERROR_MEMORY
#define COB_FERROR_MEMORY
Definition: common.h:697

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_fatal_error ( const int  )

Definition at line 1601 of file common.c.

References _, cob_file::assign, COB_D2I, __cob_global::cob_error_file, COB_FERROR_CANCEL, COB_FERROR_CHAINING, COB_FERROR_CODEGEN, COB_FERROR_FILE, COB_FERROR_FREE, COB_FERROR_FUNCTION, COB_FERROR_GLOBAL, COB_FERROR_INITIALIZED, COB_FERROR_MEMORY, COB_FERROR_MODULE, COB_FERROR_NONE, COB_FERROR_RECURSIVE, COB_FERROR_STACK, cob_field_to_string(), COB_FILE_BUFF, COB_FILE_MAX, cob_free(), cob_malloc(), COB_MODULE_PTR, cob_runtime_error(), COB_STATUS_10_END_OF_FILE, COB_STATUS_14_OUT_OF_KEY_RANGE, COB_STATUS_21_KEY_INVALID, COB_STATUS_22_KEY_EXISTS, COB_STATUS_23_KEY_NOT_EXISTS, COB_STATUS_30_PERMANENT_ERROR, COB_STATUS_35_NOT_EXISTS, COB_STATUS_37_PERMISSION_DENIED, COB_STATUS_41_ALREADY_OPEN, COB_STATUS_42_NOT_OPEN, COB_STATUS_43_READ_NOT_DONE, COB_STATUS_44_RECORD_OVERFLOW, COB_STATUS_46_READ_ERROR, COB_STATUS_47_INPUT_DENIED, COB_STATUS_48_OUTPUT_DENIED, COB_STATUS_49_I_O_DENIED, COB_STATUS_51_RECORD_LOCKED, COB_STATUS_57_I_O_LINAGE, COB_STATUS_61_FILE_SHARING, COB_STATUS_91_NOT_AVAILABLE, cob_stop_run(), and cob_file::file_status.

Referenced by CHECKSRC_(), cob_call(), cob_call_field(), cob_cancel(), cob_cancel_field(), cob_fast_malloc(), cob_file_open(), cob_free(), cob_get_global_ptr(), cob_intr_boolean_of_integer(), cob_intr_char_national(), cob_intr_display_of(), cob_intr_exception_file_n(), cob_intr_exception_location_n(), cob_intr_integer_of_boolean(), cob_intr_national_of(), cob_intr_standard_compare(), cob_longjmp(), cob_malloc(), cob_module_enter(), cob_realloc(), cob_resolve_internal(), cob_savenv(), cobxref_(), field_display(), GCic_(), get__reserved__lists_(), integer_of_ddd(), integer_of_formatted_date(), integer_of_mmdd(), integer_of_wwwd(), LISTING_(), and seconds_from_formatted_time().

1602 {
1603  const char *msg;
1604  unsigned char *file_status;
1605  char *err_cause;
1606  int status;
1607 
1608  switch (fatal_error) {
1609 #if 0 /* Currently not in use, should enter unknown error */
1610  case COB_FERROR_NONE:
1611  cob_runtime_error (_("cob_init() has not been called"));
1612  break;
1613 #endif
1614  case COB_FERROR_CANCEL:
1615  cob_runtime_error (_("Attempt to CANCEL active program"));
1616  break;
1617  case COB_FERROR_INITIALIZED:
1618  cob_runtime_error (_("cob_init() has not been called"));
1619  break;
1620  case COB_FERROR_CODEGEN:
1621  cob_runtime_error (_("Codegen error - Please report this"));
1622  break;
1623  case COB_FERROR_CHAINING:
1624  cob_runtime_error (_("Recursive call of chained program"));
1625  break;
1626  case COB_FERROR_STACK:
1627  cob_runtime_error (_("Stack overflow, possible PERFORM depth exceeded"));
1628  break;
1629  case COB_FERROR_GLOBAL:
1630  cob_runtime_error (_("Invalid entry/exit in GLOBAL USE procedure"));
1631  break;
1632  case COB_FERROR_MEMORY:
1633  cob_runtime_error (_("Unable to allocate memory"));
1634  break;
1635  case COB_FERROR_MODULE:
1636  cob_runtime_error (_("Invalid entry into module"));
1637  break;
1638  case COB_FERROR_RECURSIVE:
1639  cob_runtime_error (_("Invalid recursive COBOL CALL to '%s'"),
1640  COB_MODULE_PTR->module_name);
1641  break;
1642  case COB_FERROR_FREE:
1643  cob_runtime_error (_("Call to %s with NULL pointer"), "cob_free");
1644  break;
1645  case COB_FERROR_FILE:
1646  file_status = cobglobptr->cob_error_file->file_status;
1647  status = COB_D2I(file_status[0]) * 10 + COB_D2I(file_status[1]);
1648  switch (status) {
1649  case COB_STATUS_10_END_OF_FILE:
1650  msg = _("End of file");
1651  break;
1652  case COB_STATUS_14_OUT_OF_KEY_RANGE:
1653  msg = _("Key out of range");
1654  break;
1655  case COB_STATUS_21_KEY_INVALID:
1656  msg = _("Key order not ascending");
1657  break;
1658  case COB_STATUS_22_KEY_EXISTS:
1659  msg = _("Record key already exists");
1660  break;
1661  case COB_STATUS_23_KEY_NOT_EXISTS:
1662  msg = _("Record key does not exist");
1663  break;
1664  case COB_STATUS_30_PERMANENT_ERROR:
1665  msg = _("Permanent file error");
1666  break;
1667  case COB_STATUS_35_NOT_EXISTS:
1668  msg = _("File does not exist");
1669  break;
1670  case COB_STATUS_37_PERMISSION_DENIED:
1671  msg = _("Permission denied");
1672  break;
1673  case COB_STATUS_41_ALREADY_OPEN:
1674  msg = _("File already open");
1675  break;
1676  case COB_STATUS_42_NOT_OPEN:
1677  msg = _("File not open");
1678  break;
1679  case COB_STATUS_43_READ_NOT_DONE:
1680  msg = _("READ must be executed first");
1681  break;
1682  case COB_STATUS_44_RECORD_OVERFLOW:
1683  msg = _("Record overflow");
1684  break;
1685  case COB_STATUS_46_READ_ERROR:
1686  msg = _("Failed to READ");
1687  break;
1688  case COB_STATUS_47_INPUT_DENIED:
1689  msg = _("READ/START not allowed");
1690  break;
1691  case COB_STATUS_48_OUTPUT_DENIED:
1692  msg = _("WRITE not allowed");
1693  break;
1694  case COB_STATUS_49_I_O_DENIED:
1695  msg = _("DELETE/REWRITE not allowed");
1696  break;
1697  case COB_STATUS_51_RECORD_LOCKED:
1698  msg = _("Record locked by another file connector");
1699  break;
1700  case COB_STATUS_57_I_O_LINAGE:
1701  msg = _("LINAGE values invalid");
1702  break;
1703  case COB_STATUS_61_FILE_SHARING:
1704  msg = _("File sharing conflict");
1705  break;
1706  case COB_STATUS_91_NOT_AVAILABLE:
1707  msg = _("Runtime library is not configured for this operation");
1708  break;
1709  default:
1710  msg = _("Unknown file error");
1711  break;
1712  }
1713  err_cause = cob_malloc ((size_t)COB_FILE_BUFF);
1714  cob_field_to_string (cobglobptr->cob_error_file->assign,
1715  err_cause, (size_t)COB_FILE_MAX);
1716  cob_runtime_error (_("%s (Status = %02d) File : '%s'"),
1717  msg, status, err_cause);
1718  cob_free (err_cause);
1719  break;
1720  case COB_FERROR_FUNCTION:
1721  cob_runtime_error (_("Attempt to use non-implemented function"));
1722  break;
1723  default:
1724  cob_runtime_error (_("Unknown failure : %d"), fatal_error);
1725  break;
1726  }
1727  cob_stop_run (1);
1728 }
COB_STATUS_42_NOT_OPEN
#define COB_STATUS_42_NOT_OPEN
Definition: common.h:847
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_STATUS_10_END_OF_FILE
#define COB_STATUS_10_END_OF_FILE
Definition: common.h:833
COB_STATUS_41_ALREADY_OPEN
#define COB_STATUS_41_ALREADY_OPEN
Definition: common.h:846
COB_FERROR_CODEGEN
#define COB_FERROR_CODEGEN
Definition: common.h:693
__cob_global::cob_error_file
cob_file * cob_error_file
Definition: common.h:1187
COB_STATUS_14_OUT_OF_KEY_RANGE
#define COB_STATUS_14_OUT_OF_KEY_RANGE
Definition: common.h:834
COB_STATUS_23_KEY_NOT_EXISTS
#define COB_STATUS_23_KEY_NOT_EXISTS
Definition: common.h:837
cob_file::assign
cob_field * assign
Definition: common.h:1114
COB_STATUS_61_FILE_SHARING
#define COB_STATUS_61_FILE_SHARING
Definition: common.h:856
COB_FERROR_CANCEL
#define COB_FERROR_CANCEL
Definition: common.h:691
COB_STATUS_35_NOT_EXISTS
#define COB_STATUS_35_NOT_EXISTS
Definition: common.h:842
COB_FERROR_FUNCTION
#define COB_FERROR_FUNCTION
Definition: common.h:702
COB_FERROR_RECURSIVE
#define COB_FERROR_RECURSIVE
Definition: common.h:699
COB_STATUS_44_RECORD_OVERFLOW
#define COB_STATUS_44_RECORD_OVERFLOW
Definition: common.h:849
cob_file::file_status
unsigned char * file_status
Definition: common.h:1113
COB_FERROR_GLOBAL
#define COB_FERROR_GLOBAL
Definition: common.h:696
COB_STATUS_22_KEY_EXISTS
#define COB_STATUS_22_KEY_EXISTS
Definition: common.h:836
COB_FERROR_MODULE
#define COB_FERROR_MODULE
Definition: common.h:698
COB_STATUS_46_READ_ERROR
#define COB_STATUS_46_READ_ERROR
Definition: common.h:850
_
#define _(s)
Definition: cobcrun.c:59
COB_FILE_BUFF
#define COB_FILE_BUFF
Definition: common.h:542
COB_STATUS_48_OUTPUT_DENIED
#define COB_STATUS_48_OUTPUT_DENIED
Definition: common.h:852
COB_STATUS_30_PERMANENT_ERROR
#define COB_STATUS_30_PERMANENT_ERROR
Definition: common.h:839
COB_FERROR_CHAINING
#define COB_FERROR_CHAINING
Definition: common.h:694
COB_FERROR_FILE
#define COB_FERROR_FILE
Definition: common.h:701
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_STATUS_21_KEY_INVALID
#define COB_STATUS_21_KEY_INVALID
Definition: common.h:835
COB_FERROR_STACK
#define COB_FERROR_STACK
Definition: common.h:695
COB_STATUS_43_READ_NOT_DONE
#define COB_STATUS_43_READ_NOT_DONE
Definition: common.h:848
cob_field_to_string
void cob_field_to_string(const cob_field *f, void *str, const size_t maxsize)
Definition: common.c:1492
COB_STATUS_49_I_O_DENIED
#define COB_STATUS_49_I_O_DENIED
Definition: common.h:853
COB_FERROR_FREE
#define COB_FERROR_FREE
Definition: common.h:703
COB_FERROR_INITIALIZED
#define COB_FERROR_INITIALIZED
Definition: common.h:692
COB_STATUS_57_I_O_LINAGE
#define COB_STATUS_57_I_O_LINAGE
Definition: common.h:855
COB_STATUS_51_RECORD_LOCKED
#define COB_STATUS_51_RECORD_LOCKED
Definition: common.h:854
COB_STATUS_47_INPUT_DENIED
#define COB_STATUS_47_INPUT_DENIED
Definition: common.h:851
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130
COB_D2I
#define COB_D2I(x)
Definition: coblocal.h:177
COB_FILE_MAX
#define COB_FILE_MAX
Definition: common.h:548
COB_STATUS_91_NOT_AVAILABLE
#define COB_STATUS_91_NOT_AVAILABLE
Definition: common.h:857
COB_STATUS_37_PERMISSION_DENIED
#define COB_STATUS_37_PERMISSION_DENIED
Definition: common.h:843
COB_FERROR_MEMORY
#define COB_FERROR_MEMORY
Definition: common.h:697
cob_runtime_error
void cob_runtime_error(const char *fmt,...)
Definition: common.c:1543
COB_FERROR_NONE
#define COB_FERROR_NONE
Definition: common.h:690
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_field_accept ( cob_field *  ,
cob_field *  ,
cob_field *  ,
cob_field *  ,
cob_field *  ,
cob_field *  ,
cob_field *  ,
cob_field *  ,
cob_field *  ,
const int   
)

Definition at line 2353 of file screenio.c.

References extract_line_and_col_vals(), and field_accept().

Referenced by cob_accept(), and GCic_().

2357 {
2358  int sline;
2359  int scolumn;
2360 
2361  extract_line_and_col_vals (0, line, column, &sline, &scolumn);
2362  field_accept (f, sline, scolumn, fgc, bgc, fscroll, ftimeout, prompt, size_is, fattr);
2363 }
extract_line_and_col_vals
static void extract_line_and_col_vals(const int is_screen, cob_field *line, cob_field *column, int *sline, int *scolumn)
Definition: screenio.c:1564
field_accept
static void field_accept(cob_field *f, const int sline, const int scolumn, cob_field *fgc, cob_field *bgc, cob_field *fscroll, cob_field *ftimeout, cob_field *prompt, cob_field *size_is, const int fattr)
Definition: screenio.c:1769
line
if fold fold static computed alternate extra correct stack on syntax debugging line
Definition: flag.def:90

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_field_display ( cob_field *  ,
cob_field *  ,
cob_field *  ,
cob_field *  ,
cob_field *  ,
cob_field *  ,
cob_field *  ,
const int   
)

Definition at line 2341 of file screenio.c.

References extract_line_and_col_vals(), and field_display().

Referenced by cob_display().

2344 {
2345  int sline;
2346  int scolumn;
2347 
2348  extract_line_and_col_vals (0, line, column, &sline, &scolumn);
2349  field_display (f, sline, scolumn, fgc, bgc, fscroll, size_is, fattr);
2350 }
field_display
static void field_display(cob_field *f, const int line, const int column, cob_field *fgc, cob_field *bgc, cob_field *fscroll, cob_field *size_is, const int fattr)
Definition: screenio.c:1700
extract_line_and_col_vals
static void extract_line_and_col_vals(const int is_screen, cob_field *line, cob_field *column, int *sline, int *scolumn)
Definition: screenio.c:1564
line
if fold fold static computed alternate extra correct stack on syntax debugging line
Definition: flag.def:90

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_file_release ( cob_file *  )

Definition at line 6227 of file fileio.c.

References cob_file_sort_submit(), COB_STATUS_00_SUCCESS, COB_STATUS_30_PERMANENT_ERROR, cob_field::data, cob_file::file, cobsort::fnstatus, likely, NULL, cob_file::record, save_status(), and cobsort::sort_return.

Referenced by LISTING_().

6228 {
6229  struct cobsort *hp;
6230  cob_field *fnstatus;
6231  int ret;
6232 
6233  fnstatus = NULL;
6234  hp = f->file;
6235  if (likely(hp)) {
6236  fnstatus = hp->fnstatus;
6237  }
6238  ret = cob_file_sort_submit (f, f->record->data);
6239  if (!ret) {
6240  save_status (f, fnstatus, COB_STATUS_00_SUCCESS);
6241  return;
6242  }
6243  if (likely(hp)) {
6244  *(int *)(hp->sort_return) = 16;
6245  }
6246  save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR);
6247 }
cobsort::file
struct file_struct file[4]
Definition: fileio.c:226
COB_STATUS_00_SUCCESS
#define COB_STATUS_00_SUCCESS
Definition: common.h:828
cob_field
Definition: common.h:950
cobsort::fnstatus
cob_field * fnstatus
Definition: fileio.c:209
cobsort::sort_return
void * sort_return
Definition: fileio.c:208
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_STATUS_30_PERMANENT_ERROR
#define COB_STATUS_30_PERMANENT_ERROR
Definition: common.h:839
save_status
static void save_status(cob_file *f, cob_field *fnstatus, const int status)
Definition: fileio.c:668
cob_file_sort_submit
static int cob_file_sort_submit(cob_file *f, const unsigned char *p)
Definition: fileio.c:5969
likely
#define likely(x)
Definition: common.h:436

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_file_return ( cob_file *  )

Definition at line 6250 of file fileio.c.

References cob_file_sort_retrieve(), COB_STATUS_00_SUCCESS, COB_STATUS_10_END_OF_FILE, COB_STATUS_30_PERMANENT_ERROR, COBSORTEND, cob_field::data, cob_file::file, cobsort::fnstatus, likely, NULL, cob_file::record, save_status(), and cobsort::sort_return.

Referenced by LISTING_().

6251 {
6252  struct cobsort *hp;
6253  cob_field *fnstatus;
6254  int ret;
6255 
6256  fnstatus = NULL;
6257  hp = f->file;
6258  if (likely(hp)) {
6259  fnstatus = hp->fnstatus;
6260  }
6261  ret = cob_file_sort_retrieve (f, f->record->data);
6262  switch (ret) {
6263  case 0:
6264  save_status (f, fnstatus, COB_STATUS_00_SUCCESS);
6265  return;
6266  case COBSORTEND:
6267  save_status (f, fnstatus, COB_STATUS_10_END_OF_FILE);
6268  return;
6269  }
6270  if (likely(hp)) {
6271  *(int *)(hp->sort_return) = 16;
6272  }
6273  save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR);
6274 }
COB_STATUS_10_END_OF_FILE
#define COB_STATUS_10_END_OF_FILE
Definition: common.h:833
cobsort::file
struct file_struct file[4]
Definition: fileio.c:226
COB_STATUS_00_SUCCESS
#define COB_STATUS_00_SUCCESS
Definition: common.h:828
COBSORTEND
#define COBSORTEND
Definition: fileio.c:170
cob_field
Definition: common.h:950
cobsort::fnstatus
cob_field * fnstatus
Definition: fileio.c:209
cob_file_sort_retrieve
static int cob_file_sort_retrieve(cob_file *f, unsigned char *p)
Definition: fileio.c:6022
cobsort::sort_return
void * sort_return
Definition: fileio.c:208
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_STATUS_30_PERMANENT_ERROR
#define COB_STATUS_30_PERMANENT_ERROR
Definition: common.h:839
save_status
static void save_status(cob_file *f, cob_field *fnstatus, const int status)
Definition: fileio.c:668
likely
#define likely(x)
Definition: common.h:436

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_file_sort_close ( cob_file *  )

Definition at line 6201 of file fileio.c.

References cob_free(), cob_free_list(), COB_STATUS_00_SUCCESS, cobsort::file, cob_file::file, cobsort::fnstatus, file_struct::fp, cob_file::keys, likely, NULL, and save_status().

Referenced by cobxref_(), and LISTING_().

6202 {
6203  struct cobsort *hp;
6204  cob_field *fnstatus;
6205  size_t i;
6206 
6207  fnstatus = NULL;
6208  hp = f->file;
6209  if (likely(hp)) {
6210  fnstatus = hp->fnstatus;
6211  cob_free_list (hp);
6212  for (i = 0; i < 4; ++i) {
6213  if (hp->file[i].fp != NULL) {
6214  fclose (hp->file[i].fp);
6215  }
6216  }
6217  cob_free (hp);
6218  }
6219  if (f->keys) {
6220  cob_free (f->keys);
6221  }
6222  f->file = NULL;
6223  save_status (f, fnstatus, COB_STATUS_00_SUCCESS);
6224 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cobsort::file
struct file_struct file[4]
Definition: fileio.c:226
COB_STATUS_00_SUCCESS
#define COB_STATUS_00_SUCCESS
Definition: common.h:828
cob_field
Definition: common.h:950
cobsort::fnstatus
cob_field * fnstatus
Definition: fileio.c:209
cob_free_list
static void cob_free_list(struct cobsort *hp)
Definition: fileio.c:5646
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
save_status
static void save_status(cob_file *f, cob_field *fnstatus, const int status)
Definition: fileio.c:668
file_struct::fp
FILE * fp
Definition: fileio.c:200
likely
#define likely(x)
Definition: common.h:436

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_file_sort_giving ( cob_file *  ,
const size_t  ,
  ... 
)

Definition at line 6095 of file fileio.c.

References cob_close(), COB_CLOSE_NORMAL, cob_copy_check(), cob_file_sort_retrieve(), COB_FILE_SPECIAL, cob_free(), cob_malloc(), cob_open(), COB_OPEN_OUTPUT, COB_ORG_LINE_SEQUENTIAL, cob_write(), COB_WRITE_BEFORE, COB_WRITE_LINES, COBSORTEND, cob_field::data, cob_file::file, cob_file::file_status, NULL, cob_file::organization, cob_file::record, cob_file::record_max, cob_field::size, and cobsort::sort_return.

Referenced by cobxref_().

6096 {
6097  cob_file **fbase;
6098  struct cobsort *hp;
6099  size_t i;
6100  int ret;
6101  int opt;
6102  va_list args;
6103 
6104  fbase = cob_malloc (varcnt * sizeof(cob_file *));
6105  va_start (args, varcnt);
6106  for (i = 0; i < varcnt; ++i) {
6107  fbase[i] = va_arg (args, cob_file *);
6108  }
6109  va_end (args);
6110  for (i = 0; i < varcnt; ++i) {
6111  cob_open (fbase[i], COB_OPEN_OUTPUT, 0, NULL);
6112  }
6113  for (;;) {
6114  ret = cob_file_sort_retrieve (sort_file, sort_file->record->data);
6115  if (ret) {
6116  if (ret == COBSORTEND) {
6117  sort_file->file_status[0] = '1';
6118  sort_file->file_status[1] = '0';
6119  } else {
6120  hp = sort_file->file;
6121  *(int *)(hp->sort_return) = 16;
6122  sort_file->file_status[0] = '3';
6123  sort_file->file_status[1] = '0';
6124  }
6125  break;
6126  }
6127  for (i = 0; i < varcnt; ++i) {
6128  if (COB_FILE_SPECIAL (fbase[i]) ||
6129  fbase[i]->organization == COB_ORG_LINE_SEQUENTIAL) {
6130  opt = COB_WRITE_BEFORE | COB_WRITE_LINES | 1;
6131  } else {
6132  opt = 0;
6133  }
6134  fbase[i]->record->size = fbase[i]->record_max;
6135  cob_copy_check (fbase[i], sort_file);
6136  cob_write (fbase[i], fbase[i]->record, opt, NULL, 0);
6137  }
6138  }
6139  for (i = 0; i < varcnt; ++i) {
6140  cob_close (fbase[i], NULL, COB_CLOSE_NORMAL, 0);
6141  }
6142  cob_free (fbase);
6143 }
cob_file::record
cob_field * record
Definition: common.h:1115
COB_WRITE_LINES
#define COB_WRITE_LINES
Definition: common.h:802
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cobsort::file
struct file_struct file[4]
Definition: fileio.c:226
cob_file::organization
unsigned char organization
Definition: common.h:1127
cob_write
void cob_write(cob_file *f, cob_field *rec, const int opt, cob_field *fnstatus, const unsigned int check_eop)
Definition: fileio.c:4754
COB_FILE_SPECIAL
#define COB_FILE_SPECIAL(x)
Definition: common.h:765
COBSORTEND
#define COBSORTEND
Definition: fileio.c:170
cob_file_sort_retrieve
static int cob_file_sort_retrieve(cob_file *f, unsigned char *p)
Definition: fileio.c:6022
cobsort::sort_return
void * sort_return
Definition: fileio.c:208
cob_file::record_max
size_t record_max
Definition: common.h:1123
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_open
void cob_open(cob_file *f, const int mode, const int sharing, cob_field *fnstatus)
Definition: fileio.c:4438
COB_WRITE_BEFORE
#define COB_WRITE_BEFORE
Definition: common.h:806
cob_field::size
size_t size
Definition: common.h:951
cob_close
void cob_close(cob_file *f, cob_field *fnstatus, const int opt, const int remfil)
Definition: fileio.c:4498
cob_copy_check
static void cob_copy_check(cob_file *to, cob_file *from)
Definition: fileio.c:5849
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
COB_ORG_LINE_SEQUENTIAL
#define COB_ORG_LINE_SEQUENTIAL
Definition: common.h:743
cob_file
Definition: common.h:1111
COB_OPEN_OUTPUT
#define COB_OPEN_OUTPUT
Definition: common.h:785
COB_CLOSE_NORMAL
#define COB_CLOSE_NORMAL
Definition: common.h:792

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_file_sort_init ( cob_file *  ,
const unsigned  int,
const unsigned char *  ,
void *  ,
cob_field *   
)

Definition at line 6146 of file fileio.c.

References cobsort::alloc_size, cobsort::chunk_size, cob_fast_malloc(), cob_malloc(), COB_MODULE_PTR, __cob_settings::cob_sort_chunk, COB_STATUS_00_SUCCESS, cob_file::file, cobsort::fnstatus, cob_file::keys, cobsort::mem_base, sort_mem_struct::mem_ptr, cobsort::mem_size, cobsort::mem_total, sort_mem_struct::next, cob_file::nkeys, NULL, offsetof, cobsort::pointer, cobsort::r_size, cob_file::record_max, save_status(), cobsort::size, cob_file::sort_collating, cobsort::sort_return, and cobsort::w_size.

Referenced by cobxref_(), and LISTING_().

6149 {
6150  struct cobsort *p;
6151  size_t n;
6152 
6153  p = cob_malloc (sizeof (struct cobsort));
6154  p->fnstatus = fnstatus;
6155  p->size = f->record_max;
6156  p->r_size = f->record_max + sizeof(size_t);
6157  p->w_size = f->record_max + sizeof(size_t) + 1;
6158  n = sizeof (struct cobitem) - offsetof (struct cobitem, item);
6159  if (f->record_max <= n) {
6160  p->alloc_size = sizeof (struct cobitem);
6161  } else {
6162  p->alloc_size = offsetof (struct cobitem, item) + f->record_max;
6163  }
6164  if (p->alloc_size % sizeof(void *)) {
6165  p->alloc_size += sizeof(void *) - (p->alloc_size % sizeof(void *));
6166  }
6167  p->chunk_size = cobsetptr->cob_sort_chunk;
6168  if (p->chunk_size % p->alloc_size) {
6169  p->chunk_size += p->alloc_size - (p->chunk_size % p->alloc_size);
6170  }
6171  p->pointer = f;
6172  p->sort_return = sort_return;
6173  *(int *)sort_return = 0;
6174  p->mem_base = cob_fast_malloc (sizeof (struct sort_mem_struct));
6175  p->mem_base->mem_ptr = cob_fast_malloc (p->chunk_size);
6176  p->mem_base->next = NULL;
6177  p->mem_size = p->chunk_size;
6178  p->mem_total = p->chunk_size;
6179  f->file = p;
6180  f->keys = cob_malloc (sizeof (cob_file_key) * nkeys);
6181  f->nkeys = 0;
6182  if (collating_sequence) {
6183  f->sort_collating = collating_sequence;
6184  } else {
6185  f->sort_collating = COB_MODULE_PTR->collating_sequence;
6186  }
6187  save_status (f, fnstatus, COB_STATUS_00_SUCCESS);
6188 }
sort_mem_struct
Definition: fileio.c:186
sort_mem_struct::next
struct sort_mem_struct * next
Definition: fileio.c:187
cobsort::mem_base
struct sort_mem_struct * mem_base
Definition: fileio.c:210
cobsetptr
static cob_settings * cobsetptr
Definition: fileio.c:235
cobsort::mem_total
size_t mem_total
Definition: fileio.c:216
cobsort::size
size_t size
Definition: fileio.c:212
COB_STATUS_00_SUCCESS
#define COB_STATUS_00_SUCCESS
Definition: common.h:828
cobsort::r_size
size_t r_size
Definition: fileio.c:218
cobsort::fnstatus
cob_field * fnstatus
Definition: fileio.c:209
cobsort::mem_size
size_t mem_size
Definition: fileio.c:214
__cob_settings::cob_sort_chunk
size_t cob_sort_chunk
Definition: coblocal.h:237
cobsort::sort_return
void * sort_return
Definition: fileio.c:208
sort_mem_struct::mem_ptr
unsigned char * mem_ptr
Definition: fileio.c:188
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cobsort::pointer
void * pointer
Definition: fileio.c:206
save_status
static void save_status(cob_file *f, cob_field *fnstatus, const int status)
Definition: fileio.c:668
offsetof
#define offsetof(s_name, m_name)
Definition: coblocal.h:173
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cobsort::w_size
size_t w_size
Definition: fileio.c:219
cobsort::alloc_size
size_t alloc_size
Definition: fileio.c:213
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
cobsort::chunk_size
size_t chunk_size
Definition: fileio.c:217
cob_fast_malloc
void * cob_fast_malloc(const size_t size)
Definition: common.c:1296
cob_file_key
Definition: common.h:1101
cobitem::item
unsigned char item[1]
Definition: fileio.c:182

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_file_sort_init_key ( cob_file *  ,
cob_field *  ,
const int  ,
const unsigned  int 
)

Definition at line 6191 of file fileio.c.

References cob_file_key::field, cob_file_key::flag, cob_file::keys, cob_file::nkeys, and cob_file_key::offset.

Referenced by cobxref_(), and LISTING_().

6193 {
6194  f->keys[f->nkeys].field = field;
6195  f->keys[f->nkeys].flag = flag;
6196  f->keys[f->nkeys].offset = offset;
6197  f->nkeys++;
6198 }

Here is the caller graph for this function:

void cob_file_sort_using ( cob_file *  ,
cob_file *   
)

Definition at line 6075 of file fileio.c.

References cob_close(), COB_CLOSE_NORMAL, cob_copy_check(), cob_file_sort_submit(), cob_open(), COB_OPEN_INPUT, COB_READ_NEXT, cob_read_next(), cob_field::data, cob_file::file_status, NULL, and cob_file::record.

Referenced by cobxref_().

6076 {
6077  int ret;
6078 
6079  cob_open (data_file, COB_OPEN_INPUT, 0, NULL);
6080  for (;;) {
6081  cob_read_next (data_file, NULL, COB_READ_NEXT);
6082  if (data_file->file_status[0] != '0') {
6083  break;
6084  }
6085  cob_copy_check (sort_file, data_file);
6086  ret = cob_file_sort_submit (sort_file, sort_file->record->data);
6087  if (ret) {
6088  break;
6089  }
6090  }
6091  cob_close (data_file, NULL, COB_CLOSE_NORMAL, 0);
6092 }
cob_read_next
void cob_read_next(cob_file *f, cob_field *fnstatus, const int read_opts)
Definition: fileio.c:4696
COB_OPEN_INPUT
#define COB_OPEN_INPUT
Definition: common.h:784
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_open
void cob_open(cob_file *f, const int mode, const int sharing, cob_field *fnstatus)
Definition: fileio.c:4438
cob_file_sort_submit
static int cob_file_sort_submit(cob_file *f, const unsigned char *p)
Definition: fileio.c:5969
cob_close
void cob_close(cob_file *f, cob_field *fnstatus, const int opt, const int remfil)
Definition: fileio.c:4498
cob_copy_check
static void cob_copy_check(cob_file *to, cob_file *from)
Definition: fileio.c:5849
COB_READ_NEXT
#define COB_READ_NEXT
Definition: common.h:813
COB_CLOSE_NORMAL
#define COB_CLOSE_NORMAL
Definition: common.h:792

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_free ( void *  )

Definition at line 1284 of file common.c.

References cob_fatal_error(), COB_FERROR_FREE, and unlikely.

Referenced by alloc_figurative(), cb_config_entry(), cb_list_intrinsics(), cb_load_conf_file(), cob_accept_command_line(), cob_allocate(), cob_cache_free(), cob_cache_realloc(), cob_call(), cob_call_field(), cob_check_numeric(), cob_chk_file_env(), cob_chk_file_mapping(), cob_close(), cob_decimal_get_field(), cob_decimal_pop(), cob_decimal_set_display(), cob_display_command_line(), cob_display_env_value(), cob_display_environment(), cob_exit_call(), cob_exit_common(), cob_exit_fileio(), cob_exit_intrinsic(), cob_exit_numeric(), cob_exit_screen(), cob_exit_strings(), cob_expand_env_string(), cob_fatal_error(), cob_file_sort_close(), cob_file_sort_giving(), cob_free_alloc(), cob_free_list(), cob_get_buff(), cob_get_environment(), cob_getopt_long_long(), cob_gettmpdir(), cob_init(), cob_init_call(), cob_inspect_init(), cob_intr_concatenate(), cob_intr_exception_location(), cob_intr_locale_compare(), cob_intr_median(), cob_intr_numval_f(), cob_move_all(), cob_move_edited_to_display(), cob_realloc(), cob_resolve(), cob_resolve_cobol(), cob_restore_func(), cob_runtime_error(), cob_save_env_value(), cob_set_library_path(), cob_set_locale(), cob_set_location(), cob_srttmpfile(), cob_strcat(), cob_sys_change_dir(), cob_sys_check_file_exist(), cob_sys_copy_file(), cob_sys_create_dir(), cob_sys_delete_dir(), cob_sys_delete_file(), cob_sys_error_proc(), cob_sys_exit_proc(), cob_sys_file_info(), cob_sys_get_current_dir(), cob_sys_getopt_long_long(), cob_sys_rename_file(), cob_sys_system(), cob_table_sort(), cob_trace_section(), cob_unstring_init(), do_cancel_module(), format_field(), indexed_close(), indexed_open(), indirect_move(), insert(), make_field_entry(), numval(), open_cbl_file(), set_config_val(), substitute(), and var_print().

1285 {
1286 #ifdef _DEBUG
1287  if (unlikely(!mptr)) {
1288  cob_fatal_error (COB_FERROR_FREE);
1289  }
1290 #endif
1291  free (mptr);
1292 
1293 }
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
unlikely
#define unlikely(x)
Definition: common.h:437
COB_FERROR_FREE
#define COB_FERROR_FREE
Definition: common.h:703

Here is the call graph for this function:

void cob_free_alloc ( unsigned char **  ,
unsigned char *   
)

Definition at line 3131 of file common.c.

References cob_alloc_base, COB_EC_STORAGE_NOT_ALLOC, __cob_global::cob_exception_code, cob_free(), cob_alloc_cache::cob_pointer, cob_set_exception(), cob_alloc_cache::next, and NULL.

3132 {
3133  struct cob_alloc_cache *cache_ptr;
3134  struct cob_alloc_cache *prev_ptr;
3135  void *vptr1;
3136 
3137  /* FREE */
3138  cobglobptr->cob_exception_code = 0;
3139  cache_ptr = cob_alloc_base;
3140  prev_ptr = cob_alloc_base;
3141  if (ptr1 && *ptr1) {
3142  vptr1 = *ptr1;
3143  for (; cache_ptr; cache_ptr = cache_ptr->next) {
3144  if (vptr1 == cache_ptr->cob_pointer) {
3145  cob_free (cache_ptr->cob_pointer);
3146  if (cache_ptr == cob_alloc_base) {
3147  cob_alloc_base = cache_ptr->next;
3148  } else {
3149  prev_ptr->next = cache_ptr->next;
3150  }
3151  cob_free (cache_ptr);
3152  *ptr1 = NULL;
3153  return;
3154  }
3155  prev_ptr = cache_ptr;
3156  }
3157  cob_set_exception (COB_EC_STORAGE_NOT_ALLOC);
3158  return;
3159  }
3160  if (ptr2 && *(void **)ptr2) {
3161  for (; cache_ptr; cache_ptr = cache_ptr->next) {
3162  if (*(void **)ptr2 == cache_ptr->cob_pointer) {
3163  cob_free (cache_ptr->cob_pointer);
3164  if (cache_ptr == cob_alloc_base) {
3165  cob_alloc_base = cache_ptr->next;
3166  } else {
3167  prev_ptr->next = cache_ptr->next;
3168  }
3169  cob_free (cache_ptr);
3170  *(void **)ptr2 = NULL;
3171  return;
3172  }
3173  prev_ptr = cache_ptr;
3174  }
3175  cob_set_exception (COB_EC_STORAGE_NOT_ALLOC);
3176  return;
3177  }
3178 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_alloc_base
static struct cob_alloc_cache * cob_alloc_base
Definition: common.c:127
cob_alloc_cache::cob_pointer
void * cob_pointer
Definition: common.c:107
cob_alloc_cache::next
struct cob_alloc_cache * next
Definition: common.c:106
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
__cob_global::cob_exception_code
int cob_exception_code
Definition: common.h:1203
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130
cob_alloc_cache
Definition: common.c:105

Here is the call graph for this function:

int cob_func ( const char *  ,
const int  ,
void **   
)

Definition at line 1150 of file call.c.

References cob_call(), and cob_cancel().

1151 {
1152  int ret;
1153 
1154  ret = cob_call (name, argc, argv);
1155  cob_cancel (name);
1156  return ret;
1157 }
cob_cancel
void cob_cancel(const char *name)
Definition: call.c:1013
cob_call
int cob_call(const char *name, const int argc, void **argv)
Definition: call.c:1080

Here is the call graph for this function:

void cob_get_environment ( const cob_field *  ,
cob_field *   
)

Definition at line 3025 of file common.c.

References COB_EC_IMP_ACCEPT, __cob_settings::cob_env_mangle, cob_field_to_string(), cob_free(), cob_malloc(), cob_memcpy(), cob_set_exception(), cob_field::size, and unlikely.

Referenced by cobxref_(), GCic_(), and LISTING_().

3026 {
3027  const char *p;
3028  char *buff;
3029  size_t size;
3030 
3031  if (envname->size == 0 || envval->size == 0) {
3032  cob_set_exception (COB_EC_IMP_ACCEPT);
3033  return;
3034  }
3035 
3036  buff = cob_malloc (envname->size + 1U);
3037  cob_field_to_string (envname, buff, envname->size);
3038  if (unlikely(cobsetptr->cob_env_mangle)) {
3039  for (size = 0; size < strlen (buff); ++size) {
3040  if (!isalnum ((int)buff[size])) {
3041  buff[size] = '_';
3042  }
3043  }
3044  }
3045  p = getenv (buff);
3046  if (!p) {
3047  cob_set_exception (COB_EC_IMP_ACCEPT);
3048  p = " ";
3049  }
3050  cob_memcpy (envval, p, strlen (p));
3051  cob_free (buff);
3052 }
cob_memcpy
static void cob_memcpy(cob_field *dst, const void *src, const size_t size)
Definition: common.c:1042
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_alloc_cache::size
size_t size
Definition: common.c:108
cobsetptr
static cob_settings * cobsetptr
Definition: common.c:131
unlikely
#define unlikely(x)
Definition: common.h:437
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_field_to_string
void cob_field_to_string(const cob_field *f, void *str, const size_t maxsize)
Definition: common.c:1492
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
__cob_settings::cob_env_mangle
unsigned int cob_env_mangle
Definition: coblocal.h:205

Here is the call graph for this function:

Here is the caller graph for this function:

cob_global* cob_get_global_ptr ( void  )

Definition at line 1787 of file common.c.

References cob_fatal_error(), COB_FERROR_INITIALIZED, cob_initialized, cobglobptr, and unlikely.

1788 {
1789  if (unlikely(!cob_initialized)) {
1790  cob_fatal_error (COB_FERROR_INITIALIZED);
1791  }
1792  return cobglobptr;
1793 }
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
unlikely
#define unlikely(x)
Definition: common.h:437
COB_FERROR_INITIALIZED
#define COB_FERROR_INITIALIZED
Definition: common.h:692
cob_initialized
static int cob_initialized
Definition: common.c:124
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130

Here is the call graph for this function:

void cob_get_indirect_field ( cob_field *  )

Definition at line 3096 of file intrinsic.c.

References cob_move().

Referenced by cobxref_().

3097 {
3098  cob_move (move_field, f);
3099 }
move_field
static cob_field * move_field
Definition: intrinsic.c:77
cob_move
void cob_move(cob_field *, cob_field *)
Definition: move.c:1170

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_get_int ( cob_field *  )

Definition at line 1626 of file move.c.

References cob_field::attr, COB_ATTR_INIT, cob_binary_mget_sint64(), cob_display_get_int(), COB_FIELD_SCALE, COB_FIELD_TYPE, COB_FLAG_HAVE_SIGN, cob_move(), cob_packed_get_int(), cob_s64_t, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_PACKED, cob_field::data, NULL, and cob_field::size.

Referenced by cob_allocate(), cob_intr_char(), cob_intr_combined_datetime(), cob_intr_date_of_integer(), cob_intr_date_to_yyyymmdd(), cob_intr_day_of_integer(), cob_intr_day_to_yyyyddd(), cob_intr_factorial(), cob_intr_formatted_date(), cob_intr_formatted_datetime(), cob_intr_formatted_time(), cob_intr_integer_of_date(), cob_intr_integer_of_day(), cob_intr_lcl_time_from_secs(), cob_intr_locale_date(), cob_intr_locale_time(), cob_intr_random(), cob_intr_test_date_yyyymmdd(), cob_intr_test_day_yyyyddd(), cob_intr_year_to_yyyy(), cob_linage_write_opt(), cob_rewrite(), cob_screen_attr(), cob_screen_moveyx(), cob_start(), cob_string_init(), cob_sys_getopt_long_long(), cob_sys_parameter_size(), cob_sys_sleep(), cob_unstring_init(), cob_write(), field_accept(), field_display(), file_linage_check(), get_fractional_seconds(), get_interval_and_current_year_from_args(), get_line_column(), pos_to_line_column(), relative_delete(), relative_read(), relative_rewrite(), relative_start(), relative_write(), screen_accept(), and try_get_valid_offset_time().

1627 {
1628  int n;
1629  cob_s64_t val;
1630  cob_field temp;
1631  cob_field_attr attr;
1632 
1633  switch (COB_FIELD_TYPE (f)) {
1634  case COB_TYPE_NUMERIC_DISPLAY:
1635  return cob_display_get_int (f);
1636  case COB_TYPE_NUMERIC_PACKED:
1637  return cob_packed_get_int (f);
1638  case COB_TYPE_NUMERIC_BINARY:
1639  val = cob_binary_mget_sint64 (f);
1640  for (n = COB_FIELD_SCALE (f); n > 0 && val; --n) {
1641  val /= 10;
1642  }
1643  return (int)val;
1644  default:
1645  COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, 0,
1646  COB_FLAG_HAVE_SIGN, NULL);
1647  temp.size = 4;
1648  temp.data = (unsigned char *)&n;
1649  temp.attr = &attr;
1650  cob_move (f, &temp);
1651  return n;
1652  }
1653 }
COB_FIELD_SCALE
#define COB_FIELD_SCALE(f)
Definition: common.h:664
COB_TYPE_NUMERIC_PACKED
#define COB_TYPE_NUMERIC_PACKED
Definition: common.h:609
cob_move
void cob_move(cob_field *src, cob_field *dst)
Definition: move.c:1170
cob_display_get_int
static int cob_display_get_int(cob_field *f)
Definition: move.c:1534
COB_FIELD_TYPE
#define COB_FIELD_TYPE(f)
Definition: common.h:662
cob_field
Definition: common.h:950
COB_ATTR_INIT
#define COB_ATTR_INIT(u, v, x, y, z)
Definition: coblocal.h:150
cob_field::data
unsigned char * data
Definition: common.h:952
cob_s64_t
#define cob_s64_t
Definition: common.h:51
COB_FLAG_HAVE_SIGN
#define COB_FLAG_HAVE_SIGN
Definition: common.h:630
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_binary_mget_sint64
static COB_INLINE COB_A_INLINE cob_s64_t cob_binary_mget_sint64(const cob_field *const f)
Definition: move.c:163
COB_TYPE_NUMERIC_BINARY
#define COB_TYPE_NUMERIC_BINARY
Definition: common.h:608
COB_TYPE_NUMERIC_DISPLAY
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
cob_field_attr
Definition: common.h:940
cob_field::size
size_t size
Definition: common.h:951
cob_field::attr
const cob_field_attr * attr
Definition: common.h:953
cob_packed_get_int
static int cob_packed_get_int(cob_field *f1)
Definition: move.c:1472

Here is the call graph for this function:

Here is the caller graph for this function:

long long cob_get_llint ( cob_field *  )

Definition at line 1656 of file move.c.

References cob_field::attr, cob_binary_mget_sint64(), cob_display_get_long_long(), COB_FIELD_SCALE, COB_FIELD_TYPE, cob_move(), cob_packed_get_long_long(), cob_s64_t, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_PACKED, const_binll_attr, cob_field::data, and cob_field::size.

Referenced by cob_sys_oc_nanosleep(), cobxref_(), and LISTING_().

1657 {
1658  cob_s64_t n;
1659  int inc;
1660  cob_field temp;
1661 
1662  switch (COB_FIELD_TYPE (f)) {
1663  case COB_TYPE_NUMERIC_DISPLAY:
1664  return cob_display_get_long_long (f);
1665  case COB_TYPE_NUMERIC_PACKED:
1666  return cob_packed_get_long_long (f);
1667  case COB_TYPE_NUMERIC_BINARY:
1668  n = cob_binary_mget_sint64 (f);
1669  for (inc = COB_FIELD_SCALE (f); inc > 0 && n; --inc) {
1670  n /= 10;
1671  }
1672  return n;
1673  default:
1674  temp.size = 8;
1675  temp.data = (unsigned char *)&n;
1676  temp.attr = &const_binll_attr;
1677  cob_move (f, &temp);
1678  return n;
1679  }
1680 }
COB_FIELD_SCALE
#define COB_FIELD_SCALE(f)
Definition: common.h:664
COB_TYPE_NUMERIC_PACKED
#define COB_TYPE_NUMERIC_PACKED
Definition: common.h:609
cob_move
void cob_move(cob_field *src, cob_field *dst)
Definition: move.c:1170
COB_FIELD_TYPE
#define COB_FIELD_TYPE(f)
Definition: common.h:662
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
cob_s64_t
#define cob_s64_t
Definition: common.h:51
cob_display_get_long_long
static cob_s64_t cob_display_get_long_long(cob_field *f)
Definition: move.c:1573
cob_binary_mget_sint64
static COB_INLINE COB_A_INLINE cob_s64_t cob_binary_mget_sint64(const cob_field *const f)
Definition: move.c:163
COB_TYPE_NUMERIC_BINARY
#define COB_TYPE_NUMERIC_BINARY
Definition: common.h:608
COB_TYPE_NUMERIC_DISPLAY
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
const_binll_attr
static const cob_field_attr const_binll_attr
Definition: move.c:53
cob_field::size
size_t size
Definition: common.h:951
cob_field::attr
const cob_field_attr * attr
Definition: common.h:953
cob_packed_get_long_long
static cob_s64_t cob_packed_get_long_long(cob_field *f1)
Definition: move.c:1503

Here is the call graph for this function:

Here is the caller graph for this function:

unsigned char* cob_get_pointer ( const void *  )

Definition at line 1474 of file common.c.

References cob_u8_ptr.

1475 {
1476  void *tmptr;
1477 
1478  memcpy (&tmptr, srcptr, sizeof (void *));
1479  return (cob_u8_ptr)tmptr;
1480 }
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
void* cob_get_prog_pointer ( const void *  )

Definition at line 1483 of file common.c.

1484 {
1485  void *tmptr;
1486 
1487  memcpy (&tmptr, srcptr, sizeof (void *));
1488  return tmptr;
1489 }
int cob_get_switch ( const int  )

Definition at line 2296 of file common.c.

References cob_switch, and COB_SWITCH_MAX.

Referenced by cob_switch_value().

2297 {
2298  if (n < 0 || n > COB_SWITCH_MAX) {
2299  return 0;
2300  }
2301  return cob_switch[n];
2302 }
cob_switch
static int cob_switch[36+1]
Definition: common.c:201
COB_SWITCH_MAX
#define COB_SWITCH_MAX
Definition: common.c:199

Here is the caller graph for this function:

char* cob_getenv ( const char *  )

Definition at line 3181 of file common.c.

References cob_strdup(), and NULL.

3182 {
3183  char *p;
3184 
3185  if (name) {
3186  p = getenv (name);
3187  if (p) {
3188  return cob_strdup (p);
3189  }
3190  }
3191  return NULL;
3192 }
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_strdup
char * cob_strdup(const char *p)
Definition: common.c:1308

Here is the call graph for this function:

void cob_gmp_free ( void *  )

Definition at line 217 of file numeric.c.

References NULL.

Referenced by cob_decimal_get_display(), cob_decimal_get_packed(), cob_decimal_set_double(), and cob_decimal_set_mpf().

217  {
218 /* mpir/gmp free functions */
219 #ifdef HAVE_MP_GET_MEMORY_FUNCTIONS
220  void (*freefunc)(void *, size_t);
221  mp_get_memory_functions (NULL, NULL, &freefunc);
222  freefunc (ptr, strlen((char*) ptr) + 1);
223 #else
224  free (ptr);
225 #endif
226 }
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the caller graph for this function:

void cob_incr_temp_iteration ( void  )

Definition at line 3266 of file common.c.

References cob_temp_iteration.

Referenced by cob_srttmpfile(), and process_filename().

3267 {
3268  cob_temp_iteration++;
3269 }
cob_temp_iteration
static int cob_temp_iteration
Definition: common.c:161

Here is the caller graph for this function:

void cob_init ( const int  ,
char **   
)

Definition at line 5390 of file common.c.

References _, bindtextdomain, cob_argc, cob_argv, cob_current_paragraph, cob_current_program_id, cob_current_section, COB_ERRBUF_SIZE, cob_fast_malloc(), cob_free(), cob_init_call(), cob_init_fileio(), cob_init_intrinsic(), cob_init_move(), cob_init_numeric(), cob_init_screenio(), cob_init_strings(), cob_init_termio(), cob_initialized, COB_LARGE_BUFF, COB_LARGE_MAX, cob_last_sfile, cob_load_config(), cob_local_env, cob_local_env_size, __cob_global::cob_locale, __cob_global::cob_locale_collate, __cob_global::cob_locale_ctype, __cob_global::cob_locale_messages, __cob_global::cob_locale_monetary, __cob_global::cob_locale_numeric, __cob_global::cob_locale_orig, __cob_global::cob_locale_time, __cob_global::cob_main_argv0, cob_malloc(), COB_MEDIUM_BUFF, __cob_settings::cob_physical_cancel, __cob_global::cob_physical_cancel, cob_set_signal(), cob_source_file, cob_source_line, cob_source_statement, cob_stop_run(), cob_strdup(), cob_switch, COB_SWITCH_MAX, __cob_global::cob_term_buff, __cob_settings::cob_unix_lf, __cob_settings::cob_user_name, commlncnt, commlnptr, current_arg, exit_hdlrs, hdlrs, LOCALEDIR, NULL, PACKAGE, R_OK, runtime_err_str, set_config_val_by_name(), sort_collate, sort_nkeys, textdomain, and unlikely.

Referenced by cob_extern_init(), cob_module_enter(), main(), and process_command_line().

5391 {
5392  char *s;
5393 #if defined(HAVE_READLINK) || defined(HAVE_GETEXECNAME)
5394  const char *path;
5395 #endif
5396 #ifdef ENABLE_NLS
5397  const char* localedir;
5398 #endif
5399 #if defined(_MSC_VER) && COB_USE_VC2008_OR_GREATER
5400  HMODULE kernel32_handle;
5401 #endif
5402  int i;
5403 
5404 #if 0 /* Simon: Should not happen - is it neccessary any where?
5405  We may change this to a runtime warning/error */
5406  if (cob_initialized) {
5407  return;
5408  }
5409 #endif
5410 
5411  cob_set_signal ();
5412 
5413  cob_alloc_base = NULL;
5414  cob_local_env = NULL;
5415  cob_last_sfile = NULL;
5416  commlnptr = NULL;
5417  basext = NULL;
5418  sort_keys = NULL;
5419  sort_collate = NULL;
5420  cob_current_program_id = NULL;
5421  cob_current_section = NULL;
5422  cob_current_paragraph = NULL;
5423  cob_source_file = NULL;
5424  cob_source_statement = NULL;
5425  exit_hdlrs = NULL;
5426  hdlrs = NULL;
5427  commlncnt = 0;
5428  sort_nkeys = 0;
5429  cob_source_line = 0;
5430  cob_local_env_size = 0;
5431 
5432  current_arg = 1;
5433 
5434  cob_argc = argc;
5435  cob_argv = argv;
5436 
5437  /* Get emergency buffer */
5438  runtime_err_str = cob_fast_malloc ((size_t)COB_ERRBUF_SIZE);
5439 
5440  /* Get global structure */
5441  cobglobptr = cob_malloc (sizeof(cob_global));
5442 
5443  /* Get settings structure */
5444  cobsetptr = cob_malloc (sizeof(cob_settings));
5445 
5446  cob_initialized = 1;
5447 
5448 #ifdef HAVE_SETLOCALE
5449  /* Prime the locale from user settings */
5450  s = setlocale (LC_ALL, "");
5451  if (s) {
5452  /* Save initial values */
5453  cobglobptr->cob_locale_orig = cob_strdup (s);
5454  s = setlocale (LC_CTYPE, NULL);
5455  if (s) {
5456  cobglobptr->cob_locale_ctype = cob_strdup (s);
5457  }
5458  s = setlocale (LC_COLLATE, NULL);
5459  if (s) {
5460  cobglobptr->cob_locale_collate = cob_strdup (s);
5461  }
5462 #ifdef LC_MESSAGES
5463  s = setlocale (LC_MESSAGES, NULL);
5464  if (s) {
5465  cobglobptr->cob_locale_messages = cob_strdup (s);
5466  }
5467 #endif
5468  s = setlocale (LC_MONETARY, NULL);
5469  if (s) {
5470  cobglobptr->cob_locale_monetary = cob_strdup (s);
5471  }
5472  s = setlocale (LC_NUMERIC, NULL);
5473  if (s) {
5474  cobglobptr->cob_locale_numeric = cob_strdup (s);
5475  }
5476  s = setlocale (LC_TIME, NULL);
5477  if (s) {
5478  cobglobptr->cob_locale_time = cob_strdup (s);
5479  }
5480  /* Set to standard "C" locale for COBOL */
5481  setlocale (LC_NUMERIC, "C");
5482  setlocale (LC_CTYPE, "C");
5483  /* Save changed locale */
5484  s = setlocale (LC_ALL, NULL);
5485  if (s) {
5486  cobglobptr->cob_locale = cob_strdup (s);
5487  }
5488  }
5489 #endif
5490 
5491 #ifdef ENABLE_NLS
5492  localedir = getenv("LOCALEDIR");
5493  if (localedir != NULL) {
5494  bindtextdomain (PACKAGE, localedir);
5495  } else {
5496  bindtextdomain (PACKAGE, LOCALEDIR);
5497  }
5498  textdomain (PACKAGE);
5499 #endif
5500 
5501 #ifdef _WIN32
5502  /* cob_unix_lf needs to be set before configuration load,
5503  possible error messages would have wrong line endings otherwise */
5504  if ((s = getenv("COB_UNIX_LF")) != NULL) {
5505  set_config_val_by_name (s, "unix_lf", NULL);
5506  }
5507  if (cobsetptr->cob_unix_lf) {
5508  (void)_setmode (_fileno (stdin), _O_BINARY);
5509  (void)_setmode (_fileno (stdout), _O_BINARY);
5510  (void)_setmode (_fileno (stderr), _O_BINARY);
5511  }
5512 #endif
5513 
5514  /* Load runtime configuration file */
5515  if (unlikely(cob_load_config() < 0)) {
5516  cob_stop_run (1);
5517  }
5518 
5519  /* Copy COB_PHYSICAL_CANCEL from settings (internal) to global structure */
5520  cobglobptr->cob_physical_cancel = cobsetptr->cob_physical_cancel;
5521 
5522  /* Call inits with cobsetptr to get the adresses of all */
5523  /* Screen-IO might be needed for error outputs */
5524  cob_init_screenio(cobglobptr, cobsetptr);
5525  cob_init_numeric(cobglobptr);
5526  cob_init_strings();
5527  cob_init_move(cobglobptr, cobsetptr);
5528  cob_init_intrinsic(cobglobptr);
5529  cob_init_fileio(cobglobptr, cobsetptr);
5530  cob_init_call(cobglobptr, cobsetptr);
5531  cob_init_termio(cobglobptr, cobsetptr);
5532 
5533  /* Set up library routine stuff */
5534  cobglobptr->cob_term_buff = cob_malloc ((size_t)COB_MEDIUM_BUFF);
5535 
5536  /* Set switches */
5537  for (i = 0; i <= COB_SWITCH_MAX; ++i) {
5538  sprintf (runtime_err_str, "COB_SWITCH_%d", i);
5539  s = getenv (runtime_err_str);
5540  if (s && (*s == '1' || strcasecmp (s, "ON") == 0)) {
5541  cob_switch[i] = 1;
5542  } else {
5543  cob_switch[i] = 0;
5544  }
5545  }
5546 
5547  /* Get user name if not set via environment already */
5548  if (cobsetptr->cob_user_name == NULL || !strcmp(cobsetptr->cob_user_name, "Unknown")) {
5549 #if defined (_WIN32) && (!defined(_MSC_VER) || COB_USE_VC2008_OR_GREATER) /* Needs SDK for earlier versions */
5550  unsigned long bsiz = COB_ERRBUF_SIZE;
5551  if (GetUserName (runtime_err_str, &bsiz)) {
5552  set_config_val_by_name(runtime_err_str, "username", "GetUserName()");
5553  }
5554 #elif !defined(__OS400__)
5555  s = getlogin ();
5556  if (s) {
5557  set_config_val_by_name(s, "username", "getlogin()");
5558  }
5559 #endif
5560  }
5561 
5562 #if defined(_MSC_VER) && COB_USE_VC2008_OR_GREATER
5563  /* Get function pointer for most precisise time function */
5564  kernel32_handle = GetModuleHandle (TEXT ("kernel32.dll"));
5565  if (kernel32_handle != NULL) {
5566  time_as_filetime_func = (VOID (WINAPI *) (LPFILETIME))
5567  GetProcAddress (kernel32_handle, "GetSystemTimePreciseAsFileTime");
5568  }
5569  if (time_as_filetime_func == NULL) {
5570  time_as_filetime_func = GetSystemTimeAsFileTime;
5571  }
5572 #endif
5573 
5574  /* This must be last in this function as we do early return */
5575  /* from certain ifdef's */
5576 
5577 #ifdef _WIN32
5578  s = cob_malloc ((size_t)COB_LARGE_BUFF);
5579  i = GetModuleFileNameA (NULL, s, COB_LARGE_MAX);
5580  if (i > 0 && i < COB_LARGE_BUFF) {
5581  cobglobptr->cob_main_argv0 = cob_strdup (s);
5582  cob_free (s);
5583  return;
5584  }
5585  cob_free (s);
5586 #elif defined(HAVE_READLINK)
5587  path = NULL;
5588  if (!access ("/proc/self/exe", R_OK)) {
5589  path = "/proc/self/exe";
5590  } else if (!access ("/proc/curproc/file", R_OK)) {
5591  path = "/proc/curproc/file";
5592  } else if (!access ("/proc/self/path/a.out", R_OK)) {
5593  path = "/proc/self/path/a.out";
5594  }
5595  if (path) {
5596  s = cob_malloc ((size_t)COB_LARGE_BUFF);
5597  i = (int)readlink (path, s, (size_t)COB_LARGE_MAX);
5598  if (i > 0 && i < COB_LARGE_BUFF) {
5599  cobglobptr->cob_main_argv0 = cob_strdup (s);
5600  cob_free (s);
5601  return;
5602  }
5603  cob_free (s);
5604  }
5605 #endif
5606 
5607 #ifdef HAVE_GETEXECNAME
5608  path = getexecname ();
5609  if (path) {
5610 #ifdef HAVE_REALPATH
5611  s = cob_malloc ((size_t)COB_LARGE_BUFF);
5612  if (realpath (path, s) != NULL) {
5613  cobglobptr->cob_main_argv0 = cob_strdup (s);
5614  } else {
5615  cobglobptr->cob_main_argv0 = cob_strdup (path);
5616  }
5617  cob_free (s);
5618 #else
5619  cobglobptr->cob_main_argv0 = cob_strdup (path);
5620 #endif
5621  return;
5622  }
5623 #endif
5624 
5625  if (argc && argv && argv[0]) {
5626 #ifdef _WIN32
5627  /* Returns malloced path or NULL */
5628  cobglobptr->cob_main_argv0 = _fullpath (NULL, argv[0], 1);
5629 #elif defined(HAVE_CANONICALIZE_FILE_NAME)
5630  /* Returns malloced path or NULL */
5631  cobglobptr->cob_main_argv0 = canonicalize_file_name (argv[0]);
5632 #elif defined(HAVE_REALPATH)
5633  s = cob_malloc ((size_t)COB_LARGE_BUFF);
5634  if (realpath (argv[0], s) != NULL) {
5635  cobglobptr->cob_main_argv0 = cob_strdup (s);
5636  }
5637  cob_free (s);
5638 #endif
5639  if (!cobglobptr->cob_main_argv0) {
5640  cobglobptr->cob_main_argv0 = cob_strdup (argv[0]);
5641  }
5642  } else {
5643  cobglobptr->cob_main_argv0 = cob_strdup (_("Unknown"));
5644  }
5645  /* The above must be last in this function as we do early return */
5646  /* from certain ifdef's */
5647 }
__cob_global::cob_locale_monetary
char * cob_locale_monetary
Definition: common.h:1199
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_alloc_base
static struct cob_alloc_cache * cob_alloc_base
Definition: common.c:127
basext
static struct cob_external * basext
Definition: common.c:144
cob_init_numeric
void cob_init_numeric(cob_global *)
Definition: numeric.c:2671
__cob_global::cob_locale_time
char * cob_locale_time
Definition: common.h:1201
__cob_settings::cob_unix_lf
unsigned int cob_unix_lf
Definition: coblocal.h:228
__cob_global::cob_locale_numeric
char * cob_locale_numeric
Definition: common.h:1200
sort_keys
static cob_file_key * sort_keys
Definition: common.c:147
__cob_settings::cob_user_name
char * cob_user_name
Definition: coblocal.h:211
cob_init_intrinsic
void cob_init_intrinsic(cob_global *)
Definition: intrinsic.c:6555
exit_hdlrs
static struct exit_handlerlist * exit_hdlrs
COB_ERRBUF_SIZE
#define COB_ERRBUF_SIZE
Definition: common.c:120
cob_argc
static int cob_argc
Definition: common.c:125
COB_MEDIUM_BUFF
#define COB_MEDIUM_BUFF
Definition: common.h:543
bindtextdomain
#define bindtextdomain(Domainname, Dirname)
Definition: gettext.h:86
cob_source_line
static unsigned int cob_source_line
Definition: common.c:156
cobsetptr
static cob_settings * cobsetptr
Definition: common.c:131
COB_LARGE_BUFF
#define COB_LARGE_BUFF
Definition: common.h:544
cob_argv
static char ** cob_argv
Definition: common.c:126
commlnptr
static unsigned char * commlnptr
Definition: common.c:140
cob_init_fileio
void cob_init_fileio(cob_global *, cob_settings *)
Definition: fileio.c:6345
textdomain
#define textdomain(Domainname)
Definition: gettext.h:84
cob_last_sfile
static const char * cob_last_sfile
Definition: common.c:128
current_arg
static int current_arg
Definition: common.c:139
__cob_global
Definition: common.h:1186
__cob_global::cob_physical_cancel
unsigned int cob_physical_cancel
Definition: common.h:1209
hdlrs
static struct handlerlist * hdlrs
__cob_global::cob_term_buff
unsigned char * cob_term_buff
Definition: common.h:1214
_
#define _(s)
Definition: cobcrun.c:59
unlikely
#define unlikely(x)
Definition: common.h:437
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
__cob_global::cob_locale_collate
char * cob_locale_collate
Definition: common.h:1197
cob_local_env_size
static size_t cob_local_env_size
Definition: common.c:142
set_config_val_by_name
static int set_config_val_by_name(char *value, const char *name, const char *func)
Definition: common.c:4644
cob_load_config
int cob_load_config(void)
Definition: common.c:5063
cob_init_strings
void cob_init_strings(void)
Definition: strings.c:652
cob_current_paragraph
static const char * cob_current_paragraph
Definition: common.c:152
commlncnt
static size_t commlncnt
Definition: common.c:141
__cob_settings
Definition: coblocal.h:203
cob_init_move
void cob_init_move(cob_global *, cob_settings *)
Definition: move.c:1683
cob_init_screenio
void cob_init_screenio(cob_global *, cob_settings *)
Definition: screenio.c:2567
__cob_global::cob_locale_orig
char * cob_locale_orig
Definition: common.h:1195
cob_current_program_id
static const char * cob_current_program_id
Definition: common.c:150
__cob_global::cob_main_argv0
const char * cob_main_argv0
Definition: common.h:1193
COB_LARGE_MAX
#define COB_LARGE_MAX
Definition: common.h:550
cob_source_file
static const char * cob_source_file
Definition: common.c:153
cob_initialized
static int cob_initialized
Definition: common.c:124
cob_init_termio
void cob_init_termio(cob_global *, cob_settings *)
Definition: termio.c:343
cob_source_statement
static const char * cob_source_statement
Definition: common.c:154
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
__cob_global::cob_locale_messages
char * cob_locale_messages
Definition: common.h:1198
cob_fast_malloc
void * cob_fast_malloc(const size_t size)
Definition: common.c:1296
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130
cob_local_env
static char * cob_local_env
Definition: common.c:138
R_OK
#define R_OK
Definition: cobc.h:58
cob_set_signal
static void cob_set_signal(void)
Definition: common.c:549
__cob_global::cob_locale
char * cob_locale
Definition: common.h:1194
cob_current_section
static const char * cob_current_section
Definition: common.c:151
PACKAGE
#define PACKAGE
Definition: config.h:294
LOCALEDIR
#define LOCALEDIR
Definition: defaults.h:17
cob_switch
static int cob_switch[36+1]
Definition: common.c:201
cob_init_call
void cob_init_call(cob_global *lptr, cob_settings *sptr)
Definition: call.c:1307
sort_collate
static const unsigned char * sort_collate
Definition: common.c:148
COB_SWITCH_MAX
#define COB_SWITCH_MAX
Definition: common.c:199
runtime_err_str
static char * runtime_err_str
Definition: common.c:133
__cob_settings::cob_physical_cancel
unsigned int cob_physical_cancel
Definition: coblocal.h:218
sort_nkeys
static size_t sort_nkeys
Definition: common.c:146
__cob_global::cob_locale_ctype
char * cob_locale_ctype
Definition: common.h:1196
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524
cob_strdup
char * cob_strdup(const char *p)
Definition: common.c:1308

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_inspect_after ( const cob_field *  )

Definition at line 283 of file strings.c.

References cob_field::data, inspect_end, inspect_start, and cob_field::size.

Referenced by GCic_().

284 {
285  unsigned char *p;
286 
287  for (p = inspect_start; p < inspect_end - str->size + 1; ++p) {
288  if (memcmp (p, str->data, str->size) == 0) {
289  inspect_start = p + str->size;
290  return;
291  }
292  }
293  inspect_start = inspect_end;
294 }
inspect_end
static unsigned char * inspect_end
Definition: strings.c:60
inspect_start
static unsigned char * inspect_start
Definition: strings.c:59

Here is the caller graph for this function:

void cob_inspect_all ( cob_field *  ,
cob_field *   
)

Definition at line 329 of file strings.c.

References INSPECT_ALL, and inspect_common().

Referenced by cobxref_(), GCic_(), and LISTING_().

330 {
331  inspect_common (f1, f2, INSPECT_ALL);
332 }
inspect_common
static void inspect_common(cob_field *f1, cob_field *f2, const int type)
Definition: strings.c:145
INSPECT_ALL
#define INSPECT_ALL
Definition: strings.c:38
f2
cob_field f2
Definition: cobxref.c.l.h:55
f1
cob_field f1
Definition: cobxref.c.l.h:54

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_inspect_before ( const cob_field *  )

Definition at line 270 of file strings.c.

References cob_field::data, inspect_end, inspect_start, and cob_field::size.

Referenced by cobxref_().

271 {
272  unsigned char *p;
273 
274  for (p = inspect_start; p < inspect_end - str->size + 1; ++p) {
275  if (memcmp (p, str->data, str->size) == 0) {
276  inspect_end = p;
277  return;
278  }
279  }
280 }
inspect_end
static unsigned char * inspect_end
Definition: strings.c:60
inspect_start
static unsigned char * inspect_start
Definition: strings.c:59

Here is the caller graph for this function:

void cob_inspect_characters ( cob_field *  )

Definition at line 297 of file strings.c.

References cob_add_int(), cob_field::data, inspect_data, inspect_end, inspect_mark, inspect_replacing, and inspect_start.

Referenced by cobxref_().

298 {
299  int *mark;
300  int i;
301  int n;
302  int len;
303 
304  mark = &inspect_mark[inspect_start - inspect_data];
305  len = (int)(inspect_end - inspect_start);
306  if (inspect_replacing) {
307  /* INSPECT REPLACING CHARACTERS f1 */
308  for (i = 0; i < len; ++i) {
309  if (mark[i] == -1) {
310  mark[i] = f1->data[0];
311  }
312  }
313  } else {
314  /* INSPECT TALLYING f1 CHARACTERS */
315  n = 0;
316  for (i = 0; i < len; ++i) {
317  if (mark[i] == -1) {
318  mark[i] = 1;
319  n++;
320  }
321  }
322  if (n > 0) {
323  cob_add_int (f1, n, 0);
324  }
325  }
326 }
inspect_data
static unsigned char * inspect_data
Definition: strings.c:58
cob_add_int
int cob_add_int(cob_field *, const int, const int)
Definition: numeric.c:2195
cob_field::data
unsigned char * data
Definition: common.h:952
inspect_mark
static int * inspect_mark
Definition: strings.c:61
f1
cob_field f1
Definition: cobxref.c.l.h:54
inspect_end
static unsigned char * inspect_end
Definition: strings.c:60
inspect_replacing
static cob_u32_t inspect_replacing
Definition: strings.c:64
inspect_start
static unsigned char * inspect_start
Definition: strings.c:59

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_inspect_converting ( const cob_field *  ,
const cob_field *   
)

Definition at line 353 of file strings.c.

References alloc_figurative(), alpha_fld, COB_EC_RANGE_INSPECT_SIZE, COB_FIELD_TYPE, cob_set_exception(), COB_TYPE_ALPHANUMERIC_ALL, cob_field::data, inspect_end, inspect_mark, inspect_start, cob_field::size, str_cob_low, and unlikely.

Referenced by LISTING_().

354 {
355  size_t i;
356  size_t j;
357  size_t len;
358 
359  if (unlikely(!f1)) {
360  f1 = &str_cob_low;
361  }
362  if (unlikely(!f2)) {
363  f2 = &str_cob_low;
364  }
365  if (f1->size != f2->size) {
366  if (COB_FIELD_TYPE (f2) == COB_TYPE_ALPHANUMERIC_ALL) {
367  alloc_figurative (f2, f1);
368  f2 = &alpha_fld;
369  } else {
370  cob_set_exception (COB_EC_RANGE_INSPECT_SIZE);
371  return;
372  }
373  }
374 
375  len = (size_t)(inspect_end - inspect_start);
376  for (j = 0; j < f1->size; ++j) {
377  for (i = 0; i < len; ++i) {
378  if (inspect_mark[i] == -1 &&
379  inspect_start[i] == f1->data[j]) {
380  inspect_start[i] = f2->data[j];
381  inspect_mark[i] = 1;
382  }
383  }
384  }
385 }
COB_FIELD_TYPE
#define COB_FIELD_TYPE(f)
Definition: common.h:662
str_cob_low
static cob_field str_cob_low
Definition: strings.c:90
f2
cob_field f2
Definition: cobxref.c.l.h:55
cob_field::data
unsigned char * data
Definition: common.h:952
inspect_mark
static int * inspect_mark
Definition: strings.c:61
unlikely
#define unlikely(x)
Definition: common.h:437
alpha_fld
static cob_field alpha_fld
Definition: strings.c:89
f1
cob_field f1
Definition: cobxref.c.l.h:54
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
alloc_figurative
static void alloc_figurative(const cob_field *f1, const cob_field *f2)
Definition: strings.c:115
inspect_end
static unsigned char * inspect_end
Definition: strings.c:60
COB_TYPE_ALPHANUMERIC_ALL
#define COB_TYPE_ALPHANUMERIC_ALL
Definition: common.h:622
cob_field::size
size_t size
Definition: common.h:951
inspect_start
static unsigned char * inspect_start
Definition: strings.c:59

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_inspect_finish ( void  )

Definition at line 388 of file strings.c.

References COB_PUT_SIGN, inspect_data, inspect_mark, inspect_replacing, inspect_sign, inspect_size, and unlikely.

Referenced by cobxref_(), GCic_(), and LISTING_().

389 {
390  size_t i;
391 
392  if (inspect_replacing) {
393  for (i = 0; i < inspect_size; ++i) {
394  if (inspect_mark[i] != -1) {
395  inspect_data[i] = inspect_mark[i];
396  }
397  }
398  }
399 
400  if (unlikely(inspect_var)) {
401  COB_PUT_SIGN (inspect_var, inspect_sign);
402  }
403 }
inspect_data
static unsigned char * inspect_data
Definition: strings.c:58
inspect_var
static cob_field * inspect_var
Definition: strings.c:57
inspect_mark
static int * inspect_mark
Definition: strings.c:61
inspect_size
static size_t inspect_size
Definition: strings.c:63
unlikely
#define unlikely(x)
Definition: common.h:437
COB_PUT_SIGN
#define COB_PUT_SIGN(f, s)
Definition: coblocal.h:160
inspect_replacing
static cob_u32_t inspect_replacing
Definition: strings.c:64
inspect_sign
static int inspect_sign
Definition: strings.c:65

Here is the caller graph for this function:

void cob_inspect_first ( cob_field *  ,
cob_field *   
)

Definition at line 341 of file strings.c.

References inspect_common(), and INSPECT_FIRST.

342 {
343  inspect_common (f1, f2, INSPECT_FIRST);
344 }
inspect_common
static void inspect_common(cob_field *f1, cob_field *f2, const int type)
Definition: strings.c:145
f2
cob_field f2
Definition: cobxref.c.l.h:55
INSPECT_FIRST
#define INSPECT_FIRST
Definition: strings.c:40
f1
cob_field f1
Definition: cobxref.c.l.h:54

Here is the call graph for this function:

void cob_inspect_init ( cob_field *  ,
const unsigned  int 
)

Referenced by cobxref_(), GCic_(), and LISTING_().

Here is the caller graph for this function:

void cob_inspect_leading ( cob_field *  ,
cob_field *   
)

Definition at line 335 of file strings.c.

References inspect_common(), and INSPECT_LEADING.

336 {
337  inspect_common (f1, f2, INSPECT_LEADING);
338 }
inspect_common
static void inspect_common(cob_field *f1, cob_field *f2, const int type)
Definition: strings.c:145
f2
cob_field f2
Definition: cobxref.c.l.h:55
f1
cob_field f1
Definition: cobxref.c.l.h:54
INSPECT_LEADING
#define INSPECT_LEADING
Definition: strings.c:39

Here is the call graph for this function:

void cob_inspect_start ( void  )

Definition at line 263 of file strings.c.

References inspect_data, inspect_end, inspect_size, and inspect_start.

Referenced by cobxref_(), GCic_(), and LISTING_().

264 {
265  inspect_start = inspect_data;
266  inspect_end = inspect_data + inspect_size;
267 }
inspect_data
static unsigned char * inspect_data
Definition: strings.c:58
inspect_size
static size_t inspect_size
Definition: strings.c:63
inspect_end
static unsigned char * inspect_end
Definition: strings.c:60
inspect_start
static unsigned char * inspect_start
Definition: strings.c:59

Here is the caller graph for this function:

void cob_inspect_trailing ( cob_field *  ,
cob_field *   
)

Definition at line 347 of file strings.c.

References inspect_common(), and INSPECT_TRAILING.

348 {
349  inspect_common (f1, f2, INSPECT_TRAILING);
350 }
inspect_common
static void inspect_common(cob_field *f1, cob_field *f2, const int type)
Definition: strings.c:145
f2
cob_field f2
Definition: cobxref.c.l.h:55
INSPECT_TRAILING
#define INSPECT_TRAILING
Definition: strings.c:41
f1
cob_field f1
Definition: cobxref.c.l.h:54

Here is the call graph for this function:

char* cob_int_to_formatted_bytestring ( int  ,
char *   
)

Definition at line 4246 of file common.c.

References cob_fast_malloc(), and NULL.

4247 {
4248  double d;
4249  char *strB;
4250 
4251  if (!number) return NULL;
4252 
4253  strB = (char*) cob_fast_malloc(3);
4254 
4255  if (i > (1024 * 1024)) {
4256  d = i / 1024.0 / 1024.0;
4257  strB = (char*) "MB";
4258  } else if (i > 1024) {
4259  d = i / 1024.0;
4260  strB = (char*) "kB";
4261  } else {
4262  d = 0;
4263  strB = (char*) "B";
4264  }
4265  sprintf (number, "%3.2f %s", d, strB);
4266  return number;
4267 }
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_fast_malloc
void * cob_fast_malloc(const size_t size)
Definition: common.c:1296

Here is the call graph for this function:

char* cob_int_to_string ( int  ,
char *   
)

Definition at line 4238 of file common.c.

References NULL.

4239 {
4240  if (!number) return NULL;
4241  sprintf (number, "%i", i);
4242  return number;
4243 }
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_field* cob_intr_abs ( cob_field *  )

Definition at line 4414 of file intrinsic.c.

References cob_decimal_get_field(), cob_decimal_set_field(), curr_field, make_field_entry(), and cob_decimal::value.

4415 {
4416  cob_decimal_set_field (&d1, srcfield);
4417  mpz_abs (d1.value, d1.value);
4418 
4419  make_field_entry (srcfield);
4420  (void)cob_decimal_get_field (&d1, curr_field, 0);
4421  return curr_field;
4422 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985

Here is the call graph for this function:

cob_field* cob_intr_acos ( cob_field *  )

Definition at line 4425 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), cob_decimal_cmp(), cob_decimal_get_field(), cob_decimal_get_mpf(), cob_decimal_set_field(), cob_decimal_set_mpf(), COB_EC_ARGUMENT_FUNCTION, cob_mpf_acos(), cob_mpft, cob_set_exception(), curr_field, cob_decimal::scale, and cob_decimal::value.

4426 {
4427  cob_decimal_set_field (&d1, srcfield);
4428 
4429  mpz_set (d4.value, d1.value);
4430  mpz_set (d5.value, d1.value);
4431  d4.scale = d1.scale;
4432  d5.scale = d1.scale;
4433  mpz_set_si (d2.value, -1L);
4434  d2.scale = 0;
4435  mpz_set_ui (d3.value, 1UL);
4436  d3.scale = 0;
4437 
4438  cob_set_exception (0);
4439  if (cob_decimal_cmp (&d4, &d2) < 0 || cob_decimal_cmp (&d5, &d3) > 0) {
4440  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4441  cob_alloc_set_field_uint (0);
4442  return curr_field;
4443  }
4444 
4445  cob_decimal_get_mpf (cob_mpft, &d1);
4446  cob_mpf_acos (cob_mpft, cob_mpft);
4447  cob_decimal_set_mpf (&d1, cob_mpft);
4448  cob_alloc_field (&d1);
4449  (void)cob_decimal_get_field (&d1, curr_field, 0);
4450 
4451  return curr_field;
4452 }
d2
static cob_decimal d2
Definition: intrinsic.c:80
d3
static cob_decimal d3
Definition: intrinsic.c:81
cob_mpf_acos
static void cob_mpf_acos(mpf_t dst_val, const mpf_t src_val)
Definition: intrinsic.c:1243
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_mpft
static mpf_t cob_mpft
Definition: intrinsic.c:88
d5
static cob_decimal d5
Definition: intrinsic.c:83
cob_decimal_get_mpf
static void cob_decimal_get_mpf(mpf_t dst, const cob_decimal *d)
Definition: intrinsic.c:847
cob_decimal_cmp
int cob_decimal_cmp(cob_decimal *, cob_decimal *)
Definition: numeric.c:1922
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
d4
static cob_decimal d4
Definition: intrinsic.c:82
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal_set_mpf
static void cob_decimal_set_mpf(cob_decimal *d, const mpf_t src)
Definition: intrinsic.c:816
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_annuity ( cob_field *  ,
cob_field *   
)

Definition at line 4712 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), cob_decimal_add(), cob_decimal_div(), cob_decimal_get_field(), cob_decimal_pow(), cob_decimal_set_field(), cob_decimal_sub(), COB_EC_ARGUMENT_FUNCTION, cob_set_exception(), cob_trim_decimal(), curr_field, cob_decimal::scale, sign, and cob_decimal::value.

4713 {
4714  int sign;
4715 
4716  cob_decimal_set_field (&d1, srcfield1);
4717  cob_decimal_set_field (&d2, srcfield2);
4718 
4719  /* P1 >= 0, P2 > 0 and integer */
4720  sign = mpz_sgn (d1.value);
4721  if (sign < 0 || mpz_sgn (d2.value) <= 0 || d2.scale != 0) {
4722  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4723  cob_alloc_set_field_uint (0);
4724  return curr_field;
4725  }
4726 
4727  if (!sign) {
4728  mpz_set_ui (d1.value, 1UL);
4729  d1.scale = 0;
4730  cob_decimal_div (&d1, &d2);
4731  cob_alloc_field (&d1);
4732  (void)cob_decimal_get_field (&d1, curr_field, 0);
4733  return curr_field;
4734  }
4735 
4736  /* x = P1 / (1 - (1 + P1) ^ (-P2)) */
4737  mpz_neg (d2.value, d2.value);
4738 
4739  mpz_set (d3.value, d1.value);
4740  d3.scale = d1.scale;
4741  mpz_set_ui (d4.value, 1UL);
4742  d4.scale = 0;
4743  cob_decimal_add (&d3, &d4);
4744  cob_trim_decimal (&d3);
4745  cob_trim_decimal (&d2);
4746  cob_decimal_pow (&d3, &d2);
4747  mpz_set_ui (d4.value, 1UL);
4748  d4.scale = 0;
4749  cob_decimal_sub (&d4, &d3);
4750  cob_trim_decimal (&d4);
4751  cob_trim_decimal (&d1);
4752  cob_decimal_div (&d1, &d4);
4753  cob_alloc_field (&d1);
4754  (void)cob_decimal_get_field (&d1, curr_field, 0);
4755  return curr_field;
4756 }
d2
static cob_decimal d2
Definition: intrinsic.c:80
d3
static cob_decimal d3
Definition: intrinsic.c:81
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_decimal_pow
void cob_decimal_pow(cob_decimal *pd1, cob_decimal *pd2)
Definition: intrinsic.c:2990
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
sign
if sign
Definition: flag.def:42
cob_decimal_add
void cob_decimal_add(cob_decimal *, cob_decimal *)
Definition: numeric.c:1875
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_trim_decimal
static void cob_trim_decimal(cob_decimal *d)
Definition: intrinsic.c:517
cob_decimal_div
void cob_decimal_div(cob_decimal *, cob_decimal *)
Definition: numeric.c:1899
d1
static cob_decimal d1
Definition: intrinsic.c:79
cob_decimal_sub
void cob_decimal_sub(cob_decimal *, cob_decimal *)
Definition: numeric.c:1883
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
d4
static cob_decimal d4
Definition: intrinsic.c:82
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_asin ( cob_field *  )

Definition at line 4455 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), cob_decimal_cmp(), cob_decimal_get_field(), cob_decimal_get_mpf(), cob_decimal_set_field(), cob_decimal_set_mpf(), COB_EC_ARGUMENT_FUNCTION, cob_mpf_asin(), cob_mpft, cob_set_exception(), curr_field, cob_decimal::scale, and cob_decimal::value.

4456 {
4457  cob_decimal_set_field (&d1, srcfield);
4458 
4459  mpz_set (d4.value, d1.value);
4460  mpz_set (d5.value, d1.value);
4461  d4.scale = d1.scale;
4462  d5.scale = d1.scale;
4463  mpz_set_si (d2.value, -1L);
4464  d2.scale = 0;
4465  mpz_set_ui (d3.value, 1UL);
4466  d3.scale = 0;
4467 
4468  cob_set_exception (0);
4469  if (cob_decimal_cmp (&d4, &d2) < 0 || cob_decimal_cmp (&d5, &d3) > 0) {
4470  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4471  cob_alloc_set_field_uint (0);
4472  return curr_field;
4473  }
4474 
4475  if (!mpz_sgn (d1.value)) {
4476  /* Asin (0) = 0 */
4477  cob_alloc_set_field_uint (0);
4478  return curr_field;
4479  }
4480 
4481  cob_decimal_get_mpf (cob_mpft, &d1);
4482  cob_mpf_asin (cob_mpft, cob_mpft);
4483  cob_decimal_set_mpf (&d1, cob_mpft);
4484  cob_alloc_field (&d1);
4485  (void)cob_decimal_get_field (&d1, curr_field, 0);
4486 
4487  return curr_field;
4488 }
d2
static cob_decimal d2
Definition: intrinsic.c:80
d3
static cob_decimal d3
Definition: intrinsic.c:81
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_mpf_asin
static void cob_mpf_asin(mpf_t dst_val, const mpf_t src_val)
Definition: intrinsic.c:1196
cob_mpft
static mpf_t cob_mpft
Definition: intrinsic.c:88
d5
static cob_decimal d5
Definition: intrinsic.c:83
cob_decimal_get_mpf
static void cob_decimal_get_mpf(mpf_t dst, const cob_decimal *d)
Definition: intrinsic.c:847
cob_decimal_cmp
int cob_decimal_cmp(cob_decimal *, cob_decimal *)
Definition: numeric.c:1922
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
d4
static cob_decimal d4
Definition: intrinsic.c:82
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal_set_mpf
static void cob_decimal_set_mpf(cob_decimal *d, const mpf_t src)
Definition: intrinsic.c:816
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_atan ( cob_field *  )

Definition at line 4491 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), cob_decimal_get_field(), cob_decimal_get_mpf(), cob_decimal_set_field(), cob_decimal_set_mpf(), cob_mpf_atan(), cob_mpft, cob_set_exception(), curr_field, and cob_decimal::value.

4492 {
4493  cob_decimal_set_field (&d1, srcfield);
4494 
4495  cob_set_exception (0);
4496 
4497  if (!mpz_sgn (d1.value)) {
4498  /* Atan (0) = 0 */
4499  cob_alloc_set_field_uint (0);
4500  return curr_field;
4501  }
4502 
4503  cob_decimal_get_mpf (cob_mpft, &d1);
4504  cob_mpf_atan (cob_mpft, cob_mpft);
4505  cob_decimal_set_mpf (&d1, cob_mpft);
4506  cob_alloc_field (&d1);
4507  (void)cob_decimal_get_field (&d1, curr_field, 0);
4508 
4509  return curr_field;
4510 }
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_mpf_atan
static void cob_mpf_atan(mpf_t dst_val, const mpf_t src_val)
Definition: intrinsic.c:1132
cob_mpft
static mpf_t cob_mpft
Definition: intrinsic.c:88
cob_decimal_get_mpf
static void cob_decimal_get_mpf(mpf_t dst, const cob_decimal *d)
Definition: intrinsic.c:847
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal_set_mpf
static void cob_decimal_set_mpf(cob_decimal *d, const mpf_t src)
Definition: intrinsic.c:816

Here is the call graph for this function:

cob_field* cob_intr_binop ( cob_field *  ,
const int  ,
cob_field *   
)

Definition at line 3429 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_add(), cob_decimal_div(), cob_decimal_get_field(), cob_decimal_mul(), cob_decimal_pow(), cob_decimal_set_field(), cob_decimal_sub(), COB_EC_SIZE_ZERO_DIVIDE, cob_set_exception(), curr_field, cob_decimal::scale, and cob_decimal::value.

3430 {
3431  cob_decimal_set_field (&d1, f1);
3432  cob_decimal_set_field (&d2, f2);
3433  switch (op) {
3434  case '+':
3435  cob_decimal_add (&d1, &d2);
3436  break;
3437  case '-':
3438  cob_decimal_sub (&d1, &d2);
3439  break;
3440  case '*':
3441  cob_decimal_mul (&d1, &d2);
3442  break;
3443  case '/':
3444  cob_set_exception (0);
3445  if (!mpz_sgn (d2.value)) {
3446  /* Divide by zero */
3447  cob_set_exception (COB_EC_SIZE_ZERO_DIVIDE);
3448  mpz_set_ui (d1.value, 0UL);
3449  d1.scale = 0;
3450  } else {
3451  cob_decimal_div (&d1, &d2);
3452  }
3453  break;
3454  case '^':
3455  cob_decimal_pow (&d1, &d2);
3456  break;
3457  default:
3458  break;
3459  }
3460 
3461  cob_alloc_field (&d1);
3462  (void)cob_decimal_get_field (&d1, curr_field, 0);
3463  return curr_field;
3464 }
d2
static cob_decimal d2
Definition: intrinsic.c:80
cob_decimal_mul
void cob_decimal_mul(cob_decimal *, cob_decimal *)
Definition: numeric.c:1891
cob_decimal_pow
void cob_decimal_pow(cob_decimal *pd1, cob_decimal *pd2)
Definition: intrinsic.c:2990
f2
cob_field f2
Definition: cobxref.c.l.h:55
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_decimal_add
void cob_decimal_add(cob_decimal *, cob_decimal *)
Definition: numeric.c:1875
f1
cob_field f1
Definition: cobxref.c.l.h:54
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_decimal_div
void cob_decimal_div(cob_decimal *, cob_decimal *)
Definition: numeric.c:1899
d1
static cob_decimal d1
Definition: intrinsic.c:79
cob_decimal_sub
void cob_decimal_sub(cob_decimal *, cob_decimal *)
Definition: numeric.c:1883
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_boolean_of_integer ( cob_field *  ,
cob_field *   
)

Definition at line 6453 of file intrinsic.c.

References cob_fatal_error(), COB_FERROR_FUNCTION, and COB_UNUSED.

6454 {
6455  COB_UNUSED (f1);
6456  COB_UNUSED (f2);
6457 
6458  cob_fatal_error (COB_FERROR_FUNCTION);
6459 }
f2
cob_field f2
Definition: cobxref.c.l.h:55
COB_FERROR_FUNCTION
#define COB_FERROR_FUNCTION
Definition: common.h:702
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
f1
cob_field f1
Definition: cobxref.c.l.h:54
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

cob_field* cob_intr_byte_length ( cob_field *  )

Definition at line 3480 of file intrinsic.c.

References cob_alloc_set_field_uint(), cob_u32_t, curr_field, and cob_field::size.

3481 {
3482  cob_alloc_set_field_uint ((cob_u32_t)srcfield->size);
3483  return curr_field;
3484 }
cob_u32_t
#define cob_u32_t
Definition: common.h:31
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_char ( cob_field *  )

Definition at line 3977 of file intrinsic.c.

References COB_FIELD_INIT, cob_get_int(), curr_field, cob_field::data, make_field_entry(), and NULL.

3978 {
3979  int i;
3980  cob_field field;
3981 
3982  COB_FIELD_INIT (1, NULL, &const_alpha_attr);
3983  make_field_entry (&field);
3984 
3985  i = cob_get_int (srcfield);
3986  if (i < 1 || i > 256) {
3987  *curr_field->data = 0;
3988  } else {
3989  *curr_field->data = (unsigned char)i - 1;
3990  }
3991  return curr_field;
3992 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_char_national ( cob_field *  )

Definition at line 6462 of file intrinsic.c.

References cob_fatal_error(), COB_FERROR_FUNCTION, and COB_UNUSED.

6463 {
6464  COB_UNUSED (srcfield);
6465 
6466  cob_fatal_error (COB_FERROR_FUNCTION);
6467 }
COB_FERROR_FUNCTION
#define COB_FERROR_FUNCTION
Definition: common.h:702
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

cob_field* cob_intr_combined_datetime ( cob_field *  ,
cob_field *   
)

Definition at line 4020 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), cob_decimal_add(), cob_decimal_div(), cob_decimal_get_field(), cob_decimal_set_field(), COB_EC_ARGUMENT_FUNCTION, cob_get_int(), cob_set_exception(), curr_field, d1, d2, d3, cob_decimal::scale, valid_decimal_time(), valid_integer_date(), and cob_decimal::value.

4021 {
4022  int srdays;
4023  cob_decimal *combined_datetime;
4024  cob_decimal *srtime;
4025  cob_decimal *hundred_thousand;
4026 
4027  cob_set_exception (0);
4028 
4029  /* Validate and extract the value of srcdays */
4030  srdays = cob_get_int (srcdays);
4031  if (!valid_integer_date (srdays)) {
4032  goto invalid_args;
4033  }
4034  combined_datetime = &d1;
4035  mpz_set_ui (combined_datetime->value, (unsigned long) srdays);
4036  combined_datetime->scale = 0;
4037 
4038  /* Extract and validate the value of srctime */
4039  srtime = &d2;
4040  cob_decimal_set_field (srtime, srctime);
4041  if (!valid_decimal_time (srtime)) {
4042  goto invalid_args;
4043  }
4044 
4045  /* Set a decimal to 100 000. */
4046  hundred_thousand = &d3;
4047  mpz_set_ui (hundred_thousand->value, 100000UL);
4048  hundred_thousand->scale = 0;
4049 
4050  /* Combined datetime = date + (time / 100 000) */
4051  cob_decimal_div (srtime, hundred_thousand);
4052  cob_decimal_add (combined_datetime, srtime);
4053 
4054  cob_alloc_field (combined_datetime);
4055  (void) cob_decimal_get_field (combined_datetime, curr_field, 0);
4056  goto end_of_func;
4057 
4058  invalid_args:
4059  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4060  cob_alloc_set_field_uint (0);
4061 
4062  end_of_func:
4063  return curr_field;
4064 }
d2
static cob_decimal d2
Definition: intrinsic.c:80
d3
static cob_decimal d3
Definition: intrinsic.c:81
valid_integer_date
static int valid_integer_date(const int days)
Definition: intrinsic.c:1788
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
valid_decimal_time
static int valid_decimal_time(cob_decimal *seconds_from_midnight)
Definition: intrinsic.c:1843
cob_decimal
Definition: common.h:984
cob_decimal_add
void cob_decimal_add(cob_decimal *, cob_decimal *)
Definition: numeric.c:1875
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_decimal_div
void cob_decimal_div(cob_decimal *, cob_decimal *)
Definition: numeric.c:1899
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_concatenate ( const int  ,
const int  ,
const int  ,
  ... 
)

Definition at line 3723 of file intrinsic.c.

References calc_ref_mod(), COB_FIELD_INIT, cob_free(), cob_malloc(), curr_field, cob_field::data, make_field_entry(), NULL, params, cob_field::size, and unlikely.

Referenced by GCic_().

3725 {
3726  cob_field **f;
3727  unsigned char *p;
3728  size_t calcsize;
3729  int i;
3730  cob_field field;
3731  va_list args;
3732 
3733  f = cob_malloc ((size_t)params * sizeof (cob_field *));
3734 
3735  va_start (args, params);
3736 
3737  /* Extract args / calculate size */
3738  calcsize = 0;
3739  for (i = 0; i < params; ++i) {
3740  f[i] = va_arg (args, cob_field *);
3741  calcsize += f[i]->size;
3742  }
3743  va_end (args);
3744 
3745  COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr);
3746  make_field_entry (&field);
3747 
3748  p = curr_field->data;
3749  for (i = 0; i < params; ++i) {
3750  memcpy (p, f[i]->data, f[i]->size);
3751  p += f[i]->size;
3752  }
3753 
3754  if (unlikely(offset > 0)) {
3755  calc_ref_mod (curr_field, offset, length);
3756  }
3757  cob_free (f);
3758  return curr_field;
3759 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_alloc_cache::size
size_t size
Definition: common.c:108
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
calc_ref_mod
static void calc_ref_mod(cob_field *f, const int offset, const int length)
Definition: intrinsic.c:488
unlikely
#define unlikely(x)
Definition: common.h:437
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_field::size
size_t size
Definition: common.h:951
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

Here is the caller graph for this function:

cob_field* cob_intr_cos ( cob_field *  )

Definition at line 4513 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_get_field(), cob_decimal_get_mpf(), cob_decimal_set_field(), cob_decimal_set_mpf(), cob_mpf_cos(), cob_mpft, cob_set_exception(), and curr_field.

4514 {
4515  cob_decimal_set_field (&d1, srcfield);
4516 
4517  cob_set_exception (0);
4518 
4519  cob_decimal_get_mpf (cob_mpft, &d1);
4520  cob_mpf_cos (cob_mpft, cob_mpft);
4521  cob_decimal_set_mpf (&d1, cob_mpft);
4522  cob_alloc_field (&d1);
4523  (void)cob_decimal_get_field (&d1, curr_field, 0);
4524 
4525  return curr_field;
4526 }
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_mpft
static mpf_t cob_mpft
Definition: intrinsic.c:88
cob_decimal_get_mpf
static void cob_decimal_get_mpf(mpf_t dst, const cob_decimal *d)
Definition: intrinsic.c:847
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
d1
static cob_decimal d1
Definition: intrinsic.c:79
cob_mpf_cos
static void cob_mpf_cos(mpf_t dst_val, const mpf_t src_val)
Definition: intrinsic.c:1095
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal_set_mpf
static void cob_decimal_set_mpf(cob_decimal *d, const mpf_t src)
Definition: intrinsic.c:816

Here is the call graph for this function:

cob_field* cob_intr_currency_symbol ( void  )

Definition at line 5738 of file intrinsic.c.

References COB_FIELD_INIT, COB_MODULE_PTR, cob_set_exception(), curr_field, cob_field::data, make_field_entry(), NULL, and cob_field::size.

5739 {
5740 #ifdef HAVE_LOCALECONV
5741  struct lconv *p;
5742  size_t size;
5743 #endif
5744  cob_field field;
5745 
5746  COB_FIELD_INIT (0, NULL, &const_alpha_attr);
5747  cob_set_exception (0);
5748 
5749 #ifdef HAVE_LOCALECONV
5750  p = localeconv ();
5751  size = strlen (p->currency_symbol);
5752  if (size) {
5753  field.size = size;
5754  } else {
5755  field.size = 1;
5756  }
5757  make_field_entry (&field);
5758  if (size) {
5759  memcpy (curr_field->data, p->currency_symbol, size);
5760  } else {
5761  curr_field->size = 0;
5762  curr_field->data[0] = 0;
5763  }
5764 #else
5765  field.size = 1;
5766  make_field_entry (&field);
5767  curr_field->data[0] = COB_MODULE_PTR->currency_symbol;
5768 #endif
5769  return curr_field;
5770 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_field::size
size_t size
Definition: common.h:951

Here is the call graph for this function:

cob_field* cob_intr_current_date ( const int  ,
const int   
)

Definition at line 3952 of file intrinsic.c.

References add_offset_time(), calc_ref_mod(), COB_FIELD_INIT, cob_get_current_date_and_time(), curr_field, cob_field::data, cob_time::day_of_month, cob_time::hour, make_field_entry(), cob_time::minute, cob_time::month, cob_time::nanosecond, NULL, cob_time::second, unlikely, cob_time::utc_offset, and cob_time::year.

Referenced by cobxref_().

3953 {
3954  cob_field field;
3955  struct cob_time time;
3956  char buff[22] = { '\0' };
3957 
3958  COB_FIELD_INIT (21, NULL, &const_alpha_attr);
3959  make_field_entry (&field);
3960 
3961  time = cob_get_current_date_and_time ();
3962 
3963  sprintf (buff, "%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d%2.2d",
3964  time.year, time.month, time.day_of_month, time.hour,
3965  time.minute, time.second, (int) time.nanosecond / 10000000);
3966 
3967  add_offset_time (0, &time.utc_offset, 16, buff);
3968 
3969  memcpy (curr_field->data, buff, (size_t)21);
3970  if (unlikely(offset > 0)) {
3971  calc_ref_mod (curr_field, offset, length);
3972  }
3973  return curr_field;
3974 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
calc_ref_mod
static void calc_ref_mod(cob_field *f, const int offset, const int length)
Definition: intrinsic.c:488
unlikely
#define unlikely(x)
Definition: common.h:437
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_time
Definition: coblocal.h:261
add_offset_time
static void add_offset_time(const int with_colon, int const *offset_time, const ptrdiff_t buff_pos, char *buff)
Definition: intrinsic.c:2263
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_get_current_date_and_time
struct cob_time cob_get_current_date_and_time(void)
Definition: common.c:2699

Here is the call graph for this function:

Here is the caller graph for this function:

cob_field* cob_intr_date_of_integer ( cob_field *  )

Definition at line 4067 of file intrinsic.c.

References COB_ATTR_INIT, COB_EC_ARGUMENT_FUNCTION, COB_FIELD_INIT, cob_get_int(), cob_set_exception(), COB_TYPE_NUMERIC_DISPLAY, curr_field, cob_field::data, date_of_integer(), make_field_entry(), cob_time::month, NULL, valid_integer_date(), and cob_time::year.

4068 {
4069  int days;
4070  int month;
4071  int year;
4072  cob_field_attr attr;
4073  cob_field field;
4074  char buff[16];
4075 
4076  COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 8, 0, 0, NULL);
4077  COB_FIELD_INIT (8, NULL, &attr);
4078  make_field_entry (&field);
4079 
4080  cob_set_exception (0);
4081  /* Base 1601-01-01 */
4082  days = cob_get_int (srcdays);
4083  if (!valid_integer_date (days)) {
4084  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4085  memset (curr_field->data, '0', (size_t)8);
4086  return curr_field;
4087  }
4088 
4089  date_of_integer (days, &year, &month, &days);
4090 
4091  snprintf (buff, (size_t)15, "%4.4d%2.2d%2.2d", year, month, days);
4092  memcpy (curr_field->data, buff, (size_t)8);
4093  return curr_field;
4094 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
valid_integer_date
static int valid_integer_date(const int days)
Definition: intrinsic.c:1788
date_of_integer
static void date_of_integer(int days, int *year, int *month, int *day)
Definition: intrinsic.c:1862
cob_field
Definition: common.h:950
COB_ATTR_INIT
#define COB_ATTR_INIT(u, v, x, y, z)
Definition: coblocal.h:150
cob_field::data
unsigned char * data
Definition: common.h:952
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
cob_time::year
int year
Definition: coblocal.h:263
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_TYPE_NUMERIC_DISPLAY
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
cob_field_attr
Definition: common.h:940
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_time::month
int month
Definition: coblocal.h:264

Here is the call graph for this function:

cob_field* cob_intr_date_to_yyyymmdd ( const int  ,
  ... 
)

Definition at line 5208 of file intrinsic.c.

References cob_alloc_set_field_int(), cob_alloc_set_field_uint(), COB_EC_ARGUMENT_FUNCTION, cob_get_int(), cob_set_exception(), curr_field, get_interval_and_current_year_from_args(), and valid_year().

5209 {
5210  cob_field *f;
5211  va_list args;
5212  int year;
5213  int mmdd;
5214  int interval;
5215  int current_year;
5216  int maxyear;
5217 
5218  cob_set_exception (0);
5219 
5220  va_start (args, params);
5221 
5222  f = va_arg (args, cob_field *);
5223  year = cob_get_int (f);
5224  mmdd = year % 10000;
5225  year /= 10000;
5226 
5227  get_interval_and_current_year_from_args (params, args, &interval,
5228  &current_year);
5229 
5230  va_end (args);
5231 
5232  maxyear = current_year + interval;
5233  /* The unusual year checks are as specified in the standard */
5234  if (year < 0 || year > 999999
5235  || !valid_year (current_year)
5236  || (maxyear < 1700 || maxyear > 9999)) {
5237  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5238  cob_alloc_set_field_uint (0);
5239  return curr_field;
5240  }
5241 
5242  if (maxyear % 100 >= year) {
5243  year += 100 * (maxyear / 100);
5244  } else {
5245  year += 100 * ((maxyear / 100) - 1);
5246  }
5247  year *= 10000;
5248  year += mmdd;
5249  cob_alloc_set_field_int (year);
5250  return curr_field;
5251 }
cob_alloc_set_field_int
static void cob_alloc_set_field_int(const int val)
Definition: intrinsic.c:533
get_interval_and_current_year_from_args
static void get_interval_and_current_year_from_args(const int num_args, va_list args, int *const interval, int *const current_year)
Definition: intrinsic.c:1624
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_field
Definition: common.h:950
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
cob_time::year
int year
Definition: coblocal.h:263
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
valid_year
static int valid_year(const int year)
Definition: intrinsic.c:1794
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_day_of_integer ( cob_field *  )

Definition at line 4097 of file intrinsic.c.

References COB_ATTR_INIT, COB_EC_ARGUMENT_FUNCTION, COB_FIELD_INIT, cob_get_int(), cob_set_exception(), COB_TYPE_NUMERIC_DISPLAY, curr_field, cob_field::data, day_of_integer(), make_field_entry(), NULL, and valid_integer_date().

4098 {
4099  int days;
4100  int baseyear;
4101  cob_field_attr attr;
4102  cob_field field;
4103  char buff[16];
4104 
4105  COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 7, 0, 0, NULL);
4106  COB_FIELD_INIT (7, NULL, &attr);
4107  make_field_entry (&field);
4108 
4109  cob_set_exception (0);
4110  /* Base 1601-01-01 */
4111  days = cob_get_int (srcdays);
4112  if (!valid_integer_date (days)) {
4113  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4114  memset (curr_field->data, '0', (size_t)7);
4115  return curr_field;
4116  }
4117 
4118  day_of_integer (days, &baseyear, &days);
4119  snprintf (buff, (size_t)15, "%4.4d%3.3d", baseyear, days);
4120 
4121  memcpy (curr_field->data, buff, (size_t)7);
4122  return curr_field;
4123 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
valid_integer_date
static int valid_integer_date(const int days)
Definition: intrinsic.c:1788
cob_field
Definition: common.h:950
COB_ATTR_INIT
#define COB_ATTR_INIT(u, v, x, y, z)
Definition: coblocal.h:150
cob_field::data
unsigned char * data
Definition: common.h:952
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
day_of_integer
static void day_of_integer(int days, int *year, int *day)
Definition: intrinsic.c:1893
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_TYPE_NUMERIC_DISPLAY
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
cob_field_attr
Definition: common.h:940
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_day_to_yyyyddd ( const int  ,
  ... 
)

Definition at line 5254 of file intrinsic.c.

References cob_alloc_set_field_int(), cob_alloc_set_field_uint(), COB_EC_ARGUMENT_FUNCTION, cob_get_int(), cob_set_exception(), curr_field, get_interval_and_current_year_from_args(), and valid_year().

5255 {
5256  cob_field *f;
5257  va_list args;
5258  int year;
5259  int days;
5260  int interval;
5261  int current_year;
5262  int maxyear;
5263 
5264  cob_set_exception (0);
5265 
5266  va_start (args, params);
5267 
5268  f = va_arg (args, cob_field *);
5269  year = cob_get_int (f);
5270  days = year % 1000;
5271  year /= 1000;
5272 
5273  get_interval_and_current_year_from_args (params, args, &interval,
5274  &current_year);
5275 
5276  va_end (args);
5277 
5278  if (year < 0 || year > 999999) {
5279  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5280  cob_alloc_set_field_uint (0);
5281  return curr_field;
5282  }
5283  if (!valid_year (current_year)) {
5284  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5285  cob_alloc_set_field_uint (0);
5286  return curr_field;
5287  }
5288  maxyear = current_year + interval;
5289  if (maxyear < 1700 || maxyear > 9999) {
5290  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5291  cob_alloc_set_field_uint (0);
5292  return curr_field;
5293  }
5294  if (maxyear % 100 >= year) {
5295  year += 100 * (maxyear / 100);
5296  } else {
5297  year += 100 * ((maxyear / 100) - 1);
5298  }
5299  year *= 1000;
5300  year += days;
5301  cob_alloc_set_field_int (year);
5302  return curr_field;
5303 }
cob_alloc_set_field_int
static void cob_alloc_set_field_int(const int val)
Definition: intrinsic.c:533
get_interval_and_current_year_from_args
static void get_interval_and_current_year_from_args(const int num_args, va_list args, int *const interval, int *const current_year)
Definition: intrinsic.c:1624
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_field
Definition: common.h:950
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
cob_time::year
int year
Definition: coblocal.h:263
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
valid_year
static int valid_year(const int year)
Definition: intrinsic.c:1794
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_display_of ( const int  ,
const int  ,
const int  ,
  ... 
)

Definition at line 6470 of file intrinsic.c.

References cob_fatal_error(), COB_FERROR_FUNCTION, and COB_UNUSED.

6472 {
6473  COB_UNUSED (offset);
6474  COB_UNUSED (length);
6475  COB_UNUSED (params);
6476 
6477  cob_fatal_error (COB_FERROR_FUNCTION);
6478 }
COB_FERROR_FUNCTION
#define COB_FERROR_FUNCTION
Definition: common.h:702
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_e ( void  )

Definition at line 4262 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_get_field(), cob_decimal_set_mpf(), cob_mpf_exp(), cob_mpft, and curr_field.

4263 {
4264  mpf_set_ui (cob_mpft, 1UL);
4265  cob_mpf_exp (cob_mpft, cob_mpft);
4266  cob_decimal_set_mpf (&d1, cob_mpft);
4267  cob_alloc_field (&d1);
4268  (void)cob_decimal_get_field (&d1, curr_field, 0);
4269 
4270  return curr_field;
4271 }
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_mpft
static mpf_t cob_mpft
Definition: intrinsic.c:88
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal_set_mpf
static void cob_decimal_set_mpf(cob_decimal *d, const mpf_t src)
Definition: intrinsic.c:816
cob_mpf_exp
static void cob_mpf_exp(mpf_t dst_val, const mpf_t src_val)
Definition: intrinsic.c:871

Here is the call graph for this function:

cob_field* cob_intr_exception_file ( void  )

Definition at line 3833 of file intrinsic.c.

References __cob_global::cob_error_file, __cob_global::cob_exception_code, COB_FIELD_INIT, curr_field, cob_field::data, cob_file::file_status, make_field_entry(), NULL, cob_file::select_name, and cob_field::size.

3834 {
3835  size_t flen;
3836  cob_field field;
3837 
3838  COB_FIELD_INIT (0, NULL, &const_alpha_attr);
3839  if (cobglobptr->cob_exception_code == 0 || !cobglobptr->cob_error_file ||
3840  (cobglobptr->cob_exception_code & 0x0500) != 0x0500) {
3841  field.size = 2;
3842  make_field_entry (&field);
3843  memcpy (curr_field->data, "00", (size_t)2);
3844  } else {
3845  flen = strlen (cobglobptr->cob_error_file->select_name);
3846  field.size = flen + 2;
3847  make_field_entry (&field);
3848  memcpy (curr_field->data,
3849  cobglobptr->cob_error_file->file_status, (size_t)2);
3850  memcpy (&(curr_field->data[2]),
3851  cobglobptr->cob_error_file->select_name, flen);
3852  }
3853  return curr_field;
3854 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
__cob_global::cob_error_file
cob_file * cob_error_file
Definition: common.h:1187
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
cob_file::file_status
unsigned char * file_status
Definition: common.h:1113
cobglobptr
static cob_global * cobglobptr
Definition: intrinsic.c:71
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_field::size
size_t size
Definition: common.h:951
__cob_global::cob_exception_code
int cob_exception_code
Definition: common.h:1203
cob_file::select_name
const char * select_name
Definition: common.h:1112

Here is the call graph for this function:

cob_field* cob_intr_exception_file_n ( void  )

Definition at line 6481 of file intrinsic.c.

References cob_fatal_error(), and COB_FERROR_FUNCTION.

6482 {
6483  cob_fatal_error (COB_FERROR_FUNCTION);
6484 }
COB_FERROR_FUNCTION
#define COB_FERROR_FUNCTION
Definition: common.h:702
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601

Here is the call graph for this function:

cob_field* cob_intr_exception_location ( void  )

Definition at line 3857 of file intrinsic.c.

References COB_FIELD_INIT, cob_free(), __cob_global::cob_got_exception, cob_malloc(), __cob_global::cob_orig_line, __cob_global::cob_orig_paragraph, __cob_global::cob_orig_program_id, __cob_global::cob_orig_section, COB_SMALL_BUFF, COB_SMALL_MAX, curr_field, cob_field::data, make_field_entry(), NULL, and cob_field::size.

3858 {
3859  char *buff;
3860  cob_field field;
3861 
3862  COB_FIELD_INIT (0, NULL, &const_alpha_attr);
3863  if (!cobglobptr->cob_got_exception || !cobglobptr->cob_orig_program_id) {
3864  field.size = 1;
3865  make_field_entry (&field);
3866  *(curr_field->data) = ' ';
3867  return curr_field;
3868  }
3869  buff = cob_malloc ((size_t)COB_SMALL_BUFF);
3870  if (cobglobptr->cob_orig_section && cobglobptr->cob_orig_paragraph) {
3871  snprintf (buff, (size_t)COB_SMALL_MAX, "%s; %s OF %s; %u",
3872  cobglobptr->cob_orig_program_id,
3873  cobglobptr->cob_orig_paragraph,
3874  cobglobptr->cob_orig_section,
3875  cobglobptr->cob_orig_line);
3876  } else if (cobglobptr->cob_orig_section) {
3877  snprintf (buff, (size_t)COB_SMALL_MAX, "%s; %s; %u",
3878  cobglobptr->cob_orig_program_id,
3879  cobglobptr->cob_orig_section,
3880  cobglobptr->cob_orig_line);
3881  } else if (cobglobptr->cob_orig_paragraph) {
3882  snprintf (buff, (size_t)COB_SMALL_MAX, "%s; %s; %u",
3883  cobglobptr->cob_orig_program_id,
3884  cobglobptr->cob_orig_paragraph,
3885  cobglobptr->cob_orig_line);
3886  } else {
3887  snprintf (buff, (size_t)COB_SMALL_MAX, "%s; ; %u",
3888  cobglobptr->cob_orig_program_id,
3889  cobglobptr->cob_orig_line);
3890  }
3891  buff[COB_SMALL_MAX] = 0; /* silence warnings */
3892  field.size = strlen (buff);
3893  make_field_entry (&field);
3894  memcpy (curr_field->data, buff, field.size);
3895  cob_free (buff);
3896  return curr_field;
3897 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
__cob_global::cob_orig_line
unsigned int cob_orig_line
Definition: common.h:1206
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
COB_SMALL_BUFF
#define COB_SMALL_BUFF
Definition: common.h:540
__cob_global::cob_orig_paragraph
const char * cob_orig_paragraph
Definition: common.h:1192
COB_SMALL_MAX
#define COB_SMALL_MAX
Definition: common.h:546
cob_field::data
unsigned char * data
Definition: common.h:952
cobglobptr
static cob_global * cobglobptr
Definition: intrinsic.c:71
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
__cob_global::cob_orig_section
const char * cob_orig_section
Definition: common.h:1191
__cob_global::cob_got_exception
unsigned int cob_got_exception
Definition: common.h:1207
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_field::size
size_t size
Definition: common.h:951
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
__cob_global::cob_orig_program_id
const char * cob_orig_program_id
Definition: common.h:1190

Here is the call graph for this function:

cob_field* cob_intr_exception_location_n ( void  )

Definition at line 6487 of file intrinsic.c.

References cob_fatal_error(), and COB_FERROR_FUNCTION.

6488 {
6489  cob_fatal_error (COB_FERROR_FUNCTION);
6490 }
COB_FERROR_FUNCTION
#define COB_FERROR_FUNCTION
Definition: common.h:702
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601

Here is the call graph for this function:

cob_field* cob_intr_exception_statement ( void  )

Definition at line 3920 of file intrinsic.c.

References __cob_global::cob_exception_code, COB_FIELD_INIT, __cob_global::cob_orig_statement, curr_field, cob_field::data, make_field_entry(), and NULL.

3921 {
3922  size_t flen;
3923  cob_field field;
3924 
3925  COB_FIELD_INIT (31, NULL, &const_alpha_attr);
3926  make_field_entry (&field);
3927 
3928  memset (curr_field->data, ' ', (size_t)31);
3929  if (cobglobptr->cob_exception_code && cobglobptr->cob_orig_statement) {
3930  flen = strlen (cobglobptr->cob_orig_statement);
3931  if (flen > 31) {
3932  flen = 31;
3933  }
3934  memcpy (curr_field->data, cobglobptr->cob_orig_statement, flen);
3935  }
3936  return curr_field;
3937 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
cobglobptr
static cob_global * cobglobptr
Definition: intrinsic.c:71
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
__cob_global::cob_orig_statement
const char * cob_orig_statement
Definition: common.h:1189
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
__cob_global::cob_exception_code
int cob_exception_code
Definition: common.h:1203

Here is the call graph for this function:

cob_field* cob_intr_exception_status ( void  )

Definition at line 3900 of file intrinsic.c.

References __cob_global::cob_exception_code, COB_FIELD_INIT, cob_get_exception_name(), curr_field, cob_field::data, make_field_entry(), and NULL.

3901 {
3902  const char *except_name;
3903  cob_field field;
3904 
3905  COB_FIELD_INIT (31, NULL, &const_alpha_attr);
3906  make_field_entry (&field);
3907 
3908  memset (curr_field->data, ' ', (size_t)31);
3909  if (cobglobptr->cob_exception_code) {
3910  except_name = cob_get_exception_name ();
3911  if (except_name == NULL) {
3912  except_name = "EXCEPTION-OBJECT";
3913  }
3914  memcpy (curr_field->data, except_name, strlen (except_name));
3915  }
3916  return curr_field;
3917 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
cob_get_exception_name
const char * cob_get_exception_name(void)
Definition: common.c:1199
cobglobptr
static cob_global * cobglobptr
Definition: intrinsic.c:71
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
__cob_global::cob_exception_code
int cob_exception_code
Definition: common.h:1203

Here is the call graph for this function:

cob_field* cob_intr_exp ( cob_field *  )

Definition at line 4285 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), cob_decimal_get_field(), cob_decimal_get_mpf(), cob_decimal_set_field(), cob_decimal_set_mpf(), cob_mpf_exp(), cob_mpft, cob_set_exception(), curr_field, and cob_decimal::value.

4286 {
4287  cob_decimal_set_field (&d1, srcfield);
4288 
4289  cob_set_exception (0);
4290 
4291  if (!mpz_sgn (d1.value)) {
4292  /* Power is zero */
4293  cob_alloc_set_field_uint (1);
4294  return curr_field;
4295  }
4296 
4297  cob_decimal_get_mpf (cob_mpft, &d1);
4298  cob_mpf_exp (cob_mpft, cob_mpft);
4299  cob_decimal_set_mpf (&d1, cob_mpft);
4300  cob_alloc_field (&d1);
4301  (void)cob_decimal_get_field (&d1, curr_field, 0);
4302 
4303  return curr_field;
4304 }
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_mpft
static mpf_t cob_mpft
Definition: intrinsic.c:88
cob_decimal_get_mpf
static void cob_decimal_get_mpf(mpf_t dst, const cob_decimal *d)
Definition: intrinsic.c:847
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal_set_mpf
static void cob_decimal_set_mpf(cob_decimal *d, const mpf_t src)
Definition: intrinsic.c:816
cob_mpf_exp
static void cob_mpf_exp(mpf_t dst_val, const mpf_t src_val)
Definition: intrinsic.c:871

Here is the call graph for this function:

cob_field* cob_intr_exp10 ( cob_field *  )

Definition at line 4307 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), cob_decimal_get_field(), cob_decimal_pow(), cob_decimal_set_field(), cob_set_exception(), cob_trim_decimal(), curr_field, cob_decimal::scale, sign, and cob_decimal::value.

4308 {
4309  int sign;
4310 
4311  cob_decimal_set_field (&d1, srcfield);
4312 
4313  cob_set_exception (0);
4314 
4315  sign = mpz_sgn (d1.value);
4316  if (!sign) {
4317  /* Power is zero */
4318  cob_alloc_set_field_uint (1);
4319  return curr_field;
4320  }
4321 
4322  cob_trim_decimal (&d1);
4323 
4324  if (!d1.scale) {
4325  /* Integer positive/negative powers */
4326  if (sign < 0 && mpz_fits_sint_p (d1.value)) {
4327  mpz_abs (d1.value, d1.value);
4328  d1.scale = mpz_get_si (d1.value);
4329  mpz_set_ui (d1.value, 1UL);
4330  cob_alloc_field (&d1);
4331  (void)cob_decimal_get_field (&d1, curr_field, 0);
4332  return curr_field;
4333  }
4334  if (sign > 0 && mpz_fits_ulong_p (d1.value)) {
4335  mpz_ui_pow_ui (d1.value, 10UL, mpz_get_ui (d1.value));
4336  cob_alloc_field (&d1);
4337  (void)cob_decimal_get_field (&d1, curr_field, 0);
4338  return curr_field;
4339  }
4340  }
4341 
4342  mpz_set_ui (d2.value, 10UL);
4343  d2.scale = 0;
4344  cob_decimal_pow (&d2, &d1);
4345  cob_alloc_field (&d2);
4346  (void)cob_decimal_get_field (&d2, curr_field, 0);
4347 
4348  return curr_field;
4349 }
d2
static cob_decimal d2
Definition: intrinsic.c:80
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_decimal_pow
void cob_decimal_pow(cob_decimal *pd1, cob_decimal *pd2)
Definition: intrinsic.c:2990
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
sign
if sign
Definition: flag.def:42
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_trim_decimal
static void cob_trim_decimal(cob_decimal *d)
Definition: intrinsic.c:517
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_factorial ( cob_field *  )

Definition at line 4241 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), cob_decimal_get_field(), COB_EC_ARGUMENT_FUNCTION, cob_get_int(), cob_set_exception(), cob_uli_t, curr_field, cob_decimal::scale, and cob_decimal::value.

4242 {
4243  int srcval;
4244 
4245  cob_set_exception (0);
4246  srcval = cob_get_int (srcfield);
4247  d1.scale = 0;
4248  if (srcval < 0) {
4249  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4250  cob_alloc_set_field_uint (0);
4251  return curr_field;
4252  } else {
4253  mpz_fac_ui (d1.value, (cob_uli_t)srcval);
4254  }
4255 
4256  cob_alloc_field (&d1);
4257  (void)cob_decimal_get_field (&d1, curr_field, 0);
4258  return curr_field;
4259 }
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
cob_uli_t
#define cob_uli_t
Definition: common.h:33
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_formatted_current_date ( const int  ,
const int  ,
cob_field *   
)

Definition at line 6407 of file intrinsic.c.

References calc_ref_mod(), COB_DATESTR_LEN, COB_DATETIMESTR_LEN, COB_EC_ARGUMENT_FUNCTION, COB_FIELD_INIT, COB_MODULE_PTR, cob_set_exception(), COB_TIMESTR_LEN, cob_valid_datetime_format(), curr_field, cob_field::data, format_current_date(), make_field_entry(), NULL, num_leading_nonspace(), parse_date_format_string(), parse_time_format_string(), split_around_t(), and unlikely.

6409 {
6410  cob_field field;
6411  size_t field_length =
6412  num_leading_nonspace ((char *) format_field->data);
6413  char format_str[COB_DATETIMESTR_LEN] = { '\0' };
6414  char date_format_str[COB_DATESTR_LEN] = { '\0' };
6415  char time_format_str[COB_TIMESTR_LEN] = { '\0' };
6416  struct date_format date_fmt;
6417  struct time_format time_fmt;
6418  char formatted_date[COB_DATETIMESTR_LEN] = { '\0' };
6419 
6420  strncpy (format_str, (char *) format_field->data, field_length);
6421 
6422  COB_FIELD_INIT (field_length, NULL, &const_alpha_attr);
6423  make_field_entry (&field);
6424 
6425  cob_set_exception (0);
6426 
6427  /* Validate format */
6428  if (!cob_valid_datetime_format (format_str, COB_MODULE_PTR->decimal_point)) {
6429  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
6430  memset (curr_field->data, ' ', field_length);
6431  goto end_of_func;
6432  }
6433 
6434  /* Parse format */
6435  split_around_t (format_str, date_format_str, time_format_str);
6436  date_fmt = parse_date_format_string (date_format_str);
6437  time_fmt = parse_time_format_string (time_format_str);
6438 
6439  /* Format current date */
6440  format_current_date (date_fmt, time_fmt, formatted_date);
6441  memcpy (curr_field->data, formatted_date, field_length);
6442 
6443  end_of_func:
6444  if (unlikely (offset > 0)) {
6445  calc_ref_mod (curr_field, offset, length);
6446  }
6447  return curr_field;
6448 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
date_format
Definition: intrinsic.c:2125
num_leading_nonspace
static int num_leading_nonspace(const char *str)
Definition: intrinsic.c:2007
split_around_t
static void split_around_t(const char *str, char *first, char *second)
Definition: intrinsic.c:2384
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
time_format
Definition: intrinsic.c:1955
COB_DATETIMESTR_LEN
#define COB_DATETIMESTR_LEN
Definition: intrinsic.c:127
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
format_field
static void format_field(cob_screen *s)
Definition: screenio.c:1025
calc_ref_mod
static void calc_ref_mod(cob_field *f, const int offset, const int length)
Definition: intrinsic.c:488
unlikely
#define unlikely(x)
Definition: common.h:437
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
format_current_date
static void format_current_date(const struct date_format date_fmt, const struct time_format time_fmt, char *formatted_datetime)
Definition: intrinsic.c:2950
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cob_valid_datetime_format
int cob_valid_datetime_format(const char *format, const char decimal_point)
Definition: intrinsic.c:3402
COB_DATESTR_LEN
#define COB_DATESTR_LEN
Definition: intrinsic.c:119
COB_TIMESTR_LEN
#define COB_TIMESTR_LEN
Definition: intrinsic.c:124
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
parse_time_format_string
static struct time_format parse_time_format_string(const char *str)
Definition: intrinsic.c:2282
parse_date_format_string
static struct date_format parse_date_format_string(const char *format_str)
Definition: intrinsic.c:2131

Here is the call graph for this function:

cob_field* cob_intr_formatted_date ( const int  ,
const int  ,
cob_field *  ,
cob_field *   
)

Definition at line 6035 of file intrinsic.c.

References calc_ref_mod(), COB_DATESTR_LEN, COB_EC_ARGUMENT_FUNCTION, COB_FIELD_INIT, cob_get_int(), cob_set_exception(), curr_field, cob_field::data, format_date(), make_field_entry(), NULL, num_leading_nonspace(), parse_date_format_string(), unlikely, and valid_day_and_format().

6037 {
6038  cob_field field;
6039  size_t field_length =
6040  num_leading_nonspace ((char *) format_field->data);
6041  char format_str[COB_DATESTR_LEN] = { '\0' };
6042  int days;
6043  struct date_format format;
6044  char buff[COB_DATESTR_LEN] = { '\0' };
6045 
6046  memcpy (format_str, format_field->data, field_length);
6047 
6048  COB_FIELD_INIT (field_length, NULL, &const_alpha_attr);
6049  make_field_entry (&field);
6050 
6051  cob_set_exception (0);
6052  days = cob_get_int (days_field);
6053 
6054  if (!valid_day_and_format (days, format_str)) {
6055  goto invalid_args;
6056  }
6057 
6058  format = parse_date_format_string (format_str);
6059  format_date (format, days, buff);
6060 
6061  memcpy (curr_field->data, buff, field_length);
6062  goto end_of_func;
6063 
6064  invalid_args:
6065  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
6066  memset (curr_field->data, ' ', strlen (format_str));
6067 
6068  end_of_func:
6069  if (unlikely (offset > 0)) {
6070  calc_ref_mod (curr_field, offset, length);
6071  }
6072  return curr_field;
6073 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
date_format
Definition: intrinsic.c:2125
num_leading_nonspace
static int num_leading_nonspace(const char *str)
Definition: intrinsic.c:2007
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
format_field
static void format_field(cob_screen *s)
Definition: screenio.c:1025
calc_ref_mod
static void calc_ref_mod(cob_field *f, const int offset, const int length)
Definition: intrinsic.c:488
unlikely
#define unlikely(x)
Definition: common.h:437
format_date
static void format_date(const struct date_format format, const int days, char *buff)
Definition: intrinsic.c:2149
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_DATESTR_LEN
#define COB_DATESTR_LEN
Definition: intrinsic.c:119
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
valid_day_and_format
static int valid_day_and_format(const int day, const char *format)
Definition: intrinsic.c:2001
parse_date_format_string
static struct date_format parse_date_format_string(const char *format_str)
Definition: intrinsic.c:2131

Here is the call graph for this function:

cob_field* cob_intr_formatted_datetime ( const int  ,
const int  ,
const int  ,
  ... 
)

Definition at line 6169 of file intrinsic.c.

References calc_ref_mod(), COB_DATESTR_LEN, COB_DATETIMESTR_LEN, COB_EC_ARGUMENT_FUNCTION, COB_FIELD_INIT, cob_get_int(), COB_MODULE_PTR, cob_set_exception(), COB_TIMESTR_LEN, cob_valid_datetime_format(), curr_field, d1, cob_field::data, format_datetime(), get_fractional_seconds(), get_system_offset_time_ptr(), make_field_entry(), NULL, num_leading_nonspace(), parse_date_format_string(), parse_time_format_string(), split_around_t(), try_get_valid_offset_time(), unlikely, valid_integer_date(), and valid_time().

6171 {
6172  va_list args;
6173  cob_field *fmt_field;
6174  cob_field *days_field;
6175  cob_field *time_field;
6176  cob_field *offset_time_field;
6177  cob_field field;
6178  size_t field_length;
6179  char fmt_str[COB_DATETIMESTR_LEN] = { '\0' };
6180  char date_fmt_str[COB_DATESTR_LEN] = { '\0' };
6181  char time_fmt_str[COB_TIMESTR_LEN] = { '\0' };
6182  struct date_format date_fmt;
6183  struct time_format time_fmt;
6184  int days;
6185  int whole_seconds;
6186  cob_decimal *fractional_seconds;
6187  int use_system_offset;
6188  int offset_time;
6189  int *offset_time_ptr;
6190  char buff[COB_DATETIMESTR_LEN] = { '\0' };
6191 
6192  if (!(params == 4 || params == 5)) {
6193  COB_FIELD_INIT (0, NULL, &const_alpha_attr);
6194  make_field_entry (&field);
6195  goto invalid_args;
6196  }
6197 
6198  /* Get arguments */
6199  va_start (args, params);
6200 
6201  fmt_field = va_arg (args, cob_field *);
6202  days_field = va_arg (args, cob_field *);
6203  time_field = va_arg (args, cob_field *);
6204  if (params == 5) {
6205  offset_time_field = va_arg (args, cob_field *);
6206  } else {
6207  offset_time_field = NULL;
6208  }
6209  use_system_offset = va_arg (args, int);
6210 
6211  va_end (args);
6212 
6213  field_length = num_leading_nonspace ((char *) fmt_field->data);
6214  memcpy (fmt_str, fmt_field->data, field_length);
6215 
6216  COB_FIELD_INIT (field_length, NULL, &const_alpha_attr);
6217  make_field_entry (&field);
6218 
6219  cob_set_exception (0);
6220 
6221  /* Validate the formats, dates and times */
6222  if (!cob_valid_datetime_format (fmt_str, COB_MODULE_PTR->decimal_point)) {
6223  goto invalid_args;
6224  }
6225 
6226  days = cob_get_int (days_field);
6227  whole_seconds = cob_get_int (time_field);
6228 
6229  if (!valid_integer_date (days) || !valid_time (whole_seconds)) {
6230  goto invalid_args;
6231  }
6232 
6233  split_around_t (fmt_str, date_fmt_str, time_fmt_str);
6234 
6235  time_fmt = parse_time_format_string (time_fmt_str);
6236  if (use_system_offset) {
6237  offset_time_ptr = get_system_offset_time_ptr (&offset_time);
6238  } else {
6239  if (try_get_valid_offset_time (time_fmt, offset_time_field,
6240  &offset_time)) {
6241  goto invalid_args;
6242  } else {
6243  offset_time_ptr = &offset_time;
6244  }
6245  }
6246  date_fmt = parse_date_format_string (date_fmt_str);
6247 
6248  /* Format */
6249 
6250  fractional_seconds = &d1;
6251  get_fractional_seconds (time_field, fractional_seconds);
6252 
6253  format_datetime (date_fmt, time_fmt, days, whole_seconds,
6254  fractional_seconds, offset_time_ptr, buff);
6255 
6256  memcpy (curr_field->data, buff, (size_t) field_length);
6257  goto end_of_func;
6258 
6259  invalid_args:
6260  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
6261  if (fmt_str != NULL) {
6262  memset (curr_field->data, ' ', strlen (fmt_str));
6263  }
6264 
6265  end_of_func:
6266  if (unlikely (offset > 0)) {
6267  calc_ref_mod (curr_field, offset, length);
6268  }
6269  return curr_field;
6270 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
date_format
Definition: intrinsic.c:2125
num_leading_nonspace
static int num_leading_nonspace(const char *str)
Definition: intrinsic.c:2007
valid_integer_date
static int valid_integer_date(const int days)
Definition: intrinsic.c:1788
format_datetime
static void format_datetime(const struct date_format date_fmt, const struct time_format time_fmt, const int days, const int whole_seconds, cob_decimal *fractional_seconds, int *offset_time, char *buff)
Definition: intrinsic.c:2929
split_around_t
static void split_around_t(const char *str, char *first, char *second)
Definition: intrinsic.c:2384
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
time_format
Definition: intrinsic.c:1955
COB_DATETIMESTR_LEN
#define COB_DATETIMESTR_LEN
Definition: intrinsic.c:127
cob_field
Definition: common.h:950
valid_time
static int valid_time(const int seconds_from_midnight)
Definition: intrinsic.c:1836
cob_field::data
unsigned char * data
Definition: common.h:952
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
calc_ref_mod
static void calc_ref_mod(cob_field *f, const int offset, const int length)
Definition: intrinsic.c:488
unlikely
#define unlikely(x)
Definition: common.h:437
cob_decimal
Definition: common.h:984
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
try_get_valid_offset_time
static int try_get_valid_offset_time(const struct time_format time_format, cob_field *offset_time_field, int *offset_time)
Definition: intrinsic.c:2419
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cob_valid_datetime_format
int cob_valid_datetime_format(const char *format, const char decimal_point)
Definition: intrinsic.c:3402
COB_DATESTR_LEN
#define COB_DATESTR_LEN
Definition: intrinsic.c:119
d1
static cob_decimal d1
Definition: intrinsic.c:79
get_fractional_seconds
static void get_fractional_seconds(cob_field *time, cob_decimal *fraction)
Definition: intrinsic.c:2165
COB_TIMESTR_LEN
#define COB_TIMESTR_LEN
Definition: intrinsic.c:124
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
parse_time_format_string
static struct time_format parse_time_format_string(const char *str)
Definition: intrinsic.c:2282
get_system_offset_time_ptr
static int * get_system_offset_time_ptr(int *const offset_time)
Definition: intrinsic.c:2436
parse_date_format_string
static struct date_format parse_date_format_string(const char *format_str)
Definition: intrinsic.c:2131
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_formatted_time ( const int  ,
const int  ,
const int  ,
  ... 
)

Definition at line 6076 of file intrinsic.c.

References calc_ref_mod(), COB_EC_ARGUMENT_FUNCTION, COB_FIELD_INIT, cob_get_int(), COB_MODULE_PTR, cob_set_exception(), COB_TIMESTR_LEN, cob_valid_time_format(), curr_field, d2, cob_field::data, format_field(), format_time(), get_fractional_seconds(), get_system_offset_time_ptr(), make_field_entry(), NULL, num_leading_nonspace(), parse_time_format_string(), try_get_valid_offset_time(), unlikely, and valid_time().

6078 {
6079  va_list args;
6080  cob_field *format_field;
6081  cob_field *time_field;
6082  cob_field *offset_time_field;
6083  cob_field field;
6084  size_t field_length;
6085  char buff[COB_TIMESTR_LEN] = { '\0' };
6086  char format_str[COB_TIMESTR_LEN] = { '\0' };
6087  int whole_seconds;
6088  cob_decimal *fractional_seconds;
6089  int use_system_offset;
6090  int offset_time;
6091  int *offset_time_ptr;
6092  struct time_format format;
6093 
6094  if (!(params == 3 || params == 4)) {
6095  COB_FIELD_INIT (0, NULL, &const_alpha_attr);
6096  make_field_entry (&field);
6097  goto invalid_args;
6098  }
6099 
6100  /* Get args */
6101  va_start (args, params);
6102 
6103  format_field = va_arg (args, cob_field *);
6104  time_field = va_arg (args, cob_field *);
6105  if (params == 4) {
6106  offset_time_field = va_arg (args, cob_field *);
6107  } else {
6108  offset_time_field = NULL;
6109  }
6110  use_system_offset = va_arg (args, int);
6111 
6112  va_end (args);
6113 
6114  /* Initialise buffers */
6115  field_length = num_leading_nonspace ((char *) format_field->data);
6116  memcpy (format_str, format_field->data, field_length);
6117 
6118  COB_FIELD_INIT (field_length, NULL, &const_alpha_attr);
6119  make_field_entry (&field);
6120 
6121  cob_set_exception (0);
6122 
6123  /* Extract and validate the times and time format */
6124 
6125  whole_seconds = cob_get_int (time_field);
6126  if (!valid_time (whole_seconds)) {
6127  goto invalid_args;
6128  }
6129 
6130  fractional_seconds = &d2;
6131  get_fractional_seconds (time_field, fractional_seconds);
6132 
6133  if (!cob_valid_time_format (format_str, COB_MODULE_PTR->decimal_point)) {
6134  goto invalid_args;
6135  }
6136  format = parse_time_format_string (format_str);
6137 
6138  if (use_system_offset) {
6139  offset_time_ptr = get_system_offset_time_ptr (&offset_time);
6140  } else {
6141  if (try_get_valid_offset_time (format, offset_time_field,
6142  &offset_time)) {
6143  goto invalid_args;
6144  } else {
6145  offset_time_ptr = &offset_time;
6146  }
6147  }
6148 
6149  format_time (format, whole_seconds, fractional_seconds, offset_time_ptr,
6150  buff);
6151 
6152  memcpy (curr_field->data, buff, field_length);
6153  goto end_of_func;
6154 
6155  invalid_args:
6156  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
6157  if (format_str != NULL) {
6158  memset (curr_field->data, ' ', strlen (format_str));
6159  }
6160 
6161  end_of_func:
6162  if (unlikely (offset > 0)) {
6163  calc_ref_mod (curr_field, offset, length);
6164  }
6165  return curr_field;
6166 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
d2
static cob_decimal d2
Definition: intrinsic.c:80
num_leading_nonspace
static int num_leading_nonspace(const char *str)
Definition: intrinsic.c:2007
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
time_format
Definition: intrinsic.c:1955
cob_valid_time_format
int cob_valid_time_format(const char *format, const char decimal_point)
Definition: intrinsic.c:3366
cob_field
Definition: common.h:950
valid_time
static int valid_time(const int seconds_from_midnight)
Definition: intrinsic.c:1836
cob_field::data
unsigned char * data
Definition: common.h:952
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
format_field
static void format_field(cob_screen *s)
Definition: screenio.c:1025
calc_ref_mod
static void calc_ref_mod(cob_field *f, const int offset, const int length)
Definition: intrinsic.c:488
unlikely
#define unlikely(x)
Definition: common.h:437
cob_decimal
Definition: common.h:984
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
try_get_valid_offset_time
static int try_get_valid_offset_time(const struct time_format time_format, cob_field *offset_time_field, int *offset_time)
Definition: intrinsic.c:2419
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
get_fractional_seconds
static void get_fractional_seconds(cob_field *time, cob_decimal *fraction)
Definition: intrinsic.c:2165
COB_TIMESTR_LEN
#define COB_TIMESTR_LEN
Definition: intrinsic.c:124
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
format_time
static int format_time(const struct time_format format, int time, cob_decimal *second_fraction, int *offset_time, char *buff)
Definition: intrinsic.c:2316
parse_time_format_string
static struct time_format parse_time_format_string(const char *str)
Definition: intrinsic.c:2282
get_system_offset_time_ptr
static int * get_system_offset_time_ptr(int *const offset_time)
Definition: intrinsic.c:2436
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_fraction_part ( cob_field *  )

Definition at line 3532 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_get_field(), cob_decimal_set_field(), cob_mexp, cob_uli_t, curr_field, cob_decimal::scale, and cob_decimal::value.

3533 {
3534  cob_decimal_set_field (&d1, srcfield);
3535  /* Check scale */
3536  if (d1.scale > 0) {
3537  mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)d1.scale);
3538  mpz_tdiv_r (d1.value, d1.value, cob_mexp);
3539  } else {
3540  /* No decimals */
3541  mpz_set_ui (d1.value, 0UL);
3542  d1.scale = 0;
3543  }
3544 
3545  cob_alloc_field (&d1);
3546  (void)cob_decimal_get_field (&d1, curr_field, 0);
3547  return curr_field;
3548 }
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_mexp
static mpz_t cob_mexp
Definition: intrinsic.c:85
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_uli_t
#define cob_uli_t
Definition: common.h:33
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_highest_algebraic ( cob_field *  )

Definition at line 5866 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), cob_decimal_get_field(), COB_EC_ARGUMENT_FUNCTION, COB_FIELD_BINARY_TRUNC, COB_FIELD_DIGITS, COB_FIELD_HAVE_SIGN, COB_FIELD_INIT, COB_FIELD_REAL_BINARY, COB_FIELD_SCALE, COB_FIELD_SIZE, COB_FIELD_TYPE, cob_set_exception(), COB_TYPE_ALPHANUMERIC, COB_TYPE_ALPHANUMERIC_EDITED, COB_TYPE_NATIONAL, COB_TYPE_NATIONAL_EDITED, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_DOUBLE, COB_TYPE_NUMERIC_EDITED, COB_TYPE_NUMERIC_FLOAT, COB_TYPE_NUMERIC_PACKED, cob_uli_t, curr_field, cob_field::data, make_field_entry(), NULL, cob_decimal::scale, and cob_decimal::value.

5867 {
5868  cob_uli_t expo;
5869  size_t size;
5870  cob_field field;
5871 
5872  switch (COB_FIELD_TYPE (srcfield)) {
5873  case COB_TYPE_ALPHANUMERIC:
5874  case COB_TYPE_NATIONAL:
5875  size = COB_FIELD_SIZE (srcfield);
5876  COB_FIELD_INIT (size, NULL, &const_alpha_attr);
5877  make_field_entry (&field);
5878  memset (curr_field->data, 255, size);
5879  break;
5880 
5881  case COB_TYPE_ALPHANUMERIC_EDITED:
5882  case COB_TYPE_NATIONAL_EDITED:
5883  size = COB_FIELD_DIGITS (srcfield);
5884  COB_FIELD_INIT (size, NULL, &const_alpha_attr);
5885  make_field_entry (&field);
5886  memset (curr_field->data, 255, size);
5887  break;
5888 
5889  case COB_TYPE_NUMERIC_BINARY:
5890  if (COB_FIELD_REAL_BINARY (srcfield) ||
5891  !COB_FIELD_BINARY_TRUNC (srcfield)) {
5892  if (!COB_FIELD_HAVE_SIGN (srcfield)) {
5893  expo = COB_FIELD_SIZE (srcfield) * 8U;
5894  } else {
5895  expo = (COB_FIELD_SIZE (srcfield) * 8U) - 1U;
5896  }
5897  mpz_ui_pow_ui (d1.value, 2UL, expo);
5898  mpz_sub_ui (d1.value, d1.value, 1UL);
5899  d1.scale = COB_FIELD_SCALE (srcfield);
5900  cob_alloc_field (&d1);
5901  (void)cob_decimal_get_field (&d1, curr_field, 0);
5902  break;
5903  }
5904  expo = (cob_uli_t)COB_FIELD_DIGITS (srcfield);
5905  mpz_ui_pow_ui (d1.value, 10UL, expo);
5906  mpz_sub_ui (d1.value, d1.value, 1UL);
5907  d1.scale = COB_FIELD_SCALE (srcfield);
5908  cob_alloc_field (&d1);
5909  (void)cob_decimal_get_field (&d1, curr_field, 0);
5910  break;
5911 
5912  case COB_TYPE_NUMERIC_FLOAT:
5913  case COB_TYPE_NUMERIC_DOUBLE:
5914  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5915  cob_alloc_set_field_uint (0);
5916  break;
5917 
5918  case COB_TYPE_NUMERIC_DISPLAY:
5919  case COB_TYPE_NUMERIC_PACKED:
5920  case COB_TYPE_NUMERIC_EDITED:
5921  expo = (cob_uli_t)COB_FIELD_DIGITS (srcfield);
5922  mpz_ui_pow_ui (d1.value, 10UL, expo);
5923  mpz_sub_ui (d1.value, d1.value, 1UL);
5924  d1.scale = COB_FIELD_SCALE (srcfield);
5925  cob_alloc_field (&d1);
5926  (void)cob_decimal_get_field (&d1, curr_field, 0);
5927  break;
5928  default:
5929  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5930  cob_alloc_set_field_uint (0);
5931  break;
5932  }
5933  return curr_field;
5934 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
COB_TYPE_NATIONAL_EDITED
#define COB_TYPE_NATIONAL_EDITED
Definition: common.h:626
COB_FIELD_SCALE
#define COB_FIELD_SCALE(f)
Definition: common.h:664
COB_TYPE_NUMERIC_PACKED
#define COB_TYPE_NUMERIC_PACKED
Definition: common.h:609
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
COB_TYPE_ALPHANUMERIC
#define COB_TYPE_ALPHANUMERIC
Definition: common.h:621
COB_FIELD_TYPE
#define COB_FIELD_TYPE(f)
Definition: common.h:662
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
COB_TYPE_NATIONAL
#define COB_TYPE_NATIONAL
Definition: common.h:625
cob_uli_t
#define cob_uli_t
Definition: common.h:33
COB_TYPE_NUMERIC_FLOAT
#define COB_TYPE_NUMERIC_FLOAT
Definition: common.h:610
COB_FIELD_REAL_BINARY
#define COB_FIELD_REAL_BINARY(f)
Definition: common.h:649
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_FIELD_BINARY_TRUNC
#define COB_FIELD_BINARY_TRUNC(f)
Definition: common.h:654
COB_TYPE_NUMERIC_BINARY
#define COB_TYPE_NUMERIC_BINARY
Definition: common.h:608
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_TYPE_ALPHANUMERIC_EDITED
#define COB_TYPE_ALPHANUMERIC_EDITED
Definition: common.h:623
COB_TYPE_NUMERIC_DISPLAY
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
COB_TYPE_NUMERIC_DOUBLE
#define COB_TYPE_NUMERIC_DOUBLE
Definition: common.h:611
COB_FIELD_HAVE_SIGN
#define COB_FIELD_HAVE_SIGN(f)
Definition: common.h:643
cob_decimal::value
mpz_t value
Definition: common.h:985
COB_FIELD_DIGITS
#define COB_FIELD_DIGITS(f)
Definition: common.h:663
COB_TYPE_NUMERIC_EDITED
#define COB_TYPE_NUMERIC_EDITED
Definition: common.h:619
COB_FIELD_SIZE
#define COB_FIELD_SIZE(f)
Definition: common.h:671
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_integer ( cob_field *  )

Definition at line 3487 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_get_field(), cob_decimal_set_field(), cob_mexp, cob_mpzt, cob_uli_t, curr_field, cob_decimal::scale, sign, and cob_decimal::value.

3488 {
3489  int sign;
3490 
3491  cob_decimal_set_field (&d1, srcfield);
3492  /* Check scale */
3493  if (d1.scale < 0) {
3494  mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)-d1.scale);
3495  mpz_mul (d1.value, d1.value, cob_mexp);
3496  } else if (d1.scale > 0) {
3497  sign = mpz_sgn (d1.value);
3498  mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)d1.scale);
3499  mpz_tdiv_qr (d1.value, cob_mpzt, d1.value, cob_mexp);
3500  /* Check negative and has decimal places */
3501  if (sign < 0 && mpz_sgn (cob_mpzt)) {
3502  mpz_sub_ui (d1.value, d1.value, 1UL);
3503  }
3504  }
3505  d1.scale = 0;
3506 
3507  cob_alloc_field (&d1);
3508  (void)cob_decimal_get_field (&d1, curr_field, 0);
3509  return curr_field;
3510 }
cob_mpzt
static mpz_t cob_mpzt
Definition: intrinsic.c:86
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_mexp
static mpz_t cob_mexp
Definition: intrinsic.c:85
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_uli_t
#define cob_uli_t
Definition: common.h:33
sign
if sign
Definition: flag.def:42
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_integer_of_boolean ( cob_field *  )

Definition at line 6493 of file intrinsic.c.

References cob_fatal_error(), COB_FERROR_FUNCTION, and COB_UNUSED.

6494 {
6495  COB_UNUSED (srcfield);
6496 
6497  cob_fatal_error (COB_FERROR_FUNCTION);
6498 }
COB_FERROR_FUNCTION
#define COB_FERROR_FUNCTION
Definition: common.h:702
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

cob_field* cob_intr_integer_of_date ( cob_field *  )

Definition at line 4126 of file intrinsic.c.

References cob_alloc_set_field_uint(), COB_EC_ARGUMENT_FUNCTION, cob_get_int(), cob_set_exception(), curr_field, integer_of_date(), cob_time::month, valid_day_of_month(), valid_month(), valid_year(), and cob_time::year.

4127 {
4128  int indate;
4129  int days;
4130  int month;
4131  int year;
4132 
4133  cob_set_exception (0);
4134  /* Base 1601-01-01 */
4135  indate = cob_get_int (srcfield);
4136  year = indate / 10000;
4137  if (!valid_year (year)) {
4138  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4139  cob_alloc_set_field_uint (0);
4140  return curr_field;
4141  }
4142  indate %= 10000;
4143  month = indate / 100;
4144  if (!valid_month (month)) {
4145  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4146  cob_alloc_set_field_uint (0);
4147  return curr_field;
4148  }
4149  days = indate % 100;
4150  if (!valid_day_of_month (year, month, days)) {
4151  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4152  cob_alloc_set_field_uint (0);
4153  return curr_field;
4154  }
4155 
4156  cob_alloc_set_field_uint (integer_of_date (year, month, days));
4157  return curr_field;
4158 }
integer_of_date
static cob_u32_t integer_of_date(const int, const int, const int)
Definition: intrinsic.c:1922
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
valid_day_of_month
static int valid_day_of_month(const int year, const int month, const int day)
Definition: intrinsic.c:1812
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
valid_month
static int valid_month(const int month)
Definition: intrinsic.c:1800
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
valid_year
static int valid_year(const int year)
Definition: intrinsic.c:1794
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_integer_of_day ( cob_field *  )

Definition at line 4161 of file intrinsic.c.

References cob_alloc_set_field_uint(), COB_EC_ARGUMENT_FUNCTION, cob_get_int(), cob_set_exception(), curr_field, integer_of_day(), valid_day_of_year(), valid_year(), and cob_time::year.

4162 {
4163  int indate;
4164  int days;
4165  int year;
4166 
4167  cob_set_exception (0);
4168  /* Base 1601-01-01 */
4169  indate = cob_get_int (srcfield);
4170  year = indate / 1000;
4171  if (!valid_year (year)) {
4172  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4173  cob_alloc_set_field_uint (0);
4174  return curr_field;
4175  }
4176  days = indate % 1000;
4177  if (!valid_day_of_year (year, days)) {
4178  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4179  cob_alloc_set_field_uint (0);
4180  return curr_field;
4181  }
4182 
4183  cob_alloc_set_field_uint (integer_of_day (year, days));
4184  return curr_field;
4185 }
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
integer_of_day
static cob_u32_t integer_of_day(const int year, const int days)
Definition: intrinsic.c:1939
valid_day_of_year
static int valid_day_of_year(const int year, const int day)
Definition: intrinsic.c:1806
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
valid_year
static int valid_year(const int year)
Definition: intrinsic.c:1794
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_integer_of_formatted_date ( cob_field *  ,
cob_field *   
)

Definition at line 6361 of file intrinsic.c.

References COB_DATESTR_LEN, and cob_field::data.

6363 {
6364  char *format_field_data = (char *) format_field->data;
6365  char format_str[COB_DATESTR_LEN] = { '\0' };
6366  char *date_field_data = (char *) date_field->data;
6367  char date_str[COB_DATESTR_LEN] = { '\0' };
6368  int is_date;
6369  struct date_format date_fmt;
6370 
6371  cob_set_exception (0);
6372 
6373  /* Get date format string and parse it */
6374  is_date = cob_valid_date_format (format_field_data);
6375  if (is_date) {
6376  strncpy (format_str, format_field_data, COB_DATESTR_MAX);
6377  } else if (cob_valid_datetime_format (format_field_data,
6378  COB_MODULE_PTR->decimal_point)) { /* Datetime */
6379  split_around_t (format_field_data, format_str, NULL);
6380  } else { /* Invalid format string */
6381  goto invalid_args;
6382  }
6383  date_fmt = parse_date_format_string (format_str);
6384 
6385  /* Get formatted date and validate it */
6386  if (is_date) {
6387  strncpy (date_str, date_field_data, COB_DATESTR_MAX);
6388  } else { /* Datetime */
6389  split_around_t (date_field_data, date_str, NULL);
6390  }
6391  if (test_formatted_date (date_fmt, date_str, 1) != 0) {
6392  goto invalid_args;
6393  }
6394 
6395  cob_alloc_set_field_uint (integer_of_formatted_date (date_fmt, date_str));
6396  goto end_of_func;
6397 
6398  invalid_args:
6399  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
6400  cob_alloc_set_field_uint (0);
6401 
6402  end_of_func:
6403  return curr_field;
6404 }
date_format
Definition: intrinsic.c:2125
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
split_around_t
static void split_around_t(const char *str, char *first, char *second)
Definition: intrinsic.c:2384
test_formatted_date
static int test_formatted_date(const struct date_format format, const char *date, const int end_of_string)
Definition: intrinsic.c:2713
integer_of_formatted_date
static cob_u32_t integer_of_formatted_date(const struct date_format format, const char *formatted_date)
Definition: intrinsic.c:2908
format_field
static void format_field(cob_screen *s)
Definition: screenio.c:1025
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_valid_date_format
int cob_valid_date_format(const char *format)
Definition: intrinsic.c:3355
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cob_valid_datetime_format
int cob_valid_datetime_format(const char *format, const char decimal_point)
Definition: intrinsic.c:3402
COB_DATESTR_LEN
#define COB_DATESTR_LEN
Definition: intrinsic.c:119
COB_DATESTR_MAX
#define COB_DATESTR_MAX
Definition: intrinsic.c:120
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
parse_date_format_string
static struct date_format parse_date_format_string(const char *format_str)
Definition: intrinsic.c:2131
cob_field* cob_intr_integer_part ( cob_field *  )

Definition at line 3513 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_get_field(), cob_decimal_set_field(), cob_mexp, cob_uli_t, curr_field, cob_decimal::scale, and cob_decimal::value.

3514 {
3515  cob_decimal_set_field (&d1, srcfield);
3516  /* Check scale */
3517  if (d1.scale < 0) {
3518  mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)-d1.scale);
3519  mpz_mul (d1.value, d1.value, cob_mexp);
3520  } else if (d1.scale > 0) {
3521  mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)d1.scale);
3522  mpz_tdiv_q (d1.value, d1.value, cob_mexp);
3523  }
3524  d1.scale = 0;
3525 
3526  cob_alloc_field (&d1);
3527  (void)cob_decimal_get_field (&d1, curr_field, 0);
3528  return curr_field;
3529 }
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_mexp
static mpz_t cob_mexp
Definition: intrinsic.c:85
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_uli_t
#define cob_uli_t
Definition: common.h:33
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_lcl_time_from_secs ( const int  ,
const int  ,
cob_field *  ,
cob_field *   
)

Definition at line 5557 of file intrinsic.c.

References cob_alloc_set_field_spaces(), cob_alloc_set_field_str(), COB_EC_ARGUMENT_FUNCTION, COB_FIELD_IS_NUMERIC, cob_get_int(), cob_set_exception(), curr_field, and valid_time().

5559 {
5560 #if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET)
5561  int indate;
5562  int hours;
5563  int minutes;
5564  int seconds;
5565  char buff[LOCTIME_BUFSIZE] = { '\0' };
5566 #endif
5567 
5568  cob_set_exception (0);
5569 
5570 #if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET)
5571  if (COB_FIELD_IS_NUMERIC (srcfield)) {
5572  indate = cob_get_int (srcfield);
5573  } else {
5574  goto derror;
5575  }
5576  if (!valid_time (indate)) {
5577  goto derror;
5578  }
5579  hours = indate / 3600;
5580  indate %= 3600;
5581  minutes = indate / 60;
5582  seconds = indate % 60;
5583 
5584  if (locale_time (hours, minutes, seconds, locale_field, buff)) {
5585  goto derror;
5586  }
5587 
5588  cob_alloc_set_field_str (buff, offset, length);
5589  return curr_field;
5590 derror:
5591 #endif
5592  cob_alloc_set_field_spaces (10);
5593  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5594  return curr_field;
5595 }
COB_FIELD_IS_NUMERIC
#define COB_FIELD_IS_NUMERIC(f)
Definition: common.h:674
cob_alloc_set_field_str
static void cob_alloc_set_field_str(char *str, const int offset, const int length)
Definition: intrinsic.c:1749
valid_time
static int valid_time(const int seconds_from_midnight)
Definition: intrinsic.c:1836
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_alloc_set_field_spaces
static void cob_alloc_set_field_spaces(const int n)
Definition: intrinsic.c:1764

Here is the call graph for this function:

cob_field* cob_intr_length ( cob_field *  )

Definition at line 3469 of file intrinsic.c.

References cob_alloc_set_field_uint(), COB_FIELD_IS_NATIONAL, COB_NATIONAL_SIZE, cob_u32_t, curr_field, and cob_field::size.

Referenced by GCic_(), and LISTING_().

3470 {
3471  if (COB_FIELD_IS_NATIONAL (srcfield)) {
3472  cob_alloc_set_field_uint ((cob_u32_t)srcfield->size / COB_NATIONAL_SIZE);
3473  } else {
3474  cob_alloc_set_field_uint ((cob_u32_t)srcfield->size);
3475  }
3476  return curr_field;
3477 }
cob_u32_t
#define cob_u32_t
Definition: common.h:31
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
COB_FIELD_IS_NATIONAL
#define COB_FIELD_IS_NATIONAL(f)
Definition: common.h:677
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
COB_NATIONAL_SIZE
#define COB_NATIONAL_SIZE
Definition: common.h:683

Here is the call graph for this function:

Here is the caller graph for this function:

cob_field* cob_intr_locale_compare ( const int  ,
  ... 
)

Definition at line 5937 of file intrinsic.c.

References COB_EC_ARGUMENT_FUNCTION, COB_FIELD_INIT, cob_field_to_string(), cob_free(), __cob_global::cob_locale, cob_malloc(), cob_set_exception(), curr_field, cob_field::data, f1, f2, make_field_entry(), NULL, and cob_field::size.

5938 {
5939  cob_field *f1;
5940  cob_field *f2;
5941  cob_field *locale_field;
5942 #ifdef HAVE_STRCOLL
5943  unsigned char *p;
5944  unsigned char *p1;
5945  unsigned char *p2;
5946  char *deflocale;
5947  size_t size;
5948  size_t size2;
5949  int ret;
5950 #endif
5951  cob_field field;
5952  va_list args;
5953 
5954  cob_set_exception (0);
5955  va_start (args, params);
5956  f1 = va_arg (args, cob_field *);
5957  f2 = va_arg (args, cob_field *);
5958  if (params > 2) {
5959  locale_field = va_arg (args, cob_field *);
5960  } else {
5961  locale_field = NULL;
5962  }
5963  va_end (args);
5964 
5965  COB_FIELD_INIT (1, NULL, &const_alpha_attr);
5966  make_field_entry (&field);
5967 
5968 #ifdef HAVE_STRCOLL
5969  deflocale = NULL;
5970 
5971  size = f1->size;
5972  size2 = size;
5973  for (p = f1->data + size - 1U; p != f1->data; --p) {
5974  if (*p != ' ') {
5975  break;
5976  }
5977  size2--;
5978  }
5979  p1 = cob_malloc (size2 + 1U);
5980  memcpy (p1, f1->data, size2);
5981 
5982  size = f2->size;
5983  size2 = size;
5984  for (p = f2->data + size - 1U; p != f2->data; --p) {
5985  if (*p != ' ') {
5986  break;
5987  }
5988  size2--;
5989  }
5990  p2 = cob_malloc (size2 + 1U);
5991  memcpy (p2, f2->data, size2);
5992 
5993  if (locale_field) {
5994  if (!locale_field->size) {
5995  goto derror;
5996  }
5997 #ifdef HAVE_SETLOCALE
5998  deflocale = cob_malloc (locale_field->size + 1U);
5999  cob_field_to_string (locale_field, deflocale,
6000  (size_t)(locale_field->size + 1U));
6001  (void) setlocale (LC_COLLATE, deflocale);
6002 #else
6003  goto derror;
6004 #endif
6005  }
6006 
6007  ret = strcoll ((char *)p1, (char *)p2);
6008  if (ret < 0) {
6009  curr_field->data[0] = '<';
6010  } else if (ret > 0) {
6011  curr_field->data[0] = '>';
6012  } else {
6013  curr_field->data[0] = '=';
6014  }
6015  cob_free (p1);
6016  cob_free (p2);
6017 
6018 #ifdef HAVE_SETLOCALE
6019  if (deflocale) {
6020  (void) setlocale (LC_ALL, cobglobptr->cob_locale);
6021  cob_free (deflocale);
6022  }
6023 #endif
6024 
6025  return curr_field;
6026 derror:
6027 #endif
6028  curr_field->data[0] = ' ';
6029  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
6030 
6031  return curr_field;
6032 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
f2
cob_field f2
Definition: cobxref.c.l.h:55
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
cob_field_to_string
void cob_field_to_string(const cob_field *, void *, const size_t)
Definition: common.c:1492
cobglobptr
static cob_global * cobglobptr
Definition: intrinsic.c:71
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
f1
cob_field f1
Definition: cobxref.c.l.h:54
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_field::size
size_t size
Definition: common.h:951
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
__cob_global::cob_locale
char * cob_locale
Definition: common.h:1194
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_locale_date ( const int  ,
const int  ,
cob_field *  ,
cob_field *   
)

Definition at line 5375 of file intrinsic.c.

References cob_alloc_set_field_spaces(), cob_alloc_set_field_str(), COB_EC_ARGUMENT_FUNCTION, COB_FIELD_IS_NUMERIC, cob_field_to_string(), cob_get_int(), __cob_global::cob_locale, cob_set_exception(), COB_SMALL_BUFF, COB_SMALL_MAX, curr_field, cob_field::data, NULL, cob_field::size, valid_day_of_month(), valid_month(), valid_year(), and WORD.

5377 {
5378 #if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET)
5379  size_t len;
5380  int indate;
5381  int days;
5382  int month;
5383  int year;
5384 #ifdef HAVE_LANGINFO_CODESET
5385  unsigned char *p;
5386  char *deflocale = NULL;
5387  struct tm tstruct;
5388  char buff2[128];
5389 #else
5390  unsigned char *p;
5391  LCID localeid = LOCALE_USER_DEFAULT;
5392  SYSTEMTIME syst;
5393 #endif
5394  char buff[128];
5395  char locale_buff[COB_SMALL_BUFF];
5396 #endif
5397 
5398  cob_set_exception (0);
5399 
5400 #if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET)
5401  if (COB_FIELD_IS_NUMERIC (srcfield)) {
5402  indate = cob_get_int (srcfield);
5403  } else {
5404  if (srcfield->size < 8) {
5405  goto derror;
5406  }
5407  p = srcfield->data;
5408  indate = 0;
5409  for (len = 0; len < 8; ++len, ++p) {
5410  if (isdigit (*p)) {
5411  indate *= 10;
5412  indate += (*p - '0');
5413  } else {
5414  goto derror;
5415  }
5416  }
5417  }
5418  year = indate / 10000;
5419  if (!valid_year (year)) {
5420  goto derror;
5421  }
5422  indate %= 10000;
5423  month = indate / 100;
5424  if (!valid_month (month)) {
5425  goto derror;
5426  }
5427  days = indate % 100;
5428  if (!valid_day_of_month (year, month, days)) {
5429  goto derror;
5430  }
5431 #ifdef HAVE_LANGINFO_CODESET
5432  month--;
5433 
5434  memset ((void *)&tstruct, 0, sizeof(struct tm));
5435  tstruct.tm_year = year - 1900;
5436  tstruct.tm_mon = month;
5437  tstruct.tm_mday = days;
5438  if (locale_field) {
5439  if (locale_field->size >= COB_SMALL_BUFF) {
5440  goto derror;
5441  }
5442  cob_field_to_string (locale_field, locale_buff,
5443  (size_t)COB_SMALL_MAX);
5444  deflocale = locale_buff;
5445  (void) setlocale (LC_TIME, deflocale);
5446  }
5447  memset (buff2, 0, sizeof(buff2));
5448  snprintf(buff2, sizeof(buff2) - 1, "%s", nl_langinfo(D_FMT));
5449  if (deflocale) {
5450  (void) setlocale (LC_ALL, cobglobptr->cob_locale);
5451  }
5452  strftime (buff, sizeof(buff), buff2, &tstruct);
5453 #else
5454  memset ((void *)&syst, 0, sizeof(syst));
5455  syst.wYear = (WORD)year;
5456  syst.wMonth = (WORD)month;
5457  syst.wDay = (WORD)days;
5458  if (locale_field) {
5459  if (locale_field->size >= COB_SMALL_BUFF) {
5460  goto derror;
5461  }
5462  cob_field_to_string (locale_field, locale_buff,
5463  COB_SMALL_MAX);
5464  locale_buff[COB_SMALL_MAX] = 0; /* silence warnings */
5465  for (p = (unsigned char *)locale_buff; *p; ++p) {
5466  if (isalnum(*p) || *p == '_') {
5467  continue;
5468  }
5469  break;
5470  }
5471  *p = 0;
5472  for (len = 0; len < WINLOCSIZE; ++len) {
5473  if (!strcmp(locale_buff, wintable[len].winlocalename)) {
5474  localeid = wintable[len].winlocaleid;
5475  break;
5476  }
5477  }
5478  if (len == WINLOCSIZE) {
5479  goto derror;
5480  }
5481  }
5482  if (!GetDateFormat (localeid, DATE_SHORTDATE, &syst, NULL, buff, sizeof(buff))) {
5483  goto derror;
5484  }
5485 #endif
5486  cob_alloc_set_field_str (buff, offset, length);
5487  return curr_field;
5488 derror:
5489 #endif
5490  cob_alloc_set_field_spaces (10);
5491  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5492  return curr_field;
5493 }
COB_FIELD_IS_NUMERIC
#define COB_FIELD_IS_NUMERIC(f)
Definition: common.h:674
cob_alloc_set_field_str
static void cob_alloc_set_field_str(char *str, const int offset, const int length)
Definition: intrinsic.c:1749
COB_SMALL_BUFF
#define COB_SMALL_BUFF
Definition: common.h:540
valid_day_of_month
static int valid_day_of_month(const int year, const int month, const int day)
Definition: intrinsic.c:1812
COB_SMALL_MAX
#define COB_SMALL_MAX
Definition: common.h:546
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
cob_field_to_string
void cob_field_to_string(const cob_field *, void *, const size_t)
Definition: common.c:1492
valid_month
static int valid_month(const int month)
Definition: intrinsic.c:1800
cobglobptr
static cob_global * cobglobptr
Definition: intrinsic.c:71
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
valid_year
static int valid_year(const int year)
Definition: intrinsic.c:1794
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_alloc_set_field_spaces
static void cob_alloc_set_field_spaces(const int n)
Definition: intrinsic.c:1764
__cob_global::cob_locale
char * cob_locale
Definition: common.h:1194
date_format::days
enum days_format days
Definition: intrinsic.c:2126
WORD
Definition: parser.c:1853

Here is the call graph for this function:

cob_field* cob_intr_locale_time ( const int  ,
const int  ,
cob_field *  ,
cob_field *   
)

Definition at line 5496 of file intrinsic.c.

References cob_alloc_set_field_spaces(), cob_alloc_set_field_str(), COB_EC_ARGUMENT_FUNCTION, COB_FIELD_IS_NUMERIC, cob_get_int(), cob_set_exception(), curr_field, cob_field::data, and cob_field::size.

5498 {
5499 #if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET)
5500  unsigned char *p;
5501  size_t len;
5502  int indate;
5503  int hours;
5504  int minutes;
5505  int seconds;
5506  char buff[LOCTIME_BUFSIZE] = { '\0' };
5507 #endif
5508 
5509  cob_set_exception (0);
5510 
5511 #if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET)
5512  if (COB_FIELD_IS_NUMERIC (srcfield)) {
5513  indate = cob_get_int (srcfield);
5514  } else {
5515  if (srcfield->size < 6) {
5516  goto derror;
5517  }
5518  p = srcfield->data;
5519  indate = 0;
5520  for (len = 0; len < 6; ++len, ++p) {
5521  if (isdigit (*p)) {
5522  indate *= 10;
5523  indate += (*p - '0');
5524  } else {
5525  goto derror;
5526  }
5527  }
5528  }
5529  hours = indate / 10000;
5530  if (hours < 0 || hours > 24) {
5531  goto derror;
5532  }
5533  indate %= 10000;
5534  minutes = indate / 100;
5535  if (minutes < 0 || minutes > 59) {
5536  goto derror;
5537  }
5538  seconds = indate % 100;
5539  if (seconds < 0 || seconds > 59) {
5540  goto derror;
5541  }
5542 
5543  if (locale_time (hours, minutes, seconds, locale_field, buff)) {
5544  goto derror;
5545  }
5546 
5547  cob_alloc_set_field_str (buff, offset, length);
5548  return curr_field;
5549 derror:
5550 #endif
5551  cob_alloc_set_field_spaces (10);
5552  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5553  return curr_field;
5554 }
COB_FIELD_IS_NUMERIC
#define COB_FIELD_IS_NUMERIC(f)
Definition: common.h:674
cob_alloc_set_field_str
static void cob_alloc_set_field_str(char *str, const int offset, const int length)
Definition: intrinsic.c:1749
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_alloc_set_field_spaces
static void cob_alloc_set_field_spaces(const int n)
Definition: intrinsic.c:1764

Here is the call graph for this function:

cob_field* cob_intr_log ( cob_field *  )

Definition at line 4352 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), cob_decimal_get_field(), cob_decimal_get_mpf(), cob_decimal_set_field(), cob_decimal_set_mpf(), COB_EC_ARGUMENT_FUNCTION, cob_mpf_log(), cob_mpft, cob_set_exception(), cob_trim_decimal(), curr_field, cob_decimal::scale, and cob_decimal::value.

4353 {
4354  cob_decimal_set_field (&d1, srcfield);
4355 
4356  cob_set_exception (0);
4357  if (mpz_sgn (d1.value) <= 0) {
4358  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4359  cob_alloc_set_field_uint (0);
4360  return curr_field;
4361  }
4362 
4363  if (d1.scale) {
4364  cob_trim_decimal (&d1);
4365  }
4366 
4367  if (!d1.scale && !mpz_cmp_ui (d1.value, 1UL)) {
4368  /* Log (1) = 0 */
4369  cob_alloc_set_field_uint (0);
4370  return curr_field;
4371  }
4372 
4373  cob_decimal_get_mpf (cob_mpft, &d1);
4374  cob_mpf_log (cob_mpft, cob_mpft);
4375  cob_decimal_set_mpf (&d1, cob_mpft);
4376  cob_alloc_field (&d1);
4377  (void)cob_decimal_get_field (&d1, curr_field, 0);
4378 
4379  return curr_field;
4380 }
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_mpf_log
static void cob_mpf_log(mpf_t dst_val, const mpf_t src_val)
Definition: intrinsic.c:931
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_mpft
static mpf_t cob_mpft
Definition: intrinsic.c:88
cob_decimal_get_mpf
static void cob_decimal_get_mpf(mpf_t dst, const cob_decimal *d)
Definition: intrinsic.c:847
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_trim_decimal
static void cob_trim_decimal(cob_decimal *d)
Definition: intrinsic.c:517
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal_set_mpf
static void cob_decimal_set_mpf(cob_decimal *d, const mpf_t src)
Definition: intrinsic.c:816
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_log10 ( cob_field *  )

Definition at line 4383 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), cob_decimal_get_field(), cob_decimal_get_mpf(), cob_decimal_set_field(), cob_decimal_set_mpf(), COB_EC_ARGUMENT_FUNCTION, cob_mpf_log10(), cob_mpft, cob_set_exception(), cob_trim_decimal(), curr_field, cob_decimal::scale, and cob_decimal::value.

4384 {
4385  cob_decimal_set_field (&d1, srcfield);
4386 
4387  cob_set_exception (0);
4388  if (mpz_sgn (d1.value) <= 0) {
4389  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4390  cob_alloc_set_field_uint (0);
4391  return curr_field;
4392  }
4393 
4394  if (d1.scale) {
4395  cob_trim_decimal (&d1);
4396  }
4397 
4398  if (!d1.scale && !mpz_cmp_ui (d1.value, 1UL)) {
4399  /* Log10 (1) = 0 */
4400  cob_alloc_set_field_uint (0);
4401  return curr_field;
4402  }
4403 
4404  cob_decimal_get_mpf (cob_mpft, &d1);
4405  cob_mpf_log10 (cob_mpft, cob_mpft);
4406  cob_decimal_set_mpf (&d1, cob_mpft);
4407  cob_alloc_field (&d1);
4408  (void)cob_decimal_get_field (&d1, curr_field, 0);
4409 
4410  return curr_field;
4411 }
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_mpft
static mpf_t cob_mpft
Definition: intrinsic.c:88
cob_decimal_get_mpf
static void cob_decimal_get_mpf(mpf_t dst, const cob_decimal *d)
Definition: intrinsic.c:847
cob_mpf_log10
static void cob_mpf_log10(mpf_t dst_val, const mpf_t src_val)
Definition: intrinsic.c:991
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_trim_decimal
static void cob_trim_decimal(cob_decimal *d)
Definition: intrinsic.c:517
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal_set_mpf
static void cob_decimal_set_mpf(cob_decimal *d, const mpf_t src)
Definition: intrinsic.c:816
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_lower_case ( const int  ,
const int  ,
cob_field *   
)

Definition at line 3576 of file intrinsic.c.

References calc_ref_mod(), cob_u8_t, curr_field, cob_field::data, make_field_entry(), cob_field::size, and unlikely.

Referenced by cobxref_(), GCic_(), and LISTING_().

3577 {
3578  size_t i, size;
3579 
3580  make_field_entry (srcfield);
3581 
3582  size = srcfield->size;
3583  for (i = 0; i < size; ++i) {
3584  curr_field->data[i] = (cob_u8_t)tolower (srcfield->data[i]);
3585  }
3586  if (unlikely(offset > 0)) {
3587  calc_ref_mod (curr_field, offset, length);
3588  }
3589  return curr_field;
3590 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_field::data
unsigned char * data
Definition: common.h:952
cob_u8_t
#define cob_u8_t
Definition: common.h:27
calc_ref_mod
static void calc_ref_mod(cob_field *f, const int offset, const int length)
Definition: intrinsic.c:488
unlikely
#define unlikely(x)
Definition: common.h:437
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

Here is the caller graph for this function:

cob_field* cob_intr_lowest_algebraic ( cob_field *  )

Definition at line 5794 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), cob_decimal_get_field(), COB_EC_ARGUMENT_FUNCTION, COB_FIELD_BINARY_TRUNC, COB_FIELD_DIGITS, COB_FIELD_HAVE_SIGN, COB_FIELD_INIT, COB_FIELD_REAL_BINARY, COB_FIELD_SCALE, COB_FIELD_SIZE, COB_FIELD_TYPE, cob_set_exception(), COB_TYPE_ALPHANUMERIC, COB_TYPE_ALPHANUMERIC_EDITED, COB_TYPE_NATIONAL, COB_TYPE_NATIONAL_EDITED, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_DOUBLE, COB_TYPE_NUMERIC_EDITED, COB_TYPE_NUMERIC_FLOAT, COB_TYPE_NUMERIC_PACKED, cob_uli_t, curr_field, make_field_entry(), NULL, cob_decimal::scale, and cob_decimal::value.

5795 {
5796  cob_uli_t expo;
5797  cob_field field;
5798 
5799  switch (COB_FIELD_TYPE (srcfield)) {
5800  case COB_TYPE_ALPHANUMERIC:
5801  case COB_TYPE_NATIONAL:
5802  COB_FIELD_INIT (COB_FIELD_SIZE (srcfield), NULL, &const_alpha_attr);
5803  make_field_entry (&field);
5804  break;
5805 
5806  case COB_TYPE_ALPHANUMERIC_EDITED:
5807  case COB_TYPE_NATIONAL_EDITED:
5808  COB_FIELD_INIT (COB_FIELD_DIGITS (srcfield), NULL, &const_alpha_attr);
5809  make_field_entry (&field);
5810  break;
5811 
5812  case COB_TYPE_NUMERIC_BINARY:
5813  if (!COB_FIELD_HAVE_SIGN (srcfield)) {
5814  cob_alloc_set_field_uint (0);
5815  break;
5816  }
5817  if (COB_FIELD_REAL_BINARY (srcfield) ||
5818  !COB_FIELD_BINARY_TRUNC (srcfield)) {
5819  expo = (cob_uli_t)((COB_FIELD_SIZE (srcfield) * 8U) - 1U);
5820  mpz_ui_pow_ui (d1.value, 2UL, expo);
5821  mpz_neg (d1.value, d1.value);
5822  d1.scale = COB_FIELD_SCALE (srcfield);
5823  cob_alloc_field (&d1);
5824  (void)cob_decimal_get_field (&d1, curr_field, 0);
5825  break;
5826  }
5827  expo = (cob_uli_t)COB_FIELD_DIGITS (srcfield);
5828  mpz_ui_pow_ui (d1.value, 10UL, expo);
5829  mpz_sub_ui (d1.value, d1.value, 1UL);
5830  mpz_neg (d1.value, d1.value);
5831  d1.scale = COB_FIELD_SCALE (srcfield);
5832  cob_alloc_field (&d1);
5833  (void)cob_decimal_get_field (&d1, curr_field, 0);
5834  break;
5835 
5836  case COB_TYPE_NUMERIC_FLOAT:
5837  case COB_TYPE_NUMERIC_DOUBLE:
5838  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5839  cob_alloc_set_field_uint (0);
5840  break;
5841 
5842  case COB_TYPE_NUMERIC_DISPLAY:
5843  case COB_TYPE_NUMERIC_PACKED:
5844  case COB_TYPE_NUMERIC_EDITED:
5845  if (!COB_FIELD_HAVE_SIGN (srcfield)) {
5846  cob_alloc_set_field_uint (0);
5847  break;
5848  }
5849  expo = (cob_uli_t)COB_FIELD_DIGITS (srcfield);
5850  mpz_ui_pow_ui (d1.value, 10UL, expo);
5851  mpz_sub_ui (d1.value, d1.value, 1UL);
5852  mpz_neg (d1.value, d1.value);
5853  d1.scale = COB_FIELD_SCALE (srcfield);
5854  cob_alloc_field (&d1);
5855  (void)cob_decimal_get_field (&d1, curr_field, 0);
5856  break;
5857  default:
5858  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5859  cob_alloc_set_field_uint (0);
5860  break;
5861  }
5862  return curr_field;
5863 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
COB_TYPE_NATIONAL_EDITED
#define COB_TYPE_NATIONAL_EDITED
Definition: common.h:626
COB_FIELD_SCALE
#define COB_FIELD_SCALE(f)
Definition: common.h:664
COB_TYPE_NUMERIC_PACKED
#define COB_TYPE_NUMERIC_PACKED
Definition: common.h:609
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
COB_TYPE_ALPHANUMERIC
#define COB_TYPE_ALPHANUMERIC
Definition: common.h:621
COB_FIELD_TYPE
#define COB_FIELD_TYPE(f)
Definition: common.h:662
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
COB_TYPE_NATIONAL
#define COB_TYPE_NATIONAL
Definition: common.h:625
cob_uli_t
#define cob_uli_t
Definition: common.h:33
COB_TYPE_NUMERIC_FLOAT
#define COB_TYPE_NUMERIC_FLOAT
Definition: common.h:610
COB_FIELD_REAL_BINARY
#define COB_FIELD_REAL_BINARY(f)
Definition: common.h:649
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_FIELD_BINARY_TRUNC
#define COB_FIELD_BINARY_TRUNC(f)
Definition: common.h:654
COB_TYPE_NUMERIC_BINARY
#define COB_TYPE_NUMERIC_BINARY
Definition: common.h:608
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_TYPE_ALPHANUMERIC_EDITED
#define COB_TYPE_ALPHANUMERIC_EDITED
Definition: common.h:623
COB_TYPE_NUMERIC_DISPLAY
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
COB_TYPE_NUMERIC_DOUBLE
#define COB_TYPE_NUMERIC_DOUBLE
Definition: common.h:611
COB_FIELD_HAVE_SIGN
#define COB_FIELD_HAVE_SIGN(f)
Definition: common.h:643
cob_decimal::value
mpz_t value
Definition: common.h:985
COB_FIELD_DIGITS
#define COB_FIELD_DIGITS(f)
Definition: common.h:663
COB_TYPE_NUMERIC_EDITED
#define COB_TYPE_NUMERIC_EDITED
Definition: common.h:619
COB_FIELD_SIZE
#define COB_FIELD_SIZE(f)
Definition: common.h:671
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_max ( const int  ,
  ... 
)

Definition at line 4859 of file intrinsic.c.

References cob_cmp(), curr_field, cob_field::data, make_field_entry(), params, and cob_field::size.

4860 {
4861  cob_field *f;
4862  cob_field *basef;
4863  va_list args;
4864  int i;
4865 
4866  va_start (args, params);
4867 
4868  basef = va_arg (args, cob_field *);
4869  for (i = 1; i < params; ++i) {
4870  f = va_arg (args, cob_field *);
4871  if (cob_cmp (f, basef) > 0) {
4872  basef = f;
4873  }
4874  }
4875  va_end (args);
4876 
4877  make_field_entry (basef);
4878  memcpy (curr_field->data, basef->data, basef->size);
4879  return curr_field;
4880 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
cob_cmp
int cob_cmp(cob_field *f1, cob_field *f2)
Definition: common.c:2318
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_field::size
size_t size
Definition: common.h:951
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_mean ( const int  ,
  ... 
)

Definition at line 4955 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_add(), cob_decimal_div(), cob_decimal_get_field(), cob_decimal_set_field(), cob_uli_t, curr_field, cob_field::data, make_field_entry(), params, cob_decimal::scale, cob_field::size, and cob_decimal::value.

4956 {
4957  cob_field *f;
4958  va_list args;
4959  int i;
4960 
4961  va_start (args, params);
4962 
4963  if (params == 1) {
4964  f = va_arg (args, cob_field *);
4965  va_end (args);
4966  make_field_entry (f);
4967  memcpy (curr_field->data, f->data, f->size);
4968  return curr_field;
4969  }
4970 
4971  mpz_set_ui (d1.value, 0UL);
4972  d1.scale = 0;
4973 
4974  for (i = 0; i < params; ++i) {
4975  f = va_arg (args, cob_field *);
4976  cob_decimal_set_field (&d2, f);
4977  cob_decimal_add (&d1, &d2);
4978  }
4979  va_end (args);
4980 
4981  mpz_set_ui (d2.value, (cob_uli_t)params);
4982  d2.scale = 0;
4983  cob_decimal_div (&d1, &d2);
4984 
4985  cob_alloc_field (&d1);
4986  (void)cob_decimal_get_field (&d1, curr_field, 0);
4987 
4988  return curr_field;
4989 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
d2
static cob_decimal d2
Definition: intrinsic.c:80
cob_field
Definition: common.h:950
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_field::data
unsigned char * data
Definition: common.h:952
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_uli_t
#define cob_uli_t
Definition: common.h:33
cob_decimal_add
void cob_decimal_add(cob_decimal *, cob_decimal *)
Definition: numeric.c:1875
cob_decimal_div
void cob_decimal_div(cob_decimal *, cob_decimal *)
Definition: numeric.c:1899
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_field::size
size_t size
Definition: common.h:951
cob_decimal::value
mpz_t value
Definition: common.h:985
params
strict implicit external call params
Definition: warning.def:60
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_median ( const int  ,
  ... 
)

Definition at line 4907 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_add(), cob_decimal_div(), cob_decimal_get_field(), cob_decimal_set_field(), cob_free(), cob_malloc(), comp_field(), curr_field, cob_field::data, make_field_entry(), params, cob_decimal::scale, cob_field::size, and cob_decimal::value.

4908 {
4909  cob_field *f;
4910  cob_field **field_alloc;
4911  va_list args;
4912  int i;
4913 
4914  va_start (args, params);
4915 
4916  f = va_arg (args, cob_field *);
4917  if (params == 1) {
4918  va_end (args);
4919  make_field_entry (f);
4920  memcpy (curr_field->data, f->data, f->size);
4921  return curr_field;
4922  }
4923 
4924  field_alloc = cob_malloc ((size_t)params * sizeof (cob_field *));
4925  field_alloc[0] = f;
4926 
4927  for (i = 1; i < params; ++i) {
4928  field_alloc[i] = va_arg (args, cob_field *);
4929  }
4930  va_end (args);
4931 
4932  qsort (field_alloc, (size_t)params, (size_t)sizeof (cob_field *),
4933  comp_field);
4934 
4935  i = params / 2;
4936  if (params % 2) {
4937  f = field_alloc[i];
4938  make_field_entry (f);
4939  memcpy (curr_field->data, f->data, f->size);
4940  } else {
4941  cob_decimal_set_field (&d1, field_alloc[i-1]);
4942  cob_decimal_set_field (&d2, field_alloc[i]);
4943  cob_decimal_add (&d1, &d2);
4944  mpz_set_ui (d2.value, 2UL);
4945  d2.scale = 0;
4946  cob_decimal_div (&d1, &d2);
4947  cob_alloc_field (&d1);
4948  (void)cob_decimal_get_field (&d1, curr_field, 0);
4949  }
4950  cob_free (field_alloc);
4951  return curr_field;
4952 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
d2
static cob_decimal d2
Definition: intrinsic.c:80
cob_field
Definition: common.h:950
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_field::data
unsigned char * data
Definition: common.h:952
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_decimal_add
void cob_decimal_add(cob_decimal *, cob_decimal *)
Definition: numeric.c:1875
cob_decimal_div
void cob_decimal_div(cob_decimal *, cob_decimal *)
Definition: numeric.c:1899
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_field::size
size_t size
Definition: common.h:951
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
cob_decimal::value
mpz_t value
Definition: common.h:985
params
strict implicit external call params
Definition: warning.def:60
cob_decimal::scale
int scale
Definition: common.h:986
comp_field
static int comp_field(const void *m1, const void *m2)
Definition: intrinsic.c:476

Here is the call graph for this function:

cob_field* cob_intr_midrange ( const int  ,
  ... 
)

Definition at line 4883 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_add(), cob_decimal_div(), cob_decimal_get_field(), cob_decimal_set_field(), curr_field, get_min_and_max_of_args(), cob_decimal::scale, and cob_decimal::value.

4884 {
4885  cob_field *basemin;
4886  cob_field *basemax;
4887  va_list args;
4888 
4889  va_start (args, params);
4890  get_min_and_max_of_args (params, args, &basemin, &basemax);
4891  va_end (args);
4892 
4893  /* Return (max + min) / 2 */
4894  cob_decimal_set_field (&d1, basemin);
4895  cob_decimal_set_field (&d2, basemax);
4896  cob_decimal_add (&d1, &d2);
4897  mpz_set_ui (d2.value, 2UL);
4898  d2.scale = 0;
4899  cob_decimal_div (&d1, &d2);
4900 
4901  cob_alloc_field (&d1);
4902  (void)cob_decimal_get_field (&d1, curr_field, 0);
4903  return curr_field;
4904 }
get_min_and_max_of_args
static void get_min_and_max_of_args(const int num_args, va_list args, cob_field **min, cob_field **max)
Definition: intrinsic.c:1543
d2
static cob_decimal d2
Definition: intrinsic.c:80
cob_field
Definition: common.h:950
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_decimal_add
void cob_decimal_add(cob_decimal *, cob_decimal *)
Definition: numeric.c:1875
cob_decimal_div
void cob_decimal_div(cob_decimal *, cob_decimal *)
Definition: numeric.c:1899
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
params
strict implicit external call params
Definition: warning.def:60
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_min ( const int  ,
  ... 
)

Definition at line 4835 of file intrinsic.c.

References cob_cmp(), curr_field, cob_field::data, make_field_entry(), params, and cob_field::size.

4836 {
4837  cob_field *f;
4838  cob_field *basef;
4839  va_list args;
4840  int i;
4841 
4842  va_start (args, params);
4843 
4844  basef = va_arg (args, cob_field *);
4845  for (i = 1; i < params; ++i) {
4846  f = va_arg (args, cob_field *);
4847  if (cob_cmp (f, basef) < 0) {
4848  basef = f;
4849  }
4850  }
4851  va_end (args);
4852 
4853  make_field_entry (basef);
4854  memcpy (curr_field->data, basef->data, basef->size);
4855  return curr_field;
4856 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
cob_cmp
int cob_cmp(cob_field *f1, cob_field *f2)
Definition: common.c:2318
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_field::size
size_t size
Definition: common.h:951
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_mod ( cob_field *  ,
cob_field *   
)

Definition at line 4992 of file intrinsic.c.

References cob_mod_or_rem().

4993 {
4994  return cob_mod_or_rem (srcfield1, srcfield2, 0);
4995 }
cob_mod_or_rem
static cob_field * cob_mod_or_rem(cob_field *f1, cob_field *f2, const int func_is_rem)
Definition: intrinsic.c:624

Here is the call graph for this function:

cob_field* cob_intr_module_caller_id ( void  )

Definition at line 3653 of file intrinsic.c.

References COB_FIELD_INIT, COB_MODULE_PTR, curr_field, cob_field::data, make_field_entry(), NULL, and cob_field::size.

3654 {
3655  size_t calcsize;
3656  cob_field field;
3657 
3658  if (!COB_MODULE_PTR->next) {
3659  COB_FIELD_INIT (1, NULL, &const_alpha_attr);
3660  make_field_entry (&field);
3661  curr_field->size = 0;
3662  curr_field->data[0] = ' ';
3663  return curr_field;
3664  }
3665  calcsize = strlen (COB_MODULE_PTR->next->module_name);
3666  COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr);
3667  make_field_entry (&field);
3668  memcpy (curr_field->data, COB_MODULE_PTR->next->module_name,
3669  calcsize);
3670  return curr_field;
3671 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_field::size
size_t size
Definition: common.h:951

Here is the call graph for this function:

cob_field* cob_intr_module_date ( void  )

Definition at line 3610 of file intrinsic.c.

References COB_ATTR_INIT, COB_FIELD_INIT, COB_MODULE_PTR, COB_TYPE_NUMERIC_DISPLAY, curr_field, cob_field::data, make_field_entry(), and NULL.

3611 {
3612  cob_field_attr attr;
3613  cob_field field;
3614  char buff[16];
3615 
3616  COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 8, 0, 0, NULL);
3617  COB_FIELD_INIT (8, NULL, &attr);
3618  make_field_entry (&field);
3619  snprintf (buff, sizeof(buff), "%8.8u", COB_MODULE_PTR->module_date);
3620  memcpy (curr_field->data, buff, (size_t)8);
3621  return curr_field;
3622 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_field
Definition: common.h:950
COB_ATTR_INIT
#define COB_ATTR_INIT(u, v, x, y, z)
Definition: coblocal.h:150
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_TYPE_NUMERIC_DISPLAY
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cob_field_attr
Definition: common.h:940
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_module_formatted_date ( void  )

Definition at line 3674 of file intrinsic.c.

References COB_FIELD_INIT, COB_MODULE_PTR, curr_field, cob_field::data, make_field_entry(), and NULL.

3675 {
3676  size_t calcsize;
3677  cob_field field;
3678 
3679  calcsize = strlen (COB_MODULE_PTR->module_formatted_date);
3680  COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr);
3681  make_field_entry (&field);
3682  memcpy (curr_field->data, COB_MODULE_PTR->module_formatted_date,
3683  calcsize);
3684  return curr_field;
3685 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_module_id ( void  )

Definition at line 3640 of file intrinsic.c.

References COB_FIELD_INIT, COB_MODULE_PTR, curr_field, cob_field::data, make_field_entry(), and NULL.

3641 {
3642  size_t calcsize;
3643  cob_field field;
3644 
3645  calcsize = strlen (COB_MODULE_PTR->module_name);
3646  COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr);
3647  make_field_entry (&field);
3648  memcpy (curr_field->data, COB_MODULE_PTR->module_name, calcsize);
3649  return curr_field;
3650 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_module_path ( void  )

Definition at line 3701 of file intrinsic.c.

References COB_FIELD_INIT, COB_MODULE_PTR, curr_field, cob_field::data, make_field_entry(), NULL, and cob_field::size.

3702 {
3703  size_t calcsize;
3704  cob_field field;
3705 
3706  if (!COB_MODULE_PTR->module_path ||
3707  !*(COB_MODULE_PTR->module_path)) {
3708  COB_FIELD_INIT (1, NULL, &const_alpha_attr);
3709  make_field_entry (&field);
3710  curr_field->size = 0;
3711  curr_field->data[0] = ' ';
3712  return curr_field;
3713  }
3714  calcsize = strlen (*(COB_MODULE_PTR->module_path));
3715  COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr);
3716  make_field_entry (&field);
3717  memcpy (curr_field->data, *(COB_MODULE_PTR->module_path),
3718  calcsize);
3719  return curr_field;
3720 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_field::size
size_t size
Definition: common.h:951

Here is the call graph for this function:

cob_field* cob_intr_module_source ( void  )

Definition at line 3688 of file intrinsic.c.

References COB_FIELD_INIT, COB_MODULE_PTR, curr_field, cob_field::data, make_field_entry(), and NULL.

3689 {
3690  size_t calcsize;
3691  cob_field field;
3692 
3693  calcsize = strlen (COB_MODULE_PTR->module_source);
3694  COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr);
3695  make_field_entry (&field);
3696  memcpy (curr_field->data, COB_MODULE_PTR->module_source, calcsize);
3697  return curr_field;
3698 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_module_time ( void  )

Definition at line 3625 of file intrinsic.c.

References COB_ATTR_INIT, COB_FIELD_INIT, COB_MODULE_PTR, COB_TYPE_NUMERIC_DISPLAY, curr_field, cob_field::data, make_field_entry(), and NULL.

3626 {
3627  cob_field_attr attr;
3628  cob_field field;
3629  char buff[8];
3630 
3631  COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 6, 0, 0, NULL);
3632  COB_FIELD_INIT (6, NULL, &attr);
3633  make_field_entry (&field);
3634  snprintf (buff, sizeof(buff), "%6.6u", COB_MODULE_PTR->module_time);
3635  memcpy (curr_field->data, buff, (size_t)6);
3636  return curr_field;
3637 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_field
Definition: common.h:950
COB_ATTR_INIT
#define COB_ATTR_INIT(u, v, x, y, z)
Definition: coblocal.h:150
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_TYPE_NUMERIC_DISPLAY
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cob_field_attr
Definition: common.h:940
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_mon_decimal_point ( void  )

Definition at line 5598 of file intrinsic.c.

References COB_FIELD_INIT, COB_MODULE_PTR, cob_set_exception(), curr_field, cob_field::data, make_field_entry(), NULL, and cob_field::size.

5599 {
5600 #ifdef HAVE_LOCALECONV
5601  struct lconv *p;
5602  size_t size;
5603 #endif
5604  cob_field field;
5605 
5606  COB_FIELD_INIT (0, NULL, &const_alpha_attr);
5607  cob_set_exception (0);
5608 
5609 #ifdef HAVE_LOCALECONV
5610  p = localeconv ();
5611  size = strlen (p->mon_decimal_point);
5612  if (size) {
5613  field.size = size;
5614  } else {
5615  field.size = 1;
5616  }
5617  make_field_entry (&field);
5618  if (size) {
5619  memcpy (curr_field->data, p->mon_decimal_point, size);
5620  } else {
5621  curr_field->size = 0;
5622  curr_field->data[0] = 0;
5623  }
5624 #else
5625  field.size = 1;
5626  make_field_entry (&field);
5627  curr_field->data[0] = COB_MODULE_PTR->decimal_point;
5628 #endif
5629  return curr_field;
5630 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_field::size
size_t size
Definition: common.h:951

Here is the call graph for this function:

cob_field* cob_intr_mon_thousands_sep ( void  )

Definition at line 5668 of file intrinsic.c.

References COB_FIELD_INIT, COB_MODULE_PTR, cob_set_exception(), curr_field, cob_field::data, make_field_entry(), NULL, and cob_field::size.

5669 {
5670 #ifdef HAVE_LOCALECONV
5671  struct lconv *p;
5672  size_t size;
5673 #endif
5674  cob_field field;
5675 
5676  COB_FIELD_INIT (0, NULL, &const_alpha_attr);
5677  cob_set_exception (0);
5678 
5679 #ifdef HAVE_LOCALECONV
5680  p = localeconv ();
5681  size = strlen (p->mon_thousands_sep);
5682  if (size) {
5683  field.size = size;
5684  } else {
5685  field.size = 1;
5686  }
5687  make_field_entry (&field);
5688  if (size) {
5689  memcpy (curr_field->data, p->mon_thousands_sep, size);
5690  } else {
5691  curr_field->size = 0;
5692  curr_field->data[0] = 0;
5693  }
5694 #else
5695  field.size = 1;
5696  make_field_entry (&field);
5697  curr_field->data[0] = COB_MODULE_PTR->decimal_point;
5698 #endif
5699  return curr_field;
5700 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_field::size
size_t size
Definition: common.h:951

Here is the call graph for this function:

cob_field* cob_intr_national_of ( const int  ,
const int  ,
const int  ,
  ... 
)

Definition at line 6501 of file intrinsic.c.

References cob_fatal_error(), COB_FERROR_FUNCTION, and COB_UNUSED.

6502 {
6503  COB_UNUSED (offset);
6504  COB_UNUSED (length);
6505  COB_UNUSED (params);
6506 
6507  cob_fatal_error (COB_FERROR_FUNCTION);
6508 }
COB_FERROR_FUNCTION
#define COB_FERROR_FUNCTION
Definition: common.h:702
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_num_decimal_point ( void  )

Definition at line 5633 of file intrinsic.c.

References COB_FIELD_INIT, COB_MODULE_PTR, cob_set_exception(), curr_field, cob_field::data, make_field_entry(), NULL, and cob_field::size.

5634 {
5635 #ifdef HAVE_LOCALECONV
5636  struct lconv *p;
5637  size_t size;
5638 #endif
5639  cob_field field;
5640 
5641  COB_FIELD_INIT (0, NULL, &const_alpha_attr);
5642  cob_set_exception (0);
5643 
5644 #ifdef HAVE_LOCALECONV
5645  p = localeconv ();
5646  size = strlen (p->decimal_point);
5647  if (size) {
5648  field.size = size;
5649  } else {
5650  field.size = 1;
5651  }
5652  make_field_entry (&field);
5653  if (size) {
5654  memcpy (curr_field->data, p->decimal_point, size);
5655  } else {
5656  curr_field->size = 0;
5657  curr_field->data[0] = 0;
5658  }
5659 #else
5660  field.size = 1;
5661  make_field_entry (&field);
5662  curr_field->data[0] = COB_MODULE_PTR->decimal_point;
5663 #endif
5664  return curr_field;
5665 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_field::size
size_t size
Definition: common.h:951

Here is the call graph for this function:

cob_field* cob_intr_num_thousands_sep ( void  )

Definition at line 5703 of file intrinsic.c.

References COB_FIELD_INIT, COB_MODULE_PTR, cob_set_exception(), curr_field, cob_field::data, make_field_entry(), NULL, and cob_field::size.

5704 {
5705 #ifdef HAVE_LOCALECONV
5706  struct lconv *p;
5707  size_t size;
5708 #endif
5709  cob_field field;
5710 
5711  COB_FIELD_INIT (0, NULL, &const_alpha_attr);
5712  cob_set_exception (0);
5713 
5714 #ifdef HAVE_LOCALECONV
5715  p = localeconv ();
5716  size = strlen (p->thousands_sep);
5717  if (size) {
5718  field.size = size;
5719  } else {
5720  field.size = 1;
5721  }
5722  make_field_entry (&field);
5723  if (size) {
5724  memcpy (curr_field->data, p->thousands_sep, size);
5725  } else {
5726  curr_field->size = 0;
5727  curr_field->data[0] = 0;
5728  }
5729 #else
5730  field.size = 1;
5731  make_field_entry (&field);
5732  curr_field->data[0] = COB_MODULE_PTR->decimal_point;
5733 #endif
5734  return curr_field;
5735 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: intrinsic.c:73
cob_field
Definition: common.h:950
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_field::size
size_t size
Definition: common.h:951

Here is the call graph for this function:

cob_field* cob_intr_numval ( cob_field *  )

Definition at line 4584 of file intrinsic.c.

References NULL, NUMVAL, and numval().

Referenced by format_field(), and LISTING_().

4585 {
4586  return numval (srcfield, NULL, NUMVAL);
4587 }
numval
static cob_field * numval(cob_field *srcfield, cob_field *currency, const enum numval_type type)
Definition: intrinsic.c:1456
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the call graph for this function:

Here is the caller graph for this function:

cob_field* cob_intr_numval_c ( cob_field *  ,
cob_field *   
)

Definition at line 4590 of file intrinsic.c.

References numval(), and NUMVAL_C.

Referenced by format_field().

4591 {
4592  return numval (srcfield, currency, NUMVAL_C);
4593 }
numval
static cob_field * numval(cob_field *srcfield, cob_field *currency, const enum numval_type type)
Definition: intrinsic.c:1456

Here is the call graph for this function:

Here is the caller graph for this function:

cob_field* cob_intr_numval_f ( cob_field *  )

Definition at line 4596 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), cob_check_numval_f(), cob_decimal_get_field(), COB_EC_ARGUMENT_FUNCTION, cob_free(), cob_malloc(), cob_mexp, COB_MODULE_PTR, cob_set_exception(), cob_uli_t, curr_field, cob_field::data, cob_decimal::scale, cob_field::size, and cob_decimal::value.

4597 {
4598  unsigned char *final_buff;
4599  unsigned char *p;
4600  size_t plus_minus;
4601  size_t digits;
4602  size_t decimal_digits;
4603  size_t dec_seen;
4604  size_t e_seen;
4605  size_t exponent;
4606  size_t e_plus_minus;
4607  size_t n;
4608  unsigned char dec_pt;
4609 
4610  /* Validate source field */
4611  if (cob_check_numval_f (srcfield)) {
4612  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4613  cob_alloc_set_field_uint (0);
4614  return curr_field;
4615  }
4616 
4617  plus_minus = 0;
4618  digits = 0;
4619  decimal_digits = 0;
4620  dec_seen = 0;
4621  e_seen = 0;
4622  exponent = 0;
4623  e_plus_minus = 0;
4624  dec_pt = COB_MODULE_PTR->decimal_point;
4625 
4626  final_buff = cob_malloc (srcfield->size + 1U);
4627  p = srcfield->data;
4628  for (n = 0; n < srcfield->size; ++n, ++p) {
4629  switch (*p) {
4630  case '0':
4631  case '1':
4632  case '2':
4633  case '3':
4634  case '4':
4635  case '5':
4636  case '6':
4637  case '7':
4638  case '8':
4639  case '9':
4640  if (e_seen) {
4641  exponent *= 10;
4642  exponent += (*p & 0x0F);
4643  } else {
4644  if (dec_seen) {
4645  decimal_digits++;
4646  }
4647  final_buff[digits++] = *p;
4648  }
4649  continue;
4650  case 'E':
4651  e_seen = 1;
4652  continue;
4653  case '-':
4654  if (e_seen) {
4655  e_plus_minus = 1;
4656  } else {
4657  plus_minus = 1;
4658  }
4659  continue;
4660  default:
4661  if (*p == dec_pt) {
4662  dec_seen = 1;
4663  }
4664  continue;
4665  }
4666  }
4667 
4668  if (!digits) {
4669  final_buff[0] = '0';
4670  }
4671 
4672  mpz_set_str (d1.value, (char *)final_buff, 10);
4673  cob_free (final_buff);
4674  if (!mpz_sgn (d1.value)) {
4675  /* Value is zero ; sign and exponent irrelevant */
4676  d1.scale = 0;
4677  cob_alloc_field (&d1);
4678  (void)cob_decimal_get_field (&d1, curr_field, 0);
4679  return curr_field;
4680  }
4681  if (plus_minus) {
4682  mpz_neg (d1.value, d1.value);
4683  }
4684  if (exponent) {
4685  if (e_plus_minus) {
4686  /* Negative exponent */
4687  d1.scale = decimal_digits + exponent;
4688  } else {
4689  /* Positive exponent */
4690  if (decimal_digits >= exponent) {
4691  d1.scale = decimal_digits - exponent;
4692  } else {
4693  exponent -= decimal_digits;
4694  mpz_ui_pow_ui (cob_mexp, 10UL,
4695  (cob_uli_t)exponent);
4696  mpz_mul (d1.value, d1.value, cob_mexp);
4697  d1.scale = 0;
4698  }
4699  }
4700  } else {
4701  /* No exponent */
4702  d1.scale = decimal_digits;
4703  }
4704 
4705  cob_alloc_field (&d1);
4706  (void)cob_decimal_get_field (&d1, curr_field, 0);
4707 
4708  return curr_field;
4709 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_mexp
static mpz_t cob_mexp
Definition: intrinsic.c:85
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_uli_t
#define cob_uli_t
Definition: common.h:33
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_check_numval_f
static int cob_check_numval_f(const cob_field *srcfield)
Definition: intrinsic.c:677
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_ord ( cob_field *  )

Definition at line 3995 of file intrinsic.c.

References cob_alloc_set_field_uint(), cob_u32_t, curr_field, and cob_field::data.

3996 {
3997  cob_alloc_set_field_uint ((cob_u32_t)(*srcfield->data + 1U));
3998  return curr_field;
3999 }
cob_u32_t
#define cob_u32_t
Definition: common.h:31
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_ord_max ( const int  ,
  ... 
)

Definition at line 4809 of file intrinsic.c.

References cob_alloc_set_field_uint(), cob_cmp(), cob_u32_t, curr_field, and params.

4810 {
4811  cob_field *f;
4812  cob_field *basef;
4813  cob_u32_t ordmax;
4814  int i;
4815  va_list args;
4816 
4817  va_start (args, params);
4818 
4819  ordmax = 1;
4820  basef = va_arg (args, cob_field *);
4821  for (i = 1; i < params; ++i) {
4822  f = va_arg (args, cob_field *);
4823  if (cob_cmp (f, basef) > 0) {
4824  basef = f;
4825  ordmax = i + 1;
4826  }
4827  }
4828  va_end (args);
4829 
4830  cob_alloc_set_field_uint (ordmax);
4831  return curr_field;
4832 }
cob_u32_t
#define cob_u32_t
Definition: common.h:31
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_field
Definition: common.h:950
cob_cmp
int cob_cmp(cob_field *f1, cob_field *f2)
Definition: common.c:2318
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_ord_min ( const int  ,
  ... 
)

Definition at line 4783 of file intrinsic.c.

References cob_alloc_set_field_uint(), cob_cmp(), cob_u32_t, curr_field, and params.

4784 {
4785  cob_field *f;
4786  cob_field *basef;
4787  int i;
4788  cob_u32_t ordmin;
4789  va_list args;
4790 
4791  va_start (args, params);
4792 
4793  ordmin = 1;
4794  basef = va_arg (args, cob_field *);
4795  for (i = 1; i < params; ++i) {
4796  f = va_arg (args, cob_field *);
4797  if (cob_cmp (f, basef) < 0) {
4798  basef = f;
4799  ordmin = i + 1;
4800  }
4801  }
4802  va_end (args);
4803 
4804  cob_alloc_set_field_uint (ordmin);
4805  return curr_field;
4806 }
cob_u32_t
#define cob_u32_t
Definition: common.h:31
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_field
Definition: common.h:950
cob_cmp
int cob_cmp(cob_field *f1, cob_field *f2)
Definition: common.c:2318
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_pi ( void  )

Definition at line 4274 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_get_field(), cob_decimal_set_mpf(), cob_mpft, cob_pi, and curr_field.

4275 {
4276  mpf_set (cob_mpft, cob_pi);
4277  cob_decimal_set_mpf (&d1, cob_mpft);
4278  cob_alloc_field (&d1);
4279  (void)cob_decimal_get_field (&d1, curr_field, 0);
4280 
4281  return curr_field;
4282 }
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_mpft
static mpf_t cob_mpft
Definition: intrinsic.c:88
cob_pi
static mpf_t cob_pi
Definition: intrinsic.c:93
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal_set_mpf
static void cob_decimal_set_mpf(cob_decimal *d, const mpf_t src)
Definition: intrinsic.c:816

Here is the call graph for this function:

cob_field* cob_intr_present_value ( const int  ,
  ... 
)

Definition at line 5113 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_add(), cob_decimal_div(), cob_decimal_get_field(), cob_decimal_set_field(), cob_uli_t, curr_field, params, cob_decimal::scale, and cob_decimal::value.

5114 {
5115  cob_field *f;
5116  va_list args;
5117  int i;
5118 
5119  va_start (args, params);
5120 
5121  f = va_arg (args, cob_field *);
5122 
5123  cob_decimal_set_field (&d1, f);
5124  mpz_set_ui (d2.value, 1UL);
5125  d2.scale = 0;
5126  cob_decimal_add (&d1, &d2);
5127 
5128  mpz_set_ui (d4.value, 0UL);
5129  d4.scale = 0;
5130 
5131  for (i = 1; i < params; ++i) {
5132  f = va_arg (args, cob_field *);
5133  cob_decimal_set_field (&d2, f);
5134  mpz_set (d3.value, d1.value);
5135  d3.scale = d1.scale;
5136  if (i > 1) {
5137  mpz_pow_ui (d3.value, d3.value, (cob_uli_t)i);
5138  d3.scale *= i;
5139  }
5140  cob_decimal_div (&d2, &d3);
5141  cob_decimal_add (&d4, &d2);
5142  }
5143  va_end (args);
5144 
5145  cob_alloc_field (&d4);
5146  (void)cob_decimal_get_field (&d4, curr_field, 0);
5147  return curr_field;
5148 }
d2
static cob_decimal d2
Definition: intrinsic.c:80
d3
static cob_decimal d3
Definition: intrinsic.c:81
cob_field
Definition: common.h:950
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_uli_t
#define cob_uli_t
Definition: common.h:33
cob_decimal_add
void cob_decimal_add(cob_decimal *, cob_decimal *)
Definition: numeric.c:1875
cob_decimal_div
void cob_decimal_div(cob_decimal *, cob_decimal *)
Definition: numeric.c:1899
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
d4
static cob_decimal d4
Definition: intrinsic.c:82
cob_decimal::value
mpz_t value
Definition: common.h:985
params
strict implicit external call params
Definition: warning.def:60
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_random ( const int  ,
  ... 
)

Definition at line 5023 of file intrinsic.c.

References COB_ATTR_INIT, COB_FIELD_INIT, COB_FLAG_HAVE_SIGN, cob_get_int(), COB_TYPE_NUMERIC_DOUBLE, curr_field, cob_field::data, make_field_entry(), and NULL.

5024 {
5025  cob_field *f;
5026  va_list args;
5027  double val;
5028  int seed;
5029  int randnum;
5030  cob_field_attr attr;
5031  cob_field field;
5032 
5033  COB_ATTR_INIT (COB_TYPE_NUMERIC_DOUBLE, 20, 9, COB_FLAG_HAVE_SIGN, NULL);
5034  COB_FIELD_INIT (sizeof(double), NULL, &attr);
5035  va_start (args, params);
5036 
5037  if (params) {
5038  f = va_arg (args, cob_field *);
5039  seed = cob_get_int (f);
5040  if (seed < 0) {
5041  seed = 0;
5042  }
5043 #ifdef __CYGWIN__
5044  srandom ((unsigned int)seed);
5045 #else
5046  srand ((unsigned int)seed);
5047 #endif
5048  }
5049  va_end (args);
5050 
5051 #ifdef __CYGWIN__
5052  randnum = (int)random ();
5053 #else
5054  randnum = rand ();
5055 #endif
5056  make_field_entry (&field);
5057  val = (double)randnum / (double)RAND_MAX;
5058  memcpy (curr_field->data, &val, sizeof(val));
5059  return curr_field;
5060 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_field
Definition: common.h:950
COB_ATTR_INIT
#define COB_ATTR_INIT(u, v, x, y, z)
Definition: coblocal.h:150
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FLAG_HAVE_SIGN
#define COB_FLAG_HAVE_SIGN
Definition: common.h:630
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
COB_FIELD_INIT
#define COB_FIELD_INIT(x, y, z)
Definition: coblocal.h:144
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_field_attr
Definition: common.h:940
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
COB_TYPE_NUMERIC_DOUBLE
#define COB_TYPE_NUMERIC_DOUBLE
Definition: common.h:611
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_range ( const int  ,
  ... 
)

Definition at line 4998 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_get_field(), cob_decimal_set_field(), cob_decimal_sub(), curr_field, and get_min_and_max_of_args().

4999 {
5000  cob_field *basemin, *basemax;
5001  va_list args;
5002 
5003  va_start (args, params);
5004  get_min_and_max_of_args (params, args, &basemin, &basemax);
5005  va_end (args);
5006 
5007  cob_decimal_set_field (&d1, basemax);
5008  cob_decimal_set_field (&d2, basemin);
5009  cob_decimal_sub (&d1, &d2);
5010 
5011  cob_alloc_field (&d1);
5012  (void)cob_decimal_get_field (&d1, curr_field, 0);
5013  return curr_field;
5014 }
get_min_and_max_of_args
static void get_min_and_max_of_args(const int num_args, va_list args, cob_field **min, cob_field **max)
Definition: intrinsic.c:1543
d2
static cob_decimal d2
Definition: intrinsic.c:80
cob_field
Definition: common.h:950
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
d1
static cob_decimal d1
Definition: intrinsic.c:79
cob_decimal_sub
void cob_decimal_sub(cob_decimal *, cob_decimal *)
Definition: numeric.c:1883
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_rem ( cob_field *  ,
cob_field *   
)

Definition at line 5017 of file intrinsic.c.

References cob_mod_or_rem().

5018 {
5019  return cob_mod_or_rem (srcfield1, srcfield2, 1);
5020 }
cob_mod_or_rem
static cob_field * cob_mod_or_rem(cob_field *f1, cob_field *f2, const int func_is_rem)
Definition: intrinsic.c:624

Here is the call graph for this function:

cob_field* cob_intr_reverse ( const int  ,
const int  ,
cob_field *   
)

Definition at line 3593 of file intrinsic.c.

References calc_ref_mod(), curr_field, cob_field::data, make_field_entry(), cob_field::size, and unlikely.

3594 {
3595  size_t i, size;
3596 
3597  make_field_entry (srcfield);
3598 
3599  size = srcfield->size;
3600  for (i = 0; i < size; ++i) {
3601  curr_field->data[i] = srcfield->data[size - i - 1];
3602  }
3603  if (unlikely(offset > 0)) {
3604  calc_ref_mod (curr_field, offset, length);
3605  }
3606  return curr_field;
3607 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_field::data
unsigned char * data
Definition: common.h:952
calc_ref_mod
static void calc_ref_mod(cob_field *f, const int offset, const int length)
Definition: intrinsic.c:488
unlikely
#define unlikely(x)
Definition: common.h:437
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_seconds_from_formatted_time ( cob_field *  ,
cob_field *   
)

Definition at line 5325 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), COB_DATETIMESTR_LEN, cob_decimal_get_field(), COB_EC_ARGUMENT_FUNCTION, COB_MODULE_PTR, cob_set_exception(), cob_valid_datetime_format(), cob_valid_time_format(), curr_field, d1, cob_field::data, NULL, num_leading_nonspace(), parse_time_format_string(), seconds_from_formatted_time(), split_around_t(), and test_formatted_time().

5326 {
5327  size_t str_length;
5328  char format_str[COB_DATETIMESTR_LEN] = { '\0' };
5329  const char decimal_point = COB_MODULE_PTR->decimal_point;
5330  int is_datetime = 0;
5331  char time_str[COB_DATETIMESTR_LEN] = { '\0' };
5332  struct time_format time_fmt;
5333  cob_decimal *seconds = &d1;
5334 
5335  str_length = num_leading_nonspace ((char *) format_field->data);
5336  memcpy (format_str, format_field->data, str_length);
5337 
5338  cob_set_exception (0);
5339 
5340  /* Validate the format string */
5341  if (cob_valid_datetime_format (format_str, decimal_point)) {
5342  is_datetime = 1;
5343  } else if (!cob_valid_time_format (format_str, decimal_point)) {
5344  goto invalid_args;
5345  }
5346 
5347  /* Extract the time part of the strings */
5348  if (is_datetime) {
5349  split_around_t (format_str, NULL, format_str);
5350  split_around_t ((char *) time_field->data, NULL, time_str);
5351  } else {
5352  memcpy (time_str, time_field->data, str_length);
5353  }
5354 
5355  /* Validate the formatted time */
5356  time_fmt = parse_time_format_string (format_str);
5357  if (test_formatted_time (time_fmt, time_str, decimal_point) != 0) {
5358  goto invalid_args;
5359  }
5360 
5361  seconds_from_formatted_time (time_fmt, time_str, seconds);
5362 
5363  cob_alloc_field (seconds);
5364  (void) cob_decimal_get_field (seconds, curr_field, 0);
5365 
5366  return curr_field;
5367 
5368  invalid_args:
5369  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5370  cob_alloc_set_field_uint (0);
5371  return curr_field;
5372 }
num_leading_nonspace
static int num_leading_nonspace(const char *str)
Definition: intrinsic.c:2007
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
split_around_t
static void split_around_t(const char *str, char *first, char *second)
Definition: intrinsic.c:2384
time_format
Definition: intrinsic.c:1955
COB_DATETIMESTR_LEN
#define COB_DATETIMESTR_LEN
Definition: intrinsic.c:127
cob_valid_time_format
int cob_valid_time_format(const char *format, const char decimal_point)
Definition: intrinsic.c:3366
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
test_formatted_time
static int test_formatted_time(const struct time_format format, const char *time, const char decimal_point)
Definition: intrinsic.c:2842
seconds_from_formatted_time
static void seconds_from_formatted_time(const struct time_format format, const char *str, cob_decimal *seconds_decimal)
Definition: intrinsic.c:1963
format_field
static void format_field(cob_screen *s)
Definition: screenio.c:1025
cob_decimal
Definition: common.h:984
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cob_valid_datetime_format
int cob_valid_datetime_format(const char *format, const char decimal_point)
Definition: intrinsic.c:3402
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
parse_time_format_string
static struct time_format parse_time_format_string(const char *str)
Definition: intrinsic.c:2282

Here is the call graph for this function:

cob_field* cob_intr_seconds_past_midnight ( void  )

Definition at line 5306 of file intrinsic.c.

References cob_alloc_set_field_int(), curr_field, and NULL.

5307 {
5308  struct tm *timeptr;
5309  time_t t;
5310  int seconds;
5311 
5312  t = time (NULL);
5313  timeptr = localtime (&t);
5314  /* Leap seconds ? */
5315  if (timeptr->tm_sec >= 60) {
5316  timeptr->tm_sec = 59;
5317  }
5318  seconds = (timeptr->tm_hour * 3600) + (timeptr->tm_min * 60) +
5319  timeptr->tm_sec;
5320  cob_alloc_set_field_int (seconds);
5321  return curr_field;
5322 }
cob_alloc_set_field_int
static void cob_alloc_set_field_int(const int val)
Definition: intrinsic.c:533
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_sign ( cob_field *  )

Definition at line 3551 of file intrinsic.c.

References cob_alloc_set_field_int(), cob_decimal_set_field(), curr_field, and cob_decimal::value.

3552 {
3553  cob_decimal_set_field (&d1, srcfield);
3554  cob_alloc_set_field_int (mpz_sgn (d1.value));
3555  return curr_field;
3556 }
cob_alloc_set_field_int
static void cob_alloc_set_field_int(const int val)
Definition: intrinsic.c:533
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal::value
mpz_t value
Definition: common.h:985

Here is the call graph for this function:

cob_field* cob_intr_sin ( cob_field *  )

Definition at line 4529 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_get_field(), cob_decimal_get_mpf(), cob_decimal_set_field(), cob_decimal_set_mpf(), cob_mpf_sin(), cob_mpft, cob_set_exception(), and curr_field.

4530 {
4531  cob_decimal_set_field (&d1, srcfield);
4532 
4533  cob_set_exception (0);
4534 
4535  cob_decimal_get_mpf (cob_mpft, &d1);
4536  cob_mpf_sin (cob_mpft, cob_mpft);
4537  cob_decimal_set_mpf (&d1, cob_mpft);
4538  cob_alloc_field (&d1);
4539  (void)cob_decimal_get_field (&d1, curr_field, 0);
4540 
4541  return curr_field;
4542 }
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_mpft
static mpf_t cob_mpft
Definition: intrinsic.c:88
cob_decimal_get_mpf
static void cob_decimal_get_mpf(mpf_t dst, const cob_decimal *d)
Definition: intrinsic.c:847
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_mpf_sin
static void cob_mpf_sin(mpf_t dst_val, const mpf_t src_val)
Definition: intrinsic.c:1016
cob_decimal_set_mpf
static void cob_decimal_set_mpf(cob_decimal *d, const mpf_t src)
Definition: intrinsic.c:816

Here is the call graph for this function:

cob_field* cob_intr_sqrt ( cob_field *  )

Definition at line 4561 of file intrinsic.c.

References cob_alloc_field(), cob_alloc_set_field_uint(), cob_decimal_get_field(), cob_decimal_pow(), cob_decimal_set_field(), COB_EC_ARGUMENT_FUNCTION, cob_set_exception(), cob_trim_decimal(), curr_field, cob_decimal::scale, and cob_decimal::value.

4562 {
4563  cob_decimal_set_field (&d1, srcfield);
4564 
4565  cob_set_exception (0);
4566  if (mpz_sgn (d1.value) < 0) {
4567  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
4568  cob_alloc_set_field_uint (0);
4569  return curr_field;
4570  }
4571 
4572  mpz_set_ui (d2.value, 5UL);
4573  d2.scale = 1;
4574  cob_trim_decimal (&d1);
4575  cob_decimal_pow (&d1, &d2);
4576 
4577  cob_alloc_field (&d1);
4578  (void)cob_decimal_get_field (&d1, curr_field, 0);
4579 
4580  return curr_field;
4581 }
d2
static cob_decimal d2
Definition: intrinsic.c:80
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_decimal_pow
void cob_decimal_pow(cob_decimal *pd1, cob_decimal *pd2)
Definition: intrinsic.c:2990
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_trim_decimal
static void cob_trim_decimal(cob_decimal *d)
Definition: intrinsic.c:517
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_standard_compare ( const int  ,
  ... 
)

Definition at line 6511 of file intrinsic.c.

References cob_fatal_error(), COB_FERROR_FUNCTION, and COB_UNUSED.

6512 {
6513  COB_UNUSED (params);
6514 
6515  cob_fatal_error (COB_FERROR_FUNCTION);
6516 }
COB_FERROR_FUNCTION
#define COB_FERROR_FUNCTION
Definition: common.h:702
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_standard_deviation ( const int  ,
  ... 
)

Definition at line 5090 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_get_field(), cob_decimal_pow(), cob_set_exception(), cob_trim_decimal(), curr_field, GET_VARIANCE, cob_decimal::scale, and cob_decimal::value.

5091 {
5092  va_list args;
5093 
5094  GET_VARIANCE (num_args, args);
5095  cob_trim_decimal (&d1);
5096 
5097  cob_set_exception (0);
5098 
5099  /* Take square root of variance */
5100  mpz_set_ui (d3.value, 5UL);
5101  d3.scale = 1;
5102 
5103  cob_decimal_pow (&d1, &d3);
5104 
5105  cob_alloc_field (&d1);
5106  (void)cob_decimal_get_field (&d1, curr_field, 0);
5107  return curr_field;
5108 }
d3
static cob_decimal d3
Definition: intrinsic.c:81
cob_decimal_pow
void cob_decimal_pow(cob_decimal *pd1, cob_decimal *pd2)
Definition: intrinsic.c:2990
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
GET_VARIANCE
#define GET_VARIANCE(num_args, args)
Definition: intrinsic.c:5062
cob_trim_decimal
static void cob_trim_decimal(cob_decimal *d)
Definition: intrinsic.c:517
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_stored_char_length ( cob_field *  )

Definition at line 4002 of file intrinsic.c.

References cob_alloc_set_field_uint(), cob_u32_t, curr_field, cob_field::data, and cob_field::size.

4003 {
4004  unsigned char *p;
4005  cob_u32_t count;
4006 
4007  count = srcfield->size;
4008  p = srcfield->data + srcfield->size - 1;
4009  for (; count > 0; count--, p--) {
4010  if (*p != ' ') {
4011  break;
4012  }
4013  }
4014 
4015  cob_alloc_set_field_uint (count);
4016  return curr_field;
4017 }
cob_u32_t
#define cob_u32_t
Definition: common.h:31
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_substitute ( const int  ,
const int  ,
const int  ,
  ... 
)

Definition at line 3762 of file intrinsic.c.

References substitute().

3764 {
3765  cob_field *ret;
3766  va_list args;
3767 
3768  va_start (args, params);
3769  ret = substitute (offset, length, params, &memcmp, args);
3770  va_end (args);
3771 
3772  return ret;
3773 }
substitute
static cob_field * substitute(const int offset, const int length, const int params, int(*cmp_func)(const void *, const void *, size_t), va_list args)
Definition: intrinsic.c:1380
cob_field
Definition: common.h:950
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_substitute_case ( const int  ,
const int  ,
const int  ,
  ... 
)

Definition at line 3776 of file intrinsic.c.

References int_strncasecmp(), and substitute().

3778 {
3779  cob_field *ret;
3780  va_list args;
3781 
3782  va_start (args, params);
3783  ret = substitute (offset, length, params, &int_strncasecmp, args);
3784  va_end (args);
3785 
3786  return ret;
3787 }
substitute
static cob_field * substitute(const int offset, const int length, const int params, int(*cmp_func)(const void *, const void *, size_t), va_list args)
Definition: intrinsic.c:1380
cob_field
Definition: common.h:950
int_strncasecmp
static int int_strncasecmp(const void *s1, const void *s2, size_t n)
Definition: intrinsic.c:1430
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

cob_field* cob_intr_sum ( const int  ,
  ... 
)

Definition at line 4759 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_add(), cob_decimal_get_field(), cob_decimal_set_field(), curr_field, params, cob_decimal::scale, and cob_decimal::value.

4760 {
4761  cob_field *f;
4762  va_list args;
4763  int i;
4764 
4765  mpz_set_ui (d1.value, 0UL);
4766  d1.scale = 0;
4767 
4768  va_start (args, params);
4769 
4770  for (i = 0; i < params; ++i) {
4771  f = va_arg (args, cob_field *);
4772  cob_decimal_set_field (&d2, f);
4773  cob_decimal_add (&d1, &d2);
4774  }
4775  va_end (args);
4776 
4777  cob_alloc_field (&d1);
4778  (void)cob_decimal_get_field (&d1, curr_field, 0);
4779  return curr_field;
4780 }
d2
static cob_decimal d2
Definition: intrinsic.c:80
cob_field
Definition: common.h:950
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_decimal_add
void cob_decimal_add(cob_decimal *, cob_decimal *)
Definition: numeric.c:1875
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal::value
mpz_t value
Definition: common.h:985
params
strict implicit external call params
Definition: warning.def:60
cob_decimal::scale
int scale
Definition: common.h:986

Here is the call graph for this function:

cob_field* cob_intr_tan ( cob_field *  )

Definition at line 4545 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_get_field(), cob_decimal_get_mpf(), cob_decimal_set_field(), cob_decimal_set_mpf(), cob_mpf_tan(), cob_mpft, cob_set_exception(), and curr_field.

4546 {
4547  cob_decimal_set_field (&d1, srcfield);
4548 
4549  cob_set_exception (0);
4550 
4551  cob_decimal_get_mpf (cob_mpft, &d1);
4552  cob_mpf_tan (cob_mpft, cob_mpft);
4553  cob_decimal_set_mpf (&d1, cob_mpft);
4554  cob_alloc_field (&d1);
4555  (void)cob_decimal_get_field (&d1, curr_field, 0);
4556 
4557  return curr_field;
4558 }
cob_mpf_tan
static void cob_mpf_tan(mpf_t dst_val, const mpf_t src_val)
Definition: intrinsic.c:1113
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *, cob_field *)
Definition: numeric.c:1612
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
cob_mpft
static mpf_t cob_mpft
Definition: intrinsic.c:88
cob_decimal_get_mpf
static void cob_decimal_get_mpf(mpf_t dst, const cob_decimal *d)
Definition: intrinsic.c:847
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801
cob_decimal_set_mpf
static void cob_decimal_set_mpf(cob_decimal *d, const mpf_t src)
Definition: intrinsic.c:816

Here is the call graph for this function:

cob_field* cob_intr_test_date_yyyymmdd ( cob_field *  )

Definition at line 4188 of file intrinsic.c.

References cob_alloc_set_field_uint(), cob_get_int(), curr_field, cob_time::month, valid_day_of_month(), valid_month(), valid_year(), and cob_time::year.

4189 {
4190  int indate;
4191  int days;
4192  int month;
4193  int year;
4194 
4195  /* Base 1601-01-01 */
4196  indate = cob_get_int (srcfield);
4197  year = indate / 10000;
4198  if (!valid_year (year)) {
4199  cob_alloc_set_field_uint (1);
4200  return curr_field;
4201  }
4202  indate %= 10000;
4203  month = indate / 100;
4204  if (!valid_month (month)) {
4205  cob_alloc_set_field_uint (2);
4206  return curr_field;
4207  }
4208  days = indate % 100;
4209  if (!valid_day_of_month (year, month, days)) {
4210  cob_alloc_set_field_uint (3);
4211  return curr_field;
4212  }
4213  cob_alloc_set_field_uint (0);
4214  return curr_field;
4215 }
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
valid_day_of_month
static int valid_day_of_month(const int year, const int month, const int day)
Definition: intrinsic.c:1812
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
valid_month
static int valid_month(const int month)
Definition: intrinsic.c:1800
valid_year
static int valid_year(const int year)
Definition: intrinsic.c:1794
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_test_day_yyyyddd ( cob_field *  )

Definition at line 4218 of file intrinsic.c.

References cob_alloc_set_field_uint(), cob_get_int(), curr_field, valid_day_of_year(), valid_year(), and cob_time::year.

4219 {
4220  int indate;
4221  int days;
4222  int year;
4223 
4224  /* Base 1601-01-01 */
4225  indate = cob_get_int (srcfield);
4226  year = indate / 1000;
4227  if (!valid_year (year)) {
4228  cob_alloc_set_field_uint (1);
4229  return curr_field;
4230  }
4231  days = indate % 1000;
4232  if (!valid_day_of_year (year, days)) {
4233  cob_alloc_set_field_uint (2);
4234  return curr_field;
4235  }
4236  cob_alloc_set_field_uint (0);
4237  return curr_field;
4238 }
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
valid_day_of_year
static int valid_day_of_year(const int year, const int day)
Definition: intrinsic.c:1806
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
valid_year
static int valid_year(const int year)
Definition: intrinsic.c:1794
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_test_formatted_datetime ( cob_field *  ,
cob_field *   
)

Definition at line 6273 of file intrinsic.c.

References COB_DATESTR_LEN, and cob_field::data.

6275 {
6276  char *datetime_format_str = (char *)format_field->data;
6277  char date_format_str[COB_DATESTR_LEN] = { '\0' };
6278  char time_format_str[COB_TIMESTR_LEN] = { '\0' };
6279  int date_present;
6280  int time_present;
6281  char *formatted_datetime = (char *)datetime_field->data;
6282  char formatted_date[COB_DATESTR_LEN] = { '\0' };
6283  char formatted_time[COB_TIMESTR_LEN] = { '\0' };
6284  int time_part_offset;
6285  int error_pos;
6286 
6287  cob_set_exception (0);
6288 
6289  /* Check whether date or time is present. */
6290  if (cob_valid_date_format (datetime_format_str)) {
6291  date_present = 1;
6292  time_present = 0;
6293  } else if (cob_valid_time_format (datetime_format_str,
6294  COB_MODULE_PTR->decimal_point)) {
6295  date_present = 0;
6296  time_present = 1;
6297  } else if (cob_valid_datetime_format (datetime_format_str,
6298  COB_MODULE_PTR->decimal_point)) {
6299  date_present = 1;
6300  time_present = 1;
6301  } else {
6302  goto invalid_args;
6303  }
6304 
6305  /* Move date/time to respective variables */
6306  if (date_present && time_present) {
6307  split_around_t (datetime_format_str, date_format_str, time_format_str);
6308  } else if (date_present) {
6309  strncpy (date_format_str, datetime_format_str, COB_DATESTR_MAX);
6310  } else { /* time_present */
6311  strncpy (time_format_str, datetime_format_str, COB_TIMESTR_MAX);
6312  }
6313 
6314  if (date_present && time_present) {
6315  split_around_t (formatted_datetime, formatted_date, formatted_time);
6316  } else if (date_present) {
6317  strncpy (formatted_date, formatted_datetime, COB_DATESTR_MAX);
6318  } else { /* time_present */
6319  strncpy (formatted_time, formatted_datetime, COB_TIMESTR_MAX);
6320  }
6321  /* silence warnings */
6322  formatted_date[COB_DATESTR_MAX] = formatted_time[COB_TIMESTR_MAX] = 0;
6323 
6324  /* Set time offset */
6325  if (date_present) {
6326  time_part_offset = strlen (formatted_date) + 1;
6327  } else {
6328  time_part_offset = 0;
6329  }
6330 
6331  /* Parse and validate the formatted date/time */
6332  if (date_present) {
6333  error_pos = test_formatted_date (parse_date_format_string (date_format_str),
6334  formatted_date, !time_present);
6335  if (error_pos != 0) {
6336  cob_alloc_set_field_uint (error_pos);
6337  goto end_of_func;
6338  }
6339  }
6340  if (time_present) {
6341  error_pos = test_formatted_time (parse_time_format_string (time_format_str),
6342  formatted_time, COB_MODULE_PTR->decimal_point);
6343  if (error_pos != 0) {
6344  cob_alloc_set_field_uint (time_part_offset + error_pos);
6345  goto end_of_func;
6346  }
6347  }
6348 
6349  cob_alloc_set_field_uint (0);
6350  goto end_of_func;
6351 
6352  invalid_args:
6353  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
6354  cob_alloc_set_field_uint (0);
6355 
6356  end_of_func:
6357  return curr_field;
6358 }
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
split_around_t
static void split_around_t(const char *str, char *first, char *second)
Definition: intrinsic.c:2384
cob_valid_time_format
int cob_valid_time_format(const char *format, const char decimal_point)
Definition: intrinsic.c:3366
test_formatted_date
static int test_formatted_date(const struct date_format format, const char *date, const int end_of_string)
Definition: intrinsic.c:2713
test_formatted_time
static int test_formatted_time(const struct time_format format, const char *time, const char decimal_point)
Definition: intrinsic.c:2842
format_field
static void format_field(cob_screen *s)
Definition: screenio.c:1025
cob_valid_date_format
int cob_valid_date_format(const char *format)
Definition: intrinsic.c:3355
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_TIMESTR_MAX
#define COB_TIMESTR_MAX
Definition: intrinsic.c:125
cob_valid_datetime_format
int cob_valid_datetime_format(const char *format, const char decimal_point)
Definition: intrinsic.c:3402
COB_DATESTR_LEN
#define COB_DATESTR_LEN
Definition: intrinsic.c:119
COB_DATESTR_MAX
#define COB_DATESTR_MAX
Definition: intrinsic.c:120
COB_TIMESTR_LEN
#define COB_TIMESTR_LEN
Definition: intrinsic.c:124
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
parse_time_format_string
static struct time_format parse_time_format_string(const char *str)
Definition: intrinsic.c:2282
parse_date_format_string
static struct date_format parse_date_format_string(const char *format_str)
Definition: intrinsic.c:2131
cob_field* cob_intr_test_numval ( cob_field *  )

Definition at line 5773 of file intrinsic.c.

References cob_alloc_set_field_int(), cob_check_numval(), curr_field, and NULL.

5774 {
5775  cob_alloc_set_field_int (cob_check_numval (srcfield, NULL, 0, 0));
5776  return curr_field;
5777 }
cob_alloc_set_field_int
static void cob_alloc_set_field_int(const int val)
Definition: intrinsic.c:533
cob_check_numval
int cob_check_numval(const cob_field *srcfield, const cob_field *currency, const int chkcurr, const int anycase)
Definition: intrinsic.c:3132
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_test_numval_c ( cob_field *  ,
cob_field *   
)

Definition at line 5780 of file intrinsic.c.

References cob_alloc_set_field_int(), cob_check_numval(), and curr_field.

5781 {
5782  cob_alloc_set_field_int (cob_check_numval (srcfield, currency, 1, 0));
5783  return curr_field;
5784 }
cob_alloc_set_field_int
static void cob_alloc_set_field_int(const int val)
Definition: intrinsic.c:533
cob_check_numval
int cob_check_numval(const cob_field *srcfield, const cob_field *currency, const int chkcurr, const int anycase)
Definition: intrinsic.c:3132
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

cob_field* cob_intr_test_numval_f ( cob_field *  )

Definition at line 5787 of file intrinsic.c.

References cob_alloc_set_field_int(), cob_check_numval_f(), and curr_field.

5788 {
5789  cob_alloc_set_field_int (cob_check_numval_f (srcfield));
5790  return curr_field;
5791 }
cob_alloc_set_field_int
static void cob_alloc_set_field_int(const int val)
Definition: intrinsic.c:533
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_check_numval_f
static int cob_check_numval_f(const cob_field *srcfield)
Definition: intrinsic.c:677

Here is the call graph for this function:

cob_field* cob_intr_trim ( const int  ,
const int  ,
cob_field *  ,
const int   
)

Definition at line 3790 of file intrinsic.c.

References calc_ref_mod(), curr_field, cob_field::data, make_field_entry(), cob_field::size, and unlikely.

Referenced by GCic_(), and LISTING_().

3792 {
3793  unsigned char *begin;
3794  unsigned char *end;
3795  size_t i;
3796  size_t size;
3797 
3798  make_field_entry (srcfield);
3799 
3800  for (i = 0; i < srcfield->size; ++i) {
3801  if (srcfield->data[i] != ' ') {
3802  break;
3803  }
3804  }
3805  if (i == srcfield->size) {
3806  curr_field->size = 0;
3807  curr_field->data[0] = ' ';
3808  return curr_field;
3809  }
3810 
3811  begin = srcfield->data;
3812  if (direction != 2) {
3813  for (; *begin == ' '; ++begin) ;
3814  }
3815  end = srcfield->data + srcfield->size - 1;
3816  if (direction != 1) {
3817  for (; *end == ' '; end--) ;
3818  }
3819 
3820  size = 0;
3821  for (i = 0; begin <= end; ++begin, ++i) {
3822  curr_field->data[i] = *begin;
3823  ++size;
3824  }
3825  curr_field->size = size;
3826  if (unlikely(offset > 0)) {
3827  calc_ref_mod (curr_field, offset, length);
3828  }
3829  return curr_field;
3830 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_field::data
unsigned char * data
Definition: common.h:952
calc_ref_mod
static void calc_ref_mod(cob_field *f, const int offset, const int length)
Definition: intrinsic.c:488
unlikely
#define unlikely(x)
Definition: common.h:437
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_field::size
size_t size
Definition: common.h:951

Here is the call graph for this function:

Here is the caller graph for this function:

cob_field* cob_intr_upper_case ( const int  ,
const int  ,
cob_field *   
)

Definition at line 3559 of file intrinsic.c.

References calc_ref_mod(), cob_u8_t, curr_field, cob_field::data, make_field_entry(), cob_field::size, and unlikely.

Referenced by CHECKSRC_(), cobxref_(), and LISTING_().

3560 {
3561  size_t i, size;
3562 
3563  make_field_entry (srcfield);
3564 
3565  size = srcfield->size;
3566  for (i = 0; i < size; ++i) {
3567  curr_field->data[i] = (cob_u8_t)toupper (srcfield->data[i]);
3568  }
3569  if (unlikely(offset > 0)) {
3570  calc_ref_mod (curr_field, offset, length);
3571  }
3572  return curr_field;
3573 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_field::data
unsigned char * data
Definition: common.h:952
cob_u8_t
#define cob_u8_t
Definition: common.h:27
calc_ref_mod
static void calc_ref_mod(cob_field *f, const int offset, const int length)
Definition: intrinsic.c:488
unlikely
#define unlikely(x)
Definition: common.h:437
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

Here is the caller graph for this function:

cob_field* cob_intr_variance ( const int  ,
  ... 
)

Definition at line 5078 of file intrinsic.c.

References cob_alloc_field(), cob_decimal_get_field(), curr_field, and GET_VARIANCE.

5079 {
5080  va_list args;
5081 
5082  GET_VARIANCE (num_args, args);
5083 
5084  cob_alloc_field (&d1);
5085  (void)cob_decimal_get_field (&d1, curr_field, 0);
5086  return curr_field;
5087 }
cob_alloc_field
static void cob_alloc_field(cob_decimal *d)
Definition: intrinsic.c:565
GET_VARIANCE
#define GET_VARIANCE(num_args, args)
Definition: intrinsic.c:5062
d1
static cob_decimal d1
Definition: intrinsic.c:79
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *, cob_field *, const int)
Definition: numeric.c:1801

Here is the call graph for this function:

cob_field* cob_intr_when_compiled ( const int  ,
const int  ,
cob_field *   
)

Definition at line 3940 of file intrinsic.c.

References calc_ref_mod(), curr_field, cob_field::data, make_field_entry(), cob_field::size, and unlikely.

Referenced by GCic_().

3941 {
3942  make_field_entry (f);
3943 
3944  memcpy (curr_field->data, f->data, f->size);
3945  if (unlikely(offset > 0)) {
3946  calc_ref_mod (curr_field, offset, length);
3947  }
3948  return curr_field;
3949 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
cob_field::data
unsigned char * data
Definition: common.h:952
calc_ref_mod
static void calc_ref_mod(cob_field *f, const int offset, const int length)
Definition: intrinsic.c:488
unlikely
#define unlikely(x)
Definition: common.h:437
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

Here is the caller graph for this function:

cob_field* cob_intr_year_to_yyyy ( const int  ,
  ... 
)

Definition at line 5151 of file intrinsic.c.

References cob_alloc_set_field_int(), cob_alloc_set_field_uint(), COB_EC_ARGUMENT_FUNCTION, cob_get_int(), cob_set_exception(), curr_field, NULL, and valid_year().

5152 {
5153  cob_field *f;
5154  struct tm *timeptr;
5155  va_list args;
5156  time_t t;
5157  int year;
5158  int interval;
5159  int current_year;
5160  int maxyear;
5161 
5162  cob_set_exception (0);
5163  va_start (args, params);
5164  f = va_arg (args, cob_field *);
5165  year = cob_get_int (f);
5166  if (params > 1) {
5167  f = va_arg (args, cob_field *);
5168  interval = cob_get_int (f);
5169  } else {
5170  interval = 50;
5171  }
5172  if (params > 2) {
5173  f = va_arg (args, cob_field *);
5174  current_year = cob_get_int (f);
5175  } else {
5176  t = time (NULL);
5177  timeptr = localtime (&t);
5178  current_year = 1900 + timeptr->tm_year;
5179  }
5180  va_end (args);
5181 
5182  if (year < 0 || year > 99) {
5183  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5184  cob_alloc_set_field_uint (0);
5185  return curr_field;
5186  }
5187  if (!valid_year (current_year)) {
5188  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5189  cob_alloc_set_field_uint (0);
5190  return curr_field;
5191  }
5192  maxyear = current_year + interval;
5193  if (maxyear < 1700 || maxyear > 9999) {
5194  cob_set_exception (COB_EC_ARGUMENT_FUNCTION);
5195  cob_alloc_set_field_uint (0);
5196  return curr_field;
5197  }
5198  if (maxyear % 100 >= year) {
5199  year += 100 * (maxyear / 100);
5200  } else {
5201  year += 100 * ((maxyear / 100) - 1);
5202  }
5203  cob_alloc_set_field_int (year);
5204  return curr_field;
5205 }
cob_alloc_set_field_int
static void cob_alloc_set_field_int(const int val)
Definition: intrinsic.c:533
cob_alloc_set_field_uint
static void cob_alloc_set_field_uint(const cob_u32_t val)
Definition: intrinsic.c:552
cob_field
Definition: common.h:950
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
valid_year
static int valid_year(const int year)
Definition: intrinsic.c:1794
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105
params
strict implicit external call params
Definition: warning.def:60

Here is the call graph for this function:

int cob_is_alpha ( const cob_field *  )

Definition at line 2453 of file common.c.

References cob_field::data, and cob_field::size.

Referenced by cobxref_().

2454 {
2455  size_t i;
2456 
2457  for (i = 0; i < f->size; ++i) {
2458  if (!isalpha (f->data[i]) && f->data[i] != (unsigned char)' ') {
2459  return 0;
2460  }
2461  }
2462  return 1;
2463 }

Here is the caller graph for this function:

int cob_is_lower ( const cob_field *  )

Definition at line 2479 of file common.c.

References cob_field::data, and cob_field::size.

2480 {
2481  size_t i;
2482 
2483  for (i = 0; i < f->size; ++i) {
2484  if (!islower (f->data[i]) && f->data[i] != (unsigned char)' ') {
2485  return 0;
2486  }
2487  }
2488  return 1;
2489 }
int cob_is_numeric ( const cob_field *  )

Definition at line 2375 of file common.c.

References cob_check_numdisp(), COB_FIELD_HAVE_SIGN, COB_FIELD_NO_SIGN_NIBBLE, COB_FIELD_TYPE, COB_MODULE_PTR, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_DOUBLE, COB_TYPE_NUMERIC_FLOAT, COB_TYPE_NUMERIC_FP_DEC128, COB_TYPE_NUMERIC_FP_DEC64, COB_TYPE_NUMERIC_PACKED, cob_field::data, sign, and cob_field::size.

Referenced by cob_check_numeric(), and cobxref_().

2376 {
2377  size_t i;
2378  union {
2379  float fpf;
2380  double fpd;
2381  } fval;
2382  int sign;
2383 
2384  switch (COB_FIELD_TYPE (f)) {
2385  case COB_TYPE_NUMERIC_BINARY:
2386  return 1;
2387  case COB_TYPE_NUMERIC_FLOAT:
2388  memcpy (&fval.fpf, f->data, sizeof(float));
2389  return !finite ((double)fval.fpf);
2390  case COB_TYPE_NUMERIC_DOUBLE:
2391  memcpy (&fval.fpd, f->data, sizeof(double));
2392  return !finite (fval.fpd);
2393  case COB_TYPE_NUMERIC_PACKED:
2394  /* Check digits */
2395  for (i = 0; i < f->size - 1; ++i) {
2396  if ((f->data[i] & 0xF0) > 0x90 ||
2397  (f->data[i] & 0x0F) > 0x09) {
2398  return 0;
2399  }
2400  }
2401  /* Check high nibble of last byte */
2402  if ((f->data[i] & 0xF0) > 0x90) {
2403  return 0;
2404  }
2405 
2406  if (COB_FIELD_NO_SIGN_NIBBLE (f)) {
2407  /* COMP-6 - Check last nibble */
2408  if ((f->data[i] & 0x0F) > 0x09) {
2409  return 0;
2410  }
2411  return 1;
2412  }
2413 
2414  /* Check sign */
2415  sign = f->data[i] & 0x0F;
2416  if (COB_FIELD_HAVE_SIGN (f)) {
2417  if (sign == 0x0C || sign == 0x0D) {
2418  return 1;
2419  }
2420  if (COB_MODULE_PTR->flag_host_sign &&
2421  sign == 0x0F) {
2422  return 1;
2423  }
2424  } else if (sign == 0x0F) {
2425  return 1;
2426  }
2427  return 0;
2428  case COB_TYPE_NUMERIC_DISPLAY:
2429  return cob_check_numdisp (f);
2430  case COB_TYPE_NUMERIC_FP_DEC64:
2431 #ifdef WORDS_BIGENDIAN
2432  return (f->data[0] & 0x78U) != 0x78U;
2433 #else
2434  return (f->data[7] & 0x78U) != 0x78U;
2435 #endif
2436  case COB_TYPE_NUMERIC_FP_DEC128:
2437 #ifdef WORDS_BIGENDIAN
2438  return (f->data[0] & 0x78U) != 0x78U;
2439 #else
2440  return (f->data[15] & 0x78U) != 0x78U;
2441 #endif
2442  default:
2443  for (i = 0; i < f->size; ++i) {
2444  if (!isdigit (f->data[i])) {
2445  return 0;
2446  }
2447  }
2448  return 1;
2449  }
2450 }
COB_TYPE_NUMERIC_PACKED
#define COB_TYPE_NUMERIC_PACKED
Definition: common.h:609
COB_FIELD_TYPE
#define COB_FIELD_TYPE(f)
Definition: common.h:662
cob_check_numdisp
static int cob_check_numdisp(const cob_field *f)
Definition: common.c:2108
COB_TYPE_NUMERIC_FP_DEC64
#define COB_TYPE_NUMERIC_FP_DEC64
Definition: common.h:613
COB_FIELD_NO_SIGN_NIBBLE
#define COB_FIELD_NO_SIGN_NIBBLE(f)
Definition: common.h:651
COB_TYPE_NUMERIC_FLOAT
#define COB_TYPE_NUMERIC_FLOAT
Definition: common.h:610
sign
if sign
Definition: flag.def:42
COB_TYPE_NUMERIC_BINARY
#define COB_TYPE_NUMERIC_BINARY
Definition: common.h:608
COB_TYPE_NUMERIC_DISPLAY
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_TYPE_NUMERIC_DOUBLE
#define COB_TYPE_NUMERIC_DOUBLE
Definition: common.h:611
COB_FIELD_HAVE_SIGN
#define COB_FIELD_HAVE_SIGN(f)
Definition: common.h:643
COB_TYPE_NUMERIC_FP_DEC128
#define COB_TYPE_NUMERIC_FP_DEC128
Definition: common.h:614

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_is_omitted ( const cob_field *  )

Definition at line 2369 of file common.c.

References cob_field::data, and NULL.

2370 {
2371  return f->data == NULL;
2372 }
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
int cob_is_upper ( const cob_field *  )

Definition at line 2466 of file common.c.

References cob_field::data, and cob_field::size.

2467 {
2468  size_t i;
2469 
2470  for (i = 0; i < f->size; ++i) {
2471  if (!isupper (f->data[i]) && f->data[i] != (unsigned char)' ') {
2472  return 0;
2473  }
2474  }
2475  return 1;
2476 }
int cob_load_config ( void  )

Definition at line 5063 of file common.c.

References COB_CONFIG_DIR, cob_load_config_file(), COB_MEDIUM_BUFF, COB_MEDIUM_MAX, cob_rescan_env_vals(), config_tbl::data_type, NULL, NUM_CONFIG, set_config_val(), SLASH_STR, STS_CNFSET, STS_ENVCLR, STS_ENVSET, varseq_dflt, and WITH_VARSEQ.

Referenced by cob_init().

5064 {
5065  char *env;
5066  char conf_file[COB_MEDIUM_BUFF];
5067  int isoptional = 1, sts, i, j;
5068 
5069 
5070  /* Get the name for the configuration file */
5071  if ((env = getenv ("COB_RUNTIME_CONFIG")) != NULL && env[0]) {
5072  strcpy (conf_file, env);
5073  isoptional = 0; /* If declared then it is NOT optional */
5074  } else {
5075  /* check for COB_CONFIG_DIR (use default if not in environment) */
5076  if ((env = getenv("COB_CONFIG_DIR")) != NULL && env[0]) {
5077  snprintf (conf_file, (size_t)COB_MEDIUM_MAX, "%s%s%s", env, SLASH_STR, "runtime.cfg");
5078  } else {
5079  snprintf (conf_file, (size_t)COB_MEDIUM_MAX, "%s%s%s", COB_CONFIG_DIR, SLASH_STR, "runtime.cfg");
5080  }
5081  isoptional = 1; /* If not present, then just use env vars */
5082  }
5083 
5084  sprintf (varseq_dflt, "%d", WITH_VARSEQ); /* Default comes from config.h */
5085  for (i=0; i < NUM_CONFIG; i++) {
5086  gc_conf[i].data_type &= ~(STS_ENVSET|STS_CNFSET|STS_ENVCLR); /* Clear status */
5087  }
5088 
5089  sts = cob_load_config_file (conf_file, isoptional);
5090 
5091  cob_rescan_env_vals(); /* Check for possible environment variables */
5092 
5093  /* Set with default value if present and not set otherwise */
5094  for (i=0; i < NUM_CONFIG; i++) {
5095  if (gc_conf[i].default_val
5096  && !(gc_conf[i].data_type & STS_CNFSET)
5097  && !(gc_conf[i].data_type & STS_ENVSET)) {
5098  for (j=0; j < NUM_CONFIG; j++) { /* Any alias present? */
5099  if(j != i
5100  && gc_conf[i].data_loc == gc_conf[j].data_loc)
5101  break;
5102  }
5103  if(j < NUM_CONFIG) {
5104  if(!(gc_conf[j].data_type & STS_CNFSET)
5105  && !(gc_conf[j].data_type & STS_ENVSET)) { /* alias not defined? */
5106  set_config_val((char*)gc_conf[i].default_val,i);
5107  }
5108  } else {
5109  set_config_val((char*)gc_conf[i].default_val,i); /* Set default value */
5110  }
5111  }
5112  }
5113 
5114  return sts;
5115 }
SLASH_STR
#define SLASH_STR
Definition: common.h:506
WITH_VARSEQ
#define WITH_VARSEQ
Definition: config.h:370
COB_MEDIUM_BUFF
#define COB_MEDIUM_BUFF
Definition: common.h:543
config_tbl::data_type
int data_type
Definition: coblocal.h:281
gc_conf
static struct config_tbl gc_conf[]
Definition: common.c:235
cob_rescan_env_vals
static void cob_rescan_env_vals(void)
Definition: common.c:1099
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
varseq_dflt
static char varseq_dflt[8]
Definition: common.c:225
STS_ENVCLR
#define STS_ENVCLR
Definition: coblocal.h:302
set_config_val
static int set_config_val(char *value, int pos)
Definition: common.c:4503
STS_ENVSET
#define STS_ENVSET
Definition: coblocal.h:300
STS_CNFSET
#define STS_CNFSET
Definition: coblocal.h:301
cob_load_config_file
static int cob_load_config_file(const char *config_file, int isoptional)
Definition: common.c:4944
COB_CONFIG_DIR
#define COB_CONFIG_DIR
Definition: defaults.h:6
NUM_CONFIG
#define NUM_CONFIG
Definition: common.c:283
COB_MEDIUM_MAX
#define COB_MEDIUM_MAX
Definition: common.h:549

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_longjmp ( struct cobjmp_buf *  )

Definition at line 1186 of file call.c.

References _, cobjmp_buf::cbj_jmp_buf, cob_fatal_error(), COB_FERROR_INITIALIZED, cob_runtime_error(), cob_stop_run(), and unlikely.

1187 {
1188  if (unlikely(!cobglobptr)) {
1189  cob_fatal_error (COB_FERROR_INITIALIZED);
1190  }
1191  if (unlikely(!jbuf)) {
1192  cob_runtime_error (_("NULL parameter passed to '%s'"), "cob_longjmp");
1193  cob_stop_run (1);
1194  }
1195  if (!cob_jmp_primed) {
1196  cob_runtime_error (_("Call to 'cob_longjmp' with no prior 'cob_setjmp'"));
1197  cob_stop_run (1);
1198  }
1199  cob_jmp_primed = 0;
1200  longjmp (jbuf->cbj_jmp_buf, 1);
1201 }
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
cob_runtime_error
void cob_runtime_error(const char *,...) COB_A_FORMAT12
Definition: common.c:1543
_
#define _(s)
Definition: cobcrun.c:59
unlikely
#define unlikely(x)
Definition: common.h:437
cobglobptr
static cob_global * cobglobptr
Definition: call.c:161
COB_FERROR_INITIALIZED
#define COB_FERROR_INITIALIZED
Definition: common.h:692
cob_jmp_primed
static unsigned int cob_jmp_primed
Definition: call.c:177
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

void* cob_malloc ( const size_t  )

Definition at line 1250 of file common.c.

References cob_fatal_error(), COB_FERROR_MEMORY, and unlikely.

Referenced by alloc_figurative(), cache_dynload(), cache_preload(), cb_config_entry(), cb_list_intrinsics(), cb_load_conf_file(), cob_accept_command_line(), cob_allocate(), cob_cache_file(), cob_cache_malloc(), cob_cache_realloc(), cob_call(), cob_decimal_get_field(), cob_decimal_push(), cob_display_command_line(), cob_display_env_value(), cob_display_environment(), cob_expand_env_string(), cob_external_addr(), cob_fatal_error(), cob_file_sort_giving(), cob_file_sort_init(), cob_get_environment(), cob_init(), cob_init_call(), cob_init_fileio(), cob_init_intrinsic(), cob_init_numeric(), cob_init_strings(), cob_intr_concatenate(), cob_intr_exception_location(), cob_intr_locale_compare(), cob_intr_median(), cob_intr_numval_f(), cob_load_config_file(), cob_move_all(), cob_move_edited_to_display(), cob_rescan_env_vals(), cob_resolve_internal(), cob_save_func(), cob_set_library_path(), cob_set_locale(), cob_srttmpfile(), cob_str_from_fld(), cob_strdup(), cob_sys_error_proc(), cob_sys_exit_proc(), cob_sys_getopt_long_long(), cob_sys_system(), cob_table_sort_init(), cob_unstring_init(), format_field(), indexed_open(), indexed_write(), indirect_move(), insert(), make_field_entry(), numval(), screen_accept(), and substitute().

1251 {
1252  void *mptr;
1253 
1254  mptr = calloc ((size_t)1, size);
1255  if (unlikely(!mptr)) {
1256  cob_fatal_error (COB_FERROR_MEMORY);
1257  }
1258  return mptr;
1259 }
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
unlikely
#define unlikely(x)
Definition: common.h:437
COB_FERROR_MEMORY
#define COB_FERROR_MEMORY
Definition: common.h:697

Here is the call graph for this function:

void cob_module_enter ( cob_module **  ,
cob_global **  ,
const int   
)

Definition at line 1796 of file common.c.

References cob_cache_malloc(), __cob_global::cob_call_params, cob_fatal_error(), COB_FERROR_INITIALIZED, cob_init(), cob_initialized, COB_MODULE_PTR, cobglobptr, module, NULL, and unlikely.

Referenced by CHECKSRC_(), cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

1798 {
1799  /* Check initialized */
1800  if (unlikely(!cob_initialized)) {
1801  if (auto_init) {
1802  cob_init (0, NULL);
1803  } else {
1804  cob_fatal_error (COB_FERROR_INITIALIZED);
1805  }
1806  }
1807 
1808  /* Set global pointer */
1809  *mglobal = cobglobptr;
1810 
1811  /* Check module pointer */
1812  if (!*module) {
1813  *module = cob_cache_malloc (sizeof(cob_module));
1814  }
1815 
1816 #if 0 /* RXWRXW - Params */
1817  /* Save parameter count */
1818  (*module)->module_num_params = cobglobptr->cob_call_params;
1819 #endif
1820 
1821  /* Push module pointer */
1822  (*module)->next = COB_MODULE_PTR;
1823  COB_MODULE_PTR = *module;
1824 }
module
static cob_module * module
Definition: cobxref.c.l.h:14
__cob_module
Definition: common.h:1046
__cob_global::cob_call_params
int cob_call_params
Definition: common.h:1204
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
unlikely
#define unlikely(x)
Definition: common.h:437
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_init
void cob_init(const int argc, char **argv)
Definition: common.c:5390
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_FERROR_INITIALIZED
#define COB_FERROR_INITIALIZED
Definition: common.h:692
cob_initialized
static int cob_initialized
Definition: common.c:124
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130
cob_cache_malloc
void * cob_cache_malloc(const size_t size)
Definition: common.c:1321

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_module_leave ( cob_module *  )

Definition at line 1827 of file common.c.

References COB_MODULE_PTR, and COB_UNUSED.

Referenced by CHECKSRC_(), cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

1828 {
1829  COB_UNUSED (module);
1830  /* Pop module pointer */
1831  COB_MODULE_PTR = COB_MODULE_PTR->next;
1832 }
module
static cob_module * module
Definition: cobxref.c.l.h:14
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the caller graph for this function:

void cob_move ( cob_field *  ,
cob_field *   
)

Definition at line 1170 of file move.c.

References cob_field::attr, cob_decimal_move_temp(), cob_decimal_setget_fld(), COB_FIELD_BINARY_TRUNC, COB_FIELD_DIGITS, COB_FIELD_REAL_BINARY, COB_FIELD_SCALE, COB_FIELD_TYPE, COB_MAX_DIGITS, cob_max_int(), cob_move_all(), cob_move_alphanum_to_alphanum(), cob_move_alphanum_to_display(), cob_move_alphanum_to_edited(), cob_move_binary_to_binary(), cob_move_binary_to_display(), cob_move_display_to_alphanum(), cob_move_display_to_binary(), cob_move_display_to_display(), cob_move_display_to_edited(), cob_move_display_to_packed(), cob_move_edited_to_display(), cob_move_fp_to_fp(), cob_move_packed_to_display(), COB_STORE_TRUNC_ON_OVERFLOW, COB_TYPE_ALPHANUMERIC_ALL, COB_TYPE_ALPHANUMERIC_EDITED, COB_TYPE_GROUP, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_DOUBLE, COB_TYPE_NUMERIC_EDITED, COB_TYPE_NUMERIC_FLOAT, COB_TYPE_NUMERIC_FP_BIN128, COB_TYPE_NUMERIC_FP_BIN32, COB_TYPE_NUMERIC_FP_BIN64, COB_TYPE_NUMERIC_FP_DEC128, COB_TYPE_NUMERIC_FP_DEC64, COB_TYPE_NUMERIC_L_DOUBLE, COB_TYPE_NUMERIC_PACKED, const_alpha_attr, cob_field::data, indirect_move(), cob_field::size, and unlikely.

Referenced by CHECKSRC_(), cob_accept(), cob_accept_arg_number(), cob_allocate(), cob_cmp(), cob_decimal_get_field(), cob_decimal_move_temp(), cob_display_arg_number(), cob_get_indirect_field(), cob_get_int(), cob_get_llint(), cob_memcpy(), cob_move_all(), cob_set_int(), cob_str_memcpy(), cobxref_(), display_numeric(), field_accept(), format_field(), GCic_(), get__reserved__lists_(), indirect_move(), LISTING_(), and pretty_display_numeric().

1171 {
1172  int opt;
1173  cob_field temp;
1174  unsigned char data[4];
1175 
1176  if (src == dst) {
1177  return;
1178  }
1179  if (dst->size == 0) {
1180  return;
1181  }
1182  if (unlikely(src->size == 0)) {
1183  temp.size = 1;
1184  temp.data = data;
1185  temp.attr = &const_alpha_attr;
1186  data[0] = ' ';
1187  data[1] = 0;
1188  src = &temp;
1189  }
1190  if (COB_FIELD_TYPE (src) == COB_TYPE_ALPHANUMERIC_ALL) {
1191  cob_move_all (src, dst);
1192  return;
1193  }
1194 
1195  /* Non-elementary move */
1196  if (COB_FIELD_TYPE (src) == COB_TYPE_GROUP ||
1197  COB_FIELD_TYPE (dst) == COB_TYPE_GROUP) {
1198  cob_move_alphanum_to_alphanum (src, dst);
1199  return;
1200  }
1201 
1202  opt = 0;
1203  if (COB_FIELD_TYPE (dst) == COB_TYPE_NUMERIC_BINARY) {
1204  if (COB_FIELD_BINARY_TRUNC (dst) &&
1205  !COB_FIELD_REAL_BINARY(dst)) {
1206  opt = COB_STORE_TRUNC_ON_OVERFLOW;
1207  }
1208  }
1209 
1210  /* Elementary move */
1211  switch (COB_FIELD_TYPE (src)) {
1212  case COB_TYPE_NUMERIC_DISPLAY:
1213  switch (COB_FIELD_TYPE (dst)) {
1214  case COB_TYPE_NUMERIC_FLOAT:
1215  case COB_TYPE_NUMERIC_DOUBLE:
1216  case COB_TYPE_NUMERIC_L_DOUBLE:
1217  case COB_TYPE_NUMERIC_FP_BIN32:
1218  case COB_TYPE_NUMERIC_FP_BIN64:
1219  case COB_TYPE_NUMERIC_FP_BIN128:
1220  case COB_TYPE_NUMERIC_FP_DEC64:
1221  case COB_TYPE_NUMERIC_FP_DEC128:
1222  cob_decimal_setget_fld (src, dst, 0);
1223  return;
1224  case COB_TYPE_NUMERIC_DISPLAY:
1225  cob_move_display_to_display (src, dst);
1226  return;
1227  case COB_TYPE_NUMERIC_PACKED:
1228  cob_move_display_to_packed (src, dst);
1229  return;
1230  case COB_TYPE_NUMERIC_BINARY:
1231  cob_move_display_to_binary (src, dst);
1232  return;
1233  case COB_TYPE_NUMERIC_EDITED:
1234  cob_move_display_to_edited (src, dst);
1235  return;
1236  case COB_TYPE_ALPHANUMERIC_EDITED:
1237  if (COB_FIELD_SCALE(src) < 0 ||
1238  COB_FIELD_SCALE(src) > COB_FIELD_DIGITS(src)) {
1239  /* Expand P's */
1240  indirect_move (cob_move_display_to_display, src, dst,
1241  (size_t)cob_max_int ((int)COB_FIELD_DIGITS(src), (int)COB_FIELD_SCALE(src)),
1242  cob_max_int (0, (int)COB_FIELD_SCALE(src)));
1243  return;
1244  } else {
1245  cob_move_alphanum_to_edited (src, dst);
1246  return;
1247  }
1248  default:
1249  cob_move_display_to_alphanum (src, dst);
1250  return;
1251  }
1252 
1253  case COB_TYPE_NUMERIC_PACKED:
1254  switch (COB_FIELD_TYPE (dst)) {
1255  case COB_TYPE_NUMERIC_DISPLAY:
1256  cob_move_packed_to_display (src, dst);
1257  return;
1258  case COB_TYPE_NUMERIC_BINARY:
1259  cob_decimal_setget_fld (src, dst, opt);
1260  return;
1261  case COB_TYPE_NUMERIC_PACKED:
1262  case COB_TYPE_NUMERIC_DOUBLE:
1263  case COB_TYPE_NUMERIC_FLOAT:
1264  case COB_TYPE_NUMERIC_L_DOUBLE:
1265  case COB_TYPE_NUMERIC_FP_BIN32:
1266  case COB_TYPE_NUMERIC_FP_BIN64:
1267  case COB_TYPE_NUMERIC_FP_BIN128:
1268  case COB_TYPE_NUMERIC_FP_DEC64:
1269  case COB_TYPE_NUMERIC_FP_DEC128:
1270  cob_decimal_setget_fld (src, dst, 0);
1271  return;
1272  default:
1273  indirect_move (cob_move_packed_to_display, src, dst,
1274  (size_t)(COB_FIELD_DIGITS(src)),
1275  COB_FIELD_SCALE(src));
1276  return;
1277  }
1278 
1279  case COB_TYPE_NUMERIC_BINARY:
1280  switch (COB_FIELD_TYPE (dst)) {
1281  case COB_TYPE_NUMERIC_BINARY:
1282  if (COB_FIELD_SCALE(src) == COB_FIELD_SCALE(dst)) {
1283  cob_move_binary_to_binary (src, dst);
1284  return;
1285  }
1286  cob_decimal_setget_fld (src, dst, opt);
1287  return;
1288  case COB_TYPE_NUMERIC_DISPLAY:
1289  cob_move_binary_to_display (src, dst);
1290  return;
1291  case COB_TYPE_NUMERIC_PACKED:
1292  case COB_TYPE_NUMERIC_DOUBLE:
1293  case COB_TYPE_NUMERIC_FLOAT:
1294  case COB_TYPE_NUMERIC_L_DOUBLE:
1295  case COB_TYPE_NUMERIC_FP_BIN32:
1296  case COB_TYPE_NUMERIC_FP_BIN64:
1297  case COB_TYPE_NUMERIC_FP_BIN128:
1298  case COB_TYPE_NUMERIC_FP_DEC64:
1299  case COB_TYPE_NUMERIC_FP_DEC128:
1300  cob_decimal_setget_fld (src, dst, 0);
1301  return;
1302  case COB_TYPE_NUMERIC_EDITED:
1303  indirect_move (cob_move_binary_to_display, src, dst,
1304  (size_t)COB_MAX_DIGITS,
1305  COB_FIELD_SCALE(src));
1306  return;
1307  default:
1308  indirect_move (cob_move_binary_to_display, src, dst,
1309  (size_t)(COB_FIELD_DIGITS(src)),
1310  COB_FIELD_SCALE(src));
1311  return;
1312  }
1313 
1314  case COB_TYPE_NUMERIC_EDITED:
1315  switch (COB_FIELD_TYPE (dst)) {
1316  case COB_TYPE_NUMERIC_DISPLAY:
1317  cob_move_edited_to_display (src, dst);
1318  return;
1319  case COB_TYPE_NUMERIC_PACKED:
1320  case COB_TYPE_NUMERIC_BINARY:
1321  case COB_TYPE_NUMERIC_EDITED:
1322  case COB_TYPE_NUMERIC_FLOAT:
1323  case COB_TYPE_NUMERIC_DOUBLE:
1324  case COB_TYPE_NUMERIC_L_DOUBLE:
1325  case COB_TYPE_NUMERIC_FP_BIN32:
1326  case COB_TYPE_NUMERIC_FP_BIN64:
1327  case COB_TYPE_NUMERIC_FP_BIN128:
1328  case COB_TYPE_NUMERIC_FP_DEC64:
1329  case COB_TYPE_NUMERIC_FP_DEC128:
1330  indirect_move (cob_move_edited_to_display, src, dst,
1331  (size_t)(2 * COB_MAX_DIGITS),
1332  COB_MAX_DIGITS);
1333  return;
1334  case COB_TYPE_ALPHANUMERIC_EDITED:
1335  cob_move_alphanum_to_edited (src, dst);
1336  return;
1337  default:
1338  cob_move_alphanum_to_alphanum (src, dst);
1339  return;
1340  }
1341 
1342  case COB_TYPE_NUMERIC_DOUBLE:
1343  switch (COB_FIELD_TYPE (dst)) {
1344  case COB_TYPE_NUMERIC_DOUBLE:
1345  memmove (dst->data, src->data, sizeof(double));
1346  return;
1347  case COB_TYPE_NUMERIC_FLOAT:
1348  cob_move_fp_to_fp (src, dst);
1349  return;
1350  case COB_TYPE_NUMERIC_BINARY:
1351  cob_decimal_setget_fld (src, dst, opt);
1352  return;
1353  case COB_TYPE_NUMERIC_PACKED:
1354  case COB_TYPE_NUMERIC_DISPLAY:
1355  case COB_TYPE_NUMERIC_L_DOUBLE:
1356  case COB_TYPE_NUMERIC_FP_BIN32:
1357  case COB_TYPE_NUMERIC_FP_BIN64:
1358  case COB_TYPE_NUMERIC_FP_BIN128:
1359  case COB_TYPE_NUMERIC_FP_DEC64:
1360  case COB_TYPE_NUMERIC_FP_DEC128:
1361  cob_decimal_setget_fld (src, dst, 0);
1362  return;
1363  default:
1364  cob_decimal_move_temp (src, dst);
1365  return;
1366  }
1367 
1368  case COB_TYPE_NUMERIC_FLOAT:
1369  switch (COB_FIELD_TYPE (dst)) {
1370  case COB_TYPE_NUMERIC_FLOAT:
1371  memmove (dst->data, src->data, sizeof(float));
1372  return;
1373  case COB_TYPE_NUMERIC_DOUBLE:
1374  cob_move_fp_to_fp (src, dst);
1375  return;
1376  case COB_TYPE_NUMERIC_BINARY:
1377  cob_decimal_setget_fld (src, dst, opt);
1378  return;
1379  case COB_TYPE_NUMERIC_PACKED:
1380  case COB_TYPE_NUMERIC_DISPLAY:
1381  case COB_TYPE_NUMERIC_L_DOUBLE:
1382  case COB_TYPE_NUMERIC_FP_BIN32:
1383  case COB_TYPE_NUMERIC_FP_BIN64:
1384  case COB_TYPE_NUMERIC_FP_BIN128:
1385  case COB_TYPE_NUMERIC_FP_DEC64:
1386  case COB_TYPE_NUMERIC_FP_DEC128:
1387  cob_decimal_setget_fld (src, dst, 0);
1388  return;
1389  default:
1390  cob_decimal_move_temp (src, dst);
1391  return;
1392  }
1393 
1394  case COB_TYPE_NUMERIC_FP_DEC64:
1395  switch (COB_FIELD_TYPE (dst)) {
1396  case COB_TYPE_NUMERIC_BINARY:
1397  cob_decimal_setget_fld (src, dst, opt);
1398  return;
1399  case COB_TYPE_NUMERIC_FP_DEC64:
1400  memmove (dst->data, src->data, (size_t)8);
1401  return;
1402  case COB_TYPE_NUMERIC_FLOAT:
1403  case COB_TYPE_NUMERIC_DOUBLE:
1404  case COB_TYPE_NUMERIC_PACKED:
1405  case COB_TYPE_NUMERIC_DISPLAY:
1406  case COB_TYPE_NUMERIC_L_DOUBLE:
1407  case COB_TYPE_NUMERIC_FP_BIN32:
1408  case COB_TYPE_NUMERIC_FP_BIN128:
1409  case COB_TYPE_NUMERIC_FP_DEC128:
1410  cob_decimal_setget_fld (src, dst, 0);
1411  return;
1412  default:
1413  cob_decimal_move_temp (src, dst);
1414  return;
1415  }
1416  case COB_TYPE_NUMERIC_FP_DEC128:
1417  switch (COB_FIELD_TYPE (dst)) {
1418  case COB_TYPE_NUMERIC_BINARY:
1419  cob_decimal_setget_fld (src, dst, opt);
1420  return;
1421  case COB_TYPE_NUMERIC_FP_DEC128:
1422  memmove (dst->data, src->data, (size_t)16);
1423  return;
1424  case COB_TYPE_NUMERIC_FLOAT:
1425  case COB_TYPE_NUMERIC_DOUBLE:
1426  case COB_TYPE_NUMERIC_PACKED:
1427  case COB_TYPE_NUMERIC_DISPLAY:
1428  case COB_TYPE_NUMERIC_L_DOUBLE:
1429  case COB_TYPE_NUMERIC_FP_BIN32:
1430  case COB_TYPE_NUMERIC_FP_BIN64:
1431  case COB_TYPE_NUMERIC_FP_BIN128:
1432  case COB_TYPE_NUMERIC_FP_DEC64:
1433  cob_decimal_setget_fld (src, dst, 0);
1434  return;
1435  default:
1436  cob_decimal_move_temp (src, dst);
1437  return;
1438  }
1439  default:
1440  switch (COB_FIELD_TYPE (dst)) {
1441  case COB_TYPE_NUMERIC_DISPLAY:
1442  cob_move_alphanum_to_display (src, dst);
1443  return;
1444  case COB_TYPE_NUMERIC_PACKED:
1445  case COB_TYPE_NUMERIC_BINARY:
1446  case COB_TYPE_NUMERIC_EDITED:
1447  case COB_TYPE_NUMERIC_FLOAT:
1448  case COB_TYPE_NUMERIC_DOUBLE:
1449  case COB_TYPE_NUMERIC_L_DOUBLE:
1450  case COB_TYPE_NUMERIC_FP_BIN32:
1451  case COB_TYPE_NUMERIC_FP_BIN64:
1452  case COB_TYPE_NUMERIC_FP_BIN128:
1453  case COB_TYPE_NUMERIC_FP_DEC64:
1454  case COB_TYPE_NUMERIC_FP_DEC128:
1455  indirect_move (cob_move_alphanum_to_display, src, dst,
1456  (size_t)(2* COB_MAX_DIGITS),
1457  COB_MAX_DIGITS);
1458  return;
1459  case COB_TYPE_ALPHANUMERIC_EDITED:
1460  cob_move_alphanum_to_edited (src, dst);
1461  return;
1462  default:
1463  cob_move_alphanum_to_alphanum (src, dst);
1464  return;
1465  }
1466  }
1467 }
COB_FIELD_SCALE
#define COB_FIELD_SCALE(f)
Definition: common.h:664
cob_move_edited_to_display
static void cob_move_edited_to_display(cob_field *f1, cob_field *f2)
Definition: move.c:984
COB_TYPE_NUMERIC_PACKED
#define COB_TYPE_NUMERIC_PACKED
Definition: common.h:609
cob_move_alphanum_to_display
static void cob_move_alphanum_to_display(cob_field *f1, cob_field *f2)
Definition: move.c:259
cob_move_display_to_packed
static void cob_move_display_to_packed(cob_field *f1, cob_field *f2)
Definition: move.c:451
cob_move_alphanum_to_edited
static void cob_move_alphanum_to_edited(cob_field *f1, cob_field *f2)
Definition: move.c:1065
cob_move_binary_to_display
static void cob_move_binary_to_display(cob_field *f1, cob_field *f2)
Definition: move.c:637
COB_TYPE_NUMERIC_FP_BIN32
#define COB_TYPE_NUMERIC_FP_BIN32
Definition: common.h:615
COB_FIELD_TYPE
#define COB_FIELD_TYPE(f)
Definition: common.h:662
cob_move_display_to_binary
static void cob_move_display_to_binary(cob_field *f1, cob_field *f2)
Definition: move.c:593
cob_move_packed_to_display
static void cob_move_packed_to_display(cob_field *f1, cob_field *f2)
Definition: move.c:506
COB_TYPE_GROUP
#define COB_TYPE_GROUP
Definition: common.h:603
cob_field
Definition: common.h:950
cob_max_int
static COB_INLINE int cob_max_int(const int x, const int y)
Definition: move.c:102
cob_move_alphanum_to_alphanum
static void cob_move_alphanum_to_alphanum(cob_field *f1, cob_field *f2)
Definition: move.c:418
cob_field::data
unsigned char * data
Definition: common.h:952
indirect_move
static void indirect_move(void(*func)(cob_field *src, cob_field *dst), cob_field *src, cob_field *dst, const size_t size, const int scale)
Definition: move.c:1108
cob_move_display_to_display
static void cob_move_display_to_display(cob_field *f1, cob_field *f2)
Definition: move.c:342
COB_TYPE_NUMERIC_FP_BIN64
#define COB_TYPE_NUMERIC_FP_BIN64
Definition: common.h:616
COB_MAX_DIGITS
#define COB_MAX_DIGITS
Definition: common.h:562
cob_move_display_to_alphanum
static void cob_move_display_to_alphanum(cob_field *f1, cob_field *f2)
Definition: move.c:355
COB_TYPE_NUMERIC_FP_DEC64
#define COB_TYPE_NUMERIC_FP_DEC64
Definition: common.h:613
COB_TYPE_NUMERIC_FLOAT
#define COB_TYPE_NUMERIC_FLOAT
Definition: common.h:610
COB_FIELD_REAL_BINARY
#define COB_FIELD_REAL_BINARY(f)
Definition: common.h:649
unlikely
#define unlikely(x)
Definition: common.h:437
cob_move_all
static void cob_move_all(cob_field *src, cob_field *dst)
Definition: move.c:1126
COB_FIELD_BINARY_TRUNC
#define COB_FIELD_BINARY_TRUNC(f)
Definition: common.h:654
COB_TYPE_NUMERIC_BINARY
#define COB_TYPE_NUMERIC_BINARY
Definition: common.h:608
COB_TYPE_ALPHANUMERIC_EDITED
#define COB_TYPE_ALPHANUMERIC_EDITED
Definition: common.h:623
COB_TYPE_NUMERIC_DISPLAY
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
COB_TYPE_NUMERIC_FP_BIN128
#define COB_TYPE_NUMERIC_FP_BIN128
Definition: common.h:617
COB_TYPE_ALPHANUMERIC_ALL
#define COB_TYPE_ALPHANUMERIC_ALL
Definition: common.h:622
cob_move_display_to_edited
static void cob_move_display_to_edited(cob_field *f1, cob_field *f2)
Definition: move.c:676
cob_move_fp_to_fp
static void cob_move_fp_to_fp(cob_field *src, cob_field *dst)
Definition: move.c:541
cob_decimal_setget_fld
void cob_decimal_setget_fld(cob_field *, cob_field *, const int)
Definition: numeric.c:2007
cob_field::size
size_t size
Definition: common.h:951
COB_TYPE_NUMERIC_DOUBLE
#define COB_TYPE_NUMERIC_DOUBLE
Definition: common.h:611
cob_field::attr
const cob_field_attr * attr
Definition: common.h:953
COB_STORE_TRUNC_ON_OVERFLOW
#define COB_STORE_TRUNC_ON_OVERFLOW
Definition: common.h:869
COB_TYPE_NUMERIC_FP_DEC128
#define COB_TYPE_NUMERIC_FP_DEC128
Definition: common.h:614
cob_decimal_move_temp
void cob_decimal_move_temp(cob_field *, cob_field *)
Definition: intrinsic.c:3104
COB_FIELD_DIGITS
#define COB_FIELD_DIGITS(f)
Definition: common.h:663
COB_TYPE_NUMERIC_EDITED
#define COB_TYPE_NUMERIC_EDITED
Definition: common.h:619
COB_TYPE_NUMERIC_L_DOUBLE
#define COB_TYPE_NUMERIC_L_DOUBLE
Definition: common.h:612
cob_move_binary_to_binary
static void cob_move_binary_to_binary(cob_field *f1, cob_field *f2)
Definition: move.c:564
const_alpha_attr
static const cob_field_attr const_alpha_attr
Definition: move.c:51

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_mul ( cob_field *  ,
cob_field *  ,
const int   
)

Definition at line 1949 of file numeric.c.

References cob_decimal_get_field(), cob_decimal_mul(), and cob_decimal_set_field().

1950 {
1951  cob_decimal_set_field (&cob_d1, f1);
1952  cob_decimal_set_field (&cob_d2, f2);
1953  cob_decimal_mul (&cob_d1, &cob_d2);
1954  (void)cob_decimal_get_field (&cob_d1, f1, opt);
1955 }
cob_decimal_mul
void cob_decimal_mul(cob_decimal *d1, cob_decimal *d2)
Definition: numeric.c:1891
f2
cob_field f2
Definition: cobxref.c.l.h:55
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *d, cob_field *f)
Definition: numeric.c:1612
f1
cob_field f1
Definition: cobxref.c.l.h:54
cob_d2
static cob_decimal cob_d2
Definition: numeric.c:109
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *d, cob_field *f, const int opt)
Definition: numeric.c:1801
cob_d1
static cob_decimal cob_d1
Definition: numeric.c:108

Here is the call graph for this function:

int cob_numeric_cmp ( cob_field *  ,
cob_field *   
)

Definition at line 2348 of file numeric.c.

References cob_cmp_float(), cob_decimal_cmp(), cob_decimal_set_field(), COB_FIELD_TYPE, COB_TYPE_NUMERIC_DOUBLE, and COB_TYPE_NUMERIC_FLOAT.

Referenced by cob_cmp(), cob_file_sort_compare(), and sort_compare().

2349 {
2350  if(COB_FIELD_TYPE (f1) == COB_TYPE_NUMERIC_FLOAT
2351  || COB_FIELD_TYPE (f1) == COB_TYPE_NUMERIC_DOUBLE
2352  || COB_FIELD_TYPE (f2) == COB_TYPE_NUMERIC_FLOAT
2353  || COB_FIELD_TYPE (f2) == COB_TYPE_NUMERIC_DOUBLE) {
2354  return cob_cmp_float(f1,f2);
2355  }
2356  cob_decimal_set_field (&cob_d1, f1);
2357  cob_decimal_set_field (&cob_d2, f2);
2358  return cob_decimal_cmp (&cob_d1, &cob_d2);
2359 }
cob_cmp_float
int cob_cmp_float(cob_field *f1, cob_field *f2)
Definition: numeric.c:2315
COB_FIELD_TYPE
#define COB_FIELD_TYPE(f)
Definition: common.h:662
f2
cob_field f2
Definition: cobxref.c.l.h:55
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *d, cob_field *f)
Definition: numeric.c:1612
cob_decimal_cmp
int cob_decimal_cmp(cob_decimal *d1, cob_decimal *d2)
Definition: numeric.c:1922
COB_TYPE_NUMERIC_FLOAT
#define COB_TYPE_NUMERIC_FLOAT
Definition: common.h:610
f1
cob_field f1
Definition: cobxref.c.l.h:54
COB_TYPE_NUMERIC_DOUBLE
#define COB_TYPE_NUMERIC_DOUBLE
Definition: common.h:611
cob_d2
static cob_decimal cob_d2
Definition: numeric.c:109
cob_d1
static cob_decimal cob_d1
Definition: numeric.c:108

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_open ( cob_file *  ,
const int  ,
const int  ,
cob_field *   
)

Definition at line 4438 of file fileio.c.

References cob_file::assign, cob_cache_file(), cob_field_to_string(), COB_FILE_MAX, COB_FILE_STDIN, COB_FILE_STDOUT, COB_LOCK_OPEN_EXCLUSIVE, COB_OPEN_CLOSED, COB_OPEN_INPUT, COB_OPEN_LOCKED, COB_OPEN_OUTPUT, COB_STATUS_00_SUCCESS, COB_STATUS_30_PERMANENT_ERROR, COB_STATUS_38_CLOSED_WITH_LOCK, COB_STATUS_41_ALREADY_OPEN, cob_file::fd, cob_file::file, file_open_name, cob_file::flag_begin_of_file, cob_file::flag_end_of_file, cob_file::flag_first_read, cob_file::flag_nonexistent, cob_file::flag_operation, cob_file::flag_read_done, cob_file::last_open_mode, cob_file::lock_mode, cob_fileio_funcs::open, cob_file::open_mode, cob_file::organization, save_status(), and unlikely.

Referenced by cob_file_sort_giving(), cob_file_sort_using(), cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

4439 {
4440  f->flag_read_done = 0;
4441 
4442  /* File was previously closed with lock */
4443  if (f->open_mode == COB_OPEN_LOCKED) {
4444  save_status (f, fnstatus, COB_STATUS_38_CLOSED_WITH_LOCK);
4445  return;
4446  }
4447 
4448  /* File is already open */
4449  if (f->open_mode != COB_OPEN_CLOSED) {
4450  save_status (f, fnstatus, COB_STATUS_41_ALREADY_OPEN);
4451  return;
4452  }
4453 
4454  f->last_open_mode = mode;
4455  f->flag_nonexistent = 0;
4456  f->flag_end_of_file = 0;
4457  f->flag_begin_of_file = 0;
4458  f->flag_first_read = 2;
4459  f->flag_operation = 0;
4460  f->lock_mode &= ~COB_LOCK_OPEN_EXCLUSIVE;
4461  f->lock_mode |= sharing;
4462 
4463  if (unlikely(COB_FILE_STDIN (f))) {
4464  if (mode != COB_OPEN_INPUT) {
4465  save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR);
4466  return;
4467  }
4468  f->file = stdin;
4469  f->fd = fileno (stdin);
4470  f->open_mode = mode;
4471  save_status (f, fnstatus, COB_STATUS_00_SUCCESS);
4472  return;
4473  }
4474  if (unlikely(COB_FILE_STDOUT (f))) {
4475  if (mode != COB_OPEN_OUTPUT) {
4476  save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR);
4477  return;
4478  }
4479  f->file = stdout;
4480  f->fd = fileno (stdout);
4481  f->open_mode = mode;
4482  save_status (f, fnstatus, COB_STATUS_00_SUCCESS);
4483  return;
4484  }
4485 
4486  /* Obtain the file name */
4487  cob_field_to_string (f->assign, file_open_name, (size_t)COB_FILE_MAX);
4488 
4489  cob_cache_file (f);
4490 
4491  /* Open the file */
4492  save_status (f, fnstatus,
4493  fileio_funcs[(int)f->organization]->open (f, file_open_name,
4494  mode, sharing));
4495 }
COB_STATUS_41_ALREADY_OPEN
#define COB_STATUS_41_ALREADY_OPEN
Definition: common.h:846
COB_STATUS_00_SUCCESS
#define COB_STATUS_00_SUCCESS
Definition: common.h:828
COB_OPEN_CLOSED
#define COB_OPEN_CLOSED
Definition: common.h:783
file_open_name
static char * file_open_name
Definition: fileio.c:244
cob_field_to_string
void cob_field_to_string(const cob_field *, void *, const size_t)
Definition: common.c:1492
COB_OPEN_INPUT
#define COB_OPEN_INPUT
Definition: common.h:784
unlikely
#define unlikely(x)
Definition: common.h:437
COB_FILE_STDOUT
#define COB_FILE_STDOUT(x)
Definition: common.h:768
COB_STATUS_30_PERMANENT_ERROR
#define COB_STATUS_30_PERMANENT_ERROR
Definition: common.h:839
save_status
static void save_status(cob_file *f, cob_field *fnstatus, const int status)
Definition: fileio.c:668
COB_OPEN_LOCKED
#define COB_OPEN_LOCKED
Definition: common.h:788
COB_FILE_STDIN
#define COB_FILE_STDIN(x)
Definition: common.h:767
COB_STATUS_38_CLOSED_WITH_LOCK
#define COB_STATUS_38_CLOSED_WITH_LOCK
Definition: common.h:844
cob_cache_file
static void cob_cache_file(cob_file *f)
Definition: fileio.c:652
fileio_funcs
static const struct cob_fileio_funcs * fileio_funcs[COB_ORG_MAX]
Definition: fileio.c:339
COB_LOCK_OPEN_EXCLUSIVE
#define COB_LOCK_OPEN_EXCLUSIVE
Definition: common.h:777
COB_OPEN_OUTPUT
#define COB_OPEN_OUTPUT
Definition: common.h:785
COB_FILE_MAX
#define COB_FILE_MAX
Definition: common.h:548
cob_fileio_funcs::open
int(* open)(cob_file *, char *, const int, const int)
Definition: common.h:1224

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_put_indirect_field ( cob_field *  )

Definition at line 3088 of file intrinsic.c.

References curr_field, cob_field::data, make_field_entry(), and cob_field::size.

Referenced by cobxref_().

3089 {
3090  make_field_entry (f);
3091  memcpy (curr_field->data, f->data, f->size);
3092  move_field = curr_field;
3093 }
make_field_entry
static void make_field_entry(cob_field *f)
Definition: intrinsic.c:440
move_field
static cob_field * move_field
Definition: intrinsic.c:77
cob_field::data
unsigned char * data
Definition: common.h:952
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_putenv ( char *  )

Definition at line 3195 of file common.c.

References cob_rescan_env_vals(), and cob_strdup().

3196 {
3197  int ret;
3198 
3199  if (name && strchr (name, '=')) {
3200  ret = putenv (cob_strdup(name));
3201  if (!ret) {
3202  cob_rescan_env_vals ();
3203  }
3204  return ret;
3205  }
3206  return -1;
3207 }
cob_rescan_env_vals
static void cob_rescan_env_vals(void)
Definition: common.c:1099
cob_strdup
char * cob_strdup(const char *p)
Definition: common.c:1308

Here is the call graph for this function:

void cob_read ( cob_file *  ,
cob_field *  ,
cob_field *  ,
const int   
)

Definition at line 4633 of file fileio.c.

References COB_OPEN_I_O, COB_OPEN_INPUT, COB_READ_PREVIOUS, cob_set_int(), COB_STATUS_00_SUCCESS, COB_STATUS_02_SUCCESS_DUPLICATE, COB_STATUS_10_END_OF_FILE, COB_STATUS_23_KEY_NOT_EXISTS, COB_STATUS_46_READ_ERROR, COB_STATUS_47_INPUT_DENIED, cob_file::flag_begin_of_file, cob_file::flag_end_of_file, cob_file::flag_first_read, cob_file::flag_nonexistent, cob_file::flag_read_done, NULL, cob_file::open_mode, cob_file::organization, cob_fileio_funcs::read, cob_fileio_funcs::read_next, cob_file::record, save_status(), cob_field::size, unlikely, and cob_file::variable_record.

4634 {
4635  int ret;
4636 
4637  f->flag_read_done = 0;
4638 
4639  if (unlikely(f->open_mode != COB_OPEN_INPUT &&
4640  f->open_mode != COB_OPEN_I_O)) {
4641  save_status (f, fnstatus, COB_STATUS_47_INPUT_DENIED);
4642  return;
4643  }
4644 
4645  if (unlikely(f->flag_nonexistent)) {
4646  if (f->flag_first_read == 0) {
4647  save_status (f, fnstatus, COB_STATUS_23_KEY_NOT_EXISTS);
4648  return;
4649  }
4650  f->flag_first_read = 0;
4651  save_status (f, fnstatus, COB_STATUS_10_END_OF_FILE);
4652  return;
4653  }
4654 
4655  /* Sequential read at the end of file is an error */
4656  if (key == NULL) {
4657  if (unlikely(f->flag_end_of_file &&
4658  !(read_opts & COB_READ_PREVIOUS))) {
4659  save_status (f, fnstatus, COB_STATUS_46_READ_ERROR);
4660  return;
4661  }
4662  if (unlikely(f->flag_begin_of_file &&
4663  (read_opts & COB_READ_PREVIOUS))) {
4664  save_status (f, fnstatus, COB_STATUS_46_READ_ERROR);
4665  return;
4666  }
4667  ret = fileio_funcs[(int)f->organization]->read_next (f, read_opts);
4668  } else {
4669  ret = fileio_funcs[(int)f->organization]->read (f, key, read_opts);
4670  }
4671 
4672  switch (ret) {
4673  case COB_STATUS_00_SUCCESS:
4674  case COB_STATUS_02_SUCCESS_DUPLICATE:
4675  f->flag_first_read = 0;
4676  f->flag_read_done = 1;
4677  f->flag_end_of_file = 0;
4678  f->flag_begin_of_file = 0;
4679  if (f->variable_record) {
4680  cob_set_int (f->variable_record, (int) f->record->size);
4681  }
4682  break;
4683  case COB_STATUS_10_END_OF_FILE:
4684  if (read_opts & COB_READ_PREVIOUS) {
4685  f->flag_begin_of_file = 1;
4686  } else {
4687  f->flag_end_of_file = 1;
4688  }
4689  break;
4690  }
4691 
4692  save_status (f, fnstatus, ret);
4693 }
COB_STATUS_10_END_OF_FILE
#define COB_STATUS_10_END_OF_FILE
Definition: common.h:833
COB_STATUS_23_KEY_NOT_EXISTS
#define COB_STATUS_23_KEY_NOT_EXISTS
Definition: common.h:837
COB_STATUS_00_SUCCESS
#define COB_STATUS_00_SUCCESS
Definition: common.h:828
cob_fileio_funcs::read
int(* read)(cob_file *, cob_field *, const int)
Definition: common.h:1227
COB_READ_PREVIOUS
#define COB_READ_PREVIOUS
Definition: common.h:814
COB_STATUS_46_READ_ERROR
#define COB_STATUS_46_READ_ERROR
Definition: common.h:850
COB_OPEN_INPUT
#define COB_OPEN_INPUT
Definition: common.h:784
unlikely
#define unlikely(x)
Definition: common.h:437
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
save_status
static void save_status(cob_file *f, cob_field *fnstatus, const int status)
Definition: fileio.c:668
cob_set_int
void cob_set_int(cob_field *, const int)
Definition: move.c:1612
COB_OPEN_I_O
#define COB_OPEN_I_O
Definition: common.h:786
cob_fileio_funcs::read_next
int(* read_next)(cob_file *, const int)
Definition: common.h:1228
fileio_funcs
static const struct cob_fileio_funcs * fileio_funcs[COB_ORG_MAX]
Definition: fileio.c:339
COB_STATUS_47_INPUT_DENIED
#define COB_STATUS_47_INPUT_DENIED
Definition: common.h:851
COB_STATUS_02_SUCCESS_DUPLICATE
#define COB_STATUS_02_SUCCESS_DUPLICATE
Definition: common.h:829

Here is the call graph for this function:

void cob_read_next ( cob_file *  ,
cob_field *  ,
const int   
)

Definition at line 4696 of file fileio.c.

References COB_OPEN_I_O, COB_OPEN_INPUT, COB_READ_PREVIOUS, cob_set_int(), COB_STATUS_00_SUCCESS, COB_STATUS_02_SUCCESS_DUPLICATE, COB_STATUS_10_END_OF_FILE, COB_STATUS_23_KEY_NOT_EXISTS, COB_STATUS_46_READ_ERROR, COB_STATUS_47_INPUT_DENIED, cob_file::flag_begin_of_file, cob_file::flag_end_of_file, cob_file::flag_first_read, cob_file::flag_nonexistent, cob_file::flag_read_done, cob_file::open_mode, cob_file::organization, cob_fileio_funcs::read_next, cob_file::record, save_status(), cob_field::size, unlikely, and cob_file::variable_record.

Referenced by cob_file_sort_using(), cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

4697 {
4698  int ret;
4699 
4700  f->flag_read_done = 0;
4701 
4702  if (unlikely(f->open_mode != COB_OPEN_INPUT &&
4703  f->open_mode != COB_OPEN_I_O)) {
4704  save_status (f, fnstatus, COB_STATUS_47_INPUT_DENIED);
4705  return;
4706  }
4707 
4708  if (unlikely(f->flag_nonexistent)) {
4709  if (f->flag_first_read == 0) {
4710  save_status (f, fnstatus, COB_STATUS_23_KEY_NOT_EXISTS);
4711  return;
4712  }
4713  f->flag_first_read = 0;
4714  save_status (f, fnstatus, COB_STATUS_10_END_OF_FILE);
4715  return;
4716  }
4717 
4718  /* Sequential read at the end of file is an error */
4719  if (unlikely(f->flag_end_of_file && !(read_opts & COB_READ_PREVIOUS))) {
4720  save_status (f, fnstatus, COB_STATUS_46_READ_ERROR);
4721  return;
4722  }
4723  if (unlikely(f->flag_begin_of_file && (read_opts & COB_READ_PREVIOUS))) {
4724  save_status (f, fnstatus, COB_STATUS_46_READ_ERROR);
4725  return;
4726  }
4727 
4728  ret = fileio_funcs[(int)f->organization]->read_next (f, read_opts);
4729 
4730  switch (ret) {
4731  case COB_STATUS_00_SUCCESS:
4732  case COB_STATUS_02_SUCCESS_DUPLICATE:
4733  f->flag_first_read = 0;
4734  f->flag_read_done = 1;
4735  f->flag_end_of_file = 0;
4736  f->flag_begin_of_file = 0;
4737  if (f->variable_record) {
4738  cob_set_int (f->variable_record, (int) f->record->size);
4739  }
4740  break;
4741  case COB_STATUS_10_END_OF_FILE:
4742  if (read_opts & COB_READ_PREVIOUS) {
4743  f->flag_begin_of_file = 1;
4744  } else {
4745  f->flag_end_of_file = 1;
4746  }
4747  break;
4748  }
4749 
4750  save_status (f, fnstatus, ret);
4751 }
COB_STATUS_10_END_OF_FILE
#define COB_STATUS_10_END_OF_FILE
Definition: common.h:833
COB_STATUS_23_KEY_NOT_EXISTS
#define COB_STATUS_23_KEY_NOT_EXISTS
Definition: common.h:837
COB_STATUS_00_SUCCESS
#define COB_STATUS_00_SUCCESS
Definition: common.h:828
COB_READ_PREVIOUS
#define COB_READ_PREVIOUS
Definition: common.h:814
COB_STATUS_46_READ_ERROR
#define COB_STATUS_46_READ_ERROR
Definition: common.h:850
COB_OPEN_INPUT
#define COB_OPEN_INPUT
Definition: common.h:784
unlikely
#define unlikely(x)
Definition: common.h:437
save_status
static void save_status(cob_file *f, cob_field *fnstatus, const int status)
Definition: fileio.c:668
cob_set_int
void cob_set_int(cob_field *, const int)
Definition: move.c:1612
COB_OPEN_I_O
#define COB_OPEN_I_O
Definition: common.h:786
cob_fileio_funcs::read_next
int(* read_next)(cob_file *, const int)
Definition: common.h:1228
fileio_funcs
static const struct cob_fileio_funcs * fileio_funcs[COB_ORG_MAX]
Definition: fileio.c:339
COB_STATUS_47_INPUT_DENIED
#define COB_STATUS_47_INPUT_DENIED
Definition: common.h:851
COB_STATUS_02_SUCCESS_DUPLICATE
#define COB_STATUS_02_SUCCESS_DUPLICATE
Definition: common.h:829

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_ready_trace ( void  )

Definition at line 1462 of file common.c.

References __cob_settings::cob_line_trace.

1463 {
1464  cobsetptr->cob_line_trace = 1;
1465 }
cobsetptr
static cob_settings * cobsetptr
Definition: common.c:131
__cob_settings::cob_line_trace
unsigned int cob_line_trace
Definition: coblocal.h:206
void* cob_realloc ( void *  ,
const size_t  ,
const size_t   
)

Definition at line 1262 of file common.c.

References cob_fatal_error(), COB_FERROR_FREE, COB_FERROR_MEMORY, cob_free(), and unlikely.

Referenced by cob_expand_env_string(), and cob_load_config_file().

1263 {
1264  void *mptr;
1265 
1266  if (unlikely(!optr)) {
1267  cob_fatal_error (COB_FERROR_FREE);
1268  }
1269 
1270  if (unlikely(osize <= nsize)) {
1271  return realloc (optr, nsize);
1272  }
1273 
1274  mptr = calloc ((size_t)1, nsize);
1275  if (unlikely(!mptr)) {
1276  cob_fatal_error (COB_FERROR_MEMORY);
1277  }
1278  memcpy (mptr, optr, osize);
1279  cob_free (optr);
1280  return mptr;
1281 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
unlikely
#define unlikely(x)
Definition: common.h:437
COB_FERROR_FREE
#define COB_FERROR_FREE
Definition: common.h:703
COB_FERROR_MEMORY
#define COB_FERROR_MEMORY
Definition: common.h:697

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_reg_sighnd ( void(*)(int)  sighnd)

Definition at line 2288 of file common.c.

References cob_ext_sighdl.

2289 {
2290  cob_ext_sighdl = sighnd;
2291 }
cob_ext_sighdl
static void(* cob_ext_sighdl)(int)
Definition: common.c:172
void cob_reset_trace ( void  )

Definition at line 1468 of file common.c.

References __cob_settings::cob_line_trace.

1469 {
1470  cobsetptr->cob_line_trace = 0;
1471 }
cobsetptr
static cob_settings * cobsetptr
Definition: common.c:131
__cob_settings::cob_line_trace
unsigned int cob_line_trace
Definition: coblocal.h:206
void* cob_resolve ( const char *  )

Definition at line 908 of file call.c.

References cob_chk_call_path(), cob_free(), and cob_resolve_internal().

Referenced by main().

909 {
910  void *p;
911  char *entry;
912  char *dirent;
913 
914  entry = cob_chk_call_path (name, &dirent);
915  p = cob_resolve_internal (entry, dirent, 0);
916  if (dirent) {
917  cob_free (dirent);
918  }
919  return p;
920 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_chk_call_path
static char * cob_chk_call_path(const char *name, char **dirent)
Definition: call.c:825
cob_resolve_internal
static void * cob_resolve_internal(const char *name, const char *dirent, const int fold_case)
Definition: call.c:599

Here is the call graph for this function:

Here is the caller graph for this function:

void* cob_resolve_cobol ( const char *  ,
const int  ,
const int   
)

Definition at line 923 of file call.c.

References cob_call_error(), cob_chk_call_path(), COB_EC_PROGRAM_NOT_FOUND, cob_free(), cob_resolve_internal(), cob_set_exception(), and unlikely.

Referenced by cob_call(), cobxref_(), and GCic_().

924 {
925  void *p;
926  char *entry;
927  char *dirent;
928 
929  entry = cob_chk_call_path (name, &dirent);
930  p = cob_resolve_internal (entry, dirent, fold_case);
931  if (dirent) {
932  cob_free (dirent);
933  }
934  if (unlikely(!p)) {
935  if (errind) {
936  cob_call_error ();
937  }
938  cob_set_exception (COB_EC_PROGRAM_NOT_FOUND);
939  }
940  return p;
941 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
unlikely
#define unlikely(x)
Definition: common.h:437
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_call_error
void cob_call_error(void)
Definition: call.c:878
cob_chk_call_path
static char * cob_chk_call_path(const char *name, char **dirent)
Definition: call.c:825
cob_resolve_internal
static void * cob_resolve_internal(const char *name, const char *dirent, const int fold_case)
Definition: call.c:599

Here is the call graph for this function:

Here is the caller graph for this function:

const char* cob_resolve_error ( void  )

Definition at line 864 of file call.c.

References _, NULL, and resolve_error.

Referenced by cob_call_error().

865 {
866  const char *p;
867 
868  if (!resolve_error) {
869  p = _("Indeterminable error in resolve of COBOL CALL");
870  } else {
871  p = resolve_error;
872  resolve_error = NULL;
873  }
874  return p;
875 }
resolve_error
static char * resolve_error
Definition: call.c:165
_
#define _(s)
Definition: cobcrun.c:59
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the caller graph for this function:

void* cob_resolve_func ( const char *  )

Definition at line 944 of file call.c.

References _, cob_resolve_internal(), cob_runtime_error(), cob_stop_run(), NULL, and unlikely.

945 {
946  void *p;
947 
948  p = cob_resolve_internal (name, NULL, 0);
949  if (unlikely(!p)) {
950  cob_runtime_error (_("User FUNCTION '%s' not found"), name);
951  cob_stop_run (1);
952  }
953  return p;
954 }
cob_runtime_error
void cob_runtime_error(const char *,...) COB_A_FORMAT12
Definition: common.c:1543
_
#define _(s)
Definition: cobcrun.c:59
unlikely
#define unlikely(x)
Definition: common.h:437
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_resolve_internal
static void * cob_resolve_internal(const char *name, const char *dirent, const int fold_case)
Definition: call.c:599
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

void cob_restore_func ( struct cob_func_loc *  )

Definition at line 1879 of file common.c.

References __cob_global::cob_call_params, cob_free(), COB_MODULE_PTR, cob_func_loc::data, cob_func_loc::func_params, cob_func_loc::save_call_params, cob_func_loc::save_module, cob_func_loc::save_num_params, and cob_func_loc::save_proc_parms.

1880 {
1881  /* Restore calling environment */
1882  cobglobptr->cob_call_params = fl->save_call_params;
1883 #if 0 /* RXWRXW - MODNEXT */
1884  COB_MODULE_PTR->next = fl->save_module;
1885 #endif
1886  COB_MODULE_PTR->cob_procedure_params = fl->save_proc_parms;
1887  COB_MODULE_PTR->module_num_params = fl->save_num_params;
1888  cob_free (fl->data);
1889  cob_free (fl->func_params);
1890  cob_free (fl);
1891 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
__cob_global::cob_call_params
int cob_call_params
Definition: common.h:1204
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130

Here is the call graph for this function:

void cob_rewrite ( cob_file *  ,
cob_field *  ,
const int  ,
cob_field *   
)

Definition at line 4793 of file fileio.c.

References cob_file::access_mode, COB_ACCESS_SEQUENTIAL, cob_get_int(), COB_OPEN_I_O, COB_ORG_SEQUENTIAL, COB_STATUS_43_READ_NOT_DONE, COB_STATUS_44_RECORD_OVERFLOW, COB_STATUS_49_I_O_DENIED, cob_file::flag_read_done, cob_file::open_mode, cob_file::organization, cob_file::record, cob_fileio_funcs::rewrite, save_status(), cob_field::size, unlikely, and cob_file::variable_record.

4794 {
4795  int read_done;
4796 
4797  read_done = f->flag_read_done;
4798  f->flag_read_done = 0;
4799 
4800  if (unlikely(f->open_mode != COB_OPEN_I_O)) {
4801  save_status (f, fnstatus, COB_STATUS_49_I_O_DENIED);
4802  return;
4803  }
4804 
4805  if (f->access_mode == COB_ACCESS_SEQUENTIAL && !read_done) {
4806  save_status (f, fnstatus, COB_STATUS_43_READ_NOT_DONE);
4807  return;
4808  }
4809 
4810  if (unlikely(f->organization == COB_ORG_SEQUENTIAL)) {
4811  if (f->record->size != rec->size) {
4812  save_status (f, fnstatus, COB_STATUS_44_RECORD_OVERFLOW);
4813  return;
4814  }
4815 
4816  if (f->variable_record) {
4817  if (f->record->size != (size_t)cob_get_int (f->variable_record)) {
4818  save_status (f, fnstatus, COB_STATUS_44_RECORD_OVERFLOW);
4819  return;
4820  }
4821  }
4822  }
4823 
4824  save_status (f, fnstatus,
4825  fileio_funcs[(int)f->organization]->rewrite (f, opt));
4826 }
cob_fileio_funcs::rewrite
int(* rewrite)(cob_file *, const int)
Definition: common.h:1230
COB_STATUS_44_RECORD_OVERFLOW
#define COB_STATUS_44_RECORD_OVERFLOW
Definition: common.h:849
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
unlikely
#define unlikely(x)
Definition: common.h:437
COB_ORG_SEQUENTIAL
#define COB_ORG_SEQUENTIAL
Definition: common.h:742
save_status
static void save_status(cob_file *f, cob_field *fnstatus, const int status)
Definition: fileio.c:668
COB_ACCESS_SEQUENTIAL
#define COB_ACCESS_SEQUENTIAL
Definition: common.h:751
COB_OPEN_I_O
#define COB_OPEN_I_O
Definition: common.h:786
COB_STATUS_43_READ_NOT_DONE
#define COB_STATUS_43_READ_NOT_DONE
Definition: common.h:848
COB_STATUS_49_I_O_DENIED
#define COB_STATUS_49_I_O_DENIED
Definition: common.h:853
fileio_funcs
static const struct cob_fileio_funcs * fileio_funcs[COB_ORG_MAX]
Definition: fileio.c:339

Here is the call graph for this function:

void cob_rollback ( void  )

Definition at line 4863 of file fileio.c.

References cob_file_unlock(), file_list::file, and file_list::next.

4864 {
4865  struct file_list *l;
4866 
4867  for (l = file_cache; l; l = l->next) {
4868  if (l->file) {
4869  cob_file_unlock (l->file);
4870  }
4871  }
4872 }
file_cache
static struct file_list * file_cache
Definition: fileio.c:241
file_list
Definition: fileio.c:155
file_list::next
struct file_list * next
Definition: fileio.c:156
file_list::file
cob_file * file
Definition: fileio.c:157
cob_file_unlock
static void cob_file_unlock(cob_file *f)
Definition: fileio.c:4366

Here is the call graph for this function:

void* cob_save_func ( cob_field **  ,
const int  ,
const int  ,
  ... 
)

Definition at line 1835 of file common.c.

References __cob_global::cob_call_params, cob_malloc(), COB_MODULE_PTR, cob_field::data, cob_func_loc::data, cob_func_loc::func_params, params, cob_func_loc::save_call_params, cob_func_loc::save_module, cob_func_loc::save_num_params, cob_func_loc::save_proc_parms, and unlikely.

1837 {
1838  struct cob_func_loc *fl;
1839  va_list args;
1840  int numparams;
1841  int n;
1842 
1843  if (unlikely(params > eparams)) {
1844  numparams = eparams;
1845  } else {
1846  numparams = params;
1847  }
1848 
1849  /* Allocate return field */
1850  *savefld = cob_malloc (sizeof (cob_field));
1851  /* Allocate save area */
1852  fl = cob_malloc (sizeof(struct cob_func_loc));
1853  fl->func_params = cob_malloc (sizeof(void *) * ((size_t)numparams + 1U));
1854  fl->data = cob_malloc (sizeof(void *) * ((size_t)numparams + 1U));
1855 
1856  /* Save values */
1857  fl->save_module = COB_MODULE_PTR->next;
1858  fl->save_call_params = cobglobptr->cob_call_params;
1859  fl->save_proc_parms = COB_MODULE_PTR->cob_procedure_params;
1860  fl->save_num_params = COB_MODULE_PTR->module_num_params;
1861 
1862  /* Set current values */
1863  COB_MODULE_PTR->cob_procedure_params = fl->func_params;
1864  cobglobptr->cob_call_params = numparams;
1865  if (numparams) {
1866  va_start (args, eparams);
1867  for (n = 0; n < numparams; ++n) {
1868  fl->func_params[n] = va_arg (args, cob_field *);
1869  if (fl->func_params[n]) {
1870  fl->data[n] = fl->func_params[n]->data;
1871  }
1872  }
1873  va_end (args);
1874  }
1875  return fl;
1876 }
cob_field
Definition: common.h:950
cob_func_loc::save_module
cob_module * save_module
Definition: common.h:1092
cob_field::data
unsigned char * data
Definition: common.h:952
__cob_global::cob_call_params
int cob_call_params
Definition: common.h:1204
cob_func_loc::save_call_params
int save_call_params
Definition: common.h:1093
unlikely
#define unlikely(x)
Definition: common.h:437
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cob_func_loc
Definition: common.h:1087
cob_func_loc::save_num_params
int save_num_params
Definition: common.h:1094
cob_func_loc::save_proc_parms
cob_field ** save_proc_parms
Definition: common.h:1089
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130
cob_func_loc::func_params
cob_field ** func_params
Definition: common.h:1090
params
strict implicit external call params
Definition: warning.def:60
cob_func_loc::data
unsigned char ** data
Definition: common.h:1091

Here is the call graph for this function:

void* cob_savenv ( struct cobjmp_buf *  )

Definition at line 1160 of file call.c.

References _, cobjmp_buf::cbj_jmp_buf, cob_fatal_error(), COB_FERROR_INITIALIZED, cob_runtime_error(), cob_stop_run(), and unlikely.

Referenced by cob_savenv2().

1161 {
1162  if (unlikely(!cobglobptr)) {
1163  cob_fatal_error (COB_FERROR_INITIALIZED);
1164  }
1165  if (unlikely(!jbuf)) {
1166  cob_runtime_error (_("NULL parameter passed to '%s'"), "cob_savenv");
1167  cob_stop_run (1);
1168  }
1169  if (cob_jmp_primed) {
1170  cob_runtime_error (_("Multiple call to 'cob_setjmp'"));
1171  cob_stop_run (1);
1172  }
1173  cob_jmp_primed = 1;
1174  return jbuf->cbj_jmp_buf;
1175 }
cob_fatal_error
void cob_fatal_error(const int fatal_error)
Definition: common.c:1601
cob_runtime_error
void cob_runtime_error(const char *,...) COB_A_FORMAT12
Definition: common.c:1543
_
#define _(s)
Definition: cobcrun.c:59
unlikely
#define unlikely(x)
Definition: common.h:437
cobglobptr
static cob_global * cobglobptr
Definition: call.c:161
COB_FERROR_INITIALIZED
#define COB_FERROR_INITIALIZED
Definition: common.h:692
cob_jmp_primed
static unsigned int cob_jmp_primed
Definition: call.c:177
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

Here is the caller graph for this function:

void* cob_savenv2 ( struct cobjmp_buf *  ,
const int   
)

Definition at line 1178 of file call.c.

References cob_savenv(), and COB_UNUSED.

1179 {
1180  COB_UNUSED (jsize);
1181 
1182  return cob_savenv (jbuf);
1183 }
cob_savenv
void * cob_savenv(struct cobjmp_buf *jbuf)
Definition: call.c:1160
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

void cob_screen_accept ( cob_screen *  ,
cob_field *  ,
cob_field *  ,
cob_field *   
)

Definition at line 2330 of file screenio.c.

References extract_line_and_col_vals(), and screen_accept().

Referenced by GCic_().

2332 {
2333  int sline;
2334  int scolumn;
2335 
2336  extract_line_and_col_vals (1, line, column, &sline, &scolumn);
2337  screen_accept (s, sline, scolumn, ftimeout);
2338 }
screen_accept
static void screen_accept(cob_screen *s, const int line, const int column, cob_field *ftimeout)
Definition: screenio.c:1604
extract_line_and_col_vals
static void extract_line_and_col_vals(const int is_screen, cob_field *line, cob_field *column, int *sline, int *scolumn)
Definition: screenio.c:1564
line
if fold fold static computed alternate extra correct stack on syntax debugging line
Definition: flag.def:90

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_screen_display ( cob_screen *  ,
cob_field *  ,
cob_field *   
)

Definition at line 2321 of file screenio.c.

References extract_line_and_col_vals(), and screen_display().

Referenced by GCic_().

2322 {
2323  int sline;
2324  int scolumn;
2325 
2326  extract_line_and_col_vals (1, line, column, &sline, &scolumn);
2327  screen_display (s, sline, scolumn);
2328 }
extract_line_and_col_vals
static void extract_line_and_col_vals(const int is_screen, cob_field *line, cob_field *column, int *sline, int *scolumn)
Definition: screenio.c:1564
line
if fold fold static computed alternate extra correct stack on syntax debugging line
Definition: flag.def:90
screen_display
static void screen_display(cob_screen *s, const int line, const int column)
Definition: screenio.c:1591

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_screen_line_col ( cob_field *  ,
const int   
)

Definition at line 2366 of file screenio.c.

References cob_set_int(), COLS, init_cob_screen_if_needed(), and LINES.

2367 {
2368  init_cob_screen_if_needed ();
2369  if (!l_or_c) {
2370  cob_set_int (f, (int)LINES);
2371  } else {
2372  cob_set_int (f, (int)COLS);
2373  }
2374 }
COLS
Definition: parser.c:1409
LINES
Definition: parser.c:1598
cob_set_int
void cob_set_int(cob_field *, const int)
Definition: move.c:1612
init_cob_screen_if_needed
static COB_INLINE COB_A_INLINE void init_cob_screen_if_needed(void)
Definition: screenio.c:1583

Here is the call graph for this function:

void cob_set_cancel ( cob_module *  )

Definition at line 885 of file call.c.

References call_table, cob_call_union::funcvoid, hash(), insert(), call_hash::module, __cob_module::module_entry, __cob_module::module_name, __cob_module::module_path, call_hash::name, call_hash::next, NULL, and call_hash::path.

Referenced by CHECKSRC_(), cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

886 {
887  struct call_hash *p;
888 
889 #ifdef COB_ALT_HASH
890  p = call_table;
891 #else
892  p = call_table[hash ((const unsigned char *)(m->module_name))];
893 #endif
894  for (; p; p = p->next) {
895  if (strcmp (m->module_name, p->name) == 0) {
896  p->module = m;
897  /* Set path in program module structure */
898  if (p->path && m->module_path && !*(m->module_path)) {
899  *(m->module_path) = p->path;
900  }
901  return;
902  }
903  }
904  insert (m->module_name, m->module_entry.funcvoid, NULL, m, NULL, 1);
905 }
call_hash::module
cob_module * module
Definition: call.c:133
call_table
static struct call_hash ** call_table
Definition: call.c:155
insert
static void insert(const char *name, void *func, lt_dlhandle handle, cob_module *module, const char *path, const unsigned int nocanc)
Definition: call.c:535
hash
static COB_INLINE unsigned int hash(const unsigned char *s)
Definition: call.c:523
call_hash::name
const char * name
Definition: call.c:131
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
call_hash::next
struct call_hash * next
Definition: call.c:130
call_hash
Definition: call.c:129
call_hash::path
const char * path
Definition: call.c:135

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_set_environment ( const cob_field *  ,
const cob_field *   
)

Definition at line 3018 of file common.c.

References cob_display_env_value(), and cob_display_environment().

Referenced by GCic_().

3019 {
3020  cob_display_environment (f1);
3021  cob_display_env_value (f2);
3022 }
cob_display_environment
void cob_display_environment(const cob_field *f)
Definition: common.c:2959
f2
cob_field f2
Definition: cobxref.c.l.h:55
f1
cob_field f1
Definition: cobxref.c.l.h:54
cob_display_env_value
void cob_display_env_value(const cob_field *f)
Definition: common.c:2981

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_set_exception ( const int  )

Definition at line 1212 of file common.c.

References cob_current_paragraph, cob_current_program_id, cob_current_section, __cob_global::cob_exception_code, cob_exception_tab_code, __cob_global::cob_got_exception, __cob_global::cob_orig_line, __cob_global::cob_orig_paragraph, __cob_global::cob_orig_program_id, __cob_global::cob_orig_section, __cob_global::cob_orig_statement, cob_source_line, cob_source_statement, and NULL.

Referenced by cob_accept(), cob_accept_arg_value(), cob_accept_environment(), cob_alloc_field(), cob_allocate(), cob_call_field(), cob_check_odo(), cob_check_pos_status(), cob_check_ref_mod(), cob_check_subscript(), cob_decimal_div(), cob_decimal_do_round(), cob_decimal_get_binary(), cob_decimal_get_display(), cob_decimal_get_field(), cob_decimal_get_ieee128dec(), cob_decimal_get_ieee64dec(), cob_decimal_get_packed(), cob_decimal_pow(), cob_display_arg_number(), cob_display_env_value(), cob_free_alloc(), cob_get_environment(), cob_inspect_converting(), cob_inspect_init(), cob_intr_acos(), cob_intr_annuity(), cob_intr_asin(), cob_intr_atan(), cob_intr_binop(), cob_intr_combined_datetime(), cob_intr_cos(), cob_intr_currency_symbol(), cob_intr_date_of_integer(), cob_intr_date_to_yyyymmdd(), cob_intr_day_of_integer(), cob_intr_day_to_yyyyddd(), cob_intr_exp(), cob_intr_exp10(), cob_intr_factorial(), cob_intr_formatted_current_date(), cob_intr_formatted_date(), cob_intr_formatted_datetime(), cob_intr_formatted_time(), cob_intr_highest_algebraic(), cob_intr_integer_of_date(), cob_intr_integer_of_day(), cob_intr_lcl_time_from_secs(), cob_intr_locale_compare(), cob_intr_locale_date(), cob_intr_locale_time(), cob_intr_log(), cob_intr_log10(), cob_intr_lowest_algebraic(), cob_intr_mon_decimal_point(), cob_intr_mon_thousands_sep(), cob_intr_num_decimal_point(), cob_intr_num_thousands_sep(), cob_intr_numval_f(), cob_intr_seconds_from_formatted_time(), cob_intr_sin(), cob_intr_sqrt(), cob_intr_standard_deviation(), cob_intr_tan(), cob_intr_year_to_yyyy(), cob_mod_or_rem(), cob_resolve_cobol(), cob_resolve_internal(), cob_set_locale(), cob_string_append(), cob_string_init(), cob_unstring_finish(), cob_unstring_init(), format_time(), inspect_common(), numval(), raise_ec_on_invalid_line_or_col(), raise_ec_on_truncation(), save_status(), and set_resolve_error().

1213 {
1214  cobglobptr->cob_exception_code = cob_exception_tab_code[id];
1215  if (cobglobptr->cob_exception_code) {
1216  cobglobptr->cob_got_exception = 1;
1217  cobglobptr->cob_orig_statement = cob_source_statement;
1218  cobglobptr->cob_orig_line = cob_source_line;
1219  cobglobptr->cob_orig_program_id = cob_current_program_id;
1220  cobglobptr->cob_orig_section = cob_current_section;
1221  cobglobptr->cob_orig_paragraph = cob_current_paragraph;
1222  } else {
1223  cobglobptr->cob_got_exception = 0;
1224  cobglobptr->cob_orig_statement = NULL;
1225  cobglobptr->cob_orig_line = 0;
1226  cobglobptr->cob_orig_program_id = NULL;
1227  cobglobptr->cob_orig_section = NULL;
1228  cobglobptr->cob_orig_paragraph = NULL;
1229  }
1230 }
__cob_global::cob_orig_line
unsigned int cob_orig_line
Definition: common.h:1206
__cob_global::cob_orig_paragraph
const char * cob_orig_paragraph
Definition: common.h:1192
cob_source_line
static unsigned int cob_source_line
Definition: common.c:156
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_current_paragraph
static const char * cob_current_paragraph
Definition: common.c:152
__cob_global::cob_orig_section
const char * cob_orig_section
Definition: common.h:1191
__cob_global::cob_orig_statement
const char * cob_orig_statement
Definition: common.h:1189
__cob_global::cob_got_exception
unsigned int cob_got_exception
Definition: common.h:1207
cob_current_program_id
static const char * cob_current_program_id
Definition: common.c:150
cob_source_statement
static const char * cob_source_statement
Definition: common.c:154
__cob_global::cob_orig_program_id
const char * cob_orig_program_id
Definition: common.h:1190
__cob_global::cob_exception_code
int cob_exception_code
Definition: common.h:1203
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130
cob_current_section
static const char * cob_current_section
Definition: common.c:151
cob_exception_tab_code
static const int cob_exception_tab_code[]
Definition: common.c:188
void cob_set_int ( cob_field *  ,
const int   
)

Definition at line 1612 of file move.c.

References cob_field::attr, COB_ATTR_INIT, COB_FLAG_HAVE_SIGN, COB_FLAG_REAL_BINARY, cob_move(), COB_TYPE_NUMERIC_BINARY, cob_field::data, NULL, and cob_field::size.

Referenced by cob_accept(), cob_accept_escape_key(), cob_accept_exception_status(), cob_check_pos_status(), cob_file_open(), cob_linage_write_opt(), cob_read(), cob_read_next(), cob_screen_line_col(), cob_string_finish(), cob_sys_chdir(), cob_sys_getopt_long_long(), cob_sys_return_args(), cob_unstring_finish(), cob_unstring_into(), cobxref_(), field_accept(), file_linage_check(), relative_read_next(), relative_start(), and relative_write().

1613 {
1614  cob_field temp;
1615  cob_field_attr attr;
1616 
1617  COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, 0,
1618  COB_FLAG_HAVE_SIGN | COB_FLAG_REAL_BINARY, NULL);
1619  temp.size = 4;
1620  temp.data = (unsigned char *)&n;
1621  temp.attr = &attr;
1622  cob_move (&temp, f);
1623 }
cob_move
void cob_move(cob_field *src, cob_field *dst)
Definition: move.c:1170
cob_field
Definition: common.h:950
COB_FLAG_REAL_BINARY
#define COB_FLAG_REAL_BINARY
Definition: common.h:636
COB_ATTR_INIT
#define COB_ATTR_INIT(u, v, x, y, z)
Definition: coblocal.h:150
cob_field::data
unsigned char * data
Definition: common.h:952
COB_FLAG_HAVE_SIGN
#define COB_FLAG_HAVE_SIGN
Definition: common.h:630
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_TYPE_NUMERIC_BINARY
#define COB_TYPE_NUMERIC_BINARY
Definition: common.h:608
cob_field_attr
Definition: common.h:940
cob_field::size
size_t size
Definition: common.h:951
cob_field::attr
const cob_field_attr * attr
Definition: common.h:953

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_set_locale ( cob_field *  ,
const int   
)

Definition at line 4165 of file common.c.

References COB_EC_LOCALE_MISSING, cob_field_to_string(), cob_free(), COB_LC_ALL, COB_LC_CLASS, COB_LC_COLLATE, COB_LC_CTYPE, COB_LC_MESSAGES, COB_LC_MONETARY, COB_LC_NUMERIC, COB_LC_TIME, COB_LC_USER, __cob_global::cob_locale, __cob_global::cob_locale_ctype, __cob_global::cob_locale_orig, cob_malloc(), cob_set_exception(), cob_strdup(), NULL, and cob_field::size.

4166 {
4167 #ifdef HAVE_SETLOCALE
4168  char *p;
4169  char *buff;
4170 
4171  p = NULL;
4172  if (locale) {
4173  if (locale->size == 0) {
4174  return;
4175  }
4176  buff = cob_malloc (locale->size + 1U);
4177  cob_field_to_string (locale, buff, locale->size);
4178  } else {
4179  buff = NULL;
4180  }
4181 
4182  switch (category) {
4183  case COB_LC_COLLATE:
4184  p = setlocale (LC_COLLATE, buff);
4185  break;
4186  case COB_LC_CTYPE:
4187  p = setlocale (LC_CTYPE, buff);
4188  break;
4189 #ifdef LC_MESSAGES
4190  case COB_LC_MESSAGES:
4191  p = setlocale (LC_MESSAGES, buff);
4192  break;
4193 #endif
4194  case COB_LC_MONETARY:
4195  p = setlocale (LC_MONETARY, buff);
4196  break;
4197  case COB_LC_NUMERIC:
4198  p = setlocale (LC_NUMERIC, buff);
4199  break;
4200  case COB_LC_TIME:
4201  p = setlocale (LC_TIME, buff);
4202  break;
4203  case COB_LC_ALL:
4204  p = setlocale (LC_ALL, buff);
4205  break;
4206  case COB_LC_USER:
4207  if (cobglobptr->cob_locale_orig) {
4208  p = setlocale (LC_ALL, cobglobptr->cob_locale_orig);
4209  (void)setlocale (LC_NUMERIC, "C");
4210  }
4211  break;
4212  case COB_LC_CLASS:
4213  if (cobglobptr->cob_locale_ctype) {
4214  p = setlocale (LC_CTYPE, cobglobptr->cob_locale_ctype);
4215  }
4216  break;
4217  }
4218  if (buff) {
4219  cob_free (buff);
4220  }
4221  if (!p) {
4222  cob_set_exception (COB_EC_LOCALE_MISSING);
4223  return;
4224  }
4225  p = setlocale (LC_ALL, NULL);
4226  if (p) {
4227  if (cobglobptr->cob_locale) {
4228  cob_free (cobglobptr->cob_locale);
4229  }
4230  cobglobptr->cob_locale = cob_strdup (p);
4231  }
4232 #else
4233  cob_set_exception (COB_EC_LOCALE_MISSING);
4234 #endif
4235 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_LC_MESSAGES
#define COB_LC_MESSAGES
Definition: common.h:592
COB_LC_ALL
#define COB_LC_ALL
Definition: common.h:596
COB_LC_NUMERIC
#define COB_LC_NUMERIC
Definition: common.h:594
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_LC_CLASS
#define COB_LC_CLASS
Definition: common.h:598
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
COB_LC_TIME
#define COB_LC_TIME
Definition: common.h:595
COB_LC_COLLATE
#define COB_LC_COLLATE
Definition: common.h:590
cob_field_to_string
void cob_field_to_string(const cob_field *f, void *str, const size_t maxsize)
Definition: common.c:1492
__cob_global::cob_locale_orig
char * cob_locale_orig
Definition: common.h:1195
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
COB_LC_USER
#define COB_LC_USER
Definition: common.h:597
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130
__cob_global::cob_locale
char * cob_locale
Definition: common.h:1194
COB_LC_CTYPE
#define COB_LC_CTYPE
Definition: common.h:591
COB_LC_MONETARY
#define COB_LC_MONETARY
Definition: common.h:593
__cob_global::cob_locale_ctype
char * cob_locale_ctype
Definition: common.h:1196
cob_strdup
char * cob_strdup(const char *p)
Definition: common.c:1308

Here is the call graph for this function:

void cob_set_location ( const char *  ,
const unsigned  int,
const char *  ,
const char *  ,
const char *   
)

Definition at line 1388 of file common.c.

References cob_check_trace_file(), cob_current_paragraph, cob_current_program_id, cob_current_section, cob_free(), cob_last_sfile, __cob_settings::cob_line_trace, COB_MODULE_PTR, cob_source_file, cob_source_line, cob_source_statement, cob_strdup(), and cob_trace_file.

Referenced by CHECKSRC_(), cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

1391 {
1392  const char *s;
1393 
1394  cob_current_program_id = COB_MODULE_PTR->module_name;
1395  cob_source_file = sfile;
1396  cob_source_line = sline;
1397  cob_current_section = csect;
1398  cob_current_paragraph = cpara;
1399  if (cstatement) {
1400  cob_source_statement = cstatement;
1401  }
1402  if (cobsetptr->cob_line_trace) {
1403  if (!cob_trace_file) {
1404  cob_check_trace_file ();
1405  if (!cob_trace_file) return; /* silence warnings */
1406  }
1407  if (!cob_last_sfile || strcmp (cob_last_sfile, sfile)) {
1408  if (cob_last_sfile) {
1409  cob_free((void *)cob_last_sfile);
1410  }
1411  cob_last_sfile = cob_strdup (sfile);
1412  fprintf (cob_trace_file, "Source : '%s'\n", sfile);
1413  }
1414  if (COB_MODULE_PTR->module_name) {
1415  s = COB_MODULE_PTR->module_name;
1416  } else {
1417  s = "Unknown";
1418  }
1419  fprintf (cob_trace_file,
1420  "Program-Id: %-16s Statement: %-21.21s Line: %u\n",
1421  s, cstatement ? (char *)cstatement : "Unknown",
1422  sline);
1423  fflush (cob_trace_file);
1424  }
1425 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_trace_file
static FILE * cob_trace_file
Definition: common.c:155
cob_source_line
static unsigned int cob_source_line
Definition: common.c:156
cobsetptr
static cob_settings * cobsetptr
Definition: common.c:131
cob_last_sfile
static const char * cob_last_sfile
Definition: common.c:128
__cob_settings::cob_line_trace
unsigned int cob_line_trace
Definition: coblocal.h:206
cob_current_paragraph
static const char * cob_current_paragraph
Definition: common.c:152
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cob_current_program_id
static const char * cob_current_program_id
Definition: common.c:150
cob_source_file
static const char * cob_source_file
Definition: common.c:153
cob_source_statement
static const char * cob_source_statement
Definition: common.c:154
cob_current_section
static const char * cob_current_section
Definition: common.c:151
cob_check_trace_file
static void cob_check_trace_file(void)
Definition: common.c:1056
cob_strdup
char * cob_strdup(const char *p)
Definition: common.c:1308

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_set_packed_int ( cob_field *  ,
const int   
)

Definition at line 1261 of file numeric.c.

References COB_FIELD_DIGITS, COB_FIELD_HAVE_SIGN, COB_FIELD_NO_SIGN_NIBBLE, cob_set_packed_zero(), cob_u32_t, cob_field::data, packed_bytes, and cob_field::size.

1262 {
1263  unsigned char *p;
1264  size_t sign = 0;
1265  cob_u32_t n;
1266 
1267  if (!val) {
1268  cob_set_packed_zero (f);
1269  return;
1270  }
1271  if (val < 0) {
1272  n = (cob_u32_t)-val;
1273  sign = 1;
1274  } else {
1275  n = (cob_u32_t)val;
1276  }
1277  memset (f->data, 0, f->size);
1278  p = f->data + f->size - 1;
1279  if (!COB_FIELD_NO_SIGN_NIBBLE (f)) {
1280  *p = (n % 10) << 4;
1281  if (!COB_FIELD_HAVE_SIGN (f)) {
1282  *p |= 0x0FU;
1283  } else if (sign) {
1284  *p |= 0x0DU;
1285  } else {
1286  *p |= 0x0CU;
1287  }
1288  n /= 10;
1289  p--;
1290  }
1291  for (; n && p >= f->data; n /= 100, p--) {
1292  *p = packed_bytes[n % 100];
1293  }
1294  if (COB_FIELD_NO_SIGN_NIBBLE (f)) {
1295  if ((COB_FIELD_DIGITS(f) % 2) == 1) {
1296  *(f->data) &= 0x0FU;
1297  }
1298  return;
1299  }
1300  if ((COB_FIELD_DIGITS(f) % 2) == 0) {
1301  *(f->data) &= 0x0FU;
1302  }
1303 }
cob_u32_t
#define cob_u32_t
Definition: common.h:31
cob_set_packed_zero
void cob_set_packed_zero(cob_field *f)
Definition: numeric.c:1073
COB_FIELD_NO_SIGN_NIBBLE
#define COB_FIELD_NO_SIGN_NIBBLE(f)
Definition: common.h:651
sign
if sign
Definition: flag.def:42
COB_FIELD_HAVE_SIGN
#define COB_FIELD_HAVE_SIGN(f)
Definition: common.h:643
packed_bytes
static const unsigned char packed_bytes[]
Definition: numeric.c:58
COB_FIELD_DIGITS
#define COB_FIELD_DIGITS(f)
Definition: common.h:663

Here is the call graph for this function:

void cob_set_packed_zero ( cob_field *  )

Definition at line 1073 of file numeric.c.

References COB_FIELD_HAVE_SIGN, COB_FIELD_NO_SIGN_NIBBLE, cob_field::data, and cob_field::size.

Referenced by cob_decimal_get_packed(), and cob_set_packed_int().

1074 {
1075  memset (f->data, 0, f->size);
1076  if (COB_FIELD_NO_SIGN_NIBBLE (f)) {
1077  return;
1078  }
1079  if (!COB_FIELD_HAVE_SIGN (f)) {
1080  *(f->data + f->size - 1) = 0x0F;
1081  } else {
1082  *(f->data + f->size - 1) = 0x0C;
1083  }
1084 }
COB_FIELD_NO_SIGN_NIBBLE
#define COB_FIELD_NO_SIGN_NIBBLE(f)
Definition: common.h:651
COB_FIELD_HAVE_SIGN
#define COB_FIELD_HAVE_SIGN(f)
Definition: common.h:643

Here is the caller graph for this function:

void cob_set_switch ( const int  ,
const int   
)

Definition at line 2305 of file common.c.

References cob_switch, and COB_SWITCH_MAX.

2306 {
2307  if (n < 0 || n > COB_SWITCH_MAX) {
2308  return;
2309  }
2310  if (flag == 0) {
2311  cob_switch[n] = 0;
2312  } else if (flag == 1) {
2313  cob_switch[n] = 1;
2314  }
2315 }
cob_switch
static int cob_switch[36+1]
Definition: common.c:201
COB_SWITCH_MAX
#define COB_SWITCH_MAX
Definition: common.c:199
void cob_start ( cob_file *  ,
const int  ,
cob_field *  ,
cob_field *  ,
cob_field *   
)

Definition at line 4584 of file fileio.c.

References cob_file::access_mode, COB_ACCESS_RANDOM, cob_get_int(), COB_OPEN_I_O, COB_OPEN_INPUT, COB_STATUS_00_SUCCESS, COB_STATUS_23_KEY_NOT_EXISTS, COB_STATUS_47_INPUT_DENIED, cob_file::flag_begin_of_file, cob_file::flag_end_of_file, cob_file::flag_first_read, cob_file::flag_nonexistent, cob_file::flag_read_done, cob_file::open_mode, cob_file::organization, save_status(), cob_field::size, cob_fileio_funcs::start, and unlikely.

4586 {
4587  int ret;
4588  int size;
4589  cob_field tempkey;
4590 
4591  f->flag_read_done = 0;
4592  f->flag_first_read = 0;
4593 
4594  if (unlikely(f->open_mode != COB_OPEN_I_O &&
4595  f->open_mode != COB_OPEN_INPUT)) {
4596  save_status (f, fnstatus, COB_STATUS_47_INPUT_DENIED);
4597  return;
4598  }
4599 
4600  if (unlikely(f->access_mode == COB_ACCESS_RANDOM)) {
4601  save_status (f, fnstatus, COB_STATUS_47_INPUT_DENIED);
4602  return;
4603  }
4604 
4605  if (f->flag_nonexistent) {
4606  save_status (f, fnstatus, COB_STATUS_23_KEY_NOT_EXISTS);
4607  return;
4608  }
4609 
4610  size = 0;
4611  if (unlikely(keysize)) {
4612  size = cob_get_int (keysize);
4613  if (size < 1 || size > (int)key->size) {
4614  save_status (f, fnstatus, COB_STATUS_23_KEY_NOT_EXISTS);
4615  return;
4616  }
4617  tempkey = *key;
4618  tempkey.size = (size_t)size;
4619  ret = fileio_funcs[(int)f->organization]->start (f, cond, &tempkey);
4620  } else {
4621  ret = fileio_funcs[(int)f->organization]->start (f, cond, key);
4622  }
4623  if (ret == COB_STATUS_00_SUCCESS) {
4624  f->flag_end_of_file = 0;
4625  f->flag_begin_of_file = 0;
4626  f->flag_first_read = 1;
4627  }
4628 
4629  save_status (f, fnstatus, ret);
4630 }
COB_STATUS_23_KEY_NOT_EXISTS
#define COB_STATUS_23_KEY_NOT_EXISTS
Definition: common.h:837
COB_STATUS_00_SUCCESS
#define COB_STATUS_00_SUCCESS
Definition: common.h:828
cob_field
Definition: common.h:950
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
COB_OPEN_INPUT
#define COB_OPEN_INPUT
Definition: common.h:784
unlikely
#define unlikely(x)
Definition: common.h:437
save_status
static void save_status(cob_file *f, cob_field *fnstatus, const int status)
Definition: fileio.c:668
COB_OPEN_I_O
#define COB_OPEN_I_O
Definition: common.h:786
cob_field::size
size_t size
Definition: common.h:951
fileio_funcs
static const struct cob_fileio_funcs * fileio_funcs[COB_ORG_MAX]
Definition: fileio.c:339
cob_fileio_funcs::start
int(* start)(cob_file *, const int, cob_field *)
Definition: common.h:1226
COB_STATUS_47_INPUT_DENIED
#define COB_STATUS_47_INPUT_DENIED
Definition: common.h:851
COB_ACCESS_RANDOM
#define COB_ACCESS_RANDOM
Definition: common.h:753

Here is the call graph for this function:

void cob_stop_run ( const int  )

Definition at line 1524 of file common.c.

References cob_initialized, cob_terminate_routines(), exit_hdlrs, exit_handlerlist::next, NULL, and exit_handlerlist::proc.

Referenced by cob_call(), cob_call_error(), cob_cancel(), cob_check_based(), cob_check_linkage(), cob_check_numeric(), cob_check_odo(), cob_check_ref_mod(), cob_check_subscript(), cob_check_version(), cob_command_line(), cob_external_addr(), cob_fatal_error(), cob_get_sort_tempfile(), cob_init(), cob_longjmp(), cob_parameter_check(), cob_resolve_func(), cob_savenv(), cob_screen_init(), cob_sys_check_file_exist(), cob_sys_file_info(), cob_sys_getopt_long_long(), cob_sys_system(), GCic_(), and main().

1525 {
1526  struct exit_handlerlist *h;
1527 
1528  if (!cob_initialized) {
1529  exit (1);
1530  }
1531  if (exit_hdlrs != NULL) {
1532  h = exit_hdlrs;
1533  while (h != NULL) {
1534  h->proc ();
1535  h = h->next;
1536  }
1537  }
1538  cob_terminate_routines ();
1539  exit (status);
1540 }
exit_handlerlist::next
struct exit_handlerlist * next
Definition: common.c:205
exit_hdlrs
static struct exit_handlerlist * exit_hdlrs
exit_handlerlist::proc
int(* proc)(void)
Definition: common.c:206
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
exit_handlerlist
Definition: common.c:204
cob_initialized
static int cob_initialized
Definition: common.c:124
cob_terminate_routines
static void cob_terminate_routines(void)
Definition: common.c:406

Here is the call graph for this function:

Here is the caller graph for this function:

char* cob_strcat ( char *  ,
char *   
)

Definition at line 4270 of file common.c.

References cob_fast_malloc(), cob_free(), cob_strdup(), and strbuff.

Referenced by cache_preload(), cob_strjoin(), and var_print().

4271 {
4272  size_t l;
4273  char *temp1, *temp2;
4274 
4275  l = strlen (str1) + strlen (str2) + 1;
4276 
4277  /*
4278  * If one of the parameter is the buffer itself,
4279  * we copy the buffer before continuing.
4280  */
4281  if (str1 == strbuff) {
4282  temp1 = cob_strdup (str1);
4283  } else {
4284  temp1 = str1;
4285  }
4286  if (str2 == strbuff) {
4287  temp2 = cob_strdup (str2);
4288  } else {
4289  temp2 = str2;
4290  }
4291 
4292  if (strbuff) {
4293  cob_free (strbuff);
4294  }
4295  strbuff = (char*) cob_fast_malloc(l);
4296 
4297  sprintf (strbuff, "%s%s", temp1, temp2);
4298  return strbuff;
4299 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
strbuff
static char * strbuff
Definition: common.c:158
cob_fast_malloc
void * cob_fast_malloc(const size_t size)
Definition: common.c:1296
cob_strdup
char * cob_strdup(const char *p)
Definition: common.c:1308

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_string_append ( cob_field *  )

Definition at line 440 of file strings.c.

References COB_EC_OVERFLOW_STRING, cob_get_exception_code(), cob_set_exception(), cob_field::data, cob_field::size, and string_offset.

Referenced by cobxref_(), GCic_(), and LISTING_().

441 {
442  size_t src_size;
443  int i;
444  int size;
445 
446  if (cob_get_exception_code ()) {
447  return;
448  }
449 
450  src_size = src->size;
451  if (!src_size) {
452  return;
453  }
454  if (string_dlm) {
455  size = (int)(src_size - string_dlm->size + 1);
456  for (i = 0; i < size; ++i) {
457  if (memcmp (src->data + i, string_dlm->data,
458  string_dlm->size) == 0) {
459  src_size = i;
460  break;
461  }
462  }
463  }
464 
465  if (src_size <= string_dst->size - string_offset) {
466  memcpy (string_dst->data + string_offset, src->data, src_size);
467  string_offset += (int) src_size;
468  } else {
469  size = (int)(string_dst->size - string_offset);
470  memcpy (string_dst->data + string_offset, src->data, (size_t)size);
471  string_offset += size;
472  cob_set_exception (COB_EC_OVERFLOW_STRING);
473  }
474 }
cob_field::data
unsigned char * data
Definition: common.h:952
string_dst
static cob_field * string_dst
Definition: strings.c:68
cob_get_exception_code
int cob_get_exception_code(void)
Definition: common.c:1193
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_field::size
size_t size
Definition: common.h:951
string_offset
static int string_offset
Definition: strings.c:74
string_dlm
static cob_field * string_dlm
Definition: strings.c:70

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_string_delimited ( cob_field *  )

Definition at line 430 of file strings.c.

References NULL, and string_dlm_copy.

Referenced by cobxref_(), GCic_(), and LISTING_().

431 {
432  string_dlm = NULL;
433  if (dlm) {
434  string_dlm_copy = *dlm;
435  string_dlm = &string_dlm_copy;
436  }
437 }
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
string_dlm_copy
static cob_field string_dlm_copy
Definition: strings.c:73
string_dlm
static cob_field * string_dlm
Definition: strings.c:70

Here is the caller graph for this function:

void cob_string_finish ( void  )

Definition at line 477 of file strings.c.

References cob_set_int(), and string_offset.

Referenced by cobxref_(), GCic_(), and LISTING_().

478 {
479  if (string_ptr) {
480  cob_set_int (string_ptr, string_offset + 1);
481  }
482 }
string_ptr
static cob_field * string_ptr
Definition: strings.c:69
cob_set_int
void cob_set_int(cob_field *, const int)
Definition: move.c:1612
string_offset
static int string_offset
Definition: strings.c:74

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_string_init ( cob_field *  ,
cob_field *   
)

Definition at line 408 of file strings.c.

References COB_EC_OVERFLOW_STRING, cob_get_int(), cob_set_exception(), NULL, cob_field::size, string_dst_copy, string_offset, and string_ptr_copy.

Referenced by cobxref_(), GCic_(), and LISTING_().

409 {
410  string_dst_copy = *dst;
411  string_dst = &string_dst_copy;
412  string_ptr = NULL;
413  if (ptr) {
414  string_ptr_copy = *ptr;
415  string_ptr = &string_ptr_copy;
416  }
417  string_offset = 0;
418  cob_set_exception (0);
419 
420  if (string_ptr) {
421  string_offset = cob_get_int (string_ptr) - 1;
422  if (string_offset < 0 ||
423  string_offset >= (int)string_dst->size) {
424  cob_set_exception (COB_EC_OVERFLOW_STRING);
425  }
426  }
427 }
string_ptr
static cob_field * string_ptr
Definition: strings.c:69
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
string_dst
static cob_field * string_dst
Definition: strings.c:68
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
string_ptr_copy
static cob_field string_ptr_copy
Definition: strings.c:72
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
string_dst_copy
static cob_field string_dst_copy
Definition: strings.c:71
cob_field::size
size_t size
Definition: common.h:951
string_offset
static int string_offset
Definition: strings.c:74

Here is the call graph for this function:

Here is the caller graph for this function:

char* cob_strjoin ( char **  ,
int  ,
char *   
)

Definition at line 4302 of file common.c.

References cob_strcat(), and NULL.

4303 {
4304  char *result;
4305  int i;
4306 
4307  if(!strarray || size <= 0 || !separator) return NULL;
4308 
4309  result = strarray[0];
4310  for (i = 1; i < size; i++) {
4311  result = cob_strcat(result, separator);
4312  result = cob_strcat(result, strarray[i]);
4313  }
4314 
4315  return result;
4316 }
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_strcat
char * cob_strcat(char *str1, char *str2)
Definition: common.c:4270

Here is the call graph for this function:

void cob_sub ( cob_field *  ,
cob_field *  ,
const int   
)

Definition at line 1940 of file numeric.c.

References cob_decimal_get_field(), cob_decimal_set_field(), and cob_decimal_sub().

1941 {
1942  cob_decimal_set_field (&cob_d1, f1);
1943  cob_decimal_set_field (&cob_d2, f2);
1944  cob_decimal_sub (&cob_d1, &cob_d2);
1945  (void)cob_decimal_get_field (&cob_d1, f1, opt);
1946 }
f2
cob_field f2
Definition: cobxref.c.l.h:55
cob_decimal_set_field
void cob_decimal_set_field(cob_decimal *d, cob_field *f)
Definition: numeric.c:1612
cob_decimal_sub
void cob_decimal_sub(cob_decimal *d1, cob_decimal *d2)
Definition: numeric.c:1883
f1
cob_field f1
Definition: cobxref.c.l.h:54
cob_d2
static cob_decimal cob_d2
Definition: numeric.c:109
cob_decimal_get_field
int cob_decimal_get_field(cob_decimal *d, cob_field *f, const int opt)
Definition: numeric.c:1801
cob_d1
static cob_decimal cob_d1
Definition: numeric.c:108

Here is the call graph for this function:

int cob_sub_int ( cob_field *  ,
const int  ,
const int   
)

Definition at line 2251 of file numeric.c.

References cob_add_int().

2252 {
2253  return cob_add_int (f, -n, opt);
2254 }
cob_add_int
int cob_add_int(cob_field *f, const int n, const int opt)
Definition: numeric.c:2195

Here is the call graph for this function:

cob_field* cob_switch_value ( const int  )

Definition at line 2980 of file intrinsic.c.

References cob_alloc_set_field_int(), cob_get_switch(), and curr_field.

2981 {
2982  cob_alloc_set_field_int (cob_get_switch (id));
2983  return curr_field;
2984 }
cob_alloc_set_field_int
static void cob_alloc_set_field_int(const int val)
Definition: intrinsic.c:533
cob_get_switch
int cob_get_switch(const int n)
Definition: common.c:2296
curr_field
static cob_field * curr_field
Definition: intrinsic.c:105

Here is the call graph for this function:

int cob_sys_and ( const void *  ,
void *  ,
const int   
)

Definition at line 3522 of file common.c.

References COB_CHK_PARMS, and cob_u8_ptr.

3523 {
3524  const cob_u8_ptr data_1 = p1;
3525  cob_u8_ptr data_2 = p2;
3526  size_t n;
3527 
3528  COB_CHK_PARMS (CBL_AND, 3);
3529 
3530  if (length <= 0) {
3531  return 0;
3532  }
3533  for (n = 0; n < (size_t)length; ++n) {
3534  data_2[n] &= data_1[n];
3535  }
3536  return 0;
3537 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
int cob_sys_calledby ( void *  )

Definition at line 3841 of file common.c.

References COB_CHK_PARMS, and COB_MODULE_PTR.

3842 {
3843  size_t size;
3844  size_t msize;
3845 
3846  COB_CHK_PARMS (C$CALLEDBY, 1);
3847 
3848  if (!COB_MODULE_PTR->cob_procedure_params[0]) {
3849  /* check what ACU ccbl/runcbl returns,
3850  the documentation doesn't say anything about this */
3851  return -1;
3852  }
3853  size = COB_MODULE_PTR->cob_procedure_params[0]->size;
3854  memset (data, ' ', size);
3855  if (!COB_MODULE_PTR->next) {
3856  return 0;
3857  }
3858  msize = strlen (COB_MODULE_PTR->next->module_name);
3859  if (msize > size) {
3860  msize = size;
3861  }
3862  memcpy (data, COB_MODULE_PTR->next->module_name, msize);
3863  return 1;
3864 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
int cob_sys_change_dir ( unsigned char *  )

Definition at line 5395 of file fileio.c.

References COB_CHK_PARMS, cob_free(), COB_MODULE_PTR, cob_str_from_fld(), and COB_UNUSED.

Referenced by cob_sys_chdir(), and GCic_().

5396 {
5397  char *fn;
5398  int ret;
5399 
5400  COB_UNUSED (dir);
5401 
5402  COB_CHK_PARMS (CBL_CHANGE_DIR, 1);
5403 
5404  if (!COB_MODULE_PTR->cob_procedure_params[0]) {
5405  return -1;
5406  }
5407  fn = cob_str_from_fld (COB_MODULE_PTR->cob_procedure_params[0]);
5408  ret = chdir (fn);
5409  cob_free (fn);
5410  if (ret) {
5411  return 128;
5412  }
5413  return 0;
5414 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_str_from_fld
static void * cob_str_from_fld(const cob_field *f)
Definition: fileio.c:4928
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_sys_chdir ( unsigned char *  ,
unsigned char *   
)

Definition at line 5453 of file fileio.c.

References COB_CHK_PARMS, COB_MODULE_PTR, cob_set_int(), cob_sys_change_dir(), and COB_UNUSED.

5454 {
5455  int ret;
5456 
5457  COB_UNUSED (status);
5458 
5459  COB_CHK_PARMS (C$CHDIR, 2);
5460 
5461  ret = cob_sys_change_dir (dir);
5462  if (ret < 0) {
5463  ret = 128;
5464  }
5465  cob_set_int (COB_MODULE_PTR->cob_procedure_params[1], ret);
5466  return ret;
5467 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_sys_change_dir
int cob_sys_change_dir(unsigned char *dir)
Definition: fileio.c:5395
cob_set_int
void cob_set_int(cob_field *, const int)
Definition: move.c:1612
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

int cob_sys_check_file_exist ( unsigned char *  ,
unsigned char *   
)

Definition at line 5239 of file fileio.c.

References _, COB_BSWAP_16, COB_BSWAP_64, COB_CHK_PARMS, cob_free(), COB_MODULE_PTR, cob_runtime_error(), cob_s64_t, cob_stop_run(), cob_str_from_fld(), and COB_UNUSED.

Referenced by LISTING_().

5240 {
5241  char *fn;
5242  struct tm *tm;
5243  cob_s64_t sz;
5244  struct stat st;
5245  short y;
5246  short d, m, hh, mm, ss;
5247 
5248  COB_UNUSED (file_name);
5249 
5250  COB_CHK_PARMS (CBL_CHECK_FILE_EXIST, 2);
5251 
5252  if (!COB_MODULE_PTR->cob_procedure_params[0]) {
5253  return -1;
5254  }
5255  if (!COB_MODULE_PTR->cob_procedure_params[1]) {
5256  return -1;
5257  }
5258  if (COB_MODULE_PTR->cob_procedure_params[1]->size < 16U) {
5259  cob_runtime_error (_("'%s' - File detail area is too short"), "CBL_CHECK_FILE_EXIST");
5260  cob_stop_run (1);
5261  }
5262 
5263  fn = cob_str_from_fld (COB_MODULE_PTR->cob_procedure_params[0]);
5264  if (stat (fn, &st) < 0) {
5265  cob_free (fn);
5266  return 35;
5267  }
5268  cob_free (fn);
5269  sz = (cob_s64_t)st.st_size;
5270  tm = localtime (&st.st_mtime);
5271  d = (short)tm->tm_mday;
5272  m = (short)(tm->tm_mon + 1);
5273  y = (short)(tm->tm_year + 1900);
5274  hh = (short)tm->tm_hour;
5275  mm = (short)tm->tm_min;
5276  /* Leap seconds ? */
5277  if (tm->tm_sec >= 60) {
5278  ss = 59;
5279  } else {
5280  ss = (short)tm->tm_sec;
5281  }
5282 
5283 #ifndef WORDS_BIGENDIAN
5284  sz = COB_BSWAP_64 (sz);
5285  y = COB_BSWAP_16 (y);
5286 #endif
5287  memcpy (file_info, &sz, (size_t)8);
5288  file_info[8] = (unsigned char)d;
5289  file_info[9] = (unsigned char)m;
5290  memcpy (file_info+10, &y, (size_t)2);
5291  file_info[12] = (unsigned char)hh;
5292  file_info[13] = (unsigned char)mm;
5293  file_info[14] = (unsigned char)ss;
5294  file_info[15] = 0;
5295  return 0;
5296 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_str_from_fld
static void * cob_str_from_fld(const cob_field *f)
Definition: fileio.c:4928
cob_s64_t
#define cob_s64_t
Definition: common.h:51
COB_BSWAP_16
#define COB_BSWAP_16(val)
Definition: common.h:256
cob_runtime_error
void cob_runtime_error(const char *,...) COB_A_FORMAT12
Definition: common.c:1543
_
#define _(s)
Definition: cobcrun.c:59
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535
COB_BSWAP_64
#define COB_BSWAP_64(val)
Definition: common.h:258
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_sys_clear_screen ( void  )

Definition at line 2377 of file screenio.c.

References cob_current_x, cob_current_y, and init_cob_screen_if_needed().

Referenced by GCic_().

2378 {
2379  init_cob_screen_if_needed ();
2380  clear ();
2381  refresh ();
2382  cob_current_y = 0;
2383  cob_current_x = 0;
2384  return 0;
2385 }
cob_current_y
static int cob_current_y
Definition: screenio.c:104
cob_current_x
static int cob_current_x
Definition: screenio.c:105
init_cob_screen_if_needed
static COB_INLINE COB_A_INLINE void init_cob_screen_if_needed(void)
Definition: screenio.c:1583

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_sys_close_file ( unsigned char *  )

Definition at line 5144 of file fileio.c.

References COB_CHK_PARMS.

5145 {
5146  int fd;
5147 
5148  COB_CHK_PARMS (CBL_CLOSE_FILE, 1);
5149 
5150  memcpy (&fd, file_handle, (size_t)4);
5151  return close (fd);
5152 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
int cob_sys_copy_file ( unsigned char *  ,
unsigned char *   
)

Definition at line 5187 of file fileio.c.

References COB_CHK_PARMS, COB_FILE_BUFF, COB_FILE_MODE, cob_free(), COB_MODULE_PTR, cob_str_from_fld(), COB_UNUSED, file_open_buff, and O_BINARY.

Referenced by cob_sys_copyfile().

5188 {
5189  char *fn1;
5190  char *fn2;
5191  int flag = O_BINARY;
5192  int ret;
5193  int i;
5194  int fd1, fd2;
5195 
5196  COB_UNUSED (fname1);
5197  COB_UNUSED (fname2);
5198 
5199  COB_CHK_PARMS (CBL_COPY_FILE, 2);
5200 
5201  if (!COB_MODULE_PTR->cob_procedure_params[0]) {
5202  return -1;
5203  }
5204  if (!COB_MODULE_PTR->cob_procedure_params[1]) {
5205  return -1;
5206  }
5207  fn1 = cob_str_from_fld (COB_MODULE_PTR->cob_procedure_params[0]);
5208  flag |= O_RDONLY;
5209  fd1 = open (fn1, flag, 0);
5210  if (fd1 < 0) {
5211  cob_free (fn1);
5212  return -1;
5213  }
5214  cob_free (fn1);
5215  fn2 = cob_str_from_fld (COB_MODULE_PTR->cob_procedure_params[1]);
5216  flag &= ~O_RDONLY;
5217  flag |= O_CREAT | O_TRUNC | O_WRONLY;
5218  fd2 = open (fn2, flag, COB_FILE_MODE);
5219  if (fd2 < 0) {
5220  close (fd1);
5221  cob_free (fn2);
5222  return -1;
5223  }
5224  cob_free (fn2);
5225 
5226  ret = 0;
5227  while ((i = read (fd1, file_open_buff, COB_FILE_BUFF)) > 0) {
5228  if (write (fd2, file_open_buff, (size_t)i) < 0) {
5229  ret = -1;
5230  break;
5231  }
5232  }
5233  close (fd1);
5234  close (fd2);
5235  return ret;
5236 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_str_from_fld
static void * cob_str_from_fld(const cob_field *f)
Definition: fileio.c:4928
O_BINARY
#define O_BINARY
Definition: fileio.c:90
COB_FILE_BUFF
#define COB_FILE_BUFF
Definition: common.h:542
COB_FILE_MODE
#define COB_FILE_MODE
Definition: common.h:738
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
file_open_buff
static char * file_open_buff
Definition: fileio.c:245
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_sys_copyfile ( unsigned char *  ,
unsigned char *  ,
unsigned char *   
)

Definition at line 5470 of file fileio.c.

References __cob_global::cob_call_params, COB_CHK_PARMS, cob_sys_copy_file(), and COB_UNUSED.

5472 {
5473  int ret;
5474 
5475  /* RXW - Type is not yet evaluated */
5476  COB_UNUSED (file_type);
5477 
5478  COB_CHK_PARMS (C$COPY, 3);
5479 
5480  if (cobglobptr->cob_call_params < 3) {
5481  return 128;
5482  }
5483  ret = cob_sys_copy_file (fname1, fname2);
5484  if (ret < 0) {
5485  ret = 128;
5486  }
5487  return ret;
5488 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
__cob_global::cob_call_params
int cob_call_params
Definition: common.h:1204
cobglobptr
static cob_global * cobglobptr
Definition: fileio.c:234
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535
cob_sys_copy_file
int cob_sys_copy_file(unsigned char *fname1, unsigned char *fname2)
Definition: fileio.c:5187

Here is the call graph for this function:

int cob_sys_create_dir ( unsigned char *  )

Definition at line 5369 of file fileio.c.

References COB_CHK_PARMS, cob_free(), COB_MODULE_PTR, cob_str_from_fld(), and COB_UNUSED.

Referenced by cob_sys_mkdir().

5370 {
5371  char *fn;
5372  int ret;
5373 
5374  COB_UNUSED (dir);
5375 
5376  COB_CHK_PARMS (CBL_CREATE_DIR, 1);
5377 
5378  if (!COB_MODULE_PTR->cob_procedure_params[0]) {
5379  return -1;
5380  }
5381  fn = cob_str_from_fld (COB_MODULE_PTR->cob_procedure_params[0]);
5382 #ifdef _WIN32
5383  ret = mkdir (fn);
5384 #else
5385  ret = mkdir (fn, 0770);
5386 #endif
5387  cob_free (fn);
5388  if (ret) {
5389  return 128;
5390  }
5391  return 0;
5392 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_str_from_fld
static void * cob_str_from_fld(const cob_field *f)
Definition: fileio.c:4928
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_sys_create_file ( unsigned char *  ,
unsigned char *  ,
unsigned char *  ,
unsigned char *  ,
unsigned char *   
)

Definition at line 5039 of file fileio.c.

References _, COB_CHK_PARMS, __cob_settings::cob_display_warn, and open_cbl_file().

5042 {
5043  /*
5044  * @param: file_access : 1 (read-only), 2 (write-only), 3 (both)
5045  * @param: file_lock : not implemented, set 0
5046  * @param: file_dev : not implemented, set 0
5047  */
5048 
5049  if (*file_lock != 0 && cobsetptr->cob_display_warn) {
5050  fprintf (stderr, _("WARNING - Call to CBL_CREATE_FILE with wrong file_lock: %d"), *file_lock);
5051  putc ('\n', stderr);
5052  fflush (stderr);
5053  }
5054  if (*file_dev != 0 && cobsetptr->cob_display_warn) {
5055  fprintf (stderr, _("WARNING - Call to CBL_CREATE_FILE with wrong file_dev: %d"), *file_dev);
5056  putc ('\n', stderr);
5057  fflush (stderr);
5058  }
5059 
5060  COB_CHK_PARMS (CBL_CREATE_FILE, 5);
5061 
5062  return open_cbl_file (file_name, file_access, file_handle, O_CREAT | O_TRUNC);
5063 }
cobsetptr
static cob_settings * cobsetptr
Definition: fileio.c:235
__cob_settings::cob_display_warn
unsigned int cob_display_warn
Definition: coblocal.h:204
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
open_cbl_file
static int open_cbl_file(unsigned char *file_name, unsigned char *file_access, unsigned char *file_handle, const int file_flags)
Definition: fileio.c:4980
_
#define _(s)
Definition: cobcrun.c:59

Here is the call graph for this function:

int cob_sys_delete_dir ( unsigned char *  )

Definition at line 5417 of file fileio.c.

References COB_CHK_PARMS, cob_free(), COB_MODULE_PTR, cob_str_from_fld(), and COB_UNUSED.

5418 {
5419  char *fn;
5420  int ret;
5421 
5422  COB_UNUSED (dir);
5423 
5424  COB_CHK_PARMS (CBL_DELETE_DIR, 1);
5425 
5426  if (!COB_MODULE_PTR->cob_procedure_params[0]) {
5427  return -1;
5428  }
5429  fn = cob_str_from_fld (COB_MODULE_PTR->cob_procedure_params[0]);
5430  ret = rmdir (fn);
5431  cob_free (fn);
5432  if (ret) {
5433  return 128;
5434  }
5435  return 0;
5436 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_str_from_fld
static void * cob_str_from_fld(const cob_field *f)
Definition: fileio.c:4928
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

int cob_sys_delete_file ( unsigned char *  )

Definition at line 5165 of file fileio.c.

References COB_CHK_PARMS, cob_free(), COB_MODULE_PTR, cob_str_from_fld(), and COB_UNUSED.

Referenced by cob_sys_file_delete(), cobxref_(), GCic_(), and get__reserved__lists_().

5166 {
5167  char *fn;
5168  int ret;
5169 
5170  COB_UNUSED (file_name);
5171 
5172  COB_CHK_PARMS (CBL_DELETE_FILE, 1);
5173 
5174  if (!COB_MODULE_PTR->cob_procedure_params[0]) {
5175  return -1;
5176  }
5177  fn = cob_str_from_fld (COB_MODULE_PTR->cob_procedure_params[0]);
5178  ret = unlink (fn);
5179  cob_free (fn);
5180  if (ret) {
5181  return 128;
5182  }
5183  return 0;
5184 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_str_from_fld
static void * cob_str_from_fld(const cob_field *f)
Definition: fileio.c:4928
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_sys_eq ( const void *  ,
void *  ,
const int   
)

Definition at line 3630 of file common.c.

References COB_CHK_PARMS, and cob_u8_ptr.

3631 {
3632  const cob_u8_ptr data_1 = p1;
3633  cob_u8_ptr data_2 = p2;
3634  size_t n;
3635 
3636  COB_CHK_PARMS (CBL_EQ, 3);
3637 
3638  if (length <= 0) {
3639  return 0;
3640  }
3641  for (n = 0; n < (size_t)length; ++n) {
3642  data_2[n] = ~(data_1[n] ^ data_2[n]);
3643  }
3644  return 0;
3645 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
int cob_sys_error_proc ( const void *  ,
const void *   
)

Definition at line 3381 of file common.c.

References COB_CHK_PARMS, cob_free(), cob_malloc(), hdlrs, handlerlist::next, NULL, and handlerlist::proc.

3382 {
3383  struct handlerlist *hp = NULL;
3384  struct handlerlist *h = hdlrs;
3385  const unsigned char *x;
3386  int (**p)(char *s);
3387 
3388  COB_CHK_PARMS (CBL_ERROR_PROC, 2);
3389 
3390  memcpy (&p, &pptr, sizeof (void *));
3391  if (!p || !*p) {
3392  return -1;
3393  }
3394 
3395  hp = NULL;
3396  h = hdlrs;
3397  /* Remove handler anyway */
3398  while (h != NULL) {
3399  if (h->proc == *p) {
3400  if (hp != NULL) {
3401  hp->next = h->next;
3402  } else {
3403  hdlrs = h->next;
3404  }
3405  if (hp) {
3406  cob_free (hp);
3407  }
3408  break;
3409  }
3410  hp = h;
3411  h = h->next;
3412  }
3413  x = dispo;
3414  if (*x != 0) {
3415  /* Remove handler */
3416  return 0;
3417  }
3418  h = cob_malloc (sizeof(struct handlerlist));
3419  h->next = hdlrs;
3420  h->proc = *p;
3421  hdlrs = h;
3422  return 0;
3423 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
handlerlist::proc
int(* proc)(char *s)
Definition: common.c:212
hdlrs
static struct handlerlist * hdlrs
handlerlist::next
struct handlerlist * next
Definition: common.c:211
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250

Here is the call graph for this function:

int cob_sys_exit_proc ( const void *  ,
const void *   
)

Definition at line 3336 of file common.c.

References COB_CHK_PARMS, cob_free(), cob_malloc(), exit_hdlrs, exit_handlerlist::next, NULL, and exit_handlerlist::proc.

3337 {
3338  struct exit_handlerlist *hp;
3339  struct exit_handlerlist *h;
3340  const unsigned char *x;
3341  int (**p)(void);
3342 
3343  COB_CHK_PARMS (CBL_EXIT_PROC, 2);
3344 
3345  memcpy (&p, &pptr, sizeof (void *));
3346  if (!p || !*p) {
3347  return -1;
3348  }
3349 
3350  hp = NULL;
3351  h = exit_hdlrs;
3352  /* Remove handler anyway */
3353  while (h != NULL) {
3354  if (h->proc == *p) {
3355  if (hp != NULL) {
3356  hp->next = h->next;
3357  } else {
3358  exit_hdlrs = h->next;
3359  }
3360  if (hp) {
3361  cob_free (hp);
3362  }
3363  break;
3364  }
3365  hp = h;
3366  h = h->next;
3367  }
3368  x = dispo;
3369  if (*x != 0 && *x != 2 && *x != 3) {
3370  /* Remove handler */
3371  return 0;
3372  }
3373  h = cob_malloc (sizeof(struct exit_handlerlist));
3374  h->next = exit_hdlrs;
3375  h->proc = *p;
3376  exit_hdlrs = h;
3377  return 0;
3378 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
exit_handlerlist::next
struct exit_handlerlist * next
Definition: common.c:205
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
exit_hdlrs
static struct exit_handlerlist * exit_hdlrs
exit_handlerlist::proc
int(* proc)(void)
Definition: common.c:206
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
exit_handlerlist
Definition: common.c:204
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250

Here is the call graph for this function:

int cob_sys_file_delete ( unsigned char *  ,
unsigned char *   
)

Definition at line 5555 of file fileio.c.

References __cob_global::cob_call_params, COB_CHK_PARMS, COB_MODULE_PTR, cob_sys_delete_file(), and COB_UNUSED.

5556 {
5557  int ret;
5558 
5559  /* RXW - Type is not yet evaluated */
5560  COB_UNUSED (file_type);
5561 
5562  COB_CHK_PARMS (C$DELETE, 2);
5563 
5564  if (cobglobptr->cob_call_params < 2 ||
5565  !COB_MODULE_PTR->cob_procedure_params[0]) {
5566  return 128;
5567  }
5568  ret = cob_sys_delete_file (file_name);
5569  if (ret < 0) {
5570  ret = 128;
5571  }
5572  return ret;
5573 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
__cob_global::cob_call_params
int cob_call_params
Definition: common.h:1204
cobglobptr
static cob_global * cobglobptr
Definition: fileio.c:234
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535
cob_sys_delete_file
int cob_sys_delete_file(unsigned char *file_name)
Definition: fileio.c:5165

Here is the call graph for this function:

int cob_sys_file_info ( unsigned char *  ,
unsigned char *   
)

Definition at line 5491 of file fileio.c.

References _, COB_BSWAP_32, COB_BSWAP_64, __cob_global::cob_call_params, COB_CHK_PARMS, cob_free(), COB_MODULE_PTR, cob_runtime_error(), cob_stop_run(), cob_str_from_fld(), cob_u64_t, and COB_UNUSED.

5492 {
5493  char *fn;
5494  struct tm *tm;
5495  cob_u64_t sz;
5496  unsigned int dt;
5497  short y;
5498  short d, m, hh, mm, ss;
5499  struct stat st;
5500 
5501  COB_UNUSED (file_name);
5502 
5503  COB_CHK_PARMS (C$FILEINFO, 2);
5504 
5505  if (cobglobptr->cob_call_params < 2 ||
5506  !COB_MODULE_PTR->cob_procedure_params[0]) {
5507  return 128;
5508  }
5509  if (!COB_MODULE_PTR->cob_procedure_params[1]) {
5510  return 128;
5511  }
5512  if (COB_MODULE_PTR->cob_procedure_params[1]->size < 16U) {
5513  cob_runtime_error (_("'%s' - File detail area is too short"), "C$FILEINFO");
5514  cob_stop_run (1);
5515  }
5516 
5517  fn = cob_str_from_fld (COB_MODULE_PTR->cob_procedure_params[0]);
5518  if (stat (fn, &st) < 0) {
5519  cob_free (fn);
5520  return 35;
5521  }
5522  cob_free (fn);
5523  sz = (cob_u64_t)st.st_size;
5524  tm = localtime (&st.st_mtime);
5525  d = (short)tm->tm_mday;
5526  m = (short)(tm->tm_mon + 1);
5527  y = (short)(tm->tm_year + 1900);
5528  hh = (short)tm->tm_hour;
5529  mm = (short)tm->tm_min;
5530  /* Leap seconds ? */
5531  if (tm->tm_sec >= 60) {
5532  ss = 59;
5533  } else {
5534  ss = (short)tm->tm_sec;
5535  }
5536 
5537 #ifndef WORDS_BIGENDIAN
5538  sz = COB_BSWAP_64 (sz);
5539 #endif
5540  memcpy (file_info, &sz, (size_t)8);
5541  dt = (y * 10000) + (m * 100) + d;
5542 #ifndef WORDS_BIGENDIAN
5543  dt = COB_BSWAP_32 (dt);
5544 #endif
5545  memcpy (file_info + 8, &dt, (size_t)4);
5546  dt = (hh * 1000000) + (mm * 10000) + (ss * 100);
5547 #ifndef WORDS_BIGENDIAN
5548  dt = COB_BSWAP_32 (dt);
5549 #endif
5550  memcpy (file_info + 12, &dt, (size_t)4);
5551  return 0;
5552 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_str_from_fld
static void * cob_str_from_fld(const cob_field *f)
Definition: fileio.c:4928
COB_BSWAP_32
#define COB_BSWAP_32(val)
Definition: common.h:257
__cob_global::cob_call_params
int cob_call_params
Definition: common.h:1204
cob_runtime_error
void cob_runtime_error(const char *,...) COB_A_FORMAT12
Definition: common.c:1543
_
#define _(s)
Definition: cobcrun.c:59
cobglobptr
static cob_global * cobglobptr
Definition: fileio.c:234
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cob_u64_t
#define cob_u64_t
Definition: common.h:52
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535
COB_BSWAP_64
#define COB_BSWAP_64(val)
Definition: common.h:258
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

int cob_sys_flush_file ( unsigned char *  )

Definition at line 5155 of file fileio.c.

References COB_CHK_PARMS, and COB_UNUSED.

5156 {
5157  COB_UNUSED (file_handle);
5158 
5159  COB_CHK_PARMS (CBL_FLUSH_FILE, 1);
5160 
5161  return 0;
5162 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535
int cob_sys_get_csr_pos ( unsigned char *  )

Definition at line 2530 of file screenio.c.

References COB_CHK_PARMS.

2531 {
2532 #ifdef COB_GEN_SCREENIO
2533  int cline;
2534  int ccol;
2535 #endif
2536 
2537  COB_CHK_PARMS (CBL_GET_CSR_POS, 1);
2538 
2539 #ifdef COB_GEN_SCREENIO
2540  getyx (stdscr, cline, ccol);
2541  fld[0] = (unsigned char)cline;
2542  fld[1] = (unsigned char)ccol;
2543 
2544 #else
2545  fld[0] = 1U;
2546  fld[1] = 1U;
2547 #endif
2548  return 0;
2549 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
int cob_sys_get_current_dir ( const int  ,
const int  ,
unsigned char *   
)

Definition at line 5328 of file fileio.c.

References COB_CHK_PARMS, cob_free(), and NULL.

5330 {
5331  char *dirname;
5332  int dir_size;
5333  int has_space;
5334 
5335  COB_CHK_PARMS (CBL_GET_CURRENT_DIR, 3);
5336 
5337  if (dir_length < 1) {
5338  return 128;
5339  }
5340  if (flags) {
5341  return 129;
5342  }
5343  memset (dir, ' ', (size_t)dir_length);
5344  dirname = getcwd (NULL, (size_t)0);
5345  if (dirname == NULL) {
5346  return 128;
5347  }
5348  dir_size = (int) strlen (dirname);
5349  has_space = 0;
5350  if (strchr (dirname, ' ')) {
5351  has_space = 2;
5352  }
5353  if (dir_size + has_space > dir_length) {
5354  cob_free (dirname);
5355  return 128;
5356  }
5357  if (has_space) {
5358  *dir = '"';
5359  memcpy (&dir[1], dirname, (size_t)dir_size);
5360  dir[dir_size + 1] = '"';
5361  } else {
5362  memcpy (dir, dirname, (size_t)dir_size);
5363  }
5364  cob_free (dirname);
5365  return 0;
5366 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the call graph for this function:

int cob_sys_get_scr_size ( unsigned char *  ,
unsigned char *   
)

Definition at line 2552 of file screenio.c.

References COB_CHK_PARMS, COLS, and LINES.

2553 {
2554  COB_CHK_PARMS (CBL_GET_SCR_SIZE, 2);
2555 
2556 #ifdef COB_GEN_SCREENIO
2557  *line = (unsigned char)LINES;
2558  *col = (unsigned char)COLS;
2559 #else
2560  *line = 24U;
2561  *col = 80U;
2562 #endif
2563  return 0;
2564 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
COLS
Definition: parser.c:1409
LINES
Definition: parser.c:1598
line
if fold fold static computed alternate extra correct stack on syntax debugging line
Definition: flag.def:90
int cob_sys_getopt_long_long ( void *  ,
void *  ,
void *  ,
const int  ,
void *  ,
void *   
)

Definition at line 3889 of file common.c.

References _, cob_argc, cob_argv, COB_CHK_PARMS, cob_field_to_string(), cob_free(), cob_get_int(), cob_getopt_long_long(), cob_malloc(), COB_MODULE_PTR, cob_optarg, cob_runtime_error(), cob_set_int(), cob_stop_run(), COB_UNUSED, option::flag, option::has_arg, longoption_def::has_option, option::name, longoption_def::name, NULL, longoption_def::return_value, longoption_def::return_value_pointer, and option::val.

3889  {
3890  /*
3891  * cob_argc is a static int containing argc from runtime
3892  * cob_argv is a static char** containing argv from runtime
3893  */
3894 
3895  size_t opt_val_size = 0;
3896  size_t so_size = 0;
3897  size_t lo_size = 0;
3898  size_t optlen;
3899 
3900  unsigned int lo_amount;
3901 
3902  int exit_status;
3903 
3904  char* shortoptions;
3905  char* temp;
3906 
3907  struct option* longoptions;
3908  longoption_def* l = NULL;
3909 
3910  int longind = 0;
3911  unsigned int i;
3912  int j;
3913 
3914  int return_value;
3915 
3916  COB_UNUSED (idx);
3917  COB_UNUSED (lo);
3918  COB_UNUSED (so);
3919 
3920  COB_CHK_PARMS (CBL_OC_GETOPT, 6);
3921 
3922  /*
3923  * Read in sizes of some parameters
3924  */
3925  if (COB_MODULE_PTR->cob_procedure_params[1]) {
3926  lo_size = COB_MODULE_PTR->cob_procedure_params[1]->size;
3927  }
3928  if (COB_MODULE_PTR->cob_procedure_params[0]) {
3929  so_size = COB_MODULE_PTR->cob_procedure_params[0]->size;
3930  }
3931  if (COB_MODULE_PTR->cob_procedure_params[5]) {
3932  opt_val_size = COB_MODULE_PTR->cob_procedure_params[5]->size;
3933  }
3934 
3935  /*
3936  * Buffering longoptions (cobol), target format (struct option)
3937  */
3938  if (lo_size % sizeof(longoption_def) == 0) {
3939  lo_amount = (int)lo_size / sizeof(longoption_def);
3940  longoptions = (struct option*) cob_malloc(sizeof(struct option) * (lo_amount + 1U));
3941  }
3942  else {
3943  cob_runtime_error (_("Call to CBL_OC_GETOPT with wrong longoption size."));
3944  cob_stop_run (1);
3945  }
3946 
3947  if (!COB_MODULE_PTR->cob_procedure_params[2]) {
3948  cob_runtime_error (_("Call to CBL_OC_GETOPT with missing longind."));
3949  cob_stop_run (1);
3950  }
3951  longind = cob_get_int (COB_MODULE_PTR->cob_procedure_params[2]);
3952 
3953  /*
3954  * Add 0-termination to strings.
3955  */
3956  shortoptions = cob_malloc(so_size + 1U);
3957  if (COB_MODULE_PTR->cob_procedure_params[0]) {
3958  cob_field_to_string (COB_MODULE_PTR->cob_procedure_params[0], shortoptions, so_size);
3959  }
3960 
3961  if (COB_MODULE_PTR->cob_procedure_params[1]) {
3962  l = (struct longoption_def*) (COB_MODULE_PTR->cob_procedure_params[1]->data);
3963  }
3964 
3965  for (i = 0; i < lo_amount; i++) {
3966  j = sizeof(l->name) - 1;
3967  while (j >= 0 && l->name[j] == 0x20) {
3968  l->name[j] = 0x00;
3969  j--;
3970  }
3971  longoptions->name = l->name;
3972  longoptions->has_arg = (int) l->has_option - '0';
3973  memcpy (&longoptions->flag, l->return_value_pointer, sizeof(l->return_value_pointer));
3974  memcpy(&longoptions->val, &l->return_value, 4);
3975 
3976  l = l + 1; /* +1 means pointer + 1*sizeof(longoption_def) */
3977  longoptions = longoptions + 1;
3978  }
3979 
3980  /*
3981  * Appending final record, so getopt can spot the end of longoptions
3982  */
3983  longoptions->name = NULL;
3984  longoptions->has_arg = 0;
3985  longoptions->flag = NULL;
3986  longoptions->val = 0;
3987 
3988 
3989  l -= lo_amount; /* Set pointer back to begin of longoptions */
3990  longoptions -= lo_amount;
3991 
3992  return_value = cob_getopt_long_long(cob_argc, cob_argv, shortoptions, longoptions, &longind, long_only);
3993  temp = (char*) &return_value;
3994 
3995  /*
3996  * Write data back to COBOL
3997  */
3998  if (temp[0] == '?' || temp[0] == ':' || temp[0] == 'W'
3999  || temp[0] == -1 || temp[0] == 0) exit_status = return_value;
4000  else exit_status = 3;
4001 
4002  for(i = 3; i > 0; i--) {
4003  if(temp[i] == 0x00) temp[i] = 0x20;
4004  else break;
4005  }
4006 
4007  cob_set_int (COB_MODULE_PTR->cob_procedure_params[2], longind);
4008  memcpy (return_char, &return_value, 4);
4009 
4010  if(cob_optarg != NULL) {
4011  memset (opt_val, 0x00, opt_val_size);
4012 
4013  optlen = strlen (cob_optarg);
4014  if (optlen > opt_val_size) {
4015  /* Returncode 2 for "Optionvalue too long => cut" */
4016  optlen = opt_val_size;
4017  exit_status = 2;
4018  }
4019  memcpy (opt_val, cob_optarg, optlen);
4020  }
4021 
4022 
4023  cob_free (shortoptions);
4024  cob_free (longoptions);
4025 
4026  return exit_status;
4027 
4028 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
longoption_def::return_value_pointer
char return_value_pointer[sizeof(char *)]
Definition: common.h:1364
longoption_def::has_option
char has_option
Definition: common.h:1363
cob_getopt_long_long
int cob_getopt_long_long(const int argc, char *const *argv, const char *optstring, const struct option *longopts, int *longind, const int long_only)
Definition: cobgetopt.c:321
option::val
int val
Definition: cobgetopt.h:87
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_argc
static int cob_argc
Definition: common.c:125
cob_argv
static char ** cob_argv
Definition: common.c:126
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
longoption_def::name
char name[25]
Definition: common.h:1362
_
#define _(s)
Definition: cobcrun.c:59
longoption_def
Definition: common.h:1361
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
option::name
const char * name
Definition: cobgetopt.h:82
cob_set_int
void cob_set_int(cob_field *, const int)
Definition: move.c:1612
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cob_field_to_string
void cob_field_to_string(const cob_field *f, void *str, const size_t maxsize)
Definition: common.c:1492
option::flag
int * flag
Definition: cobgetopt.h:86
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
longoption_def::return_value
char return_value[4]
Definition: common.h:1365
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535
option::has_arg
int has_arg
Definition: cobgetopt.h:85
cob_runtime_error
void cob_runtime_error(const char *fmt,...)
Definition: common.c:1543
cob_optarg
char * cob_optarg
Definition: cobgetopt.c:77
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

int cob_sys_getpid ( void  )

Definition at line 3818 of file common.c.

References cob_process_id.

Referenced by cob_temp_name().

3819 {
3820  if (!cob_process_id) {
3821  cob_process_id = (int)getpid ();
3822  }
3823  return cob_process_id;
3824 }
cob_process_id
static int cob_process_id
Definition: common.c:160

Here is the caller graph for this function:

int cob_sys_hosted ( void *  ,
const void *   
)

Return some hosted C variables, argc, argv, stdin, stdout, stderr.

Definition at line 3465 of file common.c.

References cob_argc, cob_argv, COB_CHK_PARMS, COB_MODULE_PTR, and cob_u8_ptr.

3466 {
3467  const char *name = var;
3468  cob_u8_ptr data = p;
3469  size_t i;
3470 
3471  COB_CHK_PARMS (CBL_OC_HOSTED, 2);
3472 
3473  if (!data) {
3474  return 1;
3475  }
3476 
3477  if (COB_MODULE_PTR->cob_procedure_params[1]) {
3478  i = (int)COB_MODULE_PTR->cob_procedure_params[1]->size;
3479  if ((i == 4) && !strncmp (name, "argc", 4)) {
3480  *((int *)data) = cob_argc;
3481  return 0;
3482  }
3483  if ((i == 4) && !strncmp (name, "argv", 4)) {
3484  *((char ***)data) = cob_argv;
3485  return 0;
3486  }
3487  if ((i == 5) && !strncmp (name, "stdin", 5)) {
3488  *((FILE **)data) = stdin;
3489  return 0;
3490  }
3491  if ((i == 6) && !strncmp (name, "stdout", 6)) {
3492  *((FILE **)data) = stdout;
3493  return 0;
3494  }
3495  if ((i == 6) && !strncmp (name, "stderr", 6)) {
3496  *((FILE **)data) = stderr;
3497  return 0;
3498  }
3499  if ((i == 5) && !strncmp (name, "errno", 5)) {
3500  *((int **)data) = &errno;
3501  return 0;
3502  }
3503 #if defined(HAVE_TIMEZONE)
3504  if ((i == 6) && !strncmp (name, "tzname", 6)) {
3505  *((char ***)data) = tzname;
3506  return 0;
3507  }
3508  if ((i == 8) && !strncmp (name, "timezone", 8)) {
3509  *((long *)data) = timezone;
3510  return 0;
3511  }
3512  if ((i == 8) && !strncmp (name, "daylight", 8)) {
3513  *((int *)data) = daylight;
3514  return 0;
3515  }
3516 #endif
3517  }
3518  return 1;
3519 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_argc
static int cob_argc
Definition: common.c:125
cob_argv
static char ** cob_argv
Definition: common.c:126
longoption_def::name
char name[25]
Definition: common.h:1362
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
int cob_sys_imp ( const void *  ,
void *  ,
const int   
)

Definition at line 3594 of file common.c.

References COB_CHK_PARMS, and cob_u8_ptr.

3595 {
3596  const cob_u8_ptr data_1 = p1;
3597  cob_u8_ptr data_2 = p2;
3598  size_t n;
3599 
3600  COB_CHK_PARMS (CBL_IMP, 3);
3601 
3602  if (length <= 0) {
3603  return 0;
3604  }
3605  for (n = 0; n < (size_t)length; ++n) {
3606  data_2[n] = (~data_1[n]) | data_2[n];
3607  }
3608  return 0;
3609 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
int cob_sys_justify ( void *  ,
  ... 
)

Definition at line 4086 of file common.c.

References __cob_global::cob_call_params, COB_CHK_PARMS, COB_MODULE_PTR, and cob_u8_ptr.

Referenced by LISTING_().

4087 {
4088  cob_u8_ptr data;
4089  unsigned char *direction;
4090  size_t datalen;
4091  size_t left;
4092  size_t right;
4093  size_t movelen;
4094  size_t centrelen;
4095  size_t n;
4096  size_t shifting;
4097  va_list args;
4098 
4099  COB_CHK_PARMS (C$JUSTIFY, 1);
4100 
4101  if (!COB_MODULE_PTR->cob_procedure_params[0]) {
4102  return 0;
4103  }
4104  data = p1;
4105  datalen = COB_MODULE_PTR->cob_procedure_params[0]->size;
4106  if (datalen < 2) {
4107  return 0;
4108  }
4109  if (data[0] != ' ' && data[datalen - 1] != ' ') {
4110  return 0;
4111  }
4112  for (left = 0; left < datalen; ++left) {
4113  if (data[left] != ' ') {
4114  break;
4115  }
4116  }
4117  if (left == datalen) {
4118  return 0;
4119  }
4120  right = 0;
4121  for (n = datalen - 1; ; --n, ++right) {
4122  if (data[n] != ' ') {
4123  break;
4124  }
4125  if (n == 0) {
4126  break;
4127  }
4128  }
4129  movelen = datalen - left - right;
4130  shifting = 0;
4131  if (cobglobptr->cob_call_params > 1) {
4132  va_start (args, p1);
4133  direction = va_arg (args, unsigned char *);
4134  va_end (args);
4135  if (*direction == 'L') {
4136  shifting = 1;
4137  } else if (*direction == 'C') {
4138  shifting = 2;
4139  }
4140  }
4141  switch (shifting) {
4142  case 1:
4143  memmove (data, &data[left], movelen);
4144  memset (&data[movelen], ' ', datalen - movelen);
4145  break;
4146  case 2:
4147  centrelen = (left + right) / 2;
4148  memmove (&data[centrelen], &data[left], movelen);
4149  memset (data, ' ', centrelen);
4150  if ((left + right) % 2) {
4151  memset (&data[centrelen + movelen], ' ', centrelen + 1);
4152  } else {
4153  memset (&data[centrelen + movelen], ' ', centrelen);
4154  }
4155  break;
4156  default:
4157  memmove (&data[left + right], &data[left], movelen);
4158  memset (data, ' ', datalen - movelen);
4159  break;
4160  }
4161  return 0;
4162 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
__cob_global::cob_call_params
int cob_call_params
Definition: common.h:1204
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130

Here is the caller graph for this function:

int cob_sys_mkdir ( unsigned char *  )

Definition at line 5439 of file fileio.c.

References COB_CHK_PARMS, and cob_sys_create_dir().

5440 {
5441  int ret;
5442 
5443  COB_CHK_PARMS (C$MAKEDIR, 1);
5444 
5445  ret = cob_sys_create_dir (dir);
5446  if (ret < 0) {
5447  ret = 128;
5448  }
5449  return ret;
5450 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_sys_create_dir
int cob_sys_create_dir(unsigned char *dir)
Definition: fileio.c:5369

Here is the call graph for this function:

int cob_sys_nimp ( const void *  ,
void *  ,
const int   
)

Definition at line 3612 of file common.c.

References COB_CHK_PARMS, and cob_u8_ptr.

3613 {
3614  const cob_u8_ptr data_1 = p1;
3615  cob_u8_ptr data_2 = p2;
3616  size_t n;
3617 
3618  COB_CHK_PARMS (CBL_NIMP, 3);
3619 
3620  if (length <= 0) {
3621  return 0;
3622  }
3623  for (n = 0; n < (size_t)length; ++n) {
3624  data_2[n] = data_1[n] & (~data_2[n]);
3625  }
3626  return 0;
3627 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
int cob_sys_nor ( const void *  ,
void *  ,
const int   
)

Definition at line 3558 of file common.c.

References COB_CHK_PARMS, and cob_u8_ptr.

3559 {
3560  const cob_u8_ptr data_1 = p1;
3561  cob_u8_ptr data_2 = p2;
3562  size_t n;
3563 
3564  COB_CHK_PARMS (CBL_NOR, 3);
3565 
3566  if (length <= 0) {
3567  return 0;
3568  }
3569  for (n = 0; n < (size_t)length; ++n) {
3570  data_2[n] = ~(data_1[n] | data_2[n]);
3571  }
3572  return 0;
3573 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
int cob_sys_not ( void *  ,
const int   
)

Definition at line 3648 of file common.c.

References COB_CHK_PARMS, and cob_u8_ptr.

3649 {
3650  cob_u8_ptr data_1 = p1;
3651  size_t n;
3652 
3653  COB_CHK_PARMS (CBL_NOT, 2);
3654 
3655  if (length <= 0) {
3656  return 0;
3657  }
3658  for (n = 0; n < (size_t)length; ++n) {
3659  data_1[n] = ~data_1[n];
3660  }
3661  return 0;
3662 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
int cob_sys_oc_nanosleep ( const void *  )

Definition at line 3774 of file common.c.

References COB_CHK_PARMS, cob_get_llint(), COB_MODULE_PTR, cob_s64_t, COB_UNUSED, and NULL.

3775 {
3776  cob_s64_t nsecs;
3777 #if defined(_WIN32) || defined(__370__) || defined(__OS400__)
3778  unsigned int msecs;
3779 #elif defined(HAVE_NANO_SLEEP)
3780  struct timespec tsec;
3781 #else
3782  unsigned int msecs;
3783 #endif
3784 
3785  COB_UNUSED (data);
3786 
3787  COB_CHK_PARMS (CBL_OC_NANOSLEEP, 1);
3788 
3789  if (COB_MODULE_PTR->cob_procedure_params[0]) {
3790  nsecs = cob_get_llint (COB_MODULE_PTR->cob_procedure_params[0]);
3791  if (nsecs > 0) {
3792 #ifdef _WIN32
3793  msecs = (unsigned int)(nsecs / 1000000);
3794  if (msecs > 0) {
3795  Sleep (msecs);
3796  }
3797 #elif defined(__370__) || defined(__OS400__)
3798  msecs = (unsigned int)(nsecs / 1000000000);
3799  if (msecs > 0) {
3800  sleep (msecs);
3801  }
3802 #elif defined(HAVE_NANO_SLEEP)
3803  tsec.tv_sec = nsecs / 1000000000;
3804  tsec.tv_nsec = nsecs % 1000000000;
3805  nanosleep (&tsec, NULL);
3806 #else
3807  msecs = (unsigned int)(nsecs / 1000000000);
3808  if (msecs > 0) {
3809  sleep (msecs);
3810  }
3811 #endif
3812  }
3813  }
3814  return 0;
3815 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_s64_t
#define cob_s64_t
Definition: common.h:51
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535
cob_get_llint
long long cob_get_llint(cob_field *)
Definition: move.c:1656

Here is the call graph for this function:

int cob_sys_open_file ( unsigned char *  ,
unsigned char *  ,
unsigned char *  ,
unsigned char *  ,
unsigned char *   
)

Definition at line 5026 of file fileio.c.

References COB_CHK_PARMS, COB_UNUSED, and open_cbl_file().

5029 {
5030  COB_UNUSED (file_lock);
5031  COB_UNUSED (file_dev);
5032 
5033  COB_CHK_PARMS (CBL_OPEN_FILE, 5);
5034 
5035  return open_cbl_file (file_name, file_access, file_handle, 0);
5036 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
open_cbl_file
static int open_cbl_file(unsigned char *file_name, unsigned char *file_access, unsigned char *file_handle, const int file_flags)
Definition: fileio.c:4980
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

int cob_sys_or ( const void *  ,
void *  ,
const int   
)

Definition at line 3540 of file common.c.

References COB_CHK_PARMS, and cob_u8_ptr.

3541 {
3542  const cob_u8_ptr data_1 = p1;
3543  cob_u8_ptr data_2 = p2;
3544  size_t n;
3545 
3546  COB_CHK_PARMS (CBL_OR, 3);
3547 
3548  if (length <= 0) {
3549  return 0;
3550  }
3551  for (n = 0; n < (size_t)length; ++n) {
3552  data_2[n] |= data_1[n];
3553  }
3554  return 0;
3555 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
int cob_sys_parameter_size ( void *  )

Definition at line 3867 of file common.c.

References COB_CHK_PARMS, cob_get_int(), COB_MODULE_PTR, and COB_UNUSED.

3868 {
3869  int n;
3870 
3871  COB_UNUSED (data);
3872 
3873  COB_CHK_PARMS (C$PARAMSIZE, 1);
3874 
3875  if (COB_MODULE_PTR->cob_procedure_params[0]) {
3876  n = cob_get_int (COB_MODULE_PTR->cob_procedure_params[0]);
3877  if (n > 0 && n <= COB_MODULE_PTR->module_num_params) {
3878  n--;
3879  if (COB_MODULE_PTR->next &&
3880  COB_MODULE_PTR->next->cob_procedure_params[n]) {
3881  return (int)COB_MODULE_PTR->next->cob_procedure_params[n]->size;
3882  }
3883  }
3884  }
3885  return 0;
3886 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

int cob_sys_printable ( void *  ,
  ... 
)

Definition at line 4053 of file common.c.

References __cob_global::cob_call_params, COB_CHK_PARMS, COB_MODULE_PTR, and cob_u8_ptr.

4054 {
4055  cob_u8_ptr data;
4056  unsigned char *dotptr;
4057  size_t datalen;
4058  size_t n;
4059  unsigned char dotrep;
4060  va_list args;
4061 
4062  COB_CHK_PARMS (C$PRINTABLE, 1);
4063 
4064  if (!COB_MODULE_PTR->cob_procedure_params[0]) {
4065  return 0;
4066  }
4067  data = p1;
4068  datalen = COB_MODULE_PTR->cob_procedure_params[0]->size;
4069  if (cobglobptr->cob_call_params > 1) {
4070  va_start (args, p1);
4071  dotptr = va_arg (args, unsigned char *);
4072  va_end (args);
4073  dotrep = *dotptr;
4074  } else {
4075  dotrep = (unsigned char)'.';
4076  }
4077  for (n = 0; n < datalen; ++n) {
4078  if (!isprint (data[n])) {
4079  data[n] = dotrep;
4080  }
4081  }
4082  return 0;
4083 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
__cob_global::cob_call_params
int cob_call_params
Definition: common.h:1204
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130
int cob_sys_read_file ( unsigned char *  ,
unsigned char *  ,
unsigned char *  ,
unsigned char *  ,
unsigned char *   
)

Definition at line 5066 of file fileio.c.

References COB_BSWAP_32, COB_BSWAP_64, COB_CHK_PARMS, and cob_s64_t.

5069 {
5070  cob_s64_t off;
5071  int fd;
5072  int len;
5073  int rc;
5074  struct stat st;
5075 
5076  COB_CHK_PARMS (CBL_READ_FILE, 5);
5077 
5078  rc = 0;
5079  memcpy (&fd, file_handle, (size_t)4);
5080  memcpy (&off, file_offset, (size_t)8);
5081  memcpy (&len, file_len, (size_t)4);
5082 #ifndef WORDS_BIGENDIAN
5083  off = COB_BSWAP_64 (off);
5084  len = COB_BSWAP_32 (len);
5085 #endif
5086  if (lseek (fd, (off_t)off, SEEK_SET) == (off_t)-1) {
5087  return -1;
5088  }
5089  if (len > 0) {
5090  rc = read (fd, buf, (size_t)len);
5091  if (rc < 0) {
5092  rc = -1;
5093  } else if (rc == 0) {
5094  rc = 10;
5095  } else {
5096  rc = 0;
5097  }
5098  }
5099  if ((*flags & 0x80) != 0) {
5100  if (fstat (fd, &st) < 0) {
5101  return -1;
5102  }
5103  off = st.st_size;
5104 #ifndef WORDS_BIGENDIAN
5105  off = COB_BSWAP_64 (off);
5106 #endif
5107  memcpy (file_offset, &off, (size_t)8);
5108  }
5109  return rc;
5110 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_s64_t
#define cob_s64_t
Definition: common.h:51
COB_BSWAP_32
#define COB_BSWAP_32(val)
Definition: common.h:257
COB_BSWAP_64
#define COB_BSWAP_64(val)
Definition: common.h:258
int cob_sys_rename_file ( unsigned char *  ,
unsigned char *   
)

Definition at line 5299 of file fileio.c.

References COB_CHK_PARMS, cob_free(), COB_MODULE_PTR, cob_str_from_fld(), and COB_UNUSED.

5300 {
5301  char *fn1;
5302  char *fn2;
5303  int ret;
5304 
5305  COB_UNUSED (fname1);
5306  COB_UNUSED (fname2);
5307 
5308  COB_CHK_PARMS (CBL_RENAME_FILE, 2);
5309 
5310  if (!COB_MODULE_PTR->cob_procedure_params[0]) {
5311  return -1;
5312  }
5313  if (!COB_MODULE_PTR->cob_procedure_params[1]) {
5314  return -1;
5315  }
5316  fn1 = cob_str_from_fld (COB_MODULE_PTR->cob_procedure_params[0]);
5317  fn2 = cob_str_from_fld (COB_MODULE_PTR->cob_procedure_params[1]);
5318  ret = rename (fn1, fn2);
5319  cob_free (fn1);
5320  cob_free (fn2);
5321  if (ret) {
5322  return 128;
5323  }
5324  return 0;
5325 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_str_from_fld
static void * cob_str_from_fld(const cob_field *f)
Definition: fileio.c:4928
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

int cob_sys_return_args ( void *  )

Definition at line 3827 of file common.c.

References COB_CHK_PARMS, COB_MODULE_PTR, cob_set_int(), and COB_UNUSED.

3828 {
3829  COB_UNUSED (data);
3830 
3831  COB_CHK_PARMS (C$NARG, 1);
3832 
3833  if (COB_MODULE_PTR->cob_procedure_params[0]) {
3834  cob_set_int (COB_MODULE_PTR->cob_procedure_params[0],
3835  COB_MODULE_PTR->module_num_params);
3836  }
3837  return 0;
3838 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_set_int
void cob_set_int(cob_field *, const int)
Definition: move.c:1612
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

int cob_sys_sleep ( const void *  )

Definition at line 4031 of file common.c.

References COB_CHK_PARMS, cob_get_int(), COB_MODULE_PTR, and COB_UNUSED.

Referenced by GCic_().

4032 {
4033  int n;
4034 
4035  COB_UNUSED (data);
4036 
4037  COB_CHK_PARMS (C$SLEEP, 1);
4038 
4039  if (COB_MODULE_PTR->cob_procedure_params[0]) {
4040  n = cob_get_int (COB_MODULE_PTR->cob_procedure_params[0]);
4041  if (n > 0 && n < 3600*24*7) {
4042 #ifdef _WIN32
4043  Sleep (n*1000);
4044 #else
4045  sleep ((unsigned int)n);
4046 #endif
4047  }
4048  }
4049  return 0;
4050 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_sys_sound_bell ( void  )

Definition at line 2506 of file screenio.c.

References cob_beep(), COB_BEEP_VALUE, cob_screen_init(), __cob_global::cob_screen_initialized, and cob_speaker_beep().

2507 {
2508  if (COB_BEEP_VALUE == 9) {
2509  return 0;
2510  }
2511 #ifdef COB_GEN_SCREENIO
2512  if (!cobglobptr->cob_screen_initialized &&
2513  COB_BEEP_VALUE != 2) {
2514  cob_screen_init ();
2515  }
2516  cob_beep ();
2517 #else
2518  cob_speaker_beep ();
2519 #endif
2520  return 0;
2521 }
cob_screen_init
static void cob_screen_init(void)
Definition: screenio.c:490
cob_speaker_beep
static void cob_speaker_beep(void)
Definition: screenio.c:115
cob_beep
static void cob_beep(void)
Definition: screenio.c:128
__cob_global::cob_screen_initialized
unsigned int cob_screen_initialized
Definition: common.h:1208
COB_BEEP_VALUE
#define COB_BEEP_VALUE
Definition: coblocal.h:192
cobglobptr
static cob_global * cobglobptr
Definition: screenio.c:92

Here is the call graph for this function:

int cob_sys_system ( const void *  )

Definition at line 3426 of file common.c.

References _, COB_CHK_PARMS, cob_free(), cob_malloc(), COB_MEDIUM_MAX, COB_MODULE_PTR, cob_runtime_error(), __cob_global::cob_screen_initialized, cob_screen_set_mode(), cob_stop_run(), and unlikely.

Referenced by GCic_(), and get__reserved__lists_().

3427 {
3428  const char *cmd;
3429  char *buff;
3430  int i;
3431 
3432  COB_CHK_PARMS (SYSTEM, 1);
3433 
3434  if (COB_MODULE_PTR->cob_procedure_params[0]) {
3435  cmd = cmdline;
3436  i = (int)COB_MODULE_PTR->cob_procedure_params[0]->size;
3437  if (unlikely(i > COB_MEDIUM_MAX)) {
3438  cob_runtime_error (_("Parameter to SYSTEM call is larger than %d characters"), COB_MEDIUM_MAX);
3439  cob_stop_run (1);
3440  }
3441  i--;
3442  for (; i >= 0; --i) {
3443  if (cmd[i] != ' ' && cmd[i] != 0) {
3444  break;
3445  }
3446  }
3447  if (i >= 0) {
3448  buff = cob_malloc ((size_t)(i + 2));
3449  memcpy (buff, cmd, (size_t)(i + 1));
3450  if (cobglobptr->cob_screen_initialized) {
3451  cob_screen_set_mode (0);
3452  }
3453  i = system (buff);
3454  cob_free (buff);
3455  if (cobglobptr->cob_screen_initialized) {
3456  cob_screen_set_mode (1U);
3457  }
3458  return i;
3459  }
3460  }
3461  return 1;
3462 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
_
#define _(s)
Definition: cobcrun.c:59
unlikely
#define unlikely(x)
Definition: common.h:437
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
__cob_global::cob_screen_initialized
unsigned int cob_screen_initialized
Definition: common.h:1208
cob_screen_set_mode
void cob_screen_set_mode(const cob_u32_t)
Definition: screenio.c:2388
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
cobglobptr
static cob_global * cobglobptr
Definition: common.c:130
COB_MEDIUM_MAX
#define COB_MEDIUM_MAX
Definition: common.h:549
cob_runtime_error
void cob_runtime_error(const char *fmt,...)
Definition: common.c:1543
cob_stop_run
void cob_stop_run(const int status)
Definition: common.c:1524

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_sys_tolower ( void *  ,
const int   
)

Definition at line 3756 of file common.c.

References COB_CHK_PARMS, cob_u8_ptr, and cob_u8_t.

3757 {
3758  cob_u8_ptr data = p1;
3759  size_t n;
3760 
3761  COB_CHK_PARMS (CBL_TOLOWER, 2);
3762 
3763  if (length > 0) {
3764  for (n = 0; n < (size_t)length; ++n) {
3765  if (isupper (data[n])) {
3766  data[n] = (cob_u8_t)tolower (data[n]);
3767  }
3768  }
3769  }
3770  return 0;
3771 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_u8_t
#define cob_u8_t
Definition: common.h:27
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
int cob_sys_toupper ( void *  ,
const int   
)

Definition at line 3738 of file common.c.

References COB_CHK_PARMS, cob_u8_ptr, and cob_u8_t.

3739 {
3740  cob_u8_ptr data = p1;
3741  size_t n;
3742 
3743  COB_CHK_PARMS (CBL_TOUPPER, 2);
3744 
3745  if (length > 0) {
3746  for (n = 0; n < (size_t)length; ++n) {
3747  if (islower (data[n])) {
3748  data[n] = (cob_u8_t)toupper (data[n]);
3749  }
3750  }
3751  }
3752  return 0;
3753 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_u8_t
#define cob_u8_t
Definition: common.h:27
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
int cob_sys_write_file ( unsigned char *  ,
unsigned char *  ,
unsigned char *  ,
unsigned char *  ,
unsigned char *   
)

Definition at line 5113 of file fileio.c.

References COB_BSWAP_32, COB_BSWAP_64, COB_CHK_PARMS, cob_s64_t, and COB_UNUSED.

5116 {
5117  cob_s64_t off;
5118  int fd;
5119  int len;
5120  int rc;
5121 
5122  COB_UNUSED (flags);
5123 
5124  COB_CHK_PARMS (CBL_WRITE_FILE, 5);
5125 
5126  memcpy (&fd, file_handle, (size_t)4);
5127  memcpy (&off, file_offset, (size_t)8);
5128  memcpy (&len, file_len, (size_t)4);
5129 #ifndef WORDS_BIGENDIAN
5130  off = COB_BSWAP_64 (off);
5131  len = COB_BSWAP_32 (len);
5132 #endif
5133  if (lseek (fd, (off_t)off, SEEK_SET) == (off_t)-1) {
5134  return -1;
5135  }
5136  rc = write (fd, buf, (size_t)len);
5137  if (rc < 0) {
5138  return 30;
5139  }
5140  return 0;
5141 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_s64_t
#define cob_s64_t
Definition: common.h:51
COB_BSWAP_32
#define COB_BSWAP_32(val)
Definition: common.h:257
COB_UNUSED
#define COB_UNUSED(z)
Definition: common.h:535
COB_BSWAP_64
#define COB_BSWAP_64(val)
Definition: common.h:258
int cob_sys_x91 ( void *  ,
const void *  ,
void *   
)

Definition at line 3696 of file common.c.

References COB_MODULE_PTR, cob_switch, and cob_u8_ptr.

3697 {
3698  cob_u8_ptr result = p1;
3699  const cob_u8_ptr func = p2;
3700  cob_u8_ptr parm = p3;
3701  unsigned char *p;
3702  size_t i;
3703 
3704  switch (*func) {
3705  case 11:
3706  /* Set switches */
3707  p = parm;
3708  for (i = 0; i < 8; ++i, ++p) {
3709  if (*p == 0) {
3710  cob_switch[i] = 0;
3711  } else if (*p == 1) {
3712  cob_switch[i] = 1;
3713  }
3714  }
3715  *result = 0;
3716  break;
3717  case 12:
3718  /* Get switches */
3719  p = parm;
3720  for (i = 0; i < 8; ++i, ++p) {
3721  *p = (unsigned char)cob_switch[i];
3722  }
3723  *result = 0;
3724  break;
3725  case 16:
3726  /* Return number of call parameters */
3727  *parm = (unsigned char)COB_MODULE_PTR->module_num_params;
3728  *result = 0;
3729  break;
3730  default:
3731  *result = 1;
3732  break;
3733  }
3734  return 0;
3735 }
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cob_switch
static int cob_switch[36+1]
Definition: common.c:201
int cob_sys_xf4 ( void *  ,
const void *   
)

Definition at line 3665 of file common.c.

References COB_CHK_PARMS, and cob_u8_ptr.

3666 {
3667  cob_u8_ptr data_1 = p1;
3668  const cob_u8_ptr data_2 = p2;
3669  size_t n;
3670 
3671  COB_CHK_PARMS (CBL_XF4, 2);
3672 
3673  *data_1 = 0;
3674  for (n = 0; n < 8; ++n) {
3675  *data_1 |= (data_2[n] & 1) << (7 - n);
3676  }
3677  return 0;
3678 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
int cob_sys_xf5 ( const void *  ,
void *   
)

Definition at line 3681 of file common.c.

References COB_CHK_PARMS, and cob_u8_ptr.

3682 {
3683  const cob_u8_ptr data_1 = p1;
3684  cob_u8_ptr data_2 = p2;
3685  size_t n;
3686 
3687  COB_CHK_PARMS (CBL_XF5, 2);
3688 
3689  for (n = 0; n < 8; ++n) {
3690  data_2[n] = (*data_1 & (1 << (7 - n))) ? 1 : 0;
3691  }
3692  return 0;
3693 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
int cob_sys_xor ( const void *  ,
void *  ,
const int   
)

Definition at line 3576 of file common.c.

References COB_CHK_PARMS, and cob_u8_ptr.

3577 {
3578  const cob_u8_ptr data_1 = p1;
3579  cob_u8_ptr data_2 = p2;
3580  size_t n;
3581 
3582  COB_CHK_PARMS (CBL_XOR, 3);
3583 
3584  if (length <= 0) {
3585  return 0;
3586  }
3587  for (n = 0; n < (size_t)length; ++n) {
3588  data_2[n] ^= data_1[n];
3589  }
3590  return 0;
3591 }
COB_CHK_PARMS
#define COB_CHK_PARMS(x, z)
Definition: coblocal.h:167
cob_u8_ptr
#define cob_u8_ptr
Definition: common.h:66
void cob_table_sort ( cob_field *  ,
const int   
)

Definition at line 2516 of file common.c.

References cob_free(), cob_field::data, cob_field::size, and sort_compare().

Referenced by cobxref_().

2517 {
2518  qsort (f->data, (size_t) n, f->size, sort_compare);
2519  cob_free (sort_keys);
2520 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
sort_keys
static cob_file_key * sort_keys
Definition: common.c:147
sort_compare
static int sort_compare(const void *data1, const void *data2)
Definition: common.c:1018

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_table_sort_init ( const size_t  ,
const unsigned char *   
)

Definition at line 2494 of file common.c.

References cob_malloc(), COB_MODULE_PTR, sort_collate, and sort_nkeys.

Referenced by cobxref_().

2495 {
2496  sort_nkeys = 0;
2497  sort_keys = cob_malloc (nkeys * sizeof (cob_file_key));
2498  if (collating_sequence) {
2499  sort_collate = collating_sequence;
2500  } else {
2501  sort_collate = COB_MODULE_PTR->collating_sequence;
2502  }
2503 }
sort_keys
static cob_file_key * sort_keys
Definition: common.c:147
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
sort_collate
static const unsigned char * sort_collate
Definition: common.c:148
cob_file_key
Definition: common.h:1101
sort_nkeys
static size_t sort_nkeys
Definition: common.c:146

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_table_sort_init_key ( cob_field *  ,
const int  ,
const unsigned  int 
)

Definition at line 2506 of file common.c.

References cob_file_key::field, cob_file_key::flag, cob_file_key::offset, and sort_nkeys.

Referenced by cobxref_().

2508 {
2509  sort_keys[sort_nkeys].field = field;
2510  sort_keys[sort_nkeys].flag = flag;
2511  sort_keys[sort_nkeys].offset = offset;
2512  sort_nkeys++;
2513 }
sort_keys
static cob_file_key * sort_keys
Definition: common.c:147
cob_file_key::offset
unsigned int offset
Definition: common.h:1105
cob_file_key::field
cob_field * field
Definition: common.h:1102
cob_file_key::flag
int flag
Definition: common.h:1103
sort_nkeys
static size_t sort_nkeys
Definition: common.c:146

Here is the caller graph for this function:

void cob_temp_name ( char *  ,
const char *   
)

Definition at line 3253 of file common.c.

References COB_FILE_MAX, cob_gettmpdir(), cob_sys_getpid(), cob_temp_iteration, and SLASH_CHAR.

Referenced by cob_srttmpfile(), and process_filename().

3254 {
3255  /* Set temporary file name */
3256  if (ext) {
3257  snprintf (filename, (size_t)COB_FILE_MAX, "%s%ccob%d_%d%s",
3258  cob_gettmpdir(), SLASH_CHAR, cob_sys_getpid(), cob_temp_iteration, ext);
3259  } else {
3260  snprintf (filename, (size_t)COB_FILE_MAX, "%s%ccobsort%d_%d",
3261  cob_gettmpdir(), SLASH_CHAR, cob_sys_getpid(), cob_temp_iteration);
3262  }
3263 }
cob_gettmpdir
static const char * cob_gettmpdir(void)
Definition: common.c:3210
SLASH_CHAR
#define SLASH_CHAR
Definition: common.h:505
cob_temp_iteration
static int cob_temp_iteration
Definition: common.c:161
filename
Definition: cobc.h:195
COB_FILE_MAX
#define COB_FILE_MAX
Definition: common.h:548
cob_sys_getpid
int cob_sys_getpid(void)
Definition: common.c:3818

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_tidy ( void  )

Definition at line 3315 of file common.c.

References cob_initialized, cob_terminate_routines(), exit_hdlrs, exit_handlerlist::next, NULL, and exit_handlerlist::proc.

3316 {
3317  struct exit_handlerlist *h;
3318 
3319  if (!cob_initialized) {
3320  exit (1);
3321  }
3322  if (exit_hdlrs != NULL) {
3323  h = exit_hdlrs;
3324  while (h != NULL) {
3325  h->proc ();
3326  h = h->next;
3327  }
3328  }
3329  cob_terminate_routines ();
3330  return 0;
3331 }
exit_handlerlist::next
struct exit_handlerlist * next
Definition: common.c:205
exit_hdlrs
static struct exit_handlerlist * exit_hdlrs
exit_handlerlist::proc
int(* proc)(void)
Definition: common.c:206
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
exit_handlerlist
Definition: common.c:204
cob_initialized
static int cob_initialized
Definition: common.c:124
cob_terminate_routines
static void cob_terminate_routines(void)
Definition: common.c:406

Here is the call graph for this function:

void cob_trace_section ( const char *  ,
const char *  ,
const int   
)

Definition at line 1429 of file common.c.

References cob_check_trace_file(), cob_free(), cob_last_sfile, __cob_settings::cob_line_trace, COB_MODULE_PTR, cob_strdup(), and cob_trace_file.

1430 {
1431  const char *s;
1432 
1433  if (cobsetptr->cob_line_trace) {
1434  if (!cob_trace_file) {
1435  cob_check_trace_file ();
1436  if (!cob_trace_file) return; /* silence warnings */
1437  }
1438  if (source &&
1439  (!cob_last_sfile || strcmp (cob_last_sfile, source))) {
1440  if (cob_last_sfile) {
1441  cob_free ((void *)cob_last_sfile);
1442  }
1443  cob_last_sfile = cob_strdup (source);
1444  fprintf (cob_trace_file, "Source: '%s'\n", source);
1445  }
1446  if (COB_MODULE_PTR->module_name) {
1447  s = COB_MODULE_PTR->module_name;
1448  } else {
1449  s = "Unknown";
1450  }
1451  fprintf (cob_trace_file, "Program-Id: %-16s ", s);
1452  if (line) {
1453  fprintf (cob_trace_file, "%-34.34sLine: %d\n", para, line);
1454  } else {
1455  fprintf (cob_trace_file, "%s\n", para);
1456  }
1457  fflush (cob_trace_file);
1458  }
1459 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
cob_trace_file
static FILE * cob_trace_file
Definition: common.c:155
cobsetptr
static cob_settings * cobsetptr
Definition: common.c:131
cob_last_sfile
static const char * cob_last_sfile
Definition: common.c:128
__cob_settings::cob_line_trace
unsigned int cob_line_trace
Definition: coblocal.h:206
COB_MODULE_PTR
#define COB_MODULE_PTR
Definition: coblocal.h:185
line
if fold fold static computed alternate extra correct stack on syntax debugging line
Definition: flag.def:90
cob_check_trace_file
static void cob_check_trace_file(void)
Definition: common.c:1056
cob_strdup
char * cob_strdup(const char *p)
Definition: common.c:1308

Here is the call graph for this function:

void cob_unlock_file ( cob_file *  ,
cob_field *   
)

Definition at line 4431 of file fileio.c.

References cob_file_unlock(), COB_STATUS_00_SUCCESS, and save_status().

4432 {
4433  cob_file_unlock (f);
4434  save_status (f, fnstatus, COB_STATUS_00_SUCCESS);
4435 }
COB_STATUS_00_SUCCESS
#define COB_STATUS_00_SUCCESS
Definition: common.h:828
save_status
static void save_status(cob_file *f, cob_field *fnstatus, const int status)
Definition: fileio.c:668
cob_file_unlock
static void cob_file_unlock(cob_file *f)
Definition: fileio.c:4366

Here is the call graph for this function:

void cob_unstring_delimited ( cob_field *  ,
const unsigned  int 
)

Referenced by cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

Here is the caller graph for this function:

void cob_unstring_finish ( void  )

Definition at line 620 of file strings.c.

References COB_EC_OVERFLOW_UNSTRING, cob_set_exception(), cob_set_int(), cob_field::size, and unstring_offset.

Referenced by cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

621 {
622  if (unstring_offset < (int)unstring_src->size) {
623  cob_set_exception (COB_EC_OVERFLOW_UNSTRING);
624  }
625 
626  if (unstring_ptr) {
627  cob_set_int (unstring_ptr, unstring_offset + 1);
628  }
629 }
unstring_offset
static int unstring_offset
Definition: strings.c:82
unstring_ptr
static cob_field * unstring_ptr
Definition: strings.c:78
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
cob_set_int
void cob_set_int(cob_field *, const int)
Definition: move.c:1612
cob_field::size
size_t size
Definition: common.h:951
unstring_src
static cob_field * unstring_src
Definition: strings.c:77

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_unstring_init ( cob_field *  ,
cob_field *  ,
const size_t   
)

Definition at line 487 of file strings.c.

References COB_EC_OVERFLOW_UNSTRING, cob_free(), cob_get_int(), cob_malloc(), cob_set_exception(), dlm_list_size, NULL, cob_field::size, unstring_count, unstring_ndlms, unstring_offset, unstring_ptr_copy, and unstring_src_copy.

Referenced by cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

488 {
489  unstring_src_copy = *src;
490  unstring_src = &unstring_src_copy;
491  unstring_ptr = NULL;
492  if (ptr) {
493  unstring_ptr_copy = *ptr;
494  unstring_ptr = &unstring_ptr_copy;
495  }
496 
497  unstring_offset = 0;
498  unstring_count = 0;
499  unstring_ndlms = 0;
500  cob_set_exception (0);
501  if (num_dlm > dlm_list_size) {
502  cob_free (dlm_list);
503  dlm_list = cob_malloc (num_dlm * sizeof(struct dlm_struct));
504  dlm_list_size = num_dlm;
505  }
506 
507  if (unstring_ptr) {
508  unstring_offset = cob_get_int (unstring_ptr) - 1;
509  if (unstring_offset < 0 || unstring_offset >= (int)unstring_src->size) {
510  cob_set_exception (COB_EC_OVERFLOW_UNSTRING);
511  }
512  }
513 }
cob_free
void cob_free(void *mptr)
Definition: common.c:1284
unstring_offset
static int unstring_offset
Definition: strings.c:82
unstring_count
static int unstring_count
Definition: strings.c:83
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
dlm_list
static struct dlm_struct * dlm_list
Definition: strings.c:76
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
unstring_ptr
static cob_field * unstring_ptr
Definition: strings.c:78
cob_set_exception
void cob_set_exception(const int id)
Definition: common.c:1212
dlm_list_size
static size_t dlm_list_size
Definition: strings.c:79
dlm_struct
Definition: strings.c:45
unstring_ndlms
static int unstring_ndlms
Definition: strings.c:84
cob_field::size
size_t size
Definition: common.h:951
cob_malloc
void * cob_malloc(const size_t size)
Definition: common.c:1250
unstring_ptr_copy
static cob_field unstring_ptr_copy
Definition: strings.c:81
unstring_src_copy
static cob_field unstring_src_copy
Definition: strings.c:80
unstring_src
static cob_field * unstring_src
Definition: strings.c:77

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_unstring_into ( cob_field *  ,
cob_field *  ,
cob_field *   
)

Definition at line 524 of file strings.c.

References COB_FIELD_IS_NUMERIC, COB_FIELD_SIZE, cob_get_exception_code(), cob_min_int(), cob_set_int(), cob_str_memcpy(), cob_field::data, NULL, cob_field::size, dlm_struct::uns_all, dlm_struct::uns_dlm, unstring_count, unstring_ndlms, and unstring_offset.

Referenced by cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

525 {
526  unsigned char *p;
527  unsigned char *dp;
528  unsigned char *s;
529  unsigned char *dlm_data;
530  unsigned char *start;
531  size_t dlm_size = 0;
532  int i;
533  int srsize;
534  int dlsize;
535  int match_size = 0;
536  int brkpt = 0;
537 
538  if (cob_get_exception_code ()) {
539  return;
540  }
541 
542  if (unstring_offset >= (int)unstring_src->size) {
543  return;
544  }
545 
546  start = unstring_src->data + unstring_offset;
547  dlm_data = NULL;
548  if (unstring_ndlms == 0) {
549  match_size = cob_min_int ((int)COB_FIELD_SIZE (dst),
550  (int)unstring_src->size - unstring_offset);
551  cob_str_memcpy (dst, start, match_size);
552  unstring_offset += match_size;
553  } else {
554  srsize = (int) unstring_src->size;
555  s = unstring_src->data + srsize;
556  for (p = start; p < s; ++p) {
557  for (i = 0; i < unstring_ndlms; ++i) {
558  dlsize = (int) dlm_list[i].uns_dlm.size;
559  dp = dlm_list[i].uns_dlm.data;
560  if (p + dlsize > s) {
561  continue;
562  }
563  if (!memcmp (p, dp, (size_t)dlsize)) { /* delimiter equal */
564  match_size = (int)(p - start); /* count in */
565  cob_str_memcpy (dst, start, match_size); /* into */
566  unstring_offset += match_size + dlsize; /* with pointer */
567  dlm_data = dp;
568  dlm_size = dlsize;
569  if (dlm_list[i].uns_all) { /* delimited by all */
570  for (p += dlsize ; p < s; p += dlsize) {
571  if (p + dlsize > s) {
572  break;
573  }
574  if (memcmp (p, dp, (size_t)dlsize)) {
575  break;
576  }
577  unstring_offset += dlsize;
578  }
579  }
580  brkpt = 1;
581  break;
582  }
583  }
584  if (brkpt) {
585  break;
586  }
587  }
588  if (!brkpt) {
589  /* No match */
590  match_size = (int)(unstring_src->size - unstring_offset);
591  cob_str_memcpy (dst, start, match_size);
592  unstring_offset = (int) unstring_src->size;
593  dlm_data = NULL;
594  }
595  }
596  unstring_count++;
597 
598  if (dlm) {
599  if (dlm_data) {
600  cob_str_memcpy (dlm, dlm_data, (int) dlm_size);
601  } else if (COB_FIELD_IS_NUMERIC (dlm)) {
602  cob_set_int (dlm, 0);
603  } else {
604  memset (dlm->data, ' ', dlm->size);
605  }
606  }
607 
608  if (cnt) {
609  cob_set_int (cnt, match_size);
610  }
611 }
unstring_offset
static int unstring_offset
Definition: strings.c:82
cob_str_memcpy
static void cob_str_memcpy(cob_field *dst, unsigned char *src, const int size)
Definition: strings.c:104
COB_FIELD_IS_NUMERIC
#define COB_FIELD_IS_NUMERIC(f)
Definition: common.h:674
unstring_count
static int unstring_count
Definition: strings.c:83
cob_field::data
unsigned char * data
Definition: common.h:952
cob_min_int
static COB_INLINE int cob_min_int(const int x, const int y)
Definition: strings.c:95
dlm_list
static struct dlm_struct * dlm_list
Definition: strings.c:76
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cob_get_exception_code
int cob_get_exception_code(void)
Definition: common.c:1193
cob_set_int
void cob_set_int(cob_field *, const int)
Definition: move.c:1612
dlm_struct::uns_dlm
cob_field uns_dlm
Definition: strings.c:46
unstring_ndlms
static int unstring_ndlms
Definition: strings.c:84
cob_field::size
size_t size
Definition: common.h:951
unstring_src
static cob_field * unstring_src
Definition: strings.c:77
COB_FIELD_SIZE
#define COB_FIELD_SIZE(f)
Definition: common.h:671

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_unstring_tallying ( cob_field *  )

Definition at line 614 of file strings.c.

References cob_add_int(), and unstring_count.

615 {
616  cob_add_int (f, unstring_count, 0);
617 }
cob_add_int
int cob_add_int(cob_field *, const int, const int)
Definition: numeric.c:2195
unstring_count
static int unstring_count
Definition: strings.c:83

Here is the call graph for this function:

int cob_valid_date_format ( const char *  )

Definition at line 3355 of file intrinsic.c.

Referenced by cob_valid_datetime_format(), valid_day_and_format(), and valid_format().

3356 {
3357  return !strcmp (format, "YYYYMMDD")
3358  || !strcmp (format, "YYYY-MM-DD")
3359  || !strcmp (format, "YYYYDDD")
3360  || !strcmp (format, "YYYY-DDD")
3361  || !strcmp (format, "YYYYWwwD")
3362  || !strcmp (format, "YYYY-Www-D");
3363 }

Here is the caller graph for this function:

int cob_valid_datetime_format ( const char *  ,
const char   
)

Definition at line 3402 of file intrinsic.c.

References COB_DATETIMESTR_LEN, cob_valid_date_format(), cob_valid_time_format(), parse_date_format_string(), parse_time_format_string(), split_around_t(), time_format::with_colons, and date_format::with_hyphens.

Referenced by cob_intr_formatted_current_date(), cob_intr_formatted_datetime(), cob_intr_seconds_from_formatted_time(), and valid_format().

3403 {
3404  char date_format_str[COB_DATETIMESTR_LEN] = { '\0' };
3405  char time_format_str[COB_DATETIMESTR_LEN] = { '\0' };
3406  struct date_format date_format;
3407  struct time_format time_format;
3408 
3409  split_around_t (format, date_format_str, time_format_str);
3410 
3411  if (!cob_valid_date_format (date_format_str)
3412  || !cob_valid_time_format (time_format_str, decimal_point)) {
3413  return 0;
3414  }
3415 
3416  /* Check time and date formats match */
3417  date_format = parse_date_format_string (date_format_str);
3418  time_format = parse_time_format_string (time_format_str);
3419  if (date_format.with_hyphens != time_format.with_colons) {
3420  return 0;
3421  }
3422 
3423  return 1;
3424 }
date_format
Definition: intrinsic.c:2125
split_around_t
static void split_around_t(const char *str, char *first, char *second)
Definition: intrinsic.c:2384
time_format
Definition: intrinsic.c:1955
COB_DATETIMESTR_LEN
#define COB_DATETIMESTR_LEN
Definition: intrinsic.c:127
cob_valid_time_format
int cob_valid_time_format(const char *format, const char decimal_point)
Definition: intrinsic.c:3366
date_format::with_hyphens
int with_hyphens
Definition: intrinsic.c:2127
cob_valid_date_format
int cob_valid_date_format(const char *format)
Definition: intrinsic.c:3355
time_format::with_colons
int with_colons
Definition: intrinsic.c:1956
parse_time_format_string
static struct time_format parse_time_format_string(const char *str)
Definition: intrinsic.c:2282
parse_date_format_string
static struct date_format parse_date_format_string(const char *format_str)
Definition: intrinsic.c:2131

Here is the call graph for this function:

Here is the caller graph for this function:

int cob_valid_time_format ( const char *  ,
const char   
)

Definition at line 3366 of file intrinsic.c.

References COB_TIMEDEC_MAX, decimal_places_for_seconds(), rest_is_offset_format(), and rest_is_z().

Referenced by cob_intr_formatted_time(), cob_intr_seconds_from_formatted_time(), cob_valid_datetime_format(), and valid_format().

3367 {
3368  int with_colons;
3369  ptrdiff_t format_offset;
3370  unsigned int decimal_places = 0;
3371 
3372  if (!strncmp (format, "hhmmss", 6)) {
3373  with_colons = 0;
3374  format_offset = 6;
3375  } else if (!strncmp (format, "hh:mm:ss", 8)) {
3376  with_colons = 1;
3377  format_offset = 8;
3378  } else {
3379  return 0;
3380  }
3381 
3382  /* Validate number of decimal places */
3383  if (format[format_offset] == decimal_point) {
3384  decimal_places = decimal_places_for_seconds (format, format_offset);
3385  format_offset += decimal_places + 1;
3386  if (!(1 <= decimal_places && decimal_places <= COB_TIMEDEC_MAX)) {
3387  return 0;
3388  }
3389  }
3390 
3391  /* Check for trailing garbage */
3392  if (strlen (format) > (size_t) format_offset
3393  && !rest_is_z (format + format_offset)
3394  && !rest_is_offset_format (format + format_offset, with_colons)) {
3395  return 0;
3396  }
3397 
3398  return 1;
3399 }
rest_is_z
static int rest_is_z(const char *str)
Definition: intrinsic.c:2194
time_format::decimal_places
int decimal_places
Definition: intrinsic.c:1957
decimal_places_for_seconds
static int decimal_places_for_seconds(const char *str, const ptrdiff_t point_pos)
Definition: intrinsic.c:2181
rest_is_offset_format
static int rest_is_offset_format(const char *str, const int with_colon)
Definition: intrinsic.c:2200
COB_TIMEDEC_MAX
#define COB_TIMEDEC_MAX
Definition: intrinsic.c:122
time_format::with_colons
int with_colons
Definition: intrinsic.c:1956

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_write ( cob_file *  ,
cob_field *  ,
const int  ,
cob_field *  ,
const unsigned  int 
)

Definition at line 4754 of file fileio.c.

References cob_file::access_mode, check_eop_status, COB_ACCESS_SEQUENTIAL, cob_get_int(), COB_OPEN_EXTEND, COB_OPEN_I_O, COB_OPEN_OUTPUT, COB_STATUS_44_RECORD_OVERFLOW, COB_STATUS_48_OUTPUT_DENIED, cob_file::flag_read_done, cob_file::open_mode, cob_file::organization, cob_file::record, cob_file::record_max, cob_file::record_min, save_status(), cob_field::size, unlikely, cob_file::variable_record, and cob_fileio_funcs::write.

Referenced by cob_file_sort_giving(), cobxref_(), GCic_(), and LISTING_().

4756 {
4757  f->flag_read_done = 0;
4758 
4759  if (f->access_mode == COB_ACCESS_SEQUENTIAL) {
4760  if (unlikely(f->open_mode != COB_OPEN_OUTPUT &&
4761  f->open_mode != COB_OPEN_EXTEND)) {
4762  save_status (f, fnstatus, COB_STATUS_48_OUTPUT_DENIED);
4763  return;
4764  }
4765  } else {
4766  if (unlikely(f->open_mode != COB_OPEN_OUTPUT &&
4767  f->open_mode != COB_OPEN_I_O)) {
4768  save_status (f, fnstatus, COB_STATUS_48_OUTPUT_DENIED);
4769  return;
4770  }
4771  }
4772 
4773  if (f->variable_record) {
4774  f->record->size = (size_t)cob_get_int (f->variable_record);
4775  if (unlikely(f->record->size > rec->size)) {
4776  f->record->size = rec->size;
4777  }
4778  } else {
4779  f->record->size = rec->size;
4780  }
4781 
4782  if (f->record->size < f->record_min || f->record_max < f->record->size) {
4783  save_status (f, fnstatus, COB_STATUS_44_RECORD_OVERFLOW);
4784  return;
4785  }
4786 
4787  check_eop_status = check_eop;
4788  save_status (f, fnstatus,
4789  fileio_funcs[(int)f->organization]->write (f, opt));
4790 }
COB_STATUS_44_RECORD_OVERFLOW
#define COB_STATUS_44_RECORD_OVERFLOW
Definition: common.h:849
cob_get_int
int cob_get_int(cob_field *)
Definition: move.c:1626
COB_OPEN_EXTEND
#define COB_OPEN_EXTEND
Definition: common.h:787
unlikely
#define unlikely(x)
Definition: common.h:437
COB_STATUS_48_OUTPUT_DENIED
#define COB_STATUS_48_OUTPUT_DENIED
Definition: common.h:852
save_status
static void save_status(cob_file *f, cob_field *fnstatus, const int status)
Definition: fileio.c:668
check_eop_status
static unsigned int check_eop_status
Definition: fileio.c:238
COB_ACCESS_SEQUENTIAL
#define COB_ACCESS_SEQUENTIAL
Definition: common.h:751
COB_OPEN_I_O
#define COB_OPEN_I_O
Definition: common.h:786
fileio_funcs
static const struct cob_fileio_funcs * fileio_funcs[COB_ORG_MAX]
Definition: fileio.c:339
cob_fileio_funcs::write
int(* write)(cob_file *, const int)
Definition: common.h:1229
COB_OPEN_OUTPUT
#define COB_OPEN_OUTPUT
Definition: common.h:785

Here is the call graph for this function:

Here is the caller graph for this function:

void print_info ( void  )

Definition at line 5153 of file common.c.

References _, COB_BLD_BUILD, COB_BLD_CC, COB_BLD_CFLAGS, COB_BLD_CPPFLAGS, COB_BLD_LD, COB_BLD_LDFLAGS, COB_EXEEXT, COB_MODULE_EXT, COB_OBJECT_EXT, NULL, OC_C_VERSION, OC_C_VERSION_PRF, print_version(), var_print(), WITH_CURSES, and WITH_VARSEQ.

Referenced by process_command_line().

5154 {
5155  char buff[16];
5156  char *s;
5157 
5158  print_version ();
5159  putchar ('\n');
5160  puts (_("Build information"));
5161  var_print (_("Build environment"), COB_BLD_BUILD, "", 0);
5162  var_print ("CC", COB_BLD_CC, "", 0);
5163  var_print ("CPPFLAGS", COB_BLD_CPPFLAGS, "", 0);
5164  var_print ("CFLAGS", COB_BLD_CFLAGS, "", 0);
5165  var_print ("LD", COB_BLD_LD, "", 0);
5166  var_print ("LDFLAGS", COB_BLD_LDFLAGS, "", 0);
5167  putchar ('\n');
5168  printf (_("C version %s%s"), OC_C_VERSION_PRF, OC_C_VERSION);
5169  putchar ('\n');
5170 
5171  puts (_("GnuCOBOL information"));
5172 
5173  var_print ("COB_MODULE_EXT", COB_MODULE_EXT, "", 0);
5174 #if 0 /* only relevant for cobc */
5175  var_print ("COB_OBJECT_EXT", COB_OBJECT_EXT, "", 0);
5176  var_print ("COB_EXEEXT", COB_EXEEXT, "", 0);
5177 #endif
5178 
5179 #if defined(USE_LIBDL) || defined(_WIN32)
5180  var_print (_("Dynamic loading"), _("System"), "", 0);
5181 #else
5182  var_print (_("Dynamic loading"), _("Libtool"), "", 0);
5183 #endif
5184 
5185 #ifdef COB_PARAM_CHECK
5186  var_print ("\"CBL_\" param check", _("Enabled"), "", 0);
5187 #else
5188  var_print ("\"CBL_\" param check", _("Disabled"), "", 0);
5189 #endif
5190 
5191  if (sizeof (void *) > 4U) {
5192  var_print ("64bit-mode", _("yes"), "", 0);
5193  } else {
5194  var_print ("64bit-mode", _("no"), "", 0);
5195  }
5196 
5197 #ifdef COB_LI_IS_LL
5198  var_print ("BINARY-C-LONG", _("8 bytes"), "", 0);
5199 #else
5200  var_print ("BINARY-C-LONG", _("4 bytes"), "", 0);
5201 #endif
5202 
5203  var_print (_("Extended screen I/O"), WITH_CURSES, "", 0);
5204 
5205  snprintf (buff, sizeof(buff), "%d", WITH_VARSEQ);
5206  var_print (_("Variable format"), buff, "", 0);
5207  if ((s = getenv ("COB_VARSEQ_FORMAT")) != NULL) {
5208  var_print ("COB_VARSEQ_FORMAT", s, "", 1);
5209  }
5210 
5211 #ifdef WITH_SEQRA_EXTFH
5212  var_print (_("Sequential handler"), _("External"), "", 0);
5213 #else
5214  var_print (_("Sequential handler"), _("Internal"), "", 0);
5215 #endif
5216 
5217 #if defined (WITH_INDEX_EXTFH)
5218  var_print (_("ISAM handler"), _("External"), "", 0);
5219 #elif defined (WITH_DB)
5220  var_print (_("ISAM handler"), "BDB", "", 0);
5221 #elif defined (WITH_CISAM)
5222  var_print (_("ISAM handler"), "C-ISAM" "", 0);
5223 #elif defined (WITH_DISAM)
5224  var_print (_("ISAM handler"), "D-ISAM", "", 0);
5225 #elif defined (WITH_VBISAM)
5226  var_print (_("ISAM handler"), "VBISAM", "", 0);
5227 #else
5228  var_print (_("ISAM handler"), _("Not available"), "", 0);
5229 #endif
5230 }
print_version
void print_version(void)
Definition: common.c:5119
WITH_VARSEQ
#define WITH_VARSEQ
Definition: config.h:370
var_print
static void var_print(const char *msg, const char *val, const char *default_val, const unsigned int format)
Definition: common.c:4331
COB_BLD_CPPFLAGS
#define COB_BLD_CPPFLAGS
Definition: defaults.h:12
COB_MODULE_EXT
#define COB_MODULE_EXT
Definition: defaults.h:9
COB_BLD_LDFLAGS
#define COB_BLD_LDFLAGS
Definition: defaults.h:15
COB_BLD_CC
#define COB_BLD_CC
Definition: defaults.h:11
OC_C_VERSION
#define OC_C_VERSION
Definition: common.c:102
_
#define _(s)
Definition: cobcrun.c:59
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
WITH_CURSES
#define WITH_CURSES
Definition: config.h:355
COB_BLD_LD
#define COB_BLD_LD
Definition: defaults.h:14
COB_BLD_CFLAGS
#define COB_BLD_CFLAGS
Definition: defaults.h:13
OC_C_VERSION_PRF
#define OC_C_VERSION_PRF
Definition: common.c:101
COB_BLD_BUILD
#define COB_BLD_BUILD
Definition: defaults.h:16
COB_EXEEXT
#define COB_EXEEXT
Definition: config.h:8
COB_OBJECT_EXT
#define COB_OBJECT_EXT
Definition: defaults.h:10

Here is the call graph for this function:

Here is the caller graph for this function:

void print_runtime_env ( void  )

Definition at line 5234 of file common.c.

References _, __cob_settings::cob_config_file, __cob_settings::cob_config_num, COB_MEDIUM_BUFF, COB_MINI_BUFF, FUNC_NAME_IN_DEFAULT, get_config_val(), GRP_MAX, not_set, NULL, NUM_CONFIG, PACKAGE_NAME, PACKAGE_VERSION, PATCH_LEVEL, setting_group, STS_CNFSET, STS_ENVCLR, STS_ENVSET, STS_FNCSET, STS_RESET, and value.

Referenced by process_command_line().

5235 {
5236  unsigned int i,j,k,vl,dohdg,hdlen,plen;
5237  char value[COB_MEDIUM_BUFF],orgvalue[COB_MINI_BUFF];
5238 
5239  printf ("%s %s.%d ", PACKAGE_NAME, PACKAGE_VERSION, PATCH_LEVEL);
5240  puts (_("runtime environment"));
5241  if (cobsetptr->cob_config_file) {
5242  strcpy(value, _("via"));
5243  hdlen = (unsigned int)strlen(value) + 3;
5244 
5245  /* output path of main configuration file */
5246  printf(" %s ", value);
5247  plen = 80 - hdlen;
5248  strcpy(value, cobsetptr->cob_config_file[0]);
5249  vl = (unsigned int)strlen(value);
5250  for (k = 0; vl > plen; vl -= plen, k += plen) {
5251  printf("%.*s\n%-*s", plen, &value[k], hdlen, "");
5252  }
5253  printf("%s\n", &value[k]);
5254 
5255  /* output path of additional configuration files */
5256  for (i = 1; i < cobsetptr->cob_config_num; i++) {
5257  printf("%*d ", hdlen - 2, i);
5258  strcpy(value, cobsetptr->cob_config_file[i]);
5259  vl = (unsigned int)strlen(value);
5260  for (k = 0; vl > plen; vl -= plen, k += plen) {
5261  printf("%.*s\n%-*s", plen, &value[k], hdlen, "");
5262  }
5263  printf("%s\n", &value[k]);
5264  }
5265 
5266  }
5267  putchar('\n');
5268  strcpy(value,"todo");
5269  hdlen = 15;
5270  for (i=0; i < NUM_CONFIG; i++) {
5271  j = (unsigned int)strlen(gc_conf[i].env_name);
5272  if(j > hdlen)
5273  hdlen = j;
5274  j = (unsigned int)strlen(gc_conf[i].conf_name);
5275  if(j > hdlen)
5276  hdlen = j;
5277  }
5278 
5279  for (j=1; j < GRP_MAX; j++) {
5280  dohdg = 1;
5281  for (i=0; i < NUM_CONFIG; i++) {
5282  if(gc_conf[i].env_group == j) {
5283  if(dohdg) {
5284  dohdg = 0;
5285  if (j > 1) {
5286  putchar('\n');
5287  }
5288  printf(" %s\n",setting_group[j]);
5289  }
5290  /* Convert value back into string and display it */
5291  get_config_val(value,i,orgvalue);
5292  if((gc_conf[i].data_type & STS_ENVSET)
5293  || (gc_conf[i].data_type & STS_FNCSET)) {
5294  putchar(' ');
5295  if (gc_conf[i].data_type & STS_FNCSET) {
5296  printf(" ");
5297  } else if ((gc_conf[i].data_type & STS_CNFSET)) {
5298  printf("Ovr");
5299  } else {
5300  printf("env");
5301  }
5302  printf(": %-*s : ",hdlen,gc_conf[i].env_name);
5303  } else if((gc_conf[i].data_type & STS_CNFSET)) {
5304  if (gc_conf[i].config_num > 0) {
5305  printf(" %d ", gc_conf[i].config_num);
5306  } else {
5307  printf(" ");
5308  }
5309  if (gc_conf[i].set_by > 0) {
5310  printf(": %-*s : ", hdlen, gc_conf[i].env_name);
5311  } else {
5312  printf(": %-*s : ", hdlen, gc_conf[i].conf_name);
5313  }
5314  } else if(gc_conf[i].env_name) {
5315  if(gc_conf[i].config_num > 0){
5316  printf(" %d ",gc_conf[i].config_num);
5317  } else {
5318  printf(" ");
5319  }
5320  printf(": %-*s : ",hdlen,gc_conf[i].env_name);
5321  } else {
5322  printf(" : %-*s : ",hdlen,gc_conf[i].conf_name);
5323  }
5324  vl = (unsigned int)strlen(value);
5325  plen = 71 - hdlen;
5326  for (k = 0; vl > plen; vl -= plen, k += plen) {
5327  printf("%.*s\n %-*s : ", plen, &value[k], hdlen, "");
5328  }
5329  printf("%s",&value[k]);
5330  if (orgvalue[0] > ' ') {
5331  printf(" (%s)", orgvalue);
5332  }
5333  if (gc_conf[i].set_by > 0) {
5334  putchar(' ');
5335  if (gc_conf[i].set_by != FUNC_NAME_IN_DEFAULT) {
5336  printf(_("(set by %s)"), gc_conf[gc_conf[i].set_by].env_name);
5337  } else {
5338  printf(_("(set by %s)"), gc_conf[i].default_val);
5339  }
5340  }
5341  if(!(gc_conf[i].data_type & STS_ENVSET)
5342  && !(gc_conf[i].data_type & STS_CNFSET)
5343  && !(gc_conf[i].data_type & STS_FNCSET)) {
5344  putchar(' ');
5345  if ((gc_conf[i].data_type & STS_RESET)) {
5346  printf(_("(reset)"));
5347  } else if (strcmp(value, not_set) != 0) {
5348  printf(_("(default)"));
5349  }
5350  }
5351  putchar('\n');
5352  if ((gc_conf[i].data_type & STS_ENVCLR)) {
5353  puts(" : ");
5354  puts(_("... removed from environment"));
5355  }
5356  }
5357  }
5358  }
5359 
5360 
5361  /* checkme
5362 
5363  var_print ("resolve_path",
5364  cob_strjoin(&cobsetptr->cob_library_path, *(cobsetptr->resolve_size),
5365  (char*) PATHSEPS), not_set, 3);
5366  */
5367  //var_print ("base_preload_ptr",
5368  // cobsetptr->cob_preload_str, not_set, 3);
5369 
5370 
5371 #ifdef HAVE_SETLOCALE
5372  printf(" : %-*s : %s\n",hdlen,"LC_CTYPE", (char*) setlocale (LC_CTYPE, NULL));
5373  printf(" : %-*s : %s\n",hdlen,"LC_NUMERIC", (char*) setlocale (LC_NUMERIC, NULL));
5374  printf(" : %-*s : %s\n",hdlen,"LC_COLLATE", (char*) setlocale (LC_COLLATE, NULL));
5375 #ifdef LC_MESSAGES
5376  printf(" : %-*s : %s\n",hdlen,"LC_MESSAGES", (char*) setlocale (LC_MESSAGES, NULL));
5377 #endif
5378  printf(" : %-*s : %s\n",hdlen,"LC_MONETARY", (char*) setlocale (LC_MONETARY, NULL));
5379  printf(" : %-*s : %s\n",hdlen,"LC_TIME", (char*) setlocale (LC_TIME, NULL));
5380 #endif
5381 }
get_config_val
static char * get_config_val(char *value, int pos, char *orgvalue)
Definition: common.c:4665
COB_MINI_BUFF
#define COB_MINI_BUFF
Definition: common.h:539
COB_MEDIUM_BUFF
#define COB_MEDIUM_BUFF
Definition: common.h:543
cobsetptr
static cob_settings * cobsetptr
Definition: common.c:131
gc_conf
static struct config_tbl gc_conf[]
Definition: common.c:235
value
strict implicit external value
Definition: warning.def:54
PACKAGE_NAME
#define PACKAGE_NAME
Definition: config.h:300
_
#define _(s)
Definition: cobcrun.c:59
STS_RESET
#define STS_RESET
Definition: coblocal.h:303
NULL
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
STS_FNCSET
#define STS_FNCSET
Definition: coblocal.h:304
STS_ENVCLR
#define STS_ENVCLR
Definition: coblocal.h:302
STS_ENVSET
#define STS_ENVSET
Definition: coblocal.h:300
STS_CNFSET
#define STS_CNFSET
Definition: coblocal.h:301
FUNC_NAME_IN_DEFAULT
#define FUNC_NAME_IN_DEFAULT
Definition: common.c:284
GRP_MAX
#define GRP_MAX
Definition: coblocal.h:312
not_set
static char not_set[]
Definition: common.c:219
PACKAGE_VERSION
#define PACKAGE_VERSION
Definition: config.h:312
__cob_settings::cob_config_num
unsigned int cob_config_num
Definition: coblocal.h:208
NUM_CONFIG
#define NUM_CONFIG
Definition: common.c:283
PATCH_LEVEL
#define PATCH_LEVEL
Definition: config.h:315
setting_group
static const char * setting_group[]
Definition: common.c:215
__cob_settings::cob_config_file
char ** cob_config_file
Definition: coblocal.h:209

Here is the call graph for this function:

Here is the caller graph for this function:

void print_version ( void  )

Definition at line 5119 of file common.c.

References _, COB_MINI_BUFF, COB_MINI_MAX, COB_TAR_DATE, PACKAGE_NAME, PACKAGE_VERSION, and PATCH_LEVEL.

Referenced by print_info(), and process_command_line().

5120 {
5121  char cob_build_stamp[COB_MINI_BUFF];
5122  char month[64];
5123  int status, day, year;
5124 
5125  /* Set up build time stamp */
5126  memset (cob_build_stamp, 0, (size_t)COB_MINI_BUFF);
5127  memset (month, 0, sizeof(month));
5128  day = 0;
5129  year = 0;
5130  status = sscanf (__DATE__, "%s %d %d", month, &day, &year);
5131  if (status == 3) {
5132  snprintf (cob_build_stamp, (size_t)COB_MINI_MAX,
5133  "%s %2.2d %4.4d %s", month, day, year, __TIME__);
5134  } else {
5135  snprintf (cob_build_stamp, (size_t)COB_MINI_MAX,
5136  "%s %s", __DATE__, __TIME__);
5137  }
5138 
5139  printf ("libcob (%s) %s.%d\n",
5140  PACKAGE_NAME, PACKAGE_VERSION, PATCH_LEVEL);
5141  puts ("Copyright (C) 2001-2012, 2014-2016 Free Software Foundation, Inc.");
5142  printf (_("Written by %s\n"), "Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch");
5143  puts (_("This is free software; see the source for copying conditions. There is NO\n\
5144 warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."));
5145  printf (_("Built %s"), cob_build_stamp);
5146  putchar ('\n');
5147  printf (_("Packaged %s"), COB_TAR_DATE);
5148  putchar ('\n');
5149 
5150 }
COB_MINI_BUFF
#define COB_MINI_BUFF
Definition: common.h:539
PACKAGE_NAME
#define PACKAGE_NAME
Definition: config.h:300
_
#define _(s)
Definition: cobcrun.c:59
COB_TAR_DATE
#define COB_TAR_DATE
Definition: tarstamp.h:1
PACKAGE_VERSION
#define PACKAGE_VERSION
Definition: config.h:312
PATCH_LEVEL
#define PATCH_LEVEL
Definition: config.h:315
COB_MINI_MAX
#define COB_MINI_MAX
Definition: common.h:545

Here is the caller graph for this function: