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

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