rexx/lstring/lstring.c

   1 /*
   2  * $Header$
   3  * $Log$
   4  * Revision 1.1  2001/04/04 05:43:37  wang
   5  * First commit: compiles on Linux, Amiga, Windows, Windows CE, generic gcc
   6  *
   7  * Revision 1.3  1999/11/26 12:52:25  bnv
   8  * Added: Windows CE support
   9  * Added: Lwscpy, for unicode string copy
  10  * Changed: _Lisnum, it creates immediately a double number contained in
  11  * the string, for faster access. The value is hold in lLastScannedNumber
  12  *
  13  * Revision 1.2  1999/05/14 13:11:47  bnv
  14  * Minor changes
  15  *
  16  * Revision 1.1  1998/07/02 17:18:00  bnv
  17  * Initial Version
  18  *
  19  */
  20
  21 #define __LSTRING_C__
  22
  23 #include <math.h>
  24 #include <lerror.h>
  25 #include <lstring.h>
  26
  27 #ifndef WIN
  28 #       include <values.h>
  29 #endif
  30 /* ================= Lstring routines ================== */
  31
  32 /* -------------------- Linit ---------------- */
  33 void
  34 Linit( LerrorFunc Lerr)
  35 {
  36         size_t  i;
  37
  38         /* setup error function */
  39 #ifndef WCE
  40         if (Lerr)
  41                 Lerror = Lerr;
  42         else
  43                 Lerror = Lstderr;
  44 #else
  45         Lerror = Lerr;
  46 #endif
  47
  48         /* setup upper */
  49         for (i=0; i<256; i++)  u2l[i] = l2u[i] = i;
  50         for (i=0; clower[i]; i++) {
  51                 l2u[ (byte)clower[i] & 0xFF ] = cUPPER [i];
  52                 u2l[ (byte)cUPPER[i] & 0xFF ] = clower [i];
  53         }
  54
  55         /* setup time */
  56         _Ltimeinit();
  57 } /* Linit */
  58
  59 /* -------------- _Lfree ------------------- */
  60 void
  61 _Lfree(void *str)
  62 {
  63         LPFREE((PLstr)str);
  64 } /* _Lfree */
  65
  66 /* ---------------- Lfx -------------------- */
  67 void
  68 Lfx( const PLstr s, const size_t len )
  69 {
  70         size_t  max;
  71
  72         if (LISNULL(*s)) {
  73                 LSTR(*s) = (char *) MALLOC( (max = LNORMALISE(len))+LEXTRA, "Lstr" );
  74                 LLEN(*s) = 0;
  75                 LMAXLEN(*s) = max;
  76                 LTYPE(*s) = LSTRING_TY;
  77 #ifdef USEOPTION
  78                 LOPT(*s) = 0;
  79 #endif
  80         } else
  81 #ifdef USEOPTION
  82         if (!LOPTION(*s,LOPTFIX) && LMAXLEN(*s)<len) {
  83                 LSTR(*s) = (char *) REALLOC( LSTR(*s), (max=LNORMALISE(len))+LEXTRA);
  84                 LMAXLEN(*s) = max;
  85         }
  86 #else
  87         if (LMAXLEN(*s)<len) {
  88                 LSTR(*s) = (char *) REALLOC( LSTR(*s), (max=LNORMALISE(len))+LEXTRA);
  89                 LMAXLEN(*s) = max;
  90         }
  91 #endif
  92 } /* Lfx */
  93
  94 /* ---------------- Licpy ------------------ */
  95 void
  96 Licpy( const PLstr to, const long from )
  97 {
  98         LLEN(*to)  = sizeof(long);
  99         LTYPE(*to) = LINTEGER_TY;
 100         LINT(*to)  = from;
 101 } /* Licpy */
 102
 103 /* ---------------- Lrcpy ------------------ */
 104 void
 105 Lrcpy( const PLstr to, const double from )
 106 {
 107         LLEN(*to)  = sizeof(double);
 108         LTYPE(*to) = LREAL_TY;
 109         LREAL(*to) = from;
 110 } /* Lrcpy */
 111
 112 /* ---------------- Lscpy ------------------ */
 113 void
 114 Lscpy( const PLstr to, const char *from )
 115 {
 116         size_t  len;
 117
 118         if (!from)
 119                 Lfx(to,len=0);
 120         else {
 121                 Lfx(to,len = STRLEN(from));
 122                 MEMCPY( LSTR(*to), from, len );
 123         }
 124         LLEN(*to) = len;
 125         LTYPE(*to) = LSTRING_TY;
 126 } /* Lscpy */
 127
 128 #ifdef WCE
 129 /* ---------------- Lwscpy ------------------ */
 130 void
 131 Lwscpy(const PLstr to, const wchar_t *from )
 132 {
 133         size_t  len;
 134
 135         if (!from)
 136                 Lfx(to,len=0);
 137         else {
 138                 Lfx(to,len = wcslen(from));
 139                 wcstombs(LSTR(*to), from ,len );
 140         }
 141         LLEN(*to) = len;
 142         LTYPE(*to) = LSTRING_TY;
 143 } /* Lwscpy */
 144 #endif
 145
 146 /* ---------------- Lcat ------------------- */
 147 void
 148 Lcat( const PLstr to, const char *from )
 149 {
 150         size_t  l;
 151
 152         if (from==NULL) return;
 153
 154         if (LLEN(*to)==0)
 155                 Lscpy( to, from );
 156         else {
 157                 L2STR(to);
 158                 l=LLEN(*to) + STRLEN(from);
 159                 if (LMAXLEN(*to)<l) Lfx(to,l);
 160                 STRCPY( LSTR(*to) + LLEN(*to), from );
 161                 LLEN(*to) = l;
 162         }
 163 } /* Lcat */
 164
 165 /* ------------------ Lcmp ------------------- */
 166 int
 167 Lcmp( const PLstr a, const char *b )
 168 {
 169         int     r,blen;
 170
 171         L2STR(a);
 172
 173         blen = STRLEN(b);
 174         if ( (r=MEMCMP( LSTR(*a), b, MIN(LLEN(*a),blen)))!=0 )
 175                 return r;
 176         else {
 177                 if (LLEN(*a) > blen)
 178                         return 1;
 179                 else
 180                 if (LLEN(*a) == blen)
 181                         return 0;
 182                 else
 183                         return -1;
 184         }
 185 } /* Lcmp */
 186
 187 /* ---------------- Lstrcpy ----------------- */
 188 void
 189 Lstrcpy( const PLstr to, const PLstr from )
 190 {
 191         if (LLEN(*from)==0) {
 192                 LLEN(*to) = 0;
 193                 LTYPE(*to) = LSTRING_TY;
 194         } else {
 195                 if (LMAXLEN(*to)<=LLEN(*from)) Lfx(to,LLEN(*from));
 196                 switch ( LTYPE(*from) ) {
 197                         case LSTRING_TY:
 198                                 MEMCPY( LSTR(*to), LSTR(*from), LLEN(*from) );
 199                                 break;
 200
 201                         case LINTEGER_TY:
 202                                 LINT(*to) = LINT(*from);
 203                                 break;
 204
 205                         case LREAL_TY:
 206                                 LREAL(*to) = LREAL(*from);
 207                                 break;
 208                 }
 209                 LTYPE(*to) = LTYPE(*from);
 210                 LLEN(*to) = LLEN(*from);
 211         }
 212 } /* Lstrcpy */
 213
 214 /* ----------------- Lstrcat ------------------ */
 215 void
 216 Lstrcat( const PLstr to, const PLstr from )
 217 {
 218         size_t  l;
 219         if (LLEN(*from)==0) return;
 220
 221         if (LLEN(*to)==0) {
 222                 Lstrcpy( to, from );
 223                 return;
 224         }
 225
 226         L2STR(to);
 227         L2STR(from);
 228
 229         l = LLEN(*to)+LLEN(*from);
 230         if (LMAXLEN(*to) <= l)
 231                 Lfx(to, l);
 232         MEMCPY( LSTR(*to) + LLEN(*to), LSTR(*from), LLEN(*from) );
 233         LLEN(*to) = l;
 234 } /* Lstrcat */
 235
 236 /* ----------------- _Lstrcmp ----------------- */
 237 /* -- Low level strcmp, suppose that both of -- */
 238 /* -- are of the same type                      */
 239 int
 240 _Lstrcmp( const PLstr a, const PLstr b )
 241 {
 242         int     r;
 243
 244         if ( (r=MEMCMP( LSTR(*a), LSTR(*b), MIN(LLEN(*a),LLEN(*b))))!=0 )
 245                 return r;
 246         else {
 247                 if (LLEN(*a) > LLEN(*b))
 248                         return 1;
 249                 else
 250                 if (LLEN(*a) == LLEN(*b)) {
 251                         if (LTYPE(*a) > LTYPE(*b))
 252                                 return 1;
 253                         else
 254                         if (LTYPE(*a) < LTYPE(*b))
 255                                 return -1;
 256                         return 0;
 257                 } else
 258                         return -1;
 259         }
 260 } /* _Lstrcmp */
 261
 262 /* ----------------- Lstrcmp ------------------ */
 263 int
 264 Lstrcmp( const PLstr a, const PLstr b )
 265 {
 266         int     r;
 267
 268         L2STR(a);
 269         L2STR(b);
 270
 271         if ( (r=MEMCMP( LSTR(*a), LSTR(*b), MIN(LLEN(*a),LLEN(*b))))!=0 )
 272                 return r;
 273         else {
 274                 if (LLEN(*a) > LLEN(*b))
 275                         return 1;
 276                 else
 277                 if (LLEN(*a) == LLEN(*b))
 278                         return 0;
 279                 else
 280                         return -1;
 281         }
 282 }  /* Lstrcmp */
 283
 284 /* ----------------- Lstrset ------------------ */
 285 void
 286 Lstrset( const PLstr to, const size_t length, const char value)
 287 {
 288         Lfx(to,length);
 289         LTYPE(*to) = LSTRING_TY;
 290         LLEN(*to) = length;
 291         MEMSET(LSTR(*to),value,length);
 292 }  /* Lstrset */
 293
 294 /* ----------------- _Lsubstr ----------------- */
 295 /* WARNING!!! length is size_t type DO NOT PASS A NEGATIVE value */
 296 void
 297 _Lsubstr( const PLstr to, const PLstr from, size_t start, size_t length )
 298 {
 299         L2STR(from);
 300
 301         start--;
 302         if ((length==0) || (length+start>LLEN(*from)))
 303                 length = LLEN(*from) - start;
 304
 305         if (start<LLEN(*from)) {
 306                 if (LMAXLEN(*to)<length) Lfx(to,length);
 307                 MEMCPY( LSTR(*to), LSTR(*from)+start, length );
 308                 LLEN(*to) = length;
 309         } else
 310                 LZEROSTR(*to);
 311         LTYPE(*to) = LSTRING_TY;
 312 }  /* Lstrsub */
 313
 314 /* ------------------------ _Lisnum ----------------------- */
 315 /* _Lisnum      - returns if it is possible to convert      */
 316 /*               a LSTRING to NUMBER                        */
 317 /*               a LREAL_TY or LINTEGER_TY                  */
 318 /* There is one possibility that is missing...              */
 319 /* that is to hold an integer number as a real in a string. */
 320 /* ie.   '  2.0 '  this should be LINTEGER not LREAL        */
 321 /* -------------------------------------------------------- */
 322 int
 323 _Lisnum( const PLstr s )
 324 {
 325         bool    F, R;
 326         register char   *ch;
 327
 328         int     sign;
 329         int     exponent;
 330         int     expsign;
 331         int     fractionDigits;
 332
 333         lLastScannedNumber = 0.0;
 334
 335 /* ---
 336 #ifdef USEOPTION
 337         if (LOPT(*s) & (LOPTINT | LOPTREAL)) {
 338                 if (LOPT(*s) & LOPTINT)
 339                         return LINTEGER_TY;
 340                 else
 341                         return LREAL_TY;
 342         }
 343 #endif
 344 --- */
 345
 346         ch = LSTR(*s);
 347         if (ch==NULL) return LSTRING_TY;
 348         LASCIIZ(*s);    /*      ///// Remember to erase LASCIIZ
 349                                 ///// before all the calls to Lisnum */
 350
 351         /* skip leading spaces */
 352         while (ISSPACE(*ch)) ch++;
 353
 354         /* accept one sign */
 355         if (*ch=='-') {
 356                 sign = TRUE;
 357                 ch++;
 358         } else {
 359                 sign=FALSE;
 360                 if (*ch=='+')
 361                         ch++;
 362         }
 363
 364         /* skip following spaces after sign */
 365         while (ISSPACE(*ch)) ch++;
 366
 367         /* accept many digits */
 368         R = FALSE;
 369
 370         lLastScannedNumber = 0.0;
 371         fractionDigits=0;
 372         exponent=0;
 373         expsign=FALSE;
 374
 375         if (IN_RANGE('0',*ch,'9')) {
 376                 lLastScannedNumber = lLastScannedNumber*10.0 + (*ch-'0');
 377                 ch++;
 378                 F = TRUE;
 379                 while (IN_RANGE('0',*ch,'9')) {
 380                         lLastScannedNumber = lLastScannedNumber*10.0 + (*ch-'0');
 381                         ch++;
 382                 }
 383                 if (!*ch) goto isnumber;
 384         } else
 385                 F = FALSE;
 386
 387         /* accept one dot */
 388         if (*ch=='.') {
 389                 R = TRUE;
 390                 ch++;
 391
 392                 /* accept many digits */
 393                 if (IN_RANGE('0',*ch,'9')) {
 394                         lLastScannedNumber = lLastScannedNumber*10.0 + (*ch-'0');
 395                         fractionDigits++;
 396                         ch++;
 397                         while (IN_RANGE('0',*ch,'9')) {
 398                                 lLastScannedNumber = lLastScannedNumber*10.0 + (*ch-'0');
 399                                 fractionDigits++;
 400                                 ch++;
 401                         }
 402                 } else
 403                         if (!F) return LSTRING_TY;
 404
 405                 if (!*ch) goto isnumber;
 406         } else
 407                 if (!F) return LSTRING_TY;
 408
 409
 410         /* accept on 'e' or 'E' */
 411         if (*ch=='e' || *ch=='E') {
 412                 ch++;
 413                 R = TRUE;
 414                 /* accept one sign */
 415                 if (*ch=='-') {
 416                         expsign = TRUE;
 417                         ch++;
 418                 } else
 419                 if (*ch=='+')
 420                         ch++;
 421
 422                 /* accept many digits */
 423                 if (IN_RANGE('0',*ch,'9')) {
 424                         exponent = exponent*10+(*ch-'0');
 425                         ch++;
 426                         while (IN_RANGE('0',*ch,'9')) {
 427                                 exponent = exponent*10+(*ch-'0');
 428                                 ch++;
 429                         }
 430                 } else
 431                         return LSTRING_TY;
 432         }
 433
 434         /* accept many blanks */
 435         while (ISSPACE(*ch)) ch++;
 436
 437         /* is it end of string */
 438         if (*ch) return LSTRING_TY;
 439
 440 isnumber:
 441         if (expsign) exponent = -exponent;
 442
 443         exponent -= fractionDigits;
 444
 445         if (exponent)
 446 #ifdef __BORLAND_C__
 447                 lLastScannedNumber *= pow10(exponent);
 448 #else
 449                 lLastScannedNumber *= pow(10.0,(double)exponent);
 450 #endif
 451
 452         if (lLastScannedNumber>MAXLONG)
 453                 R = TRUE;       /* Treat it as real number */
 454
 455         if (sign)
 456                 lLastScannedNumber = -lLastScannedNumber;
 457
 458         if (R) return LREAL_TY;
 459
 460         return LINTEGER_TY;
 461 } /* _Lisnum */
 462
 463 /* ------------------ L2str ------------------- */
 464 void
 465 L2str( const PLstr s )
 466 {
 467         if (LTYPE(*s)==LINTEGER_TY) {
 468 #if defined(WCE) || defined(__BORLANDC__)
 469                 LTOA(LINT(*s),LSTR(*s),10);
 470 #else
 471                 sprintf(LSTR(*s), "%ld", LINT(*s));
 472 #endif
 473                 LLEN(*s) = STRLEN(LSTR(*s));
 474         } else {        /* LREAL_TY */
 475 /*////          sprintf(LSTR(*s), lFormatStringToReal, LREAL(*s)); */
 476                 GCVT(LREAL(*s),lNumericDigits,LSTR(*s));
 477 #ifdef WCE
 478                 {
 479                         /* --- remove the last dot from the number --- */
 480                         size_t  len = STRLEN(LSTR(*s));
 481                         if (LSTR(*s)[len-1] == '.') len--;
 482                         LLEN(*s) = len;
 483                 }
 484 #else
 485                 LLEN(*s) = STRLEN(LSTR(*s));
 486 #endif
 487         }
 488         LTYPE(*s) = LSTRING_TY;
 489 } /* L2str */
 490
 491 /* ------------------ L2int ------------------- */
 492 void
 493 L2int( const PLstr s )
 494 {
 495         if (LTYPE(*s)==LREAL_TY) {
 496                 if ((double)((long)LREAL(*s)) == LREAL(*s))
 497                         LINT(*s) = (long)LREAL(*s);
 498                 else
 499                         Lerror(ERR_INVALID_INTEGER,0);
 500         } else { /* LSTRING_TY */
 501                 LASCIIZ(*s);
 502                 switch (_Lisnum(s)) {
 503                         case LINTEGER_TY:
 504                                 /*///LINT(*s) = atol( LSTR(*s) ); */
 505                                 LINT(*s) = (long)lLastScannedNumber;
 506                                 break;
 507
 508                         case LREAL_TY:
 509                                 /*///LREAL(*s) = strtod( LSTR(*s), NULL ); */
 510                                 LREAL(*s) = lLastScannedNumber;
 511                                 if ((double)((long)LREAL(*s)) == LREAL(*s))
 512                                         LINT(*s) = (long)LREAL(*s);
 513                                 else
 514                                         Lerror(ERR_INVALID_INTEGER,0);
 515                                 break;
 516
 517                         default:
 518                                 Lerror(ERR_INVALID_INTEGER,0);
 519                 }
 520         }
 521         LTYPE(*s) = LINTEGER_TY;
 522         LLEN(*s) = sizeof(long);
 523 } /* L2int */
 524
 525 /* ------------------ L2real ------------------- */
 526 void
 527 L2real( const PLstr s )
 528 {
 529         if (LTYPE(*s)==LINTEGER_TY)
 530                 LREAL(*s) = (double)LINT(*s);
 531         else { /* LSTRING_TY */
 532                 LASCIIZ(*s);
 533                 if (_Lisnum(s)!=LSTRING_TY)
 534                         /*/////LREAL(*s) = strtod( LSTR(*s), NULL ); */
 535                         LREAL(*s) = lLastScannedNumber;
 536                 else
 537                         Lerror(ERR_BAD_ARITHMETIC,0);
 538         }
 539         LTYPE(*s) = LREAL_TY;
 540         LLEN(*s) = sizeof(double);
 541 } /* L2real */
 542
 543 /* ------------------- _L2num -------------------- */
 544 /* this function is used when we know to what type */
 545 /* we should change the string                     */
 546 void
 547 _L2num( const PLstr s, const int type )
 548 {
 549         LASCIIZ(*s);
 550         switch (type) {
 551                 case LINTEGER_TY:
 552                         /*////LINT(*s) = atol( LSTR(*s) ); */
 553                         LINT(*s) = (long)lLastScannedNumber;
 554                         LTYPE(*s) = LINTEGER_TY;
 555                         LLEN(*s) = sizeof(long);
 556                         break;
 557
 558                 case LREAL_TY:
 559                         /*////LREAL(*s) = strtod( LSTR(*s), NULL ); */
 560                         LREAL(*s) = lLastScannedNumber;
 561                         if ((double)((long)LREAL(*s)) == LREAL(*s)) {
 562                                 LINT(*s) = (long)LREAL(*s);
 563                                 LTYPE(*s) = LINTEGER_TY;
 564                                 LLEN(*s) = sizeof(long);
 565                         } else {
 566                                 LTYPE(*s) = LREAL_TY;
 567                                 LLEN(*s) = sizeof(double);
 568                         }
 569                         break;
 570                 default:
 571                         Lerror(ERR_BAD_ARITHMETIC,0);
 572         }
 573 } /* _L2num */
 574
 575 /* ------------------ L2num ------------------- */
 576 void
 577 L2num( const PLstr s )
 578 {
 579         switch (_Lisnum(s)) {
 580                 case LINTEGER_TY:
 581                         /*//LINT(*s) = atol( LSTR(*s) ); */
 582                         LINT(*s) = (long)lLastScannedNumber;
 583                         LTYPE(*s) = LINTEGER_TY;
 584                         LLEN(*s) = sizeof(long);
 585                         break;
 586
 587                 case LREAL_TY:
 588                         /*///LREAL(*s) = strtod( LSTR(*s), NULL ); */
 589                         LREAL(*s) = lLastScannedNumber;
 590 /*
 591 //// Numbers like 2.0 should be treated as real and not as integer
 592 //// because in cases like factorial while give an error result
 593 ////                    if ((double)((long)LREAL(*s)) == LREAL(*s)) {
 594 ////                            LINT(*s) = (long)LREAL(*s);
 595 ////                            LTYPE(*s) = LINTEGER_TY;
 596 ////                            LLEN(*s) = sizeof(long);
 597 ////                    } else {
 598 */
 599                                 LTYPE(*s) = LREAL_TY;
 600                                 LLEN(*s) = sizeof(double);
 601 /*
 602 ////                    }
 603 */
 604                         break;
 605
 606                 default:
 607                         Lerror(ERR_BAD_ARITHMETIC,0);
 608         }
 609 } /* L2num */
 610
 611 /* ----------------- Lrdint ------------------ */
 612 long
 613 Lrdint( const PLstr s )
 614 {
 615         if (LTYPE(*s)==LINTEGER_TY) return LINT(*s);
 616
 617         if (LTYPE(*s)==LREAL_TY) {
 618                 if ((double)((long)LREAL(*s)) == LREAL(*s))
 619                         return (long)LREAL(*s);
 620                 else
 621                         Lerror(ERR_INVALID_INTEGER,0);
 622         } else { /* LSTRING_TY */
 623                 LASCIIZ(*s);
 624                 switch (_Lisnum(s)) {
 625                         case LINTEGER_TY:
 626                                 /*///return atol( LSTR(*s) ); */
 627                                 return (long)lLastScannedNumber;
 628
 629                         case LREAL_TY:
 630                                 /*///d = strtod( LSTR(*s), NULL );
 631                                 //////if ((double)((long)d) == d)
 632                                 //////  return (long)d; */
 633                                 if ((double)((long)lLastScannedNumber) == lLastScannedNumber)
 634                                         return (long)lLastScannedNumber;
 635                                 else
 636                                         Lerror(ERR_INVALID_INTEGER,0);
 637                                 break;
 638
 639                         default:
 640                                 Lerror(ERR_INVALID_INTEGER,0);
 641                 }
 642         }
 643         return 0;       /* never gets here but keeps compiler happy */
 644 } /* Lrdint */
 645
 646 /* ----------------- Lrdreal ------------------ */
 647 double
 648 Lrdreal( const PLstr s )
 649 {
 650         if (LTYPE(*s)==LREAL_TY) return LREAL(*s);
 651
 652         if (LTYPE(*s)==LINTEGER_TY)
 653                 return (double)LINT(*s);
 654         else { /* LSTRING_TY */
 655                 LASCIIZ(*s);
 656                 if (_Lisnum(s)!=LSTRING_TY)
 657                         /*///// return strtod( LSTR(*s), NULL ); */
 658                         return lLastScannedNumber;
 659                 else
 660                         Lerror(ERR_BAD_ARITHMETIC,0);
 661         }
 662         return 0.0;
 663 } /* Lrdreal */