/* @(#) pf_text.c 98/01/26 1.3 */ /*************************************************************** ** Text Strings for Error Messages ** Various Text tools. ** ** For PForth based on 'C' ** ** Author: Phil Burk ** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom ** ** The pForth software code is dedicated to the public domain, ** and any third party may reproduce, distribute and modify ** the pForth software code or any derivative works thereof ** without any compensation or license. The pForth software ** code is provided on an "as is" basis without any warranty ** of any kind, including, without limitation, the implied ** warranties of merchantability and fitness for a particular ** purpose and their equivalents under the laws of any jurisdiction. ** **************************************************************** ** 19970702 PLB Fixed ConvertNumberToText for unsigned numbers. ** 19980522 PLB Expand PAD for ConvertNumberToText so "-1 binary .s" doesn't crash. ***************************************************************/ #include "pf_all.h" #define PF_ENGLISH /* ** Define array of error messages. ** These are defined in one place to make it easier to translate them. */ #ifdef PF_ENGLISH /***************************************************************/ void pfReportError( const char *FunctionName, Err ErrCode ) { const char *s; MSG("Error in "); MSG(FunctionName); MSG(" - "); switch(ErrCode & 0xFF) { case PF_ERR_NO_MEM & 0xFF: s = "insufficient memory"; break; case PF_ERR_TOO_BIG & 0xFF: s = "data chunk too large"; break; case PF_ERR_NUM_PARAMS & 0xFF: s = "incorrect number of parameters"; break; case PF_ERR_OPEN_FILE & 0xFF: s = "could not open file"; break; case PF_ERR_WRONG_FILE & 0xFF: s = "wrong type of file format"; break; case PF_ERR_BAD_FILE & 0xFF: s = "badly formatted file"; break; case PF_ERR_READ_FILE & 0xFF: s = "file read failed"; break; case PF_ERR_WRITE_FILE & 0xFF: s = "file write failed"; break; case PF_ERR_CORRUPT_DIC & 0xFF: s = "corrupted dictionary"; break; case PF_ERR_NOT_SUPPORTED & 0xFF: s = "not supported in this version"; break; case PF_ERR_VERSION_FUTURE & 0xFF: s = "version from future"; break; case PF_ERR_VERSION_PAST & 0xFF: s = "version is obsolete. Rebuild new one."; break; case PF_ERR_COLON_STACK & 0xFF: s = "stack depth changed between : and ; . Probably unbalanced conditional"; break; case PF_ERR_HEADER_ROOM & 0xFF: s = "no room left in header space"; break; case PF_ERR_CODE_ROOM & 0xFF: s = "no room left in code space"; break; case PF_ERR_NO_SHELL & 0xFF: s = "attempt to use names in forth compiled with PF_NO_SHELL"; break; case PF_ERR_NO_NAMES & 0xFF: s = "dictionary has no names"; break; case PF_ERR_OUT_OF_RANGE & 0xFF: s = "parameter out of range"; break; case PF_ERR_ENDIAN_CONFLICT & 0xFF: s = "endian-ness of dictionary does not match code"; break; case PF_ERR_FLOAT_CONFLICT & 0xFF: s = "float support mismatch between .dic file and code"; break; case PF_ERR_CELL_SIZE_CONFLICT & 0xFF: s = "cell size mismatch between .dic file and code"; break; default: s = "unrecognized error code!"; break; } MSG(s); EMIT_CR; } void pfReportThrow( ThrowCode code ) { const char *s = NULL; switch(code) { case THROW_ABORT: case THROW_ABORT_QUOTE: s = "ABORT"; break; case THROW_STACK_OVERFLOW: s = "Stack overflow!"; break; case THROW_STACK_UNDERFLOW: s = "Stack underflow!"; break; case THROW_EXECUTING: s = "Executing a compile-only word!"; break; case THROW_FLOAT_STACK_UNDERFLOW: s = "Float Stack underflow!"; break; case THROW_UNDEFINED_WORD: s = "Undefined word!"; break; case THROW_PAIRS: s = "Conditional control structure mismatch!"; break; case THROW_BYE: case THROW_QUIT: break; case THROW_SEMICOLON: s = "Stack depth changed between : and ; . Probably unbalanced conditional!"; break; case THROW_DEFERRED: s = "Not a DEFERred word!"; break; default: s = "Unrecognized throw code!"; break; } if( s ) { MSG_NUM_D("THROW code = ", code ); MSG(s); EMIT_CR; } } #endif /************************************************************** ** Copy a Forth String to a 'C' string. */ char *ForthStringToC( char *dst, const char *FString, cell_t dstSize ) { cell_t Len; Len = (cell_t) *FString; /* Make sure the text + NUL can fit. */ if( Len >= dstSize ) { Len = dstSize - 1; } pfCopyMemory( dst, FString+1, Len ); dst[Len] = '\0'; return dst; } /************************************************************** ** Copy a NUL terminated string to a Forth counted string. */ char *CStringToForth( char *dst, const char *CString, cell_t dstSize ) { cell_t i; /* Make sure the SIZE+text can fit. */ for( i=1; is2; */ cell_t ffCompare( const char *s1, cell_t len1, const char *s2, cell_t len2 ) { cell_t i, result, n, diff; result = 0; n = MIN(len1,len2); for( i=0; i 0) ? -1 : 1 ; break; } } if( result == 0 ) /* Match up to MIN(len1,len2) */ { if( len1 < len2 ) { result = -1; } else if ( len1 > len2 ) { result = 1; } } return result; } /*************************************************************** ** Convert number to text. */ #define CNTT_PAD_SIZE ((sizeof(cell_t)*8)+2) /* PLB 19980522 - Expand PAD so "-1 binary .s" doesn't crash. */ static char cnttPad[CNTT_PAD_SIZE]; char *ConvertNumberToText( cell_t Num, cell_t Base, int32_t IfSigned, int32_t MinChars ) { cell_t IfNegative = 0; char *p,c; ucell_t NewNum, Rem, uNum; cell_t i = 0; uNum = Num; if( IfSigned ) { /* Convert to positive and keep sign. */ if( Num < 0 ) { IfNegative = TRUE; uNum = -Num; } } /* Point past end of Pad */ p = cnttPad + CNTT_PAD_SIZE; *(--p) = (char) 0; /* NUL terminate */ while( (i++ '}')) c = '.'; EMIT(c); } EMIT_CR; } } /* Print name, mask off any dictionary bits. */ void TypeName( const char *Name ) { const char *FirstChar; cell_t Len; FirstChar = Name+1; Len = *Name & 0x1F; ioType( FirstChar, Len ); } #ifdef PF_UNIT_TEST /* Unit test for string conversion routines. */ #define ASSERT_PAD_IS( index, value, msg ) \ if( pad[index] != ((char)(value)) ) \ { \ ERR(( "ERROR text test failed: " msg "\n")); \ numErrors += 1; \ } \ cell_t pfUnitTestText( void ) { cell_t numErrors = 0; char pad[16]; char fpad[8]; /* test CStringToForth */ pfSetMemory(pad,0xA5,sizeof(pad)); CStringToForth( pad, "frog", 6 ); ASSERT_PAD_IS( 0, 4, "CS len 6" ); ASSERT_PAD_IS( 4, 'g', "CS end 6" ); ASSERT_PAD_IS( 5, 0xA5, "CS past 6" ); pfSetMemory(pad,0xA5,sizeof(pad)); CStringToForth( pad, "frog", 5 ); ASSERT_PAD_IS( 0, 4, "CS len 5" ); ASSERT_PAD_IS( 4, 'g', "CS end 5" ); ASSERT_PAD_IS( 5, 0xA5, "CS past 5" ); pfSetMemory(pad,0xA5,sizeof(pad)); CStringToForth( pad, "frog", 4 ); ASSERT_PAD_IS( 0, 3, "CS len 4" ); ASSERT_PAD_IS( 3, 'o', "CS end 4" ); ASSERT_PAD_IS( 4, 0xA5, "CS past 4" ); /* Make a Forth string for testing ForthStringToC. */ CStringToForth( fpad, "frog", sizeof(fpad) ); pfSetMemory(pad,0xA5,sizeof(pad)); ForthStringToC( pad, fpad, 6 ); ASSERT_PAD_IS( 0, 'f', "FS len 6" ); ASSERT_PAD_IS( 3, 'g', "FS end 6" ); ASSERT_PAD_IS( 4, 0, "FS nul 6" ); ASSERT_PAD_IS( 5, 0xA5, "FS past 6" ); pfSetMemory(pad,0xA5,sizeof(pad)); ForthStringToC( pad, fpad, 5 ); ASSERT_PAD_IS( 0, 'f', "FS len 5" ); ASSERT_PAD_IS( 3, 'g', "FS end 5" ); ASSERT_PAD_IS( 4, 0, "FS nul 5" ); ASSERT_PAD_IS( 5, 0xA5, "FS past 5" ); pfSetMemory(pad,0xA5,sizeof(pad)); ForthStringToC( pad, fpad, 4 ); ASSERT_PAD_IS( 0, 'f', "FS len 4" ); ASSERT_PAD_IS( 2, 'o', "FS end 4" ); ASSERT_PAD_IS( 3, 0, "FS nul 4" ); ASSERT_PAD_IS( 4, 0xA5, "FS past 4" ); return numErrors; } #endif