regina/dbgfuncs.c

   1 #ifndef lint
   2 static char *RCSid = "$Id$";
   3 #endif
   4
   5 /*
   6  *  The Regina Rexx Interpreter
   7  *  Copyright (C) 1992-1994  Anders Christensen <anders@pvv.unit.no>
   8  *
   9  *  This library is free software; you can redistribute it and/or
  10  *  modify it under the terms of the GNU Library General Public
  11  *  License as published by the Free Software Foundation; either
  12  *  version 2 of the License, or (at your option) any later version.
  13  *
  14  *  This library is distributed in the hope that it will be useful,
  15  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17  *  Library General Public License for more details.
  18  *
  19  *  You should have received a copy of the GNU Library General Public
  20  *  License along with this library; if not, write to the Free
  21  *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  22  */
  23
  24 #include "rexx.h"
  25 #include <stdio.h>
  26 #include <string.h>
  27 #include <ctype.h>
  28 #include <assert.h>
  29
  30 #ifdef REGINA_DEBUG_MEMORY
  31 streng *dbg_freelists( tsd_t *TSD, cparamboxptr dummy )
  32 {
  33    show_free_lists(TSD);
  34    return nullstringptr() ;
  35 }
  36 #endif
  37
  38 streng *dbg_traceback( tsd_t *TSD, cparamboxptr dummy )
  39 {
  40    traceback(TSD) ;
  41    dummy = dummy; /* keep compiler happy */
  42    return nullstringptr() ;
  43 }
  44
  45 #ifndef NDEBUG
  46
  47
  48 streng *dbg_dumpvars( tsd_t *TSD, cparamboxptr dummy )
  49 {
  50    dumpvars(TSD, (cvariableptr *) TSD->currlevel->vars) ;
  51    dummy = dummy; /* keep compiler happy */
  52    return nullstringptr() ;
  53 }
  54
  55
  56 #ifdef TRACEMEM
  57 streng *dbg_memorystats( tsd_t *TSD, cparamboxptr parms )
  58 {
  59 /*    memory_stats(TSD) ; */ /* FIXME, FGC: Shouldn't memory_stats() deleted? */
  60    return nullstringptr() ;
  61 }
  62
  63
  64 streng *dbg_allocated( tsd_t *TSD, cparamboxptr parms )
  65 {
  66    char ch=' ' ;
  67    streng *ptr=NULL ;
  68
  69    checkparam(  parms,  0,  1 , "ALLOCATED" ) ;
  70    if (!parms->value)
  71       ch = 'A' ;
  72    else
  73       ch = getonechar( TSD, parms->value, "ALLOCATED", 1 ) ;
  74
  75    switch ( ch )
  76    {
  77       case 'A' :
  78          ptr = int_to_streng( TSD,have_allocated(TSD, MEM_ALLOC)) ;
  79          break ;
  80
  81       case 'L' :
  82          ptr = int_to_streng( TSD,have_allocated(TSD, MEM_LEAKED)) ;
  83          break ;
  84
  85       case 'C' :
  86          ptr = int_to_streng( TSD,have_allocated(TSD, MEM_CURRENT)) ;
  87          break ;
  88
  89       case 'S' :
  90           ptr = Str_makeTSD( 132 ) ;
  91           sprintf( ptr->value,"Memory: Allocated=%d, Current=%d, Leaked=%d",
  92                  have_allocated(TSD, MEM_ALLOC),
  93                  have_allocated(TSD, MEM_CURRENT),
  94                  have_allocated(TSD, MEM_LEAKED)) ;
  95
  96           ptr->len = strlen( ptr->value ) ;
  97           assert( ptr->len <= ptr->max ) ;
  98           break ;
  99
 100       default:
 101           exiterror( ERR_INCORRECT_CALL, 28, "ALLOCATED", "ALCS", tmpstr_of( TSD, parms->value ) )  ;
 102    }
 103
 104    return( ptr ) ;
 105 }
 106 #endif
 107
 108
 109 streng *dbg_dumptree( tsd_t *TSD, cparamboxptr dummy )
 110 {
 111    dumptree( TSD, TSD->systeminfo->tree.root, 1, 1 ) ;
 112    dummy = dummy; /* keep compiler happy */
 113    return nullstringptr() ;
 114 }
 115
 116
 117 #ifdef TRACEMEM
 118
 119
 120 streng *dbg_listleaked( tsd_t *TSD, cparamboxptr parms )
 121 {
 122    char ch=0 ;
 123    int i=0 ;
 124
 125    checkparam(  parms,  0,  1 , "LISTLEAKED" ) ;
 126    if (parms->value)
 127       ch = getonechar( TSD, parms->value, "LISTLEAKED", 1 ) ;
 128    else
 129       ch = 'L' ;
 130
 131    if (ch=='N')
 132       i = listleaked( TSD, MEMTRC_NONE ) ;
 133    else if (ch=='L')
 134       i = listleaked( TSD, MEMTRC_LEAKED ) ;
 135    else if (ch=='A')
 136       i = listleaked( TSD, MEMTRC_ALL ) ;
 137    else
 138       exiterror( ERR_INCORRECT_CALL, 28, "LISTLEAKED", "ALN", tmpstr_of( TSD, parms->value ) )  ;
 139
 140    return int_to_streng( TSD, i ) ;
 141 }
 142 #endif
 143
 144 #endif /* !NDEBUG */