regina/debug.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
  26 #include <stdio.h>
  27 #include <string.h>
  28 #include <ctype.h>
  29 #include <assert.h>
  30
  31 #ifndef NDEBUG
  32
  33 void dumpvars( const tsd_t *TSD, cvariableptr *hashptr )
  34 {
  35 /* change by bja: dumpvars to use stderr, as trace or listleaked do */
  36 /* modified my mh: respect stdout_for_stderr OPTION also */
  37 /* change by bja: display variable's length in front of value       */
  38    cvariableptr ptr=NULL, tptr=NULL ;
  39    int i=0, j=0, k=0 ;
  40    FILE *fp=stderr;
  41
  42    if ( get_options_flag( TSD->currlevel, EXT_STDOUT_FOR_STDERR ) )
  43       fp = stdout;
  44    if (hashptr==NULL)
  45       hashptr = (cvariableptr *) TSD->currlevel->vars ;
  46
  47    fprintf(fp,"\nDumping variables to <stdout>\n") ;
  48    for (i=0;i!=HASHTABLENGTH;i++)
  49    {
  50       if (hashptr[i]!=NULL)
  51          fprintf(fp,"   Variables from bin no %d\n",i) ;
  52       for (ptr=hashptr[i];ptr!=NULL;ptr=ptr->next)
  53       {
  54          if ((ptr->name->value)[ptr->name->len-1]=='.')
  55          {
  56 #if 0
  57             fprintf(fp,"   >>> Stem    : //%s// Default: //%s//  Values:\n",
  58                   ptr->name->value,(ptr->value)?(ptr->value->value):"<none>") ;
  59 #else
  60             fprintf(fp,"   >>> Stem    : ");
  61             fprintf(fp,"(%d) :",ptr->name->len);
  62             for (k=0;k<ptr->name->len;k++)
  63                putc(ptr->name->value[k],fp);
  64  /* avoid problems with exposed variables                                              bja */
  65             if (ptr->realbox)
  66             {
  67                fprintf(fp," Exposed!\n");
  68                continue;
  69             }
  70  /* end of avoid problems with exposed variables                                       bja */
  71             fprintf(fp, " Default: [");
  72             if (ptr->value)
  73             {
  74                fprintf(fp,"(%d) :",ptr->value->len);
  75                for (k=0;k<ptr->value->len;k++)
  76                   putc(ptr->value->value[k],fp);
  77             }
  78             else
  79                fprintf(fp, "<none>");
  80             fprintf(fp, "]  Values:\n");
  81 #endif
  82             for (j=0;j<HASHTABLENGTH;j++)
  83             {
  84                if ((tptr=((ptr->index))[j])!=NULL)
  85                {
  86                   fprintf(fp, "      Sub-bin no %d\n",j) ;
  87                   for (;tptr;tptr=tptr->next)
  88                   {
  89                      if (tptr->name)
  90                      {
  91 #if 0
  92                         fprintf(fp, "      >>> Variable: //%s// Value: //%s//\n",
  93                               tptr->name->value,tptr->value->value) ;
  94 #else
  95                         fprintf(fp, "      >>> Tail: ");
  96                         fprintf(fp, "(%d) :",tptr->name->len);
  97                         for (k=0;k<tptr->name->len;k++)
  98                            putc(tptr->name->value[k],fp);
  99                         if ( tptr->num ) /* variable is a number */
 100                         {
 101 /* try printing numbers a bit better...                                                bja
 102                            fprintf(fp, " (number: %s) ",ptr->num->num );
 103  */                                                                                  /* bja */
 104                            fprintf(fp, " (number: ");                             /* bja */
 105                            if (tptr->num->negative) fprintf(fp,"-");              /* bja */
 106                            fprintf(fp, "%.*s) ",tptr->num->size, tptr->num->num );/* bja */
 107                         }
 108                         fprintf(fp," Flag: %d hwired: %ld valid: %ld ",ptr->flag, ptr->hwired, ptr->valid );
 109                         fprintf(fp," Value: [");
 110                         if (tptr->value)
 111                         {
 112                            fprintf(fp,"(%d) :",tptr->value->len);
 113                            for (k=0;k<tptr->value->len;k++)
 114                               putc(tptr->value->value[k],fp);
 115                         }
 116                         else
 117                         {                                               /* added bja */
 118                            fprintf(fp,"<none>");                           /* added bja */
 119                         }
 120                         fprintf(fp,"]\n");
 121 #endif
 122                      }
 123                   }
 124                }
 125             }
 126          }
 127          else
 128          {
 129 #if 0
 130             fprintf(fp,"   >>> Variable: //%s// Value: //%s//\n",
 131                                      ptr->name->value,ptr->value->value) ;
 132 #else
 133             fprintf(fp,"   >>> Variable: ");
 134             fprintf(fp,"(%d) :",ptr->name->len);
 135             for (k=0;k<ptr->name->len;k++)
 136                putc(ptr->name->value[k],fp);
 137  /* avoid problems with exposed variables                                              bja */
 138             if (ptr->realbox)
 139             {
 140                fprintf(fp," Exposed\n");
 141                continue;
 142             }
 143  /* end of avoid problems with exposed variables                                       bja */
 144             fprintf(fp," Value: [");
 145             if (ptr->value)
 146             {
 147                fprintf(fp,"(%d) :",ptr->value->len);
 148                for (k=0;k<ptr->value->len;k++)
 149                   putc(ptr->value->value[k],fp);
 150             }
 151             fprintf(fp,"]\n");
 152 #endif
 153          }
 154       }
 155    }
 156
 157    return ;
 158 }
 159
 160
 161 void dumptree(const tsd_t *TSD, const treenode *this, int level, int newline)
 162 {
 163    int i=0, j=0 ;
 164    streng *ptr=NULL;
 165    FILE *fp=stderr;
 166
 167    if ( get_options_flag( TSD->currlevel, EXT_STDOUT_FOR_STDERR ) )
 168       fp = stdout;
 169    if ((this->charnr)!=0
 170    &&  (this->charnr)!=(-1))
 171    {
 172       if (newline)
 173          putc('\n',fp);
 174       for (i=0;i!=level;i++) fprintf(fp,"  ") ;
 175       fprintf(fp,"Lineno: %d   Charno: %d", this->lineno, this->charnr) ;
 176       if (newline)
 177       {
 178          ptr = getsourceline(TSD, this->lineno, this->charnr,
 179                              &TSD->systeminfo->tree) ;
 180          fprintf(fp," Sourceline: [");
 181          for(i=0;i<ptr->len;i++)
 182             putc(ptr->value[i],fp);
 183          putc(']',fp);
 184       }
 185       putc('\n',fp);
 186    }
 187
 188    for (i=0;i!=level;i++)
 189       fprintf(fp,"  ") ;
 190    fprintf(fp,">>>  in type=%d == %s\n", this->type, getsym(this->type)) ;
 191
 192    for (i=0;i!=level;i++) fprintf(fp,"  ") ;
 193    fprintf(fp,"Flags: lnum %d rnum %d lsvar %d rsvar %d lcvar %d rcvar %d\n",
 194       this->u.flags.lnum,
 195       this->u.flags.rnum,
 196       this->u.flags.lsvar,
 197       this->u.flags.rsvar,
 198       this->u.flags.lcvar,
 199       this->u.flags.rcvar );
 200
 201    if ((this->name)!=NULL)
 202    {
 203       for (i=0;i!=level;i++) fprintf(fp,"  ") ;
 204       fprintf(fp,"Name: [");
 205       for (i=0;i<this->name->len;i++)
 206          putc(this->name->value[i],fp);
 207       fprintf(fp,"]\n") ;
 208    }
 209
 210    for (j=0;j<sizeof(this->p)/sizeof(this->p[0]);j++)
 211       if (this->p[j]!=NULL)
 212       {
 213          for (i=0;i!=level;i++)
 214             fprintf(fp,"  ") ;
 215          fprintf(fp,"==> (%d) going down in branch %d, type %d = %s\n",
 216                 this->type,j+1,this->p[j]->type,getsym(this->p[j]->type)) ;
 217          dumptree( TSD, this->p[j], level+1, 0 ) ;
 218       }
 219
 220    for (i=0;i!=level;i++)
 221       fprintf(fp,"  ") ;
 222    fprintf(fp,"<<< out type=%d == %s\n", this->type,getsym(this->type)) ;
 223
 224    if (this->next)
 225       dumptree( TSD, this->next, level, 1 ) ;
 226
 227 }
 228
 229 #endif /* !NDEBUG */
 230
 231
 232 #ifdef TRACEMEM
 233 void marksource( clineboxptr ptr )
 234 {
 235    for (;ptr;ptr=ptr->next) {
 236       markmemory( ptr->line,TRC_SOURCEL ) ;
 237       markmemory( (char *)ptr, TRC_SOURCE ) ; }
 238 }
 239 #endif
 240
 241
 242 static const char *sourceline( int line, const internal_parser_type *ipt, unsigned *size)
 243 {
 244    clineboxptr first;
 245    const otree *otp;
 246
 247    if (ipt->first_source_line == NULL)
 248    { /* must be incore_source but that value may be NULL because of a failed
 249       * instore[0] of RexxStart!
 250       */
 251       otp = ipt->srclines; /* NULL if incore_source==NULL */
 252       while (otp && (otp->num < (unsigned long) line)) {
 253          line -= otp->num;
 254          otp = otp->next;
 255       }
 256       if (otp == NULL)
 257       {
 258          *size = 0 ;
 259          return NULL ;
 260       }
 261       line--;
 262       *size = otp->elems[line].length ;
 263       return ipt->incore_source + otp->elems[line].offset ;
 264    }
 265    first = ipt->first_source_line;
 266    for (;first;)
 267    {
 268       if (first->lineno==line)
 269       {
 270          *size = first->line->len ;
 271          return first->line->value ;
 272       }
 273       else
 274          first = (first->lineno<line) ? first->next : first->prev ;
 275    }
 276
 277    *size = 0 ;
 278    return NULL ;
 279 }
 280
 281
 282
 283 streng *getsourceline( const tsd_t *TSD, int line, int charnr, const internal_parser_type *ipt )
 284 {
 285    int dquote=0, squote=0 ;
 286    unsigned len ;
 287    streng *string ;
 288    const char *ptr, *chptr, *chend, *tmptr ;
 289    char *outptr ;
 290
 291    assert( charnr>=0 ) ;
 292    if (!charnr)
 293      charnr++ ;
 294
 295    ptr = sourceline(line,ipt,&len) ;
 296 /*   assert( ptr ) ; */
 297    if (!ptr || (charnr >= (int) len))
 298       return nullstringptr() ;
 299
 300    chptr = ptr + --charnr ;
 301    chend = ptr + len ;
 302    for (; (chptr < chend) && isspace(*chptr); chptr++) ;
 303    string = Str_makeTSD(BUFFERSIZE+1) ;
 304    outptr = string->value ;
 305
 306    for (;;)
 307    {
 308 restart:
 309       if (chptr>=chend || outptr >= string->value + BUFFERSIZE)
 310          break ;
 311
 312       if (!squote && *chptr=='\"')
 313          dquote = !dquote ;
 314
 315       else if (!dquote && *chptr=='\'')
 316          squote = !squote ;
 317
 318       else if (!(dquote || squote))
 319       {
 320          switch (*chptr)
 321          {
 322             case ',':
 323                for(tmptr=chptr+1; tmptr<chend && isspace(*tmptr); tmptr++ ) ;
 324                assert( tmptr<=chend ) ;
 325                if (tmptr==chend)
 326                {
 327                   *(outptr++) = ' ' ;
 328                   chptr = sourceline(++line,ipt,&len) ;
 329                   chend = chptr + len ;
 330                   for(; chptr<chend && isspace(*chptr); chptr++) ;
 331                   goto restart;
 332                }
 333                break ;
 334
 335             case ':':
 336                *(outptr++) = *chptr ;
 337
 338             case ';':
 339                goto endloop ;
 340
 341          }
 342       }
 343
 344       *(outptr++) = *(chptr++) ;
 345    }
 346
 347 endloop:
 348    assert( outptr - string->value <= BUFFERSIZE ) ;
 349    *outptr = '\0'; /* needs to be 0-terminated */
 350    string->len = outptr - string->value ;
 351    return string ;
 352 }
 353