Convert-Binary-C
view release on metacpan or search on metacpan
#include "cbc/typeinfo.h"
#include "cbc/util.h"
/*===== DEFINES ==============================================================*/
#ifndef PerlEnv_getenv
# define PerlEnv_getenv getenv
#endif
#ifdef CBC_DEBUGGING
#define DBG_CTXT_FMT "%s"
#define DBG_CTXT_ARG (GIMME_V == G_VOID ? "0=" : \
(GIMME_V == G_SCALAR ? "$=" : \
(GIMME_V == G_ARRAY ? "@=" : \
"?=" \
)))
#endif
#define CBC_METHOD(name) const char * const method PERL_UNUSED_DECL = #name
#define CBC_METHOD_VAR const char * method PERL_UNUSED_DECL = ""
#define CBC_METHOD_SET(string) method = string
#define CT_DEBUG_METHOD \
CT_DEBUG(MAIN, (DBG_CTXT_FMT XSCLASS "::%s", DBG_CTXT_ARG, method))
#define CT_DEBUG_METHOD1(fmt, arg1) \
CT_DEBUG(MAIN, (DBG_CTXT_FMT XSCLASS "::%s( " fmt " )", \
DBG_CTXT_ARG, method, arg1))
#define CT_DEBUG_METHOD2(fmt, arg1, arg2) \
CT_DEBUG(MAIN, (DBG_CTXT_FMT XSCLASS "::%s( " fmt " )", \
/*===== STATIC VARIABLES =====================================================*/
static int gs_DisableParser;
static int gs_OrderMembers;
/*===== GLOBAL FUNCTIONS =====================================================*/
/*******************************************************************************
*
* ROUTINE: CBC_malloc, CBC_calloc, CBC_realloc, CBC_free
*
* WRITTEN BY: Marcus Holland-Moritz ON: Feb 2005
* CHANGED BY: ON:
*
********************************************************************************
*
* DESCRIPTION: Memory allocation routines for ucpp and util libs.
*
*******************************************************************************/
void *CBC_malloc(size_t size)
{
void *p;
New(0, p, size, char);
return p;
}
void *CBC_calloc(size_t count, size_t size)
{
void *p;
Newz(0, p, count*size, char);
return p;
}
void *CBC_realloc(void *p, size_t size)
{
Renew(p, size, char);
return p;
}
void CBC_free(void *p)
{
Safefree(p);
}
/*===== STATIC FUNCTIONS =====================================================*/
/*******************************************************************************
*
* ROUTINE: ct_*
CODE:
wflags = 0;
if (items % 2 == 0)
Perl_croak(aTHX_ "You must pass an even number of module arguments");
else
{
for (i = 1; i < items; i += 2)
{
const char *opt = SvPV_nolen(ST(i));
#ifdef CBC_DEBUGGING
const char *arg = SvPV_nolen(ST(i+1));
#endif
if (strEQ(opt, "debug"))
{
#ifdef CBC_DEBUGGING
set_debug_options(aTHX_ arg);
#else
wflags |= WARN_NO_DEBUGGING;
#endif
}
else if (strEQ(opt, "debugfile"))
{
#ifdef CBC_DEBUGGING
set_debug_file(aTHX_ arg);
#else
wflags |= WARN_NO_DEBUGGING;
#endif
}
else
Perl_croak(aTHX_ "Invalid module option '%s'", opt);
}
if (wflags & WARN_NO_DEBUGGING)
# RETURNS:
#
################################################################################
SV *
__DUMP__(val)
SV *val
CODE:
RETVAL = newSVpvn("", 0);
#ifdef CBC_DEBUGGING
dump_sv(aTHX_ RETVAL, 0, val);
#else
(void) val;
Perl_croak(aTHX_ "__DUMP__ not enabled in non-debug version");
#endif
OUTPUT:
RETVAL
{
const char *str;
PrintFunctions f;
f.newstr = ct_newstr;
f.destroy = ct_destroy;
f.scatf = ct_scatf;
f.vscatf = ct_vscatf;
f.cstring = ct_cstring;
f.fatalerr = ct_fatal;
set_print_functions(&f);
#ifdef CBC_DEBUGGING
init_debugging(aTHX);
if ((str = PerlEnv_getenv("CBC_DEBUG_OPT")) != NULL)
set_debug_options(aTHX_ str);
if ((str = PerlEnv_getenv("CBC_DEBUG_FILE")) != NULL)
set_debug_file(aTHX_ str);
#endif
gs_DisableParser = 0;
if ((str = PerlEnv_getenv("CBC_DISABLE_PARSER")) != NULL)
gs_DisableParser = atoi(str);
gs_OrderMembers = 0;
if ((str = PerlEnv_getenv("CBC_ORDER_MEMBERS")) != NULL)
{
if (isDIGIT(str[0]))
gs_OrderMembers = atoi(str);
else if (isALPHA(str[0]))
{
gs_OrderMembers = 1;
set_preferred_indexed_hash_module(strdup(str));
}
}
}
Version 0.55 (2004-08-22)
-------------------------
* new native() function to query native properties
* feature() and native() can now also be called as methods
* allow setting Alignment and CompoundAlignment to zero to
request native alignment and compound alignment
* prefix compile-time defaults with CBC_ and document them
* upgrade ppport.h
* minor cleanups
-------------------------
Version 0.54 (2004-07-01)
-------------------------
* improved hooks features
Makefile.PL view on Meta::CPAN
);
# On AIX systems, this should be defined for ucpp
$^O eq 'aix' and push @DEFINE, qw( POSIX_JMP );
# Supported features, and flags to set when (e)nabled or (d)isabled
%FEATURES = (
debug => {
enabled => $Config{ccflags} =~ /-DDEBUGGING\b/ ? 1 : 0,
e_flags => [qw( CBC_DEBUGGING CTLIB_DEBUGGING DEBUG_MEMALLOC DEBUG_UTIL_HASH DEBUG_UTIL_LIST YYDEBUG=1 )],
d_flags => [qw( NDEBUG )],
},
ieeefp => {
enabled => undef,
e_flags => [qw( CBC_HAVE_IEEE_FP )],
d_flags => [qw()],
},
$Config{gccversion} ? (
'$format-check' => {
enabled => 0,
e_flags => [qw( CTLIB_FORMAT_CHECK UTIL_FORMAT_CHECK )],
d_flags => [qw()],
},
'$coverage' => {
enabled => 0,
Makefile.PL view on Meta::CPAN
};
}
$config;
}
sub MY::c_o
{
package MY;
my $c_o = shift->SUPER::c_o(@_);
if (!$ENV{CBC_MAKEFILE_DEBUG} and eval $ExtUtils::MakeMaker::VERSION >= 6.17) {
$c_o =~ s/^(\s+)(\$\(CCCMD\).*)$/$1\$(NOECHO) \$(ECHO) Compiling [\$(CC) \$(OPTIMIZE)] \$<\n$1\$(NOECHO) $2\n$1\$(NOECHO) \$(MV) \$(\@F) tmp\$(\@F)\n$1\$(NOECHO) \$(MV) tmp\$(\@F) \$\@/mg;
}
else {
$c_o =~ s/^\s+\$\(CCCMD\).*$/$&\n\t\$(MV) \$(\@F) tmp\$(\@F)\n\t\$(MV) tmp\$(\@F) \$\@/mg;
}
$c_o;
}
sub MY::constants
{
bin/ccconfig view on Meta::CPAN
exists $self->{predefined}{_MSC_VER} and return MS_VCPP;
return UNKNOWN;
}
sub _test_type
{
my($self, $type, $init, $width) = @_;
my $begin = "\x21\x05\x19\x77*MHXCBC*\xDE\xAD\xBE\xEF";
my $end = "\x21\x05\x19\x77*MARCUS*\xDE\xAD\xBE\xEF";
my $cvt = sub { join ', ', map { sprintf "0x%02X", $_ } unpack "C*", $_[0] };
my $c_begin = $cvt->( $begin );
my $c_end = $cvt->( $end );
$self->_temp( <<ENDC );
struct _t_e_s_t_ {
unsigned char _a_[16];
bin/memmap.PL view on Meta::CPAN
unsigned alignment;
unsigned align_base;
int dataTooShortFlag;
Buffer buf;
CParseConfig cfg;
CParseInfo cpi;
ArchSpecs as;
enum {
ET_INTEGER, ET_STRING, ET_BOTH
} enumType;
} CBC;
ENDC
#-------------------------------------------------
# Print the memory map for type 'CBC' with a base
# address of 0x01500000.
#-------------------------------------------------
memmap( $c, 'CBC', 0x01500000 );
#==========================================================
# SUBROUTINES
#==========================================================
sub memmap
{
my($c, $type, $start) = @_;
$start ||= 0;
cbc/basic.h view on Meta::CPAN
* DESCRIPTION: C::B::C basic types
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_BASIC_H
#define _CBC_BASIC_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
#include "ctlib/cttype.h"
/*===== DEFINES ==============================================================*/
/*===== TYPEDEFS =============================================================*/
typedef struct _basic_types *BasicTypes;
/*===== FUNCTION PROTOTYPES ==================================================*/
#define basic_types_new CBC_basic_types_new
BasicTypes basic_types_new(void);
#define basic_types_delete CBC_basic_types_delete
void basic_types_delete(BasicTypes bt);
#define basic_types_clone CBC_basic_types_clone
BasicTypes basic_types_clone(const BasicTypes src);
#define basic_types_reset CBC_basic_types_reset
void basic_types_reset(BasicTypes bt);
#define basic_types_get_declarator CBC_basic_types_get_declarator
Declarator *basic_types_get_declarator(BasicTypes bt, unsigned tflags);
#define get_basic_type_spec CBC_get_basic_type_spec
int get_basic_type_spec(const char *name, TypeSpec *pTS);
#endif
* DESCRIPTION: C::B::C common defines
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_CBC_H
#define _CBC_CBC_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
#include "ctlib/arch.h"
#include "ctlib/ctdebug.h"
#include "ctlib/ctparse.h"
#include "ctlib/cttype.h"
#if (defined I32SIZE && I32SIZE != 4) || \
(defined U32SIZE && U32SIZE != 4)
#error "Your I32/U32 doesn't seem to have 32 bits..."
#endif
/*---------------*/
/* some defaults */
/*---------------*/
#ifndef CBC_DEFAULT_PTR_SIZE
#define CBC_DEFAULT_PTR_SIZE CTLIB_POINTER_SIZE
#else
#if CBC_DEFAULT_PTR_SIZE != 1 && \
CBC_DEFAULT_PTR_SIZE != 2 && \
CBC_DEFAULT_PTR_SIZE != 4 && \
CBC_DEFAULT_PTR_SIZE != 8
#error "CBC_DEFAULT_PTR_SIZE is invalid!"
#endif
#endif
#ifndef CBC_DEFAULT_ENUM_SIZE
#define CBC_DEFAULT_ENUM_SIZE sizeof( int )
#else
#if CBC_DEFAULT_ENUM_SIZE != 0 && \
CBC_DEFAULT_ENUM_SIZE != 1 && \
CBC_DEFAULT_ENUM_SIZE != 2 && \
CBC_DEFAULT_ENUM_SIZE != 4 && \
CBC_DEFAULT_ENUM_SIZE != 8
#error "CBC_DEFAULT_ENUM_SIZE is invalid!"
#endif
#endif
#ifndef CBC_DEFAULT_INT_SIZE
#define CBC_DEFAULT_INT_SIZE CTLIB_int_SIZE
#else
#if CBC_DEFAULT_INT_SIZE != 1 && \
CBC_DEFAULT_INT_SIZE != 2 && \
CBC_DEFAULT_INT_SIZE != 4 && \
CBC_DEFAULT_INT_SIZE != 8
#error "CBC_DEFAULT_INT_SIZE is invalid!"
#endif
#endif
#ifndef CBC_DEFAULT_CHAR_SIZE
#define CBC_DEFAULT_CHAR_SIZE CTLIB_char_SIZE
#else
#if CBC_DEFAULT_CHAR_SIZE != 1 && \
CBC_DEFAULT_CHAR_SIZE != 2 && \
CBC_DEFAULT_CHAR_SIZE != 4 && \
CBC_DEFAULT_CHAR_SIZE != 8
#error "CBC_DEFAULT_CHAR_SIZE is invalid!"
#endif
#endif
#ifndef CBC_DEFAULT_SHORT_SIZE
#define CBC_DEFAULT_SHORT_SIZE CTLIB_short_SIZE
#else
#if CBC_DEFAULT_SHORT_SIZE != 1 && \
CBC_DEFAULT_SHORT_SIZE != 2 && \
CBC_DEFAULT_SHORT_SIZE != 4 && \
CBC_DEFAULT_SHORT_SIZE != 8
#error "CBC_DEFAULT_SHORT_SIZE is invalid!"
#endif
#endif
#ifndef CBC_DEFAULT_LONG_SIZE
#define CBC_DEFAULT_LONG_SIZE CTLIB_long_SIZE
#else
#if CBC_DEFAULT_LONG_SIZE != 1 && \
CBC_DEFAULT_LONG_SIZE != 2 && \
CBC_DEFAULT_LONG_SIZE != 4 && \
CBC_DEFAULT_LONG_SIZE != 8
#error "CBC_DEFAULT_LONG_SIZE is invalid!"
#endif
#endif
#ifndef CBC_DEFAULT_LONG_LONG_SIZE
#define CBC_DEFAULT_LONG_LONG_SIZE CTLIB_long_long_SIZE
#else
#if CBC_DEFAULT_LONG_LONG_SIZE != 1 && \
CBC_DEFAULT_LONG_LONG_SIZE != 2 && \
CBC_DEFAULT_LONG_LONG_SIZE != 4 && \
CBC_DEFAULT_LONG_LONG_SIZE != 8
#error "CBC_DEFAULT_LONG_LONG_SIZE is invalid!"
#endif
#endif
#ifndef CBC_DEFAULT_FLOAT_SIZE
#define CBC_DEFAULT_FLOAT_SIZE CTLIB_float_SIZE
#else
#if CBC_DEFAULT_FLOAT_SIZE != 1 && \
CBC_DEFAULT_FLOAT_SIZE != 2 && \
CBC_DEFAULT_FLOAT_SIZE != 4 && \
CBC_DEFAULT_FLOAT_SIZE != 8 && \
CBC_DEFAULT_FLOAT_SIZE != 12 && \
CBC_DEFAULT_FLOAT_SIZE != 16
#error "CBC_DEFAULT_FLOAT_SIZE is invalid!"
#endif
#endif
#ifndef CBC_DEFAULT_DOUBLE_SIZE
#define CBC_DEFAULT_DOUBLE_SIZE CTLIB_double_SIZE
#else
#if CBC_DEFAULT_DOUBLE_SIZE != 1 && \
CBC_DEFAULT_DOUBLE_SIZE != 2 && \
CBC_DEFAULT_DOUBLE_SIZE != 4 && \
CBC_DEFAULT_DOUBLE_SIZE != 8 && \
CBC_DEFAULT_DOUBLE_SIZE != 12 && \
CBC_DEFAULT_DOUBLE_SIZE != 16
#error "CBC_DEFAULT_DOUBLE_SIZE is invalid!"
#endif
#endif
#ifndef CBC_DEFAULT_LONG_DOUBLE_SIZE
#define CBC_DEFAULT_LONG_DOUBLE_SIZE CTLIB_long_double_SIZE
#else
#if CBC_DEFAULT_LONG_DOUBLE_SIZE != 1 && \
CBC_DEFAULT_LONG_DOUBLE_SIZE != 2 && \
CBC_DEFAULT_LONG_DOUBLE_SIZE != 4 && \
CBC_DEFAULT_LONG_DOUBLE_SIZE != 8 && \
CBC_DEFAULT_LONG_DOUBLE_SIZE != 12 && \
CBC_DEFAULT_LONG_DOUBLE_SIZE != 16
#error "CBC_DEFAULT_LONG_DOUBLE_SIZE is invalid!"
#endif
#endif
#ifndef CBC_DEFAULT_ALIGNMENT
#define CBC_DEFAULT_ALIGNMENT 1
#elif CBC_DEFAULT_ALIGNMENT != 1 && \
CBC_DEFAULT_ALIGNMENT != 2 && \
CBC_DEFAULT_ALIGNMENT != 4 && \
CBC_DEFAULT_ALIGNMENT != 8 && \
CBC_DEFAULT_ALIGNMENT != 16
#error "CBC_DEFAULT_ALIGNMENT is invalid!"
#endif
#ifndef CBC_DEFAULT_COMPOUND_ALIGNMENT
#define CBC_DEFAULT_COMPOUND_ALIGNMENT 1
#elif CBC_DEFAULT_COMPOUND_ALIGNMENT != 1 && \
CBC_DEFAULT_COMPOUND_ALIGNMENT != 2 && \
CBC_DEFAULT_COMPOUND_ALIGNMENT != 4 && \
CBC_DEFAULT_COMPOUND_ALIGNMENT != 8 && \
CBC_DEFAULT_COMPOUND_ALIGNMENT != 16
#error "CBC_DEFAULT_COMPOUND_ALIGNMENT is invalid!"
#endif
#ifndef CBC_DEFAULT_ENUMTYPE
#define CBC_DEFAULT_ENUMTYPE ET_INTEGER
#endif
#if ARCH_NATIVE_BYTEORDER == ARCH_BYTEORDER_BIG_ENDIAN
#define CBC_NATIVE_BYTEORDER CBO_BIG_ENDIAN
#elif ARCH_NATIVE_BYTEORDER == ARCH_BYTEORDER_LITTLE_ENDIAN
#define CBC_NATIVE_BYTEORDER CBO_LITTLE_ENDIAN
#else
#error "unknown native byte order"
#endif
#ifndef CBC_DEFAULT_BYTEORDER
#define CBC_DEFAULT_BYTEORDER CBC_NATIVE_BYTEORDER
#endif
/*--------------------------------------*/
/* macros for different checks/warnings */
/*--------------------------------------*/
#if defined G_WARN_ON && defined G_WARN_ALL_ON
#define PERL_WARNINGS_ON (PL_dowarn & (G_WARN_ON | G_WARN_ALL_ON))
#else
#define PERL_WARNINGS_ON PL_dowarn
ET_INTEGER, ET_STRING, ET_BOTH
} enumType;
/* boolean options */
unsigned order_members : 1;
const char *ixhash;
HV *hv;
BasicTypes basic;
} CBC;
/*===== FUNCTION PROTOTYPES ==================================================*/
#endif
cbc/debug.c view on Meta::CPAN
* DESCRIPTION: C::B::C debugging stuff
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifdef CBC_DEBUGGING
/*===== GLOBAL INCLUDES ======================================================*/
#define PERL_NO_GET_CONTEXT
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
#include "ppport.h"
cbc/debug.c view on Meta::CPAN
*
* RETURNS:
*
*******************************************************************************/
void init_debugging(pTHX)
{
gs_DB_stream = stderr;
}
#endif /* CBC_DEBUGGING */
cbc/debug.h view on Meta::CPAN
* DESCRIPTION: C::B::C debugging stuff
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_DEBUG_H
#define _CBC_DEBUG_H
#ifdef CBC_DEBUGGING
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
/*===== DEFINES ==============================================================*/
/*===== TYPEDEFS =============================================================*/
/*===== FUNCTION PROTOTYPES ==================================================*/
#define set_debug_options CBC_set_debug_options
void set_debug_options(pTHX_ const char *dbopts);
#define set_debug_file CBC_set_debug_file
void set_debug_file(pTHX_ const char *dbfile);
#define init_debugging CBC_init_debugging
void init_debugging(pTHX);
#endif
#endif
cbc/dimension.c view on Meta::CPAN
{
Perl_croak(aTHX_ "Cannot use member expression '%s' as Dimension tag"
" for '%s' when not within a compound type", member, type);
}
mi.type.ptr = pmi->parent;
mi.type.tflags = ((Struct *) pmi->parent)->tflags;
mi.pDecl = NULL;
mi.level = 0;
(void) get_member(aTHX_ &mi, member, &mi2, CBC_GM_ACCEPT_DOTLESS_MEMBER |
CBC_GM_REJECT_OUT_OF_BOUNDS_INDEX |
CBC_GM_REJECT_OFFSET);
failed_type = check_allowed_types_string(&mi2, ALLOW_BASIC_TYPES);
if (failed_type)
{
Perl_croak(aTHX_ "Cannot use %s in member '%s' to determine a dimension for '%s'",
failed_type, member, type);
}
if (mi2.offset + (int)mi2.size > pmi->offset)
cbc/dimension.h view on Meta::CPAN
* DESCRIPTION: C::B::C dimension tag
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_DIMENSION_H
#define _CBC_DIMENSION_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
#include "cbc/member.h"
#include "cbc/hook.h"
cbc/dimension.h view on Meta::CPAN
union {
IV fixed;
char *member;
SingleHook *hook;
} u;
} DimensionTag;
/*===== FUNCTION PROTOTYPES ==================================================*/
#define dimtag_verify CBC_dimtag_verify
void dimtag_verify(pTHX_ const MemberInfo *pmi, const char *type);
#define dimtag_new CBC_dimtag_new
DimensionTag *dimtag_new(const DimensionTag *src);
#define dimtag_delete CBC_dimtag_delete
void dimtag_delete(DimensionTag *dim);
#define dimtag_parse CBC_dimtag_parse
int dimtag_parse(pTHX_ const MemberInfo *pmi, const char *type, SV *tag, DimensionTag *dim);
#define dimtag_update CBC_dimtag_update
void dimtag_update(DimensionTag *dst, const DimensionTag *src);
#define dimtag_get CBC_dimtag_get
SV *dimtag_get(pTHX_ const DimensionTag *dim);
#define dimtag_is_flexible CBC_dimtag_is_flexible
int dimtag_is_flexible(pTHX_ const DimensionTag *dim);
#define dimtag_eval CBC_dimtag_eval
long dimtag_eval(pTHX_ const DimensionTag *dim, long avail, SV *self, HV *parent);
#endif
* DESCRIPTION: C::B::C hooks
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_HOOK_H
#define _CBC_HOOK_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
/*===== DEFINES ==============================================================*/
#define SHF_ALLOW_ARG_SELF 0x00000001U
#include "token/t_hookid.h"
typedef struct {
SingleHook hooks[HOOKID_COUNT];
} TypeHooks;
/*===== FUNCTION PROTOTYPES ==================================================*/
#define single_hook_fill CBC_single_hook_fill
void single_hook_fill(pTHX_ const char *hook, const char *type, SingleHook *sth,
SV *sub, U32 allowed_args);
#define single_hook_new CBC_single_hook_new
SingleHook *single_hook_new(const SingleHook *h);
#define hook_new CBC_hook_new
TypeHooks *hook_new(const TypeHooks *h);
#define single_hook_update CBC_single_hook_update
void single_hook_update(SingleHook *dst, const SingleHook *src);
#define hook_update CBC_hook_update
void hook_update(TypeHooks *dst, const TypeHooks *src);
#define single_hook_delete CBC_single_hook_delete
void single_hook_delete(SingleHook *hook);
#define hook_delete CBC_hook_delete
void hook_delete(TypeHooks *h);
#define single_hook_call CBC_single_hook_call
SV *single_hook_call(pTHX_ SV *self, const char *hook_id_str, const char *id_pre,
const char *id, const SingleHook *hook, SV *in, int mortal);
#define hook_call CBC_hook_call
SV *hook_call(pTHX_ SV *self, const char *id_pre, const char *id,
const TypeHooks *pTH, enum HookId hook_id, SV *in, int mortal);
#define find_hooks CBC_find_hooks
int find_hooks(pTHX_ const char *type, HV *hooks, TypeHooks *pTH);
#define get_single_hook CBC_get_single_hook
SV *get_single_hook(pTHX_ const SingleHook *hook);
#define get_hooks CBC_get_hooks
HV *get_hooks(pTHX_ const TypeHooks *pTH);
#endif
* DESCRIPTION: C::B::C identifier lists
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_IDL_H
#define _CBC_IDL_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
/*===== DEFINES ==============================================================*/
#define IDLIST_GRANULARITY 8
union {
const char *id;
long ix;
} val;
} *cur, *list;
} IDList;
/*===== FUNCTION PROTOTYPES ==================================================*/
#define idl_to_str CBC_idl_to_str
const char *idl_to_str(pTHX_ IDList *idl);
#endif
sv_catpv(string, "\n"); \
INDENT; \
sv_catpv(string, "}"); \
} STMT_END
/*===== TYPEDEFS =============================================================*/
/*===== STATIC FUNCTION PROTOTYPES ===========================================*/
static void get_init_str_struct(pTHX_ CBC *THIS, Struct *pStruct, SV *init,
IDList *idl, int level, SV *string);
static void get_init_str_type(pTHX_ CBC *THIS, TypeSpec *pTS, Declarator *pDecl,
int dimension, SV *init, IDList *idl, int level, SV *string);
/*===== EXTERNAL VARIABLES ===================================================*/
/*===== GLOBAL VARIABLES =====================================================*/
/*===== STATIC VARIABLES =====================================================*/
/*===== STATIC FUNCTIONS =====================================================*/
********************************************************************************
*
* DESCRIPTION:
*
* ARGUMENTS:
*
* RETURNS:
*
*******************************************************************************/
static void get_init_str_struct(pTHX_ CBC *THIS, Struct *pStruct, SV *init,
IDList *idl, int level, SV *string)
{
ListIterator sdi;
StructDeclaration *pStructDecl;
Declarator *pDecl;
HV *hash = NULL;
int first = 1;
CT_DEBUG(MAIN, (XSCLASS "::get_init_str_struct( THIS=%p, pStruct=%p, "
"init=%p, idl=%p, level=%d, string=%p )",
********************************************************************************
*
* DESCRIPTION:
*
* ARGUMENTS:
*
* RETURNS:
*
*******************************************************************************/
static void get_init_str_type(pTHX_ CBC *THIS, TypeSpec *pTS, Declarator *pDecl,
int dimension, SV *init, IDList *idl, int level, SV *string)
{
CT_DEBUG(MAIN, (XSCLASS "::get_init_str_type( THIS=%p, pTS=%p, pDecl=%p, "
"dimension=%d, init=%p, idl=%p, level=%d, string=%p )",
THIS, pTS, pDecl, dimension, init, idl, level, string));
if (pDecl && pDecl->array_flag && dimension < LL_count(pDecl->ext.array))
{
AV *ary = NULL;
long i, s = ((Value *) LL_get(pDecl->ext.array, dimension))->iv;
********************************************************************************
*
* DESCRIPTION:
*
* ARGUMENTS:
*
* RETURNS:
*
*******************************************************************************/
SV *get_initializer_string(pTHX_ CBC *THIS, MemberInfo *pMI, SV *init, const char *name)
{
SV *string = newSVpvn("", 0);
IDList idl;
IDLIST_INIT(&idl);
IDLIST_PUSH(&idl, ID);
IDLIST_SET_ID(&idl, name);
get_init_str_type(aTHX_ THIS, &pMI->type, pMI->pDecl, pMI->level, init, &idl, 0, string);
* DESCRIPTION: C::B::C initializer
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_INIT_H
#define _CBC_INIT_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
#include "cbc/cbc.h"
#include "cbc/member.h"
/*===== DEFINES ==============================================================*/
/*===== TYPEDEFS =============================================================*/
/*===== FUNCTION PROTOTYPES ==================================================*/
#define get_initializer_string CBC_get_initializer_string
SV *get_initializer_string(pTHX_ CBC *THIS, MemberInfo *pMI, SV *init, const char *name);
#endif
cbc/macros.h view on Meta::CPAN
* DESCRIPTION: Handle macro lists
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_MACROS_H
#define _CBC_MACROS_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
#include "util/list.h"
#include "ctlib/ctparse.h"
/*===== DEFINES ==============================================================*/
/*===== TYPEDEFS =============================================================*/
/*===== FUNCTION PROTOTYPES ==================================================*/
#define macros_get_names CBC_macros_get_names
LinkedList macros_get_names(pTHX_ CParseInfo *pCPI, size_t *count);
#define macros_get_definitions CBC_macros_get_definitions
LinkedList macros_get_definitions(pTHX_ CParseInfo *pCPI);
#endif
cbc/member.c view on Meta::CPAN
assert(name != NULL); \
TRUNC_NAME; \
(void) sprintf(err = errbuf, \
"Cannot access member '%s' of " type " type", trunc); \
goto error; \
} STMT_END
int get_member(pTHX_ const MemberInfo *pMI, const char *member,
MemberInfo *pMIout, unsigned gm_flags)
{
unsigned accept_dotless_member = gm_flags & CBC_GM_ACCEPT_DOTLESS_MEMBER;
const unsigned do_calc = (gm_flags & CBC_GM_NO_OFFSET_SIZE_CALC) == 0;
const unsigned reject_oobi = gm_flags & CBC_GM_REJECT_OUT_OF_BOUNDS_INDEX;
const unsigned reject_offset = gm_flags & CBC_GM_REJECT_OFFSET;
const TypeSpec *pType;
int size, level, t_off;
int offset;
Struct *pStruct;
StructDeclaration *pSD;
Declarator *pDecl;
char *err, errbuf[128], trunc[32];
MemberExprWalker walker;
const char *name;
cbc/member.c view on Meta::CPAN
/* only accept dotless members at the very beginning */
accept_dotless_member = 0;
}
error:
member_expr_walker_delete(aTHX_ walker);
if (err != NULL)
{
if (gm_flags & CBC_GM_DONT_CROAK)
return 0;
Perl_croak(aTHX_ "%s", err);
}
CT_DEBUG(MAIN, ("FINISHED: typespec=[ptr=%p, flags=0x%lX], pDecl=%p[dim=%d], level=%d, offset=%d, size=%d, parent=%p",
pType->ptr, (unsigned long) pType->tflags, pDecl,
pDecl && pDecl->array_flag ? LL_count(pDecl->ext.array) : 0,
level, offset, size, pStruct));
if (pMIout)
cbc/member.c view on Meta::CPAN
* DESCRIPTION:
*
* ARGUMENTS:
*
* RETURNS:
*
*******************************************************************************/
void member_expr_walker_walk(pTHX_ MemberExprWalker me, struct me_walk_info *info)
{
#ifdef CBC_DEBUGGING
static const char *Sstate[] = {
"ST_MEMBER",
"ST_INDEX",
"ST_FINISH_INDEX",
"ST_SEARCH",
"ST_TERM"
};
#endif
const char *c, *ixstr;
cbc/member.h view on Meta::CPAN
* DESCRIPTION: C::B::C struct member utilities
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_MEMBER_H
#define _CBC_MEMBER_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
#include "util/list.h"
#include "util/hash.h"
#include "ctlib/cttype.h"
/*===== DEFINES ==============================================================*/
#define CBC_GM_ACCEPT_DOTLESS_MEMBER 0x00000001U
#define CBC_GM_DONT_CROAK 0x00000002U
#define CBC_GM_NO_OFFSET_SIZE_CALC 0x00000004U
#define CBC_GM_REJECT_OUT_OF_BOUNDS_INDEX 0x00000008U
#define CBC_GM_REJECT_OFFSET 0x00000010U
/*===== TYPEDEFS =============================================================*/
typedef struct {
LinkedList hit, off, pad;
HashTable htpad;
} GMSInfo;
typedef struct {
TypeSpec type;
cbc/member.h view on Meta::CPAN
int offset;
char invalid_char;
} u;
};
typedef struct member_expr *MemberExprWalker;
/*===== FUNCTION PROTOTYPES ==================================================*/
#define get_all_member_strings CBC_get_all_member_strings
int get_all_member_strings(pTHX_ MemberInfo *pMI, LinkedList list);
#define get_member_string CBC_get_member_string
SV *get_member_string(pTHX_ const MemberInfo *pMI, int offset, GMSInfo *pInfo);
#define get_member CBC_get_member
int get_member(pTHX_ const MemberInfo *pMI, const char *member,
MemberInfo *pMIout, unsigned gm_flags);
#define member_expr_walker_new CBC_member_expr_walker_new
MemberExprWalker member_expr_walker_new(pTHX_ const char *expr, size_t len);
#define member_expr_walker_retval_string CBC_member_expr_walker_retval_string
const char *member_expr_walker_retval_string(enum me_walk_rv retval);
#define member_expr_walker_walk CBC_member_expr_walker_walk
void member_expr_walker_walk(pTHX_ MemberExprWalker me, struct me_walk_info *info);
#define member_expr_walker_delete CBC_member_expr_walker_delete
void member_expr_walker_delete(pTHX_ MemberExprWalker me);
#endif
cbc/object.c view on Meta::CPAN
********************************************************************************
*
* DESCRIPTION:
*
* ARGUMENTS:
*
* RETURNS:
*
*******************************************************************************/
CBC *cbc_new(pTHX)
{
SV *sv;
CBC *THIS;
Newz(0, THIS, 1, CBC);
sv = newSViv(PTR2IV(THIS));
SvREADONLY_on(sv);
THIS->hv = newHV();
if (hv_store(THIS->hv, "", 0, sv, 0) == NULL)
fatal("Couldn't store THIS into object.");
THIS->enumType = CBC_DEFAULT_ENUMTYPE;
THIS->ixhash = NULL;
THIS->basic = basic_types_new();
THIS->cfg.layout.ptr_size = CBC_DEFAULT_PTR_SIZE;
THIS->cfg.layout.enum_size = CBC_DEFAULT_ENUM_SIZE;
THIS->cfg.layout.int_size = CBC_DEFAULT_INT_SIZE;
THIS->cfg.layout.char_size = CBC_DEFAULT_CHAR_SIZE;
THIS->cfg.layout.short_size = CBC_DEFAULT_SHORT_SIZE;
THIS->cfg.layout.long_size = CBC_DEFAULT_LONG_SIZE;
THIS->cfg.layout.long_long_size = CBC_DEFAULT_LONG_LONG_SIZE;
THIS->cfg.layout.float_size = CBC_DEFAULT_FLOAT_SIZE;
THIS->cfg.layout.double_size = CBC_DEFAULT_DOUBLE_SIZE;
THIS->cfg.layout.long_double_size = CBC_DEFAULT_LONG_DOUBLE_SIZE;
THIS->cfg.layout.alignment = CBC_DEFAULT_ALIGNMENT;
THIS->cfg.layout.compound_alignment = CBC_DEFAULT_COMPOUND_ALIGNMENT;
THIS->cfg.layout.byte_order = CBC_DEFAULT_BYTEORDER;
THIS->cfg.layout.bflayouter = bl_create("Generic");
THIS->cfg.get_type_info = get_type_info_generic;
THIS->cfg.layout_compound = layout_compound_generic;
THIS->cfg.includes = LL_new();
THIS->cfg.defines = LL_new();
THIS->cfg.assertions = LL_new();
THIS->cfg.disabled_keywords = LL_new();
THIS->cfg.keyword_map = HT_new(1);
THIS->cfg.keywords = HAS_ALL_KEYWORDS;
cbc/object.c view on Meta::CPAN
********************************************************************************
*
* DESCRIPTION:
*
* ARGUMENTS:
*
* RETURNS:
*
*******************************************************************************/
void cbc_delete(pTHX_ CBC *THIS)
{
free_parse_info(&THIS->cpi);
LL_destroy(THIS->cfg.includes, (LLDestroyFunc) string_delete);
LL_destroy(THIS->cfg.defines, (LLDestroyFunc) string_delete);
LL_destroy(THIS->cfg.assertions, (LLDestroyFunc) string_delete);
LL_destroy(THIS->cfg.disabled_keywords, (LLDestroyFunc) string_delete);
basic_types_delete(THIS->basic);
cbc/object.c view on Meta::CPAN
********************************************************************************
*
* DESCRIPTION:
*
* ARGUMENTS:
*
* RETURNS:
*
*******************************************************************************/
CBC *cbc_clone(pTHX_ const CBC *THIS)
{
SV *sv;
CBC *clone;
Newz(0, clone, 1, CBC);
Copy(THIS, clone, 1, CBC);
clone->cfg.includes = clone_string_list(THIS->cfg.includes);
clone->cfg.defines = clone_string_list(THIS->cfg.defines);
clone->cfg.assertions = clone_string_list(THIS->cfg.assertions);
clone->cfg.disabled_keywords = clone_string_list(THIS->cfg.disabled_keywords);
clone->basic = basic_types_clone(THIS->basic);
clone->cfg.keyword_map = HT_clone(THIS->cfg.keyword_map, NULL);
cbc/object.c view on Meta::CPAN
********************************************************************************
*
* DESCRIPTION:
*
* ARGUMENTS:
*
* RETURNS:
*
*******************************************************************************/
SV *cbc_bless(pTHX_ CBC *THIS, const char *CLASS)
{
SV *sv;
sv = newRV_noinc((SV *) THIS->hv);
sv_bless(sv, gv_stashpv(CONST_CHAR(CLASS), 0));
return sv;
}
cbc/object.h view on Meta::CPAN
* DESCRIPTION: C::B::C object
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_OBJECT_H
#define _CBC_OBJECT_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
#include "cbc/cbc.h"
/*===== DEFINES ==============================================================*/
/*===== TYPEDEFS =============================================================*/
/*===== FUNCTION PROTOTYPES ==================================================*/
#define cbc_new CBC_cbc_new
CBC *cbc_new(pTHX);
#define cbc_delete CBC_cbc_delete
void cbc_delete(pTHX_ CBC *THIS);
#define cbc_clone CBC_cbc_clone
CBC *cbc_clone(pTHX_ const CBC *THIS);
#define cbc_bless CBC_cbc_bless
SV *cbc_bless(pTHX_ CBC *THIS, const char *CLASS);
#endif
cbc/option.c view on Meta::CPAN
IMPACTS_PREPROC(pp); \
handle_string_list(aTHX_ #name, THIS->config, sv_val, rval); \
DID_CHANGE(sv_val != NULL); \
break;
#define INVALID_OPTION \
default: \
Perl_croak(aTHX_ "Invalid option '%s'", option); \
break;
void handle_option(pTHX_ CBC *THIS, SV *opt, SV *sv_val, SV **rval, HandleOptionResult *p_res)
{
START_OPTIONS
FLAG_OPTION(OrderMembers, order_members, 0, 0)
FLAG_OPTION(Warnings, cfg.issue_warnings, 0, 0)
FLAG_OPTION(HasCPPComments, cfg.has_cpp_comments, 0, 1)
FLAG_OPTION(HasMacroVAARGS, cfg.has_macro_vaargs, 0, 1)
FLAG_OPTION(UnsignedChars, cfg.unsigned_chars, 0, 0)
FLAG_OPTION(UnsignedBitfields, cfg.unsigned_bitfields, 0, 0)
cbc/option.c view on Meta::CPAN
HV_STORE_CONST(hv, #name, sv);
#define TRISTATE_INT_OPTION(name, state, config) \
sv = THIS->state ? newSViv(THIS->config) : &PL_sv_undef; \
HV_STORE_CONST(hv, #name, sv);
#define STRING_OPTION(name, value) \
sv = newSVpv(CONST_CHAR(GET_STR_OPTION(name, value, NULL)->string), 0);\
HV_STORE_CONST(hv, #name, sv);
SV *get_configuration(pTHX_ CBC *THIS)
{
HV *hv = newHV();
SV *sv;
FLAG_OPTION(OrderMembers, order_members )
FLAG_OPTION(Warnings, cfg.issue_warnings )
FLAG_OPTION(HasCPPComments, cfg.has_cpp_comments )
FLAG_OPTION(HasMacroVAARGS, cfg.has_macro_vaargs )
FLAG_OPTION(UnsignedChars, cfg.unsigned_chars )
cbc/option.h view on Meta::CPAN
* DESCRIPTION: C::B::C options
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_OPTION_H
#define _CBC_OPTION_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
#include "util/list.h"
#include "cbc/cbc.h"
cbc/option.h view on Meta::CPAN
typedef struct {
unsigned option_modified : 1;
unsigned impacts_layout : 1;
unsigned impacts_preproc : 1;
} HandleOptionResult;
/*===== FUNCTION PROTOTYPES ==================================================*/
#define handle_string_list CBC_handle_string_list
void handle_string_list(pTHX_ const char *option, LinkedList list, SV *sv, SV **rval);
#define handle_option CBC_handle_option
void handle_option(pTHX_ CBC *THIS, SV *opt, SV *sv_val, SV **rval, HandleOptionResult *p_res);
#define get_configuration CBC_get_configuration
SV *get_configuration(pTHX_ CBC *THIS);
#define get_native_property CBC_get_native_property
SV *get_native_property(pTHX_ const char *property);
#endif
#define IDLP_SET_IX(value) IDLIST_SET_IX(&(PACK->idl), value)
/*---------------------------*/
/* handling of ByteOrder tag */
/*---------------------------*/
#define dBYTEORDER const CByteOrder old_byte_order = PACK->order
#define SET_BYTEORDER(tags) \
STMT_START { \
const CtTag *BOtag = find_tag(tags, CBC_TAG_BYTE_ORDER); \
if (BOtag) \
switch (BOtag->flags) \
{ \
case CBC_TAG_BYTE_ORDER_BIG_ENDIAN: \
PACK->order = CBO_BIG_ENDIAN; \
break; \
\
case CBC_TAG_BYTE_ORDER_LITTLE_ENDIAN: \
PACK->order = CBO_LITTLE_ENDIAN; \
break; \
\
default: \
fatal("Unknown byte order (%d)", BOtag->flags); \
break; \
} \
} STMT_END
#define RESTORE_BYTEORDER PACK->order = old_byte_order
/*------------*/
#define PACK_FLEXIBLE 0x00000001
/*===== TYPEDEFS =============================================================*/
struct PackInfo {
Buffer buf;
IDList idl;
const CBC *THIS;
SV *bufsv;
SV *self;
CByteOrder order;
HV *parent;
};
typedef enum {
FPT_UNKNOWN,
FPT_FLOAT,
FPT_DOUBLE,
********************************************************************************
*
* DESCRIPTION:
*
* ARGUMENTS:
*
* RETURNS:
*
*******************************************************************************/
#ifdef CBC_HAVE_IEEE_FP
#define STORE_FLOAT(ftype) \
STMT_START { \
union { \
ftype f; \
u_8 c[sizeof(ftype)]; \
} _u; \
int _i; \
u_8 *_p = (u_8 *) pPACKBUF; \
_u.f = (ftype) SvNV(sv); \
if (PACK->order == CBC_NATIVE_BYTEORDER) \
{ \
for (_i = 0; _i < (int)sizeof(ftype); _i++) \
*_p++ = _u.c[_i]; \
} \
else /* swap */ \
{ \
for (_i = sizeof(ftype)-1; _i >= 0; _i--) \
*_p++ = _u.c[_i]; \
} \
} STMT_END
#else /* ! CBC_HAVE_IEEE_FP */
#define STORE_FLOAT(ftype) \
STMT_START { \
if (size == sizeof(ftype)) \
{ \
u_8 *_p = (u_8 *) pPACKBUF; \
ftype _v = (ftype) SvNV(sv); \
Copy(&_v, _p, 1, ftype); \
} \
else \
goto non_native; \
} STMT_END
#endif /* CBC_HAVE_IEEE_FP */
static void store_float_sv(pPACKARGS, unsigned size, u_32 flags, SV *sv)
{
FPType type = get_fp_type(flags);
if (type == FPT_UNKNOWN)
{
SV *str = NULL;
get_basic_type_spec_string(aTHX_ &str, flags);
WARN((aTHX_ "Unsupported floating point type '%s' in pack", SvPV_nolen(str)));
SvREFCNT_dec(str);
goto finish;
}
#ifdef CBC_HAVE_IEEE_FP
if (size == sizeof(float))
STORE_FLOAT(float);
else if (size == sizeof(double))
STORE_FLOAT(double);
#if ARCH_HAVE_LONG_DOUBLE
else if (size == sizeof(long double))
STORE_FLOAT(long double);
#endif
else
WARN((aTHX_ "Cannot pack %d byte floating point values", size));
#else /* ! CBC_HAVE_IEEE_FP */
if (PACK->order != CBC_NATIVE_BYTEORDER)
goto non_native;
switch (type)
{
case FPT_FLOAT : STORE_FLOAT(float); break;
case FPT_DOUBLE : STORE_FLOAT(double); break;
#if ARCH_HAVE_LONG_DOUBLE
case FPT_LONG_DOUBLE : STORE_FLOAT(long double); break;
#endif
default:
goto non_native;
}
goto finish;
non_native:
WARN((aTHX_ "Cannot pack non-native floating point values", size));
#endif /* CBC_HAVE_IEEE_FP */
finish:
return;
}
#undef STORE_FLOAT
/*******************************************************************************
*
* ROUTINE: fetch_float_sv
********************************************************************************
*
* DESCRIPTION:
*
* ARGUMENTS:
*
* RETURNS:
*
*******************************************************************************/
#ifdef CBC_HAVE_IEEE_FP
#define FETCH_FLOAT(ftype) \
STMT_START { \
union { \
ftype f; \
u_8 c[sizeof(ftype)]; \
} _u; \
int _i; \
u_8 *_p = (u_8 *) pPACKBUF; \
if (PACK->order == CBC_NATIVE_BYTEORDER) \
{ \
for (_i = 0; _i < (int)sizeof(ftype); _i++) \
_u.c[_i] = *_p++; \
} \
else /* swap */ \
{ \
for (_i = sizeof(ftype)-1; _i >= 0; _i--) \
_u.c[_i] = *_p++; \
} \
value = (NV) _u.f; \
} STMT_END
#else /* ! CBC_HAVE_IEEE_FP */
#define FETCH_FLOAT(ftype) \
STMT_START { \
if (size == sizeof(ftype)) \
{ \
u_8 *_p = (u_8 *) pPACKBUF; \
ftype _v; \
Copy(_p, &_v, 1, ftype); \
value = (NV) _v; \
} \
else \
goto non_native; \
} STMT_END
#endif /* CBC_HAVE_IEEE_FP */
static SV *fetch_float_sv(pPACKARGS, unsigned size, u_32 flags)
{
FPType type = get_fp_type(flags);
NV value = 0.0;
if (type == FPT_UNKNOWN)
{
SV *str = NULL;
get_basic_type_spec_string(aTHX_ &str, flags);
WARN((aTHX_ "Unsupported floating point type '%s' in unpack", SvPV_nolen(str)));
SvREFCNT_dec(str);
goto finish;
}
#ifdef CBC_HAVE_IEEE_FP
if (size == sizeof(float))
FETCH_FLOAT(float);
else if (size == sizeof(double))
FETCH_FLOAT(double);
#if ARCH_HAVE_LONG_DOUBLE
else if (size == sizeof(long double))
FETCH_FLOAT(long double);
#endif
else
WARN((aTHX_ "Cannot unpack %d byte floating point values", size));
#else /* ! CBC_HAVE_IEEE_FP */
if (PACK->order != CBC_NATIVE_BYTEORDER)
goto non_native;
switch (type)
{
case FPT_FLOAT : FETCH_FLOAT(float); break;
case FPT_DOUBLE : FETCH_FLOAT(double); break;
#if ARCH_HAVE_LONG_DOUBLE
case FPT_LONG_DOUBLE : FETCH_FLOAT(long double); break;
#endif
default:
goto non_native;
}
goto finish;
non_native:
WARN((aTHX_ "Cannot unpack non-native floating point values", size));
#endif /* CBC_HAVE_IEEE_FP */
finish:
return newSVnv(value);
}
#undef FETCH_FLOAT
/*******************************************************************************
*
long pos;
dBYTEORDER;
CT_DEBUG(MAIN, (XSCLASS "::pack_struct(pStruct=%p, sv=%p, inlined=%d)",
pStruct, sv, inlined));
if (pStruct->tags && !inlined)
{
const CtTag *tag;
if ((tag = find_tag(pStruct->tags, CBC_TAG_HOOKS)) != NULL)
sv = hook_call(aTHX_ PACK->self, pStruct->tflags & T_STRUCT ? "struct " : "union ",
pStruct->identifier, tag->any, HOOKID_pack, sv, 1);
if ((tag = find_tag(pStruct->tags, CBC_TAG_FORMAT)) != NULL)
{
pack_format(aPACKARGS, tag, pStruct->size, 0, sv);
return;
}
SET_BYTEORDER(pStruct->tags);
}
pos = PACKPOS;
unsigned size = pBI ? pBI->size : GET_ENUM_SIZE(PCONFIG, pEnumSpec);
IV value = 0;
dBYTEORDER;
CT_DEBUG(MAIN, (XSCLASS "::pack_enum(pEnumSpec=%p, pBI=%p sv=%p)", pEnumSpec, pBI, sv));
if (pEnumSpec->tags)
{
const CtTag *tag;
if ((tag = find_tag(pEnumSpec->tags, CBC_TAG_HOOKS)) != NULL)
sv = hook_call(aTHX_ PACK->self, "enum ", pEnumSpec->identifier,
tag->any, HOOKID_pack, sv, 1);
if ((tag = find_tag(pEnumSpec->tags, CBC_TAG_FORMAT)) != NULL)
{
assert(pBI == NULL);
pack_format(aPACKARGS, tag, size, 0, sv);
return;
}
SET_BYTEORDER(pEnumSpec->tags);
}
/* TODO: add some checks (range, perhaps even value) */
else
GROW_BUFFER(size, "insufficient space");
if (DEFINED(sv))
{
STRLEN len;
const char *p = SvPV(sv, len);
if (flags & PACK_FLEXIBLE)
{
if (format->flags == CBC_TAG_FORMAT_STRING)
{
STRLEN tmp = 0;
while (p[tmp] && tmp < len)
tmp++;
len = tmp + 1; /* null-termination */
}
size = len % size ? (unsigned) (len + size - (len % size))
copy[n] = src[n] < 32 || src[n] > 127 ? '.' : (char) src[n];
if (len > n)
for (n -= 3; n < COPY_STRING_LENGTH - 1; n++)
copy[n] = '.';
copy[n] = '\0';
switch (format->flags)
{
case CBC_TAG_FORMAT_BINARY: fmtstr = "Binary"; break;
case CBC_TAG_FORMAT_STRING: fmtstr = "String"; break;
default: fatal("Unknown format (%d)", format->flags);
}
/* hint the user that tries to pack format tagged references */
refstr = SvROK(sv) ? " (Are you sure you want to pack a reference type?)"
: "";
WARN((aTHX_ "Source string \"%s\" is longer (%u byte%s) than '%s'"
" (%u byte%s) while packing '%s' format%s",
copy, (unsigned) len, len == 1 ? "" : "s", idl_to_str(aTHX_ &(PACK->idl)),
size, size == 1 ? "" : "s", fmtstr, refstr));
len = size;
}
switch (format->flags)
{
case CBC_TAG_FORMAT_BINARY:
Copy(p, pPACKBUF, len, char);
break;
case CBC_TAG_FORMAT_STRING:
strncpy(pPACKBUF, p, len);
break;
default:
fatal("Unknown format (%d)", format->flags);
}
}
}
/*******************************************************************************
CT_DEBUG(MAIN, (XSCLASS "::pack_type(pTS=%p, pDecl=%p, dimension=%d, "
"pBI=%p, sv=%p)", pTS, pDecl, dimension, pBI, sv));
assert(sv != NULL);
if (pDecl && dimension == 0 && pDecl->tags)
{
const CtTag *tag;
if ((tag = find_tag(pDecl->tags, CBC_TAG_HOOKS)) != NULL)
sv = hook_call(aTHX_ PACK->self, NULL, pDecl->identifier,
tag->any, HOOKID_pack, sv, 1);
dimtag = find_tag(pDecl->tags, CBC_TAG_DIMENSION);
if ((tag = find_tag(pDecl->tags, CBC_TAG_FORMAT)) != NULL)
{
int size;
u_32 flags = 0;
assert(pBI == NULL);
prepare_pack_format(aPACKARGS, pDecl, dimtag, &size, &flags);
pack_format(aPACKARGS, tag, size, flags, sv);
dTHR;
dXCPT;
dBYTEORDER;
CT_DEBUG(MAIN, (XSCLASS "::unpack_struct(pStruct=%p, hash=%p)", pStruct, hash));
if (pStruct->tags && hash == NULL)
{
const CtTag *format;
hooks = find_tag(pStruct->tags, CBC_TAG_HOOKS);
if ((format = find_tag(pStruct->tags, CBC_TAG_FORMAT)) != NULL)
{
sv = unpack_format(aPACKARGS, format, pStruct->size, 0);
goto handle_unpack_hook;
}
SET_BYTEORDER(pStruct->tags);
}
ordered = PACK->THIS->order_members && PACK->THIS->ixhash != NULL;
const CtTag *hooks = NULL;
IntValue iv;
dBYTEORDER;
CT_DEBUG(MAIN, (XSCLASS "::unpack_enum(pEnumSpec=%p, pBI=%p)", pEnumSpec, pBI));
if (pEnumSpec->tags)
{
const CtTag *format;
hooks = find_tag(pEnumSpec->tags, CBC_TAG_HOOKS);
if ((format = find_tag(pEnumSpec->tags, CBC_TAG_FORMAT)) != NULL)
{
assert(pBI == NULL);
sv = unpack_format(aPACKARGS, format, size, 0);
goto handle_unpack_hook;
}
SET_BYTEORDER(pEnumSpec->tags);
}
CHECK_BUFFER(size);
remain = PACKLEN - PACKPOS;
if (remain % size)
remain -= remain % size;
size = remain;
}
switch (format->flags)
{
case CBC_TAG_FORMAT_BINARY:
sv = newSVpvn(pPACKBUF, size);
break;
case CBC_TAG_FORMAT_STRING:
{
unsigned n;
const char *buf = pPACKBUF;
for (n = 0; n < size; n++)
if (buf[n] == '\0')
break;
sv = newSVpvn(pPACKBUF, n);
}
int dim;
dBYTEORDER;
CT_DEBUG(MAIN, (XSCLASS "::unpack_type(pTS=%p, pDecl=%p, dimension=%d, pBI=%p)",
pTS, pDecl, dimension, pBI));
if (pDecl && dimension == 0 && pDecl->tags)
{
const CtTag *format;
hooks = find_tag(pDecl->tags, CBC_TAG_HOOKS);
dimtag = find_tag(pDecl->tags, CBC_TAG_DIMENSION);
if ((format = find_tag(pDecl->tags, CBC_TAG_FORMAT)) != NULL)
{
int size;
u_32 flags = 0;
assert(pBI == NULL);
prepare_pack_format(aPACKARGS, pDecl, dimtag, &size, &flags);
rv = unpack_format(aPACKARGS, format, size, flags);
{
const EnumSpecifier *p = pTS->ptr;
id = p->identifier;
tags = p->tags;
pre = "enum ";
}
if (tags)
{
const CtTag *hooks = find_tag(tags, CBC_TAG_HOOKS);
if (hooks)
return hook_call(aTHX_ self, pre, id, hooks->any, hook_id, in, mortal);
}
return in;
}
/*===== FUNCTIONS ============================================================*/
********************************************************************************
*
* DESCRIPTION:
*
* ARGUMENTS:
*
* RETURNS:
*
*******************************************************************************/
PackHandle pk_create(const CBC *THIS, SV *self)
{
PackHandle hdl;
Newz(0, hdl, 1, struct PackInfo);
hdl->THIS = THIS;
hdl->self = self;
hdl->parent = NULL;
return hdl;
}
/*******************************************************************************
* DESCRIPTION: C::B::C pack/unpack routines
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_PACK_H
#define _CBC_PACK_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
#include "ctlib/cttype.h"
#include "cbc/cbc.h"
#define aPACKARGS aTHX_ PACK
/*===== TYPEDEFS =============================================================*/
typedef struct PackInfo * PackHandle;
/*===== FUNCTION PROTOTYPES ==================================================*/
#define pk_create CBC_pk_create
PackHandle pk_create(const CBC *THIS, SV *self);
#define pk_set_type CBC_pk_set_type
void pk_set_type(PackHandle hdl, const char *type);
#define pk_set_buffer CBC_pk_set_buffer
void pk_set_buffer(PackHandle hdl, SV *bufsv, char *buffer, unsigned long buflen);
#define pk_set_buffer_pos CBC_pk_set_buffer_pos
void pk_set_buffer_pos(PackHandle hdl, unsigned long pos);
#define pk_delete CBC_pk_delete
void pk_delete(PackHandle hdl);
#define pk_pack CBC_pk_pack
void pk_pack(pPACKARGS, const TypeSpec *pTS, const Declarator *pDecl, int dimension, SV *sv);
#define pk_unpack CBC_pk_unpack
SV *pk_unpack(pPACKARGS, const TypeSpec *pTS, const Declarator *pDecl, int dimension);
#endif
cbc/sourcify.h view on Meta::CPAN
* DESCRIPTION: C::B::C sourcify
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_SOURCIFY_H
#define _CBC_SOURCIFY_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
#include "ctlib/ctparse.h"
/*===== DEFINES ==============================================================*/
cbc/sourcify.h view on Meta::CPAN
/*===== TYPEDEFS =============================================================*/
typedef struct {
int context;
int defines;
} SourcifyConfig;
/*===== FUNCTION PROTOTYPES ==================================================*/
#define get_sourcify_config CBC_get_sourcify_config
void get_sourcify_config(pTHX_ HV *cfg, SourcifyConfig *pSC);
#define get_parsed_definitions_string CBC_get_parsed_definitions_string
SV *get_parsed_definitions_string(pTHX_ CParseInfo *pCPI, SourcifyConfig *pSC);
#endif
assert(ptl);
assert(name);
if (SvROK(name))
Perl_croak(aTHX_ "Tag name must be a string, not a reference");
tagstr = SvPV_nolen(name);
tagid = get_tag_id(tagstr);
if (tagid == CBC_INVALID_TAG)
Perl_croak(aTHX_ "Invalid tag name '%s'", tagstr);
if (tagid > NUM_TAGIDS)
fatal("Unknown tag type (%d) in handle_tag()", (int) tagid);
etbl = &gs_TagTbl[tagid];
tag = find_tag(*ptl, tagid);
if (etbl->verify)
* DESCRIPTION: C::B::C tags
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_TAG_H
#define _CBC_TAG_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
#include "ctlib/arch.h"
#include "ctlib/cttags.h"
#include "cbc/member.h"
/*===== TYPEDEFS =============================================================*/
typedef struct {
const char *type;
MemberInfo mi;
} TagTypeInfo;
/*===== FUNCTION PROTOTYPES ==================================================*/
#define get_tags CBC_get_tags
SV *get_tags(pTHX_ const TagTypeInfo *ptti, CtTagList taglist);
#define handle_tag CBC_handle_tag
void handle_tag(pTHX_ const TagTypeInfo *ptti, CtTagList *ptl, SV *name, SV *val, SV **rv);
#define find_taglist_ptr CBC_find_taglist_ptr
CtTagList *find_taglist_ptr(const void *pType);
#define delete_all_tags CBC_delete_all_tags
void delete_all_tags(CtTagList *ptl);
#endif
#include "cbc/type.h"
#include "cbc/util.h"
/*===== DEFINES ==============================================================*/
/*===== TYPEDEFS =============================================================*/
/*===== STATIC FUNCTION PROTOTYPES ===========================================*/
static void *get_type_pointer(CBC *THIS, const char *name, const char **pEOS);
/*===== EXTERNAL VARIABLES ===================================================*/
/*===== GLOBAL VARIABLES =====================================================*/
/*===== STATIC VARIABLES =====================================================*/
/*===== STATIC FUNCTIONS =====================================================*/
********************************************************************************
*
* DESCRIPTION:
*
* ARGUMENTS:
*
* RETURNS:
*
*******************************************************************************/
static void *get_type_pointer(CBC *THIS, const char *name, const char **pEOS)
{
const char *c = name;
void *ptr = NULL;
int len = 0;
enum { S_UNKNOWN, S_STRUCT, S_UNION, S_ENUM } type = S_UNKNOWN;
if (!THIS->cpi.available)
return NULL;
while (isSPACE(*c))
********************************************************************************
*
* DESCRIPTION:
*
* ARGUMENTS:
*
* RETURNS:
*
*******************************************************************************/
int get_member_info(pTHX_ CBC *THIS, const char *name, MemberInfo *pMI, unsigned gmi_flags)
{
const int do_calc = (gmi_flags & CBC_GMI_NO_CALC) == 0;
const char *member;
MemberInfo mi;
if (get_type_spec(THIS, name, &member, &mi.type) == 0)
return 0;
if (pMI)
{
pMI->flags = 0;
pMI->parent = NULL;
if (member && *member)
{
mi.pDecl = NULL;
mi.level = 0;
(void) get_member(aTHX_ &mi, member, pMI, do_calc ? 0 : CBC_GM_NO_OFFSET_SIZE_CALC);
}
else if (mi.type.ptr == NULL)
{
Declarator *pDecl = basic_types_get_declarator(THIS->basic, mi.type.tflags);
if (pDecl == NULL)
{
SV *str = NULL;
get_basic_type_spec_string(aTHX_ &str, mi.type.tflags);
sv_2mortal(str);
********************************************************************************
*
* DESCRIPTION:
*
* ARGUMENTS:
*
* RETURNS:
*
*******************************************************************************/
int get_type_spec(CBC *THIS, const char *name, const char **pEOS, TypeSpec *pTS)
{
void *ptr = get_type_pointer(THIS, name, pEOS);
if (ptr == NULL)
{
if (pEOS)
*pEOS = NULL;
return get_basic_type_spec(name, pTS);
}
* DESCRIPTION: C::B::C type names
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_TYPE_H
#define _CBC_TYPE_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
#include "ctlib/cttype.h"
#include "cbc/cbc.h"
#include "cbc/member.h"
/*===== DEFINES ==============================================================*/
#define ALLOW_UNIONS 0x00000001
#define ALLOW_STRUCTS 0x00000002
#define ALLOW_ENUMS 0x00000004
#define ALLOW_POINTERS 0x00000008
#define ALLOW_ARRAYS 0x00000010
#define ALLOW_BASIC_TYPES 0x00000020
#define CBC_GMI_NO_CALC 0x1
/*===== TYPEDEFS =============================================================*/
/*===== FUNCTION PROTOTYPES ==================================================*/
#define get_member_info CBC_get_member_info
int get_member_info(pTHX_ CBC *THIS, const char *name, MemberInfo *pMI, unsigned gmi_flags);
#define get_type_spec CBC_get_type_spec
int get_type_spec(CBC *THIS, const char *name, const char **pEOS, TypeSpec *pTS);
#define get_type_name_string CBC_get_type_name_string
SV *get_type_name_string(pTHX_ const MemberInfo *pMI);
#define is_typedef_defined CBC_is_typedef_defined
int is_typedef_defined(Typedef *pTypedef);
#define check_allowed_types_string CBC_check_allowed_types_string
const char *check_allowed_types_string(const MemberInfo *pMI, U32 allowed_types);
#define check_allowed_types CBC_check_allowed_types
void check_allowed_types(pTHX_ const MemberInfo *pMI, const char *method, U32 allowed_types);
#endif
cbc/typeinfo.h view on Meta::CPAN
* DESCRIPTION: C::B::C type information
*
********************************************************************************
*
* Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
*
*******************************************************************************/
#ifndef _CBC_TYPEINFO_H
#define _CBC_TYPEINFO_H
/*===== GLOBAL INCLUDES ======================================================*/
/*===== LOCAL INCLUDES =======================================================*/
#include "ctlib/ctparse.h"
#include "ctlib/cttype.h"
/*===== DEFINES ==============================================================*/
/*===== TYPEDEFS =============================================================*/
/*===== FUNCTION PROTOTYPES ==================================================*/
#define get_typedef_def CBC_get_typedef_def
SV *get_typedef_def(pTHX_ const CParseConfig *pCfg, const Typedef *pTypedef);
#define get_enum_spec_def CBC_get_enum_spec_def
SV *get_enum_spec_def(pTHX_ const CParseConfig *pCfg, const EnumSpecifier *pEnumSpec);
#define get_struct_spec_def CBC_get_struct_spec_def
SV *get_struct_spec_def(pTHX_ const CParseConfig *pCfg, const Struct *pStruct);
#endif
( run in 1.566 second using v1.01-cache-2.11-cpan-e1769b4cff6 )