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         default:\r
  86                 s = "unrecognized error code!"; break;\r
  87         }\r
  88         MSG(s);\r
  89         EMIT_CR;\r
  90 }\r
  91 \r
  92 void pfReportThrow( ThrowCode code )\r
  93 {\r
  94         const char *s = NULL;\r
  95         switch(code)\r
  96         {\r
  97         case THROW_ABORT:\r
  98         case THROW_ABORT_QUOTE:\r
  99                 s = "ABORT"; break;\r
 100         case THROW_STACK_OVERFLOW:\r
 101                 s = "Stack overflow!"; break;\r
 102         case THROW_STACK_UNDERFLOW:\r
 103                 s = "Stack underflow!"; break;\r
 104         case THROW_EXECUTING:\r
 105                 s = "Executing a compile-only word!"; break;\r
 106         case THROW_FLOAT_STACK_UNDERFLOW:\r
 107                 s = "Float Stack underflow!"; break;\r
 108         case THROW_UNDEFINED_WORD:\r
 109                 s = "Undefined word!"; break;\r
 110         case THROW_PAIRS:\r
 111                 s = "Conditional control structure mismatch!"; break;\r
 112         case THROW_BYE:\r
 113         case THROW_QUIT:\r
 114                 break;\r
 115         case THROW_SEMICOLON:\r
 116                 s = "Stack depth changed between : and ; . Probably unbalanced conditional!"; break;\r
 117         case THROW_DEFERRED:\r
 118                 s = "Not a DEFERred word!"; break;\r
 119         default:\r
 120                 s = "Unrecognized throw code!"; break;\r
 121         }\r
 122         \r
 123         if( s )\r
 124         {\r
 125                 MSG_NUM_D("THROW code = ", code );\r
 126                 MSG(s);\r
 127                 EMIT_CR;\r
 128         }\r
 129 }\r
 130 #endif\r
 131 \r
 132 /**************************************************************\r
 133 ** Copy a Forth String to a 'C' string.\r
 134 */\r
 135 \r
 136 char *ForthStringToC( char *dst, const char *FString )\r
 137 {\r
 138         int32 Len;\r
 139 \r
 140         Len = (int32) *FString;\r
 141         pfCopyMemory( dst, FString+1, Len );\r
 142         dst[Len] = '\0';\r
 143 \r
 144         return dst;\r
 145 }\r
 146 \r
 147 /**************************************************************\r
 148 ** Copy a NUL terminated string to a Forth counted string.\r
 149 */\r
 150 char *CStringToForth( char *dst, const char *CString )\r
 151 {\r
 152         char *s;\r
 153         int32 i;\r
 154 \r
 155         s = dst+1;\r
 156         for( i=0; *CString; i++ )\r
 157         {\r
 158                 *s++ = *CString++;\r
 159         }\r
 160         *dst = (char ) i;\r
 161         return dst;\r
 162 }\r
 163 \r
 164 /**************************************************************\r
 165 ** Compare two test strings, case sensitive.\r
 166 ** Return TRUE if they match.\r
 167 */\r
 168 int32 ffCompareText( const char *s1, const char *s2, int32 len )\r
 169 {\r
 170         int32 i, Result;\r
 171         \r
 172         Result = TRUE;\r
 173         for( i=0; i<len; i++ )\r
 174         {\r
 175 DBUGX(("ffCompareText: *s1 = 0x%x, *s2 = 0x%x\n", *s1, *s2 ));\r
 176                 if( *s1++ != *s2++ )\r
 177                 {\r
 178                         Result = FALSE;\r
 179                         break;\r
 180                 }\r
 181         }\r
 182 DBUGX(("ffCompareText: return 0x%x\n", Result ));\r
 183         return Result;\r
 184 }\r
 185 \r
 186 /**************************************************************\r
 187 ** Compare two test strings, case INsensitive.\r
 188 ** Return TRUE if they match.\r
 189 */\r
 190 int32 ffCompareTextCaseN( const char *s1, const char *s2, int32 len )\r
 191 {\r
 192         int32 i, Result;\r
 193         char  c1,c2;\r
 194         \r
 195         Result = TRUE;\r
 196         for( i=0; i<len; i++ )\r
 197         {\r
 198                 c1 = pfCharToLower(*s1++);\r
 199                 c2 = pfCharToLower(*s2++);\r
 200 DBUGX(("ffCompareText: c1 = 0x%x, c2 = 0x%x\n", c1, c2 ));\r
 201                 if( c1 != c2 )\r
 202                 {\r
 203                         Result = FALSE;\r
 204                         break;\r
 205                 }\r
 206         }\r
 207 DBUGX(("ffCompareText: return 0x%x\n", Result ));\r
 208         return Result;\r
 209 }\r
 210 \r
 211 /**************************************************************\r
 212 ** Compare two strings, case sensitive.\r
 213 ** Return zero if they match, -1 if s1<s2, +1 is s1>s2;\r
 214 */\r
 215 int32 ffCompare( const char *s1, int32 len1, const char *s2, int32 len2 )\r
 216 {\r
 217         int32 i, result, n, diff;\r
 218         \r
 219         result = 0;\r
 220         n = MIN(len1,len2);\r
 221         for( i=0; i<n; i++ )\r
 222         {\r
 223                 if( (diff = (*s2++ - *s1++)) != 0 )\r
 224                 {\r
 225                         result = (diff > 0) ? -1 : 1 ;\r
 226                         break;\r
 227                 }\r
 228         }\r
 229         if( result == 0 )  /* Match up to MIN(len1,len2) */\r
 230         {\r
 231                 if( len1 < len2 )\r
 232                 {\r
 233                         result = -1;\r
 234                 }\r
 235                 else if ( len1 > len2 )\r
 236                 {\r
 237                         result = 1;\r
 238                 }\r
 239         }\r
 240         return result;\r
 241 }\r
 242 \r
 243 /***************************************************************\r
 244 ** Convert number to text.\r
 245 */\r
 246 #define CNTT_PAD_SIZE ((sizeof(int32)*8)+2)  /* PLB 19980522 - Expand PAD so "-1 binary .s" doesn't crash. */\r
 247 static char cnttPad[CNTT_PAD_SIZE];\r
 248 \r
 249 char *ConvertNumberToText( int32 Num, int32 Base, int32 IfSigned, int32 MinChars )\r
 250 {\r
 251         int32 IfNegative = 0;\r
 252         char *p,c;\r
 253         uint32 NewNum, Rem, uNum;\r
 254         int32 i = 0;\r
 255         \r
 256         uNum = Num;\r
 257         if( IfSigned )\r
 258         {\r
 259 /* Convert to positive and keep sign. */\r
 260                 if( Num < 0 )\r
 261                 {\r
 262                         IfNegative = TRUE;\r
 263                         uNum = -Num;\r
 264                 }\r
 265         }\r
 266         \r
 267 /* Point past end of Pad */\r
 268         p = cnttPad + CNTT_PAD_SIZE;\r
 269         *(--p) = (char) 0; /* NUL terminate */\r
 270         \r
 271         while( (i++<MinChars) || (uNum != 0) )\r
 272         {\r
 273                 NewNum = uNum / Base;\r
 274                 Rem = uNum - (NewNum * Base);\r
 275                 c = (char) (( Rem < 10 ) ? (Rem + '0') : (Rem - 10 + 'A'));\r
 276                 *(--p) = c;\r
 277                 uNum = NewNum;\r
 278         }\r
 279         \r
 280         if( IfSigned )\r
 281         {\r
 282                 if( IfNegative ) *(--p) = '-';\r
 283         }\r
 284         return p;\r
 285 }\r
 286 \r
 287 /***************************************************************\r
 288 ** Diagnostic routine that prints memory in table format.\r
 289 */\r
 290 void DumpMemory( void *addr, int32 cnt)\r
 291 {\r
 292         int32 ln, cn, nlines;\r
 293         unsigned char *ptr, *cptr, c;\r
 294 \r
 295         nlines = (cnt + 15) / 16;\r
 296 \r
 297         ptr = (unsigned char *) addr;\r
 298 \r
 299         EMIT_CR;\r
 300         \r
 301         for (ln=0; ln<nlines; ln++)\r
 302         {\r
 303                 MSG( ConvertNumberToText( (int32) ptr, 16, FALSE, 8 ) );\r
 304                 MSG(": ");\r
 305                 cptr = ptr;\r
 306                 for (cn=0; cn<16; cn++)\r
 307                 {\r
 308                         MSG( ConvertNumberToText( (int32) *cptr++, 16, FALSE, 2 ) );\r
 309                         EMIT(' ');\r
 310                 }\r
 311                 EMIT(' ');\r
 312                 for (cn=0; cn<16; cn++)\r
 313                 {\r
 314                         c = *ptr++;\r
 315                         if ((c < ' ') || (c > '}')) c = '.';\r
 316                         EMIT(c);\r
 317                 }\r
 318                 EMIT_CR;\r
 319         }\r
 320 }\r
 321 \r
 322 \r
 323 /* Print name, mask off any dictionary bits. */\r
 324 void TypeName( const char *Name )\r
 325 {\r
 326         const char *FirstChar;\r
 327         int32 Len;\r
 328         \r
 329         FirstChar = Name+1;\r
 330         Len = *Name & 0x1F;\r
 331         \r
 332         ioType( FirstChar, Len );\r
 333 }\r
 334 \r
 335 \r