#ifndef lint
static char *RCSid = "$Id: dbgfuncs.c,v 1.9 1993/05/07 20:12:35 anders Exp anders $";
#endif

/*
 *  The Regina Rexx Interpreter
 *  Copyright (C) 1992-1994  Anders Christensen <anders@pvv.unit.no>
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Library General Public
 *  License as published by the Free Software Foundation; either
 *  version 2 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Library General Public License for more details.
 *
 *  You should have received a copy of the GNU Library General Public
 *  License along with this library; if not, write to the Free
 *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/*
    This code modified for Win32 port by Ataman Software, Inc. June 29, 1995.
*/

#include "rexx.h"
#include <stdio.h>
#include <ctype.h>
#include <assert.h>
#include <string.h>

#ifndef NDEBUG

streng *dbg_traceback( paramboxptr parms )
{
   traceback() ;
   return nullstringptr() ;
}


streng *dbg_dumpvars( paramboxptr parms ) 
{
   extern proclevel currlevel ;

   dumpvars(currlevel->vars) ;
   return nullstringptr() ;
}


#ifdef TRACEMEM
streng *dbg_memorystats( paramboxptr parms )
{
/*    memory_stats() ; */
   return nullstringptr() ;
}


streng *dbg_allocated( paramboxptr parms )
{
   char ch ;
   streng *ptr ;

   checkparam( parms, 0, 1 ) ;
   if (!parms->value)
      ch = 'A' ;
   else
      ch = getonechar(parms->value) & 0xdf ;

   switch ( ch ) 
   {
      case 'A' :
         ptr = int_to_streng(have_allocated(MEM_ALLOC)) ;
         break ;

      case 'L' :
         ptr = int_to_streng(have_allocated(MEM_LEAKED)) ;
         break ;

      case 'C' : 
         ptr = int_to_streng(have_allocated(MEM_CURRENT)) ;
         break ;

      case 'S' :
          ptr = Str_make( 132 ) ; 
          sprintf( ptr->value,"Memory: Allocated=%d, Current=%d, Leaked=%d",
                 have_allocated(MEM_ALLOC), have_allocated(MEM_CURRENT),
                 have_allocated(MEM_LEAKED)) ;     

          ptr->len = strlen( ptr->value ) ;
          assert( ptr->len <= ptr->max ) ;
          break ;

      default:
          exiterror( ERR_INCORRECT_CALL ) ;
   }

   return( ptr ) ;
}
#endif


streng *dbg_dumptree( paramboxptr parms ) 
{
   extern sysinfobox *systeminfo ;

   dumptree( systeminfo->rootnode, 1 ) ;
   return nullstringptr() ;
}


#ifdef TRACEMEM


streng *dbg_listleaked( paramboxptr parms )
{
   char ch ;
   int i ;

   checkparam( parms, 0, 1 ) ;
   if (parms->value)
      ch = toupper(getonechar(parms->value)) ;
   else 
      ch = 'L' ;

   if (ch=='N')
      i = listleaked( MEMTRC_NONE ) ;
   else if (ch=='L')
      i = listleaked( MEMTRC_LEAKED ) ;
   else if (ch=='A')
      i = listleaked( MEMTRC_ALL ) ;
   else
      exiterror( ERR_INCORRECT_CALL ) ;

   return int_to_streng( i ) ;
}
#endif

#endif /* !NDEBUG */
