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, Devid 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_BAD_ADDR & 0xFF:\r
  48                 s = "address misaligned"; break;\r
  49         case PF_ERR_TOO_BIG & 0xFF:\r
  50                 s = "data chunk too large"; break;\r
  51         case PF_ERR_NUM_PARAMS & 0xFF:\r
  52                 s = "incorrect number of parameters"; break;\r
  53         case PF_ERR_OPEN_FILE & 0xFF:\r
  54                 s = "could not open file"; break;\r
  55         case PF_ERR_WRONG_FILE & 0xFF:\r
  56                 s = "wrong type of file format"; break;\r
  57         case PF_ERR_BAD_FILE & 0xFF:\r
  58                 s = "badly formatted file"; break;\r
  59         case PF_ERR_READ_FILE & 0xFF:\r
  60                 s = "file read failed"; break;\r
  61         case PF_ERR_WRITE_FILE & 0xFF:\r
  62                 s = "file write failed"; break;\r
  63         case PF_ERR_CORRUPT_DIC & 0xFF:\r
  64                 s = "corrupted dictionary"; break;\r
  65         case PF_ERR_NOT_SUPPORTED & 0xFF:\r
  66                 s = "not supported in this version"; break;\r
  67         case PF_ERR_VERSION_FUTURE & 0xFF:\r
  68                 s = "version from future"; break;\r
  69         case PF_ERR_VERSION_PAST & 0xFF:\r
  70                 s = "version is obsolete. Rebuild new one."; break;\r
  71         case PF_ERR_COLON_STACK & 0xFF:\r
  72                 s = "stack depth changed between : and ; . Probably unbalanced conditional"; break;\r
  73         case PF_ERR_HEADER_ROOM & 0xFF:\r
  74                 s = "no room left in header space"; break;\r
  75         case PF_ERR_CODE_ROOM & 0xFF:\r
  76                 s = "no room left in code space"; break;\r
  77         case PF_ERR_NO_SHELL & 0xFF:\r
  78                 s = "attempt to use names in forth compiled with PF_NO_SHELL"; break;\r
  79         case PF_ERR_NO_NAMES & 0xFF:\r
  80                 s = "dictionary has no names";  break;\r
  81         case PF_ERR_OUT_OF_RANGE & 0xFF:\r
  82                 s = "parameter out of range";  break;\r
  83         case PF_ERR_ENDIAN_CONFLICT & 0xFF:\r
  84                 s = "endian-ness of dictionary does not match code";  break;\r
  85         case PF_ERR_FLOAT_CONFLICT & 0xFF:\r
  86                 s = "float support 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 #endif\r
  94 \r
  95 /**************************************************************\r
  96 ** Copy a Forth String to a 'C' string.\r
  97 */\r
  98 \r
  99 char *ForthStringToC( char *dst, const char *FString )\r
 100 {\r
 101         int32 Len;\r
 102 \r
 103         Len = (int32) *FString;\r
 104         pfCopyMemory( dst, FString+1, Len );\r
 105         dst[Len] = '\0';\r
 106 \r
 107         return dst;\r
 108 }\r
 109 \r
 110 /**************************************************************\r
 111 ** Copy a NUL terminated string to a Forth counted string.\r
 112 */\r
 113 char *CStringToForth( char *dst, const char *CString )\r
 114 {\r
 115         char *s;\r
 116         int32 i;\r
 117 \r
 118         s = dst+1;\r
 119         for( i=0; *CString; i++ )\r
 120         {\r
 121                 *s++ = *CString++;\r
 122         }\r
 123         *dst = (char ) i;\r
 124         return dst;\r
 125 }\r
 126 \r
 127 /**************************************************************\r
 128 ** Compare two test strings, case sensitive.\r
 129 ** Return TRUE if they match.\r
 130 */\r
 131 int32 ffCompareText( const char *s1, const char *s2, int32 len )\r
 132 {\r
 133         int32 i, Result;\r
 134         \r
 135         Result = TRUE;\r
 136         for( i=0; i<len; i++ )\r
 137         {\r
 138 DBUGX(("ffCompareText: *s1 = 0x%x, *s2 = 0x%x\n", *s1, *s2 ));\r
 139                 if( *s1++ != *s2++ )\r
 140                 {\r
 141                         Result = FALSE;\r
 142                         break;\r
 143                 }\r
 144         }\r
 145 DBUGX(("ffCompareText: return 0x%x\n", Result ));\r
 146         return Result;\r
 147 }\r
 148 \r
 149 /**************************************************************\r
 150 ** Compare two test strings, case INsensitive.\r
 151 ** Return TRUE if they match.\r
 152 */\r
 153 int32 ffCompareTextCaseN( const char *s1, const char *s2, int32 len )\r
 154 {\r
 155         int32 i, Result;\r
 156         char  c1,c2;\r
 157         \r
 158         Result = TRUE;\r
 159         for( i=0; i<len; i++ )\r
 160         {\r
 161                 c1 = pfCharToLower(*s1++);\r
 162                 c2 = pfCharToLower(*s2++);\r
 163 DBUGX(("ffCompareText: c1 = 0x%x, c2 = 0x%x\n", c1, c2 ));\r
 164                 if( c1 != c2 )\r
 165                 {\r
 166                         Result = FALSE;\r
 167                         break;\r
 168                 }\r
 169         }\r
 170 DBUGX(("ffCompareText: return 0x%x\n", Result ));\r
 171         return Result;\r
 172 }\r
 173 \r
 174 /**************************************************************\r
 175 ** Compare two strings, case sensitive.\r
 176 ** Return zero if they match, -1 if s1<s2, +1 is s1>s2;\r
 177 */\r
 178 int32 ffCompare( const char *s1, int32 len1, const char *s2, int32 len2 )\r
 179 {\r
 180         int32 i, result, n, diff;\r
 181         \r
 182         result = 0;\r
 183         n = MIN(len1,len2);\r
 184         for( i=0; i<n; i++ )\r
 185         {\r
 186                 if( (diff = (*s2++ - *s1++)) != 0 )\r
 187                 {\r
 188                         result = (diff > 0) ? -1 : 1 ;\r
 189                         break;\r
 190                 }\r
 191         }\r
 192         if( result == 0 )  /* Match up to MIN(len1,len2) */\r
 193         {\r
 194                 if( len1 < len2 )\r
 195                 {\r
 196                         result = -1;\r
 197                 }\r
 198                 else if ( len1 > len2 )\r
 199                 {\r
 200                         result = 1;\r
 201                 }\r
 202         }\r
 203         return result;\r
 204 }\r
 205 \r
 206 /***************************************************************\r
 207 ** Convert number to text.\r
 208 */\r
 209 #define CNTT_PAD_SIZE ((sizeof(int32)*8)+2)  /* PLB 19980522 - Expand PAD so "-1 binary .s" doesn't crash. */\r
 210 static char cnttPad[CNTT_PAD_SIZE];\r
 211 \r
 212 char *ConvertNumberToText( int32 Num, int32 Base, int32 IfSigned, int32 MinChars )\r
 213 {\r
 214         int32 IfNegative = 0;\r
 215         char *p,c;\r
 216         uint32 NewNum, Rem, uNum;\r
 217         int32 i = 0;\r
 218         \r
 219         uNum = Num;\r
 220         if( IfSigned )\r
 221         {\r
 222 /* Convert to positive and keep sign. */\r
 223                 if( Num < 0 )\r
 224                 {\r
 225                         IfNegative = TRUE;\r
 226                         uNum = -Num;\r
 227                 }\r
 228         }\r
 229         \r
 230 /* Point past end of Pad */\r
 231         p = cnttPad + CNTT_PAD_SIZE;\r
 232         *(--p) = (char) 0; /* NUL terminate */\r
 233         \r
 234         while( (i++<MinChars) || (uNum != 0) )\r
 235         {\r
 236                 NewNum = uNum / Base;\r
 237                 Rem = uNum - (NewNum * Base);\r
 238                 c = (char) (( Rem < 10 ) ? (Rem + '0') : (Rem - 10 + 'A'));\r
 239                 *(--p) = c;\r
 240                 uNum = NewNum;\r
 241         }\r
 242         \r
 243         if( IfSigned )\r
 244         {\r
 245                 if( IfNegative ) *(--p) = '-';\r
 246         }\r
 247         return p;\r
 248 }\r
 249 \r
 250 /***************************************************************\r
 251 ** Diagnostic routine that prints memory in table format.\r
 252 */\r
 253 void DumpMemory( void *addr, int32 cnt)\r
 254 {\r
 255         int32 ln, cn, nlines;\r
 256         unsigned char *ptr, *cptr, c;\r
 257 \r
 258         nlines = (cnt + 15) / 16;\r
 259 \r
 260         ptr = (unsigned char *) addr;\r
 261 \r
 262         EMIT_CR;\r
 263         \r
 264         for (ln=0; ln<nlines; ln++)\r
 265         {\r
 266                 MSG( ConvertNumberToText( (int32) ptr, 16, FALSE, 8 ) );\r
 267                 MSG(": ");\r
 268                 cptr = ptr;\r
 269                 for (cn=0; cn<16; cn++)\r
 270                 {\r
 271                         MSG( ConvertNumberToText( (int32) *cptr++, 16, FALSE, 2 ) );\r
 272                         EMIT(' ');\r
 273                 }\r
 274                 EMIT(' ');\r
 275                 for (cn=0; cn<16; cn++)\r
 276                 {\r
 277                         c = *ptr++;\r
 278                         if ((c < ' ') || (c > '}')) c = '.';\r
 279                         EMIT(c);\r
 280                 }\r
 281                 EMIT_CR;\r
 282         }\r
 283 }\r
 284 \r
 285 \r
 286 /* Print name, mask off any dictionary bits. */\r
 287 void TypeName( const char *Name )\r
 288 {\r
 289         const char *FirstChar;\r
 290         int32 Len;\r
 291         \r
 292         FirstChar = Name+1;\r
 293         Len = *Name & 0x1F;\r
 294         \r
 295         ioType( FirstChar, Len );\r
 296 }\r
 297 \r