view release on metacpan or  search on metacpan

cbc/debug.c  view on Meta::CPAN

/*******************************************************************************
*
* MODULE: debug.c
*
********************************************************************************
*
* 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"


/*===== LOCAL INCLUDES =======================================================*/

#include "ctlib/ctdebug.h"
#include "util/hash.h"
#include "util/memalloc.h"
#include "cbc/cbc.h"
#include "cbc/debug.h"
#include "cbc/util.h"


/*===== DEFINES ==============================================================*/

#ifndef PERLIO_IS_STDIO
# ifdef fprintf
#  undef fprintf
# endif
# define fprintf PerlIO_printf
# ifdef vfprintf
#  undef vfprintf
# endif
# define vfprintf PerlIO_vprintf
# ifdef stderr
#  undef stderr
# endif
# define stderr PerlIO_stderr()
# ifdef fopen
#  undef fopen
# endif
# define fopen PerlIO_open
# ifdef fclose
#  undef fclose
# endif
# define fclose PerlIO_close
#endif


/*===== TYPEDEFS =============================================================*/

#ifdef PerlIO
typedef PerlIO * DebugStream;
#else
typedef FILE * DebugStream;
#endif


/*===== STATIC FUNCTION PROTOTYPES ===========================================*/

static void debug_vprintf(const char *f, va_list *l);
static void debug_printf(const char *f, ...);

cbc/debug.c  view on Meta::CPAN

  if (!SetDebugCType(debug_printf_ctlib, debug_vprintf, dbgflags))
    fatal("Cannot enable debugging");
}

/*******************************************************************************
*
*   ROUTINE: set_debug_file
*
*   WRITTEN BY: Marcus Holland-Moritz             ON: Mar 2002
*   CHANGED BY:                                   ON:
*
********************************************************************************
*
* DESCRIPTION:
*
*   ARGUMENTS:
*
*     RETURNS:
*
*******************************************************************************/

void set_debug_file(pTHX_ const char *dbfile)
{
  if (gs_DB_stream != stderr && gs_DB_stream != NULL)
  {
    fclose(gs_DB_stream);
    gs_DB_stream = NULL;
  }

  gs_DB_stream = dbfile ? fopen(dbfile, "w") : stderr;

  if (gs_DB_stream == NULL)
  {
    WARN((aTHX_ "Cannot open '%s', defaulting to stderr", dbfile));
    gs_DB_stream = stderr;
  }
}

/*******************************************************************************
*
*   ROUTINE: init_debugging
*
*   WRITTEN BY: Marcus Holland-Moritz             ON: Dec 2004
*   CHANGED BY:                                   ON:
*
********************************************************************************
*
* DESCRIPTION:
*
*   ARGUMENTS:
*
*     RETURNS:
*
*******************************************************************************/

void init_debugging(pTHX)
{
  gs_DB_stream = stderr;
}

#endif /* CBC_DEBUGGING */