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