git.gag.com Git - debian/pforth/blob - csrc/pf_text.c

   1 /* @(#) pf_text.c 98/01/26 1.3 */
   2 /***************************************************************
   3 ** Text Strings for Error Messages
   4 ** Various Text tools.
   5 **
   6 ** For PForth based on 'C'
   7 **
   8 ** Author: Phil Burk
   9 ** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
  10 **
  11 ** The pForth software code is dedicated to the public domain,
  12 ** and any third party may reproduce, distribute and modify
  13 ** the pForth software code or any derivative works thereof
  14 ** without any compensation or license.  The pForth software
  15 ** code is provided on an "as is" basis without any warranty
  16 ** of any kind, including, without limitation, the implied
  17 ** warranties of merchantability and fitness for a particular
  18 ** purpose and their equivalents under the laws of any jurisdiction.
  19 **
  20 ****************************************************************
  21 ** 19970702 PLB Fixed ConvertNumberToText for unsigned numbers.
  22 ** 19980522 PLB Expand PAD for ConvertNumberToText so "-1 binary .s" doesn't crash.
  23 ***************************************************************/
  24
  25 #include "pf_all.h"
  26
  27 #define PF_ENGLISH
  28
  29 /*
  30 ** Define array of error messages.
  31 ** These are defined in one place to make it easier to translate them.
  32 */
  33 #ifdef PF_ENGLISH
  34 /***************************************************************/
  35 void pfReportError( const char *FunctionName, Err ErrCode )
  36 {
  37     const char *s;
  38
  39     MSG("Error in ");
  40     MSG(FunctionName);
  41     MSG(" - ");
  42
  43     switch(ErrCode & 0xFF)
  44     {
  45     case PF_ERR_NO_MEM & 0xFF:
  46         s = "insufficient memory"; break;
  47     case PF_ERR_TOO_BIG & 0xFF:
  48         s = "data chunk too large"; break;
  49     case PF_ERR_NUM_PARAMS & 0xFF:
  50         s = "incorrect number of parameters"; break;
  51     case PF_ERR_OPEN_FILE & 0xFF:
  52         s = "could not open file"; break;
  53     case PF_ERR_WRONG_FILE & 0xFF:
  54         s = "wrong type of file format"; break;
  55     case PF_ERR_BAD_FILE & 0xFF:
  56         s = "badly formatted file"; break;
  57     case PF_ERR_READ_FILE & 0xFF:
  58         s = "file read failed"; break;
  59     case PF_ERR_WRITE_FILE & 0xFF:
  60         s = "file write failed"; break;
  61     case PF_ERR_CORRUPT_DIC & 0xFF:
  62         s = "corrupted dictionary"; break;
  63     case PF_ERR_NOT_SUPPORTED & 0xFF:
  64         s = "not supported in this version"; break;
  65     case PF_ERR_VERSION_FUTURE & 0xFF:
  66         s = "version from future"; break;
  67     case PF_ERR_VERSION_PAST & 0xFF:
  68         s = "version is obsolete. Rebuild new one."; break;
  69     case PF_ERR_COLON_STACK & 0xFF:
  70         s = "stack depth changed between : and ; . Probably unbalanced conditional"; break;
  71     case PF_ERR_HEADER_ROOM & 0xFF:
  72         s = "no room left in header space"; break;
  73     case PF_ERR_CODE_ROOM & 0xFF:
  74         s = "no room left in code space"; break;
  75     case PF_ERR_NO_SHELL & 0xFF:
  76         s = "attempt to use names in forth compiled with PF_NO_SHELL"; break;
  77     case PF_ERR_NO_NAMES & 0xFF:
  78         s = "dictionary has no names";  break;
  79     case PF_ERR_OUT_OF_RANGE & 0xFF:
  80         s = "parameter out of range";  break;
  81     case PF_ERR_ENDIAN_CONFLICT & 0xFF:
  82         s = "endian-ness of dictionary does not match code";  break;
  83     case PF_ERR_FLOAT_CONFLICT & 0xFF:
  84         s = "float support mismatch between .dic file and code";  break;
  85     case PF_ERR_CELL_SIZE_CONFLICT & 0xFF:
  86         s = "cell size mismatch between .dic file and code";  break;
  87     default:
  88         s = "unrecognized error code!"; break;
  89     }
  90     MSG(s);
  91     EMIT_CR;
  92 }
  93
  94 void pfReportThrow( ThrowCode code )
  95 {
  96     const char *s = NULL;
  97     switch(code)
  98     {
  99     case THROW_ABORT:
 100     case THROW_ABORT_QUOTE:
 101         s = "ABORT"; break;
 102     case THROW_STACK_OVERFLOW:
 103         s = "Stack overflow!"; break;
 104     case THROW_STACK_UNDERFLOW:
 105         s = "Stack underflow!"; break;
 106     case THROW_EXECUTING:
 107         s = "Executing a compile-only word!"; break;
 108     case THROW_FLOAT_STACK_UNDERFLOW:
 109         s = "Float Stack underflow!"; break;
 110     case THROW_UNDEFINED_WORD:
 111         s = "Undefined word!"; break;
 112     case THROW_PAIRS:
 113         s = "Conditional control structure mismatch!"; break;
 114     case THROW_BYE:
 115     case THROW_QUIT:
 116         break;
 117     case THROW_SEMICOLON:
 118         s = "Stack depth changed between : and ; . Probably unbalanced conditional!"; break;
 119     case THROW_DEFERRED:
 120         s = "Not a DEFERred word!"; break;
 121     default:
 122         s = "Unrecognized throw code!"; break;
 123     }
 124
 125     if( s )
 126     {
 127         MSG_NUM_D("THROW code = ", code );
 128         MSG(s);
 129         EMIT_CR;
 130     }
 131 }
 132 #endif
 133
 134 /**************************************************************
 135 ** Copy a Forth String to a 'C' string.
 136 */
 137
 138 char *ForthStringToC( char *dst, const char *FString, cell_t dstSize )
 139 {
 140     cell_t Len;
 141
 142     Len = (cell_t) *FString;
 143     /* Make sure the text + NUL can fit. */
 144     if( Len >= dstSize )
 145     {
 146         Len = dstSize - 1;
 147     }
 148     pfCopyMemory( dst, FString+1, Len );
 149     dst[Len] = '\0';
 150
 151     return dst;
 152 }
 153
 154 /**************************************************************
 155 ** Copy a NUL terminated string to a Forth counted string.
 156 */
 157 char *CStringToForth( char *dst, const char *CString, cell_t dstSize )
 158 {
 159     cell_t i;
 160
 161     /* Make sure the SIZE+text can fit. */
 162     for( i=1; i<dstSize; i++ )
 163     {
 164         if( *CString == 0 )
 165         {
 166             break;
 167         }
 168         dst[i] = *CString++;
 169     }
 170     *dst = (char ) i-1;
 171     return dst;
 172 }
 173
 174 /**************************************************************
 175 ** Compare two test strings, case sensitive.
 176 ** Return TRUE if they match.
 177 */
 178 cell_t ffCompareText( const char *s1, const char *s2, cell_t len )
 179 {
 180     cell_t i, Result;
 181
 182     Result = TRUE;
 183     for( i=0; i<len; i++ )
 184     {
 185 DBUGX(("ffCompareText: *s1 = 0x%x, *s2 = 0x%x\n", *s1, *s2 ));
 186         if( *s1++ != *s2++ )
 187         {
 188             Result = FALSE;
 189             break;
 190         }
 191     }
 192 DBUGX(("ffCompareText: return 0x%x\n", Result ));
 193     return Result;
 194 }
 195
 196 /**************************************************************
 197 ** Compare two test strings, case INsensitive.
 198 ** Return TRUE if they match.
 199 */
 200 cell_t ffCompareTextCaseN( const char *s1, const char *s2, cell_t len )
 201 {
 202     cell_t i, Result;
 203     char  c1,c2;
 204
 205     Result = TRUE;
 206     for( i=0; i<len; i++ )
 207     {
 208         c1 = pfCharToLower(*s1++);
 209         c2 = pfCharToLower(*s2++);
 210 DBUGX(("ffCompareText: c1 = 0x%x, c2 = 0x%x\n", c1, c2 ));
 211         if( c1 != c2 )
 212         {
 213             Result = FALSE;
 214             break;
 215         }
 216     }
 217 DBUGX(("ffCompareText: return 0x%x\n", Result ));
 218     return Result;
 219 }
 220
 221 /**************************************************************
 222 ** Compare two strings, case sensitive.
 223 ** Return zero if they match, -1 if s1<s2, +1 is s1>s2;
 224 */
 225 cell_t ffCompare( const char *s1, cell_t len1, const char *s2, int32_t len2 )
 226 {
 227     cell_t i, result, n, diff;
 228
 229     result = 0;
 230     n = MIN(len1,len2);
 231     for( i=0; i<n; i++ )
 232     {
 233         if( (diff = (*s2++ - *s1++)) != 0 )
 234         {
 235             result = (diff > 0) ? -1 : 1 ;
 236             break;
 237         }
 238     }
 239     if( result == 0 )  /* Match up to MIN(len1,len2) */
 240     {
 241         if( len1 < len2 )
 242         {
 243             result = -1;
 244         }
 245         else if ( len1 > len2 )
 246         {
 247             result = 1;
 248         }
 249     }
 250     return result;
 251 }
 252
 253 /***************************************************************
 254 ** Convert number to text.
 255 */
 256 #define CNTT_PAD_SIZE ((sizeof(cell_t)*8)+2)  /* PLB 19980522 - Expand PAD so "-1 binary .s" doesn't crash. */
 257 static char cnttPad[CNTT_PAD_SIZE];
 258
 259 char *ConvertNumberToText( cell_t Num, cell_t Base, int32_t IfSigned, int32_t MinChars )
 260 {
 261     cell_t IfNegative = 0;
 262     char *p,c;
 263     ucell_t NewNum, Rem, uNum;
 264     cell_t i = 0;
 265
 266     uNum = Num;
 267     if( IfSigned )
 268     {
 269 /* Convert to positive and keep sign. */
 270         if( Num < 0 )
 271         {
 272             IfNegative = TRUE;
 273             uNum = -Num;
 274         }
 275     }
 276
 277 /* Point past end of Pad */
 278     p = cnttPad + CNTT_PAD_SIZE;
 279     *(--p) = (char) 0; /* NUL terminate */
 280
 281     while( (i++<MinChars) || (uNum != 0) )
 282     {
 283         NewNum = uNum / Base;
 284         Rem = uNum - (NewNum * Base);
 285         c = (char) (( Rem < 10 ) ? (Rem + '0') : (Rem - 10 + 'A'));
 286         *(--p) = c;
 287         uNum = NewNum;
 288     }
 289
 290     if( IfSigned )
 291     {
 292         if( IfNegative ) *(--p) = '-';
 293     }
 294     return p;
 295 }
 296
 297 /***************************************************************
 298 ** Diagnostic routine that prints memory in table format.
 299 */
 300 void DumpMemory( void *addr, cell_t cnt)
 301 {
 302     cell_t ln, cn, nlines;
 303     unsigned char *ptr, *cptr, c;
 304
 305     nlines = (cnt + 15) / 16;
 306
 307     ptr = (unsigned char *) addr;
 308
 309     EMIT_CR;
 310
 311     for (ln=0; ln<nlines; ln++)
 312     {
 313         MSG( ConvertNumberToText( (cell_t) ptr, 16, FALSE, 8 ) );
 314         MSG(": ");
 315         cptr = ptr;
 316         for (cn=0; cn<16; cn++)
 317         {
 318             MSG( ConvertNumberToText( (cell_t) *cptr++, 16, FALSE, 2 ) );
 319             EMIT(' ');
 320         }
 321         EMIT(' ');
 322         for (cn=0; cn<16; cn++)
 323         {
 324             c = *ptr++;
 325             if ((c < ' ') || (c > '}')) c = '.';
 326             EMIT(c);
 327         }
 328         EMIT_CR;
 329     }
 330 }
 331
 332
 333 /* Print name, mask off any dictionary bits. */
 334 void TypeName( const char *Name )
 335 {
 336     const char *FirstChar;
 337     cell_t Len;
 338
 339     FirstChar = Name+1;
 340     Len = *Name & 0x1F;
 341
 342     ioType( FirstChar, Len );
 343 }
 344
 345
 346
 347 #ifdef PF_UNIT_TEST
 348 /* Unit test for string conversion routines. */
 349 #define ASSERT_PAD_IS( index, value, msg ) \
 350     if( pad[index] != ((char)(value)) ) \
 351     { \
 352         ERR(( "ERROR text test failed: " msg "\n")); \
 353         numErrors += 1; \
 354     } \
 355
 356 cell_t pfUnitTestText( void )
 357 {
 358     cell_t numErrors = 0;
 359     char pad[16];
 360     char fpad[8];
 361
 362     /* test CStringToForth */
 363     pfSetMemory(pad,0xA5,sizeof(pad));
 364     CStringToForth( pad, "frog", 6 );
 365     ASSERT_PAD_IS( 0, 4, "CS len 6" );
 366     ASSERT_PAD_IS( 4, 'g', "CS end 6" );
 367     ASSERT_PAD_IS( 5, 0xA5, "CS past 6" );
 368
 369     pfSetMemory(pad,0xA5,sizeof(pad));
 370     CStringToForth( pad, "frog", 5 );
 371     ASSERT_PAD_IS( 0, 4, "CS len 5" );
 372     ASSERT_PAD_IS( 4, 'g', "CS end 5" );
 373     ASSERT_PAD_IS( 5, 0xA5, "CS past 5" );
 374
 375     pfSetMemory(pad,0xA5,sizeof(pad));
 376     CStringToForth( pad, "frog", 4 );
 377     ASSERT_PAD_IS( 0, 3, "CS len 4" );
 378     ASSERT_PAD_IS( 3, 'o', "CS end 4" );
 379     ASSERT_PAD_IS( 4, 0xA5, "CS past 4" );
 380
 381     /* Make a Forth string for testing ForthStringToC. */
 382     CStringToForth( fpad, "frog", sizeof(fpad) );
 383
 384     pfSetMemory(pad,0xA5,sizeof(pad));
 385     ForthStringToC( pad, fpad, 6 );
 386     ASSERT_PAD_IS( 0, 'f', "FS len 6" );
 387     ASSERT_PAD_IS( 3, 'g', "FS end 6" );
 388     ASSERT_PAD_IS( 4, 0, "FS nul 6" );
 389     ASSERT_PAD_IS( 5, 0xA5, "FS past 6" );
 390
 391     pfSetMemory(pad,0xA5,sizeof(pad));
 392     ForthStringToC( pad, fpad, 5 );
 393     ASSERT_PAD_IS( 0, 'f', "FS len 5" );
 394     ASSERT_PAD_IS( 3, 'g', "FS end 5" );
 395     ASSERT_PAD_IS( 4, 0, "FS nul 5" );
 396     ASSERT_PAD_IS( 5, 0xA5, "FS past 5" );
 397
 398     pfSetMemory(pad,0xA5,sizeof(pad));
 399     ForthStringToC( pad, fpad, 4 );
 400     ASSERT_PAD_IS( 0, 'f', "FS len 4" );
 401     ASSERT_PAD_IS( 2, 'o', "FS end 4" );
 402     ASSERT_PAD_IS( 3, 0, "FS nul 4" );
 403     ASSERT_PAD_IS( 4, 0xA5, "FS past 4" );
 404
 405     return numErrors;
 406 }
 407 #endif