G:/ScriptBasic/source/commands/string.c

Go to the documentation of this file.
00001 /*string.c
00002 
00003 --GNU LGPL
00004 This library is free software; you can redistribute it and/or
00005 modify it under the terms of the GNU Lesser General Public
00006 License as published by the Free Software Foundation; either
00007 version 2.1 of the License, or (at your option) any later version.
00008 
00009 This library is distributed in the hope that it will be useful,
00010 but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
00012 Lesser General Public License for more details.
00013 
00014 You should have received a copy of the GNU Lesser General Public
00015 License along with this library; if not, write to the Free Software
00016 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
00017 
00018 */
00019 
00020 #include <stdlib.h>
00021 #include <stdio.h>
00022 #include <string.h>
00023 #include <ctype.h>
00024 #include <limits.h>
00025 #include <math.h>
00026 
00027 #include "../command.h"
00028 #include "../match.h"
00029 #include "../matchc.h"
00030 
00031 #define FMT_xMIN        1e-8            /* lowest limit to use the exp. format  */
00032 #define FMT_xMAX        1e+9            /* highest limit to use the exp. format */
00033 #define FMT_RND         9                         /* rounding on x digits                 */
00034 #define FMT_xRND        1e+9            /* 1 * 10 ^ FMT_RND                     */
00035 #define FMT_xRND2       1e+8            /* 1 * 10 ^ (FMT_RND-1)                 */
00036 
00037 static double nfta_eplus[]=
00038 { 
00039     1e+8,   1e+16,  1e+24,  1e+32,  1e+40,  1e+48,  1e+56,  1e+64,      /* 8  */
00040     1e+72,  1e+80,  1e+88,  1e+96,  1e+104, 1e+112, 1e+120, 1e+128,     /* 16 */
00041     1e+136, 1e+144, 1e+152, 1e+160, 1e+168, 1e+176, 1e+184, 1e+192,     /* 24 */
00042     1e+200, 1e+208, 1e+216, 1e+224, 1e+232, 1e+240, 1e+248, 1e+256,     /* 32 */
00043     1e+264, 1e+272, 1e+280, 1e+288, 1e+296, 1e+304                  /* 38 */
00044 };
00045 
00046 static double nfta_eminus[]=
00047 { 
00048     1e-8,   1e-16,  1e-24,  1e-32, 1e-40,   1e-48,  1e-56,  1e-64,  /* 8 */
00049     1e-72,  1e-80,  1e-88,  1e-96, 1e-104,  1e-112, 1e-120, 1e-128, /* 16 */
00050     1e-136, 1e-144, 1e-152, 1e-160, 1e-168, 1e-176, 1e-184, 1e-192, /* 24 */
00051     1e-200, 1e-208, 1e-216, 1e-224, 1e-232, 1e-240, 1e-248, 1e-256, /* 32 */
00052     1e-264, 1e-272, 1e-280, 1e-288, 1e-296, 1e-304                                        /* 38 */
00053 };
00054 
00055 
00056 /*
00057 String operator and functions
00058 
00059 This file conatins the commands for the string operator concatendate and
00060 string handling functions. When string parameters are needed conversion is done
00061 automatic as usually.
00062 
00063 */
00064 
00065 /* stringcompare two sub strings case sensitiveor case insensitive
00066    return 0 if they match and return non zero otherwise (used in InStr)
00067 */
00068 static int SUBSTRCMP(char *a, char *b, long length, int iCase){
00069   char ca,cb;
00070 
00071   iCase &= 1;/* only the lowest bit is about case sensitivity */
00072   while( length-- ){
00073     ca = *a;
00074     cb = *b;
00075     if( iCase ){
00076       if( isupper(ca) )ca = tolower(ca);
00077       if( isupper(cb) )cb = tolower(cb);
00078       }
00079     if( ca != cb )return ( (ca)-(cb) );
00080     a++;
00081     b++;
00082     }
00083   return 0;
00084   }
00085 
00086 
00095 COMMAND(CONCATENATE)
00096 #if NOTIMP_CONCATENATE
00097 NOTIMPLEMENTED;
00098 #else
00099 
00100 
00101   NODE nItem;
00102   VARIABLE Op1,Op2;
00103   long lFinalStringLength,lLen;
00104   char *s,*r;
00105 
00106   /* this is an operator and not a command, therefore we do not have our own mortal list */
00107   USE_CALLER_MORTALS;
00108 
00109   /* evaluate the parameters */
00110   nItem = PARAMETERLIST;
00111   /* CONVERT2STRING never modifies the parameter, therefore it is more efficient
00112      to use _EVALUATEEXPRESSION */
00113   Op1 = CONVERT2STRING(_EVALUATEEXPRESSION(CAR(nItem)));
00114   ASSERTOKE;
00115   nItem = CDR(nItem);
00116   Op2 = CONVERT2STRING(_EVALUATEEXPRESSION(CAR(nItem)));
00117   ASSERTOKE;
00118 
00119   lFinalStringLength  = Op1 ? STRLEN(Op1) : 0;
00120   lFinalStringLength += Op2 ? STRLEN(Op2) : 0;
00121 
00122   RESULT = NEWMORTALSTRING(lFinalStringLength);
00123   ASSERTNULL(RESULT)
00124   r = STRINGVALUE(RESULT);
00125 
00126   /* copy the characters of the strings to the new location */
00127   s = Op1 ? STRINGVALUE(Op1) : NULL;
00128   lLen = Op1 ? STRLEN(Op1) : 0;
00129   while( s && lLen ){
00130     *r++ = *s++;
00131     lLen--;
00132     }
00133   s = Op2 ? STRINGVALUE(Op2) : NULL;
00134   lLen = Op2 ? STRLEN(Op2) : 0;
00135   while( s && lLen ){
00136     *r++ = *s++;
00137     lLen--;
00138     }
00139 
00140 #endif
00141 END
00142 
00153 COMMAND(LEN)
00154 #if NOTIMP_LEN
00155 NOTIMPLEMENTED;
00156 #else
00157 
00158 
00159   NODE nItem;
00160   VARIABLE Op1;
00161 
00162   /* this is an operator and not a command, therefore we do not have our own mortal list */
00163   USE_CALLER_MORTALS;
00164 
00165   /* evaluate the parameters */
00166   nItem = PARAMETERLIST;
00167   Op1 = EVALUATEEXPRESSION(CAR(nItem));
00168   ASSERTOKE;
00169   if( memory_IsUndef(Op1) ){
00170     RESULT = NULL;
00171     RETURN;
00172     }
00173   Op1 = CONVERT2STRING(Op1);
00174   RESULT = NEWMORTALLONG;
00175   ASSERTNULL(RESULT)
00176   LONGVALUE(RESULT) = STRLEN(Op1);
00177 
00178 #endif
00179 END
00180 
00187 COMMAND(UCASE)
00188 #if NOTIMP_UCASE
00189 NOTIMPLEMENTED;
00190 #else
00191 
00192 
00193   NODE nItem;
00194   VARIABLE Op1;
00195   char *r;
00196   unsigned long lLen;
00197 
00198   /* this is an operator and not a command, therefore we do not have our own mortal list */
00199   USE_CALLER_MORTALS;
00200 
00201   /* evaluate the parameters */
00202   nItem = PARAMETERLIST;
00203   Op1 = EVALUATEEXPRESSION(CAR(nItem));
00204   ASSERTOKE;
00205   if( memory_IsUndef(Op1) ){
00206     RESULT = NULL;
00207     RETURN;
00208     }
00209   Op1 = CONVERT2STRING(Op1);
00210   RESULT = Op1;
00211   r = STRINGVALUE(RESULT);
00212   lLen = STRLEN(RESULT);
00213 
00214   while( lLen-- ){
00215     if( islower( *r ) )*r = toupper( *r );
00216     r++;
00217     }
00218 
00219 #endif
00220 END
00221 
00228 COMMAND(LCASE)
00229 #if NOTIMP_LCASE
00230 NOTIMPLEMENTED;
00231 #else
00232 
00233 
00234   NODE nItem;
00235   VARIABLE Op1;
00236   char *r;
00237   unsigned long lLen;
00238 
00239   /* this is an operator and not a command, therefore we do not have our own mortal list */
00240   USE_CALLER_MORTALS;
00241 
00242   /* evaluate the parameters */
00243   nItem = PARAMETERLIST;
00244   Op1 = EVALUATEEXPRESSION(CAR(nItem));
00245   ASSERTOKE;
00246   if( memory_IsUndef(Op1) ){
00247     RESULT = NULL;
00248     RETURN;
00249     }
00250   Op1 = CONVERT2STRING(Op1);
00251   RESULT = Op1;
00252   r = STRINGVALUE(RESULT);
00253   lLen = STRLEN(RESULT);
00254 
00255   while( lLen-- ){
00256     if( isupper( *r ) )*r = tolower( *r );
00257     r++;
00258     }
00259 
00260 #endif
00261 END
00262 
00269 COMMAND(LTRIM)
00270 #if NOTIMP_LTRIM
00271 NOTIMPLEMENTED;
00272 #else
00273 
00274 
00275   NODE nItem;
00276   VARIABLE Op1;
00277   char *r,*s;
00278   unsigned long lStringLength,lLen;
00279 
00280   /* this is an operator and not a command, therefore we do not have our own mortal list */
00281   USE_CALLER_MORTALS;
00282 
00283   /* evaluate the parameters */
00284   nItem = PARAMETERLIST;
00285   Op1 = _EVALUATEEXPRESSION(CAR(nItem));
00286   ASSERTOKE;
00287   if( memory_IsUndef(Op1) ){
00288     RESULT = NULL;
00289     RETURN;
00290     }
00291   Op1 = CONVERT2STRING(Op1);
00292   r = STRINGVALUE(Op1);
00293   lLen = STRLEN(Op1);
00294 
00295   while( lLen && isspace(*r) )r++,lLen--;
00296   s = r;
00297   lStringLength = 0;
00298   while( lLen ){
00299     lStringLength++;
00300     r++;
00301     lLen--;
00302     }
00303   RESULT = NEWMORTALSTRING(lStringLength);
00304   ASSERTNULL(RESULT)
00305   r = STRINGVALUE(RESULT);
00306 
00307   while( lStringLength-- )*r++ = *s++;
00308 
00309 #endif
00310 END
00311 
00318 COMMAND(RTRIM)
00319 #if NOTIMP_RTRIM
00320 NOTIMPLEMENTED;
00321 #else
00322 
00323 
00324   NODE nItem;
00325   VARIABLE Op1;
00326   char *r,*s;
00327   unsigned long lStringLength;
00328 
00329   /* this is an operator and not a command, therefore we do not have our own mortal list */
00330   USE_CALLER_MORTALS;
00331 
00332   /* evaluate the parameters */
00333   nItem = PARAMETERLIST;
00334   Op1 = _EVALUATEEXPRESSION(CAR(nItem));
00335   ASSERTOKE;
00336   if( memory_IsUndef(Op1) ){
00337     RESULT = NULL;
00338     RETURN;
00339     }
00340   Op1 = CONVERT2STRING(Op1);
00341   r = STRINGVALUE(Op1);
00342   lStringLength = STRLEN(Op1);
00343   while( lStringLength && isspace(r[lStringLength-1]) )lStringLength--;
00344   RESULT = NEWMORTALSTRING(lStringLength);
00345   ASSERTNULL(RESULT)
00346   r = STRINGVALUE(RESULT);
00347   s = STRINGVALUE(Op1);
00348   while( lStringLength ){
00349     *r++ = *s++;
00350     lStringLength--;
00351     }
00352 
00353 #endif
00354 END
00355 
00362 COMMAND(TRIM)
00363 #if NOTIMP_TRIM
00364 NOTIMPLEMENTED;
00365 #else
00366 
00367 
00368   NODE nItem;
00369   VARIABLE Op1;
00370   char *r,*s;
00371   unsigned long lStringLength,lLen;
00372 
00373   /* this is an operator and not a command, therefore we do not have our own mortal list */
00374   USE_CALLER_MORTALS;
00375 
00376   /* evaluate the parameters */
00377   nItem = PARAMETERLIST;
00378   Op1 = _EVALUATEEXPRESSION(CAR(nItem));
00379   ASSERTOKE;
00380   if( memory_IsUndef(Op1) ){
00381     RESULT = NULL;
00382     RETURN;
00383     }
00384   Op1 = CONVERT2STRING(Op1);
00385   r = STRINGVALUE(Op1);
00386   lLen = STRLEN(Op1);
00387   lStringLength = STRLEN(Op1);
00388   while( lLen && isspace( *r ) )r++,lLen--,lStringLength--;
00389   s = r;
00390   if( lStringLength ){
00391     lStringLength --;      /* convert length to char array index */
00392     while( lStringLength && isspace(r[lStringLength]) )lStringLength--;
00393     lStringLength++; /* convert char array index back to length */
00394     }
00395 
00396   RESULT = NEWMORTALSTRING(lStringLength);
00397   ASSERTNULL(RESULT)
00398   r = STRINGVALUE(RESULT);
00399   while( lStringLength ){
00400     *r++ = *s++;
00401     lStringLength--;
00402     }
00403 
00404 #endif
00405 END
00406 
00423 COMMAND(INSTR)
00424 #if NOTIMP_INSTR
00425 NOTIMPLEMENTED;
00426 #else
00427   NODE nItem;
00428   VARIABLE Op1,Op2,Op3;
00429   long lStart,lLength,lStringLength;
00430   char *r,*s;
00431   int iCase = OPTION("compare")&1;
00432 
00433   /* this is an operator and not a command, therefore we do not have our own mortal list */
00434   USE_CALLER_MORTALS;
00435 
00436   /* evaluate the parameters */
00437   nItem = PARAMETERLIST;
00438 
00439   /* this is the base string that we are searching in */
00440   Op1 = _EVALUATEEXPRESSION(CAR(nItem));
00441   ASSERTOKE;
00442   if( memory_IsUndef(Op1) ){
00443     RESULT = NULL;
00444     RETURN;
00445     }
00446   Op1 = CONVERT2STRING(Op1);
00447   nItem = CDR(nItem);
00448   lLength = STRLEN(Op1);
00449   r = STRINGVALUE(Op1);
00450 
00451   /* this is the string that we search */
00452   Op2 = _EVALUATEEXPRESSION(CAR(nItem));
00453   ASSERTOKE;
00454   if( memory_IsUndef(Op2) ){
00455     RESULT = NULL;
00456     RETURN;
00457     }
00458   Op2 = CONVERT2STRING(Op2);
00459   nItem = CDR(nItem);
00460   lStringLength = STRLEN(Op2);
00461   s = STRINGVALUE(Op2);
00462 
00463   Op3 = NULL;
00464   if( nItem ){
00465     Op3 = EVALUATEEXPRESSION(CAR(nItem));
00466     ASSERTOKE;
00467     }
00468 
00469   if( memory_IsUndef(Op3) )
00470     lStart = 1;
00471   else
00472     lStart = LONGVALUE(CONVERT2LONG(Op3));
00473 
00474   if( lStart < 1 )lStart = 1;
00475 
00476   if( lLength < lStringLength ){
00477     RESULT = NULL;
00478     RETURN;
00479     }
00480 
00481   while( lStart-1 <= lLength - lStringLength ){
00482     if( ! SUBSTRCMP(r+lStart-1,s, lStringLength,iCase ) ){
00483       RESULT = NEWMORTALLONG;
00484       ASSERTNULL(RESULT)
00485       LONGVALUE(RESULT) = lStart;
00486       RETURN;
00487       }
00488     lStart ++;
00489     }
00490   RESULT = NULL;
00491   RETURN;
00492 #endif
00493 END
00494 
00511 COMMAND(INSTRREV)
00512 #if NOTIMP_INSTRREV
00513 NOTIMPLEMENTED;
00514 #else
00515   NODE nItem;
00516   VARIABLE Op1,Op2,Op3;
00517   long lStart,lLength,lStringLength;
00518   char *r,*s;
00519   int iCase = OPTION("compare")&1;
00520 
00521   /* this is an operator and not a command, therefore we do not have our own mortal list */
00522   USE_CALLER_MORTALS;
00523 
00524   /* evaluate the parameters */
00525   nItem = PARAMETERLIST;
00526 
00527   /* this is the base string that we are searching in */
00528   Op1 = _EVALUATEEXPRESSION(CAR(nItem));
00529   ASSERTOKE;
00530   if( memory_IsUndef(Op1) ){
00531     RESULT = NULL;
00532     RETURN;
00533     }
00534   Op1 = CONVERT2STRING(Op1);
00535   nItem = CDR(nItem);
00536   lLength = STRLEN(Op1);
00537   r = STRINGVALUE(Op1);
00538 
00539   /* this is the string that we search */
00540   Op2 = _EVALUATEEXPRESSION(CAR(nItem));
00541   ASSERTOKE;
00542   if( memory_IsUndef(Op2) ){
00543     RESULT = NULL;
00544     RETURN;
00545     }
00546   Op2 = CONVERT2STRING(Op2);
00547   nItem = CDR(nItem);
00548   lStringLength = STRLEN(Op2);
00549   s = STRINGVALUE(Op2);
00550 
00551   Op3 = NULL;
00552   if( nItem ){
00553     Op3 = EVALUATEEXPRESSION(CAR(nItem));
00554     ASSERTOKE;
00555     }
00556 
00557   if( lLength < lStringLength ){
00558     RESULT = NULL;
00559     RETURN;
00560     }
00561 
00562   if( memory_IsUndef(Op3) )
00563     lStart = lLength - lStringLength+1;
00564   else
00565     lStart = LONGVALUE(CONVERT2LONG(Op3));
00566 
00567   if( lStart > lLength - lStringLength+1)lStart = lLength - lStringLength+1;
00568 
00569   while( lStart >= 1 ){
00570     if( ! SUBSTRCMP(r+lStart-1,s, lStringLength,iCase ) ){
00571       RESULT = NEWMORTALLONG;
00572       ASSERTNULL(RESULT)
00573       LONGVALUE(RESULT) = lStart;
00574       RETURN;
00575       }
00576     lStart --;
00577     }
00578   RESULT = NULL;
00579   RETURN;
00580 #endif
00581 END
00582 
00604 COMMAND(REPLACE)
00605 #if NOTIMP_REPLACE
00606 NOTIMPLEMENTED;
00607 #else
00608   NODE nItem;
00609   VARIABLE Op1,Op2,Op3,Op4,Op5;
00610   long lRepetitions;
00611   long lCalculatedRepetitions;
00612   int ReplaceAll;
00613   long l_start,lStart,lLength,lSearchLength,lReplaceLength,lResult;
00614   char *r,*s,*q,*w;
00615   int iCase = OPTION("compare")&1;
00616 
00617   /* this is an operator and not a command, therefore we do not have our own mortal list */
00618   USE_CALLER_MORTALS;
00619 
00620   /* evaluate the parameters */
00621   nItem = PARAMETERLIST;
00622 
00623   /* this is the base string that we are searching in */
00624   Op1 = _EVALUATEEXPRESSION(CAR(nItem));
00625   ASSERTOKE;
00626   if( memory_IsUndef(Op1) ){
00627     RESULT = NULL;
00628     RETURN;
00629     }
00630   Op1 = CONVERT2STRING(Op1);
00631   nItem = CDR(nItem);
00632   lLength = STRLEN(Op1);
00633   r = STRINGVALUE(Op1);
00634   /* this is the string that we search to replace */
00635   Op2 = _EVALUATEEXPRESSION(CAR(nItem));
00636   ASSERTOKE;
00637   if( memory_IsUndef(Op2) ){
00638     RESULT = NULL;
00639     RETURN;
00640     }
00641   Op2 = CONVERT2STRING(Op2);
00642   nItem = CDR(nItem);
00643   lSearchLength = STRLEN(Op2);
00644   s = STRINGVALUE(Op2);
00645   /* this is the string that we put into the place of the searched string */
00646   Op3 = _EVALUATEEXPRESSION(CAR(nItem));
00647   ASSERTOKE;
00648   if( memory_IsUndef(Op3) ){
00649     RESULT = NULL;
00650     RETURN;
00651     }
00652   Op3 = CONVERT2STRING(Op3);
00653   lReplaceLength = STRLEN(Op3);
00654   nItem = CDR(nItem);
00655   w = STRINGVALUE(Op3);
00656 
00657   Op4 = NULL;
00658   if( nItem ){
00659     Op4 = EVALUATEEXPRESSION(CAR(nItem));
00660     nItem = CDR(nItem);
00661     ASSERTOKE;
00662     }
00663 
00664   if( memory_IsUndef(Op4) ){
00665     lRepetitions = 0;
00666     ReplaceAll = 1;
00667     }else{
00668     lRepetitions = GETLONGVALUE(Op4);
00669     ReplaceAll = 0;
00670     }
00671   if( lRepetitions < 0 )lRepetitions = 0;
00672 
00673   Op5 = NULL;
00674   if( nItem ){
00675     Op5 = EVALUATEEXPRESSION(CAR(nItem));
00676     nItem = CDR(nItem);
00677     ASSERTOKE;
00678     }
00679 
00680   if( memory_IsUndef(Op5) )
00681     l_start = 1;
00682   else{
00683     l_start = GETLONGVALUE(Op5);
00684     }
00685   if( l_start < 1 )l_start = 1;
00686   lStart = l_start;
00687 
00688   /* first calculate the repeat actions */
00689   lCalculatedRepetitions = 0;
00690   while( lStart-1 <= lLength - lSearchLength ){
00691     if( ! SUBSTRCMP(r+lStart-1,s, lSearchLength,iCase ) ){
00692       lCalculatedRepetitions++;
00693       lStart += lSearchLength;
00694       }else lStart ++;
00695     }
00696   if( ! ReplaceAll && lCalculatedRepetitions > lRepetitions )lCalculatedRepetitions = lRepetitions;
00697   /* calculate the length of the new string */
00698   lResult = STRLEN(Op1) + lCalculatedRepetitions * (lReplaceLength-lSearchLength);
00699 
00700   /* allocate space for the result */
00701   RESULT = NEWMORTALSTRING(lResult);
00702   ASSERTNULL(RESULT)
00703 
00704   /* perform the replacements */
00705   lStart = l_start;
00706 
00707   q = STRINGVALUE(RESULT);
00708   if( lStart > 1 ){
00709     memcpy(q,r,lStart-1);
00710     q+=lStart-1;
00711     }
00712   while( lStart <= lLength ){
00713     if( lCalculatedRepetitions && ! SUBSTRCMP(r+lStart-1,s, lSearchLength,iCase ) ){
00714       memcpy(q,w,lReplaceLength);
00715       q += lReplaceLength;
00716       lStart += lSearchLength;
00717       lCalculatedRepetitions--;
00718       }else{
00719       *q++ = r[lStart-1];
00720       lStart ++;
00721       }
00722     }
00723 #endif
00724 END
00725 
00805 COMMAND(MID)
00806 #if NOTIMP_MID
00807 NOTIMPLEMENTED;
00808 #else
00809 
00810 
00811   NODE nItem;
00812   VARIABLE Op1,Op2,Op3;
00813   long lStart,lLength,lStringLength;
00814   char *r,*s;
00815 
00816   /* this is an operator and not a command, therefore we do not have our own mortal list */
00817   USE_CALLER_MORTALS;
00818 
00819   /* evaluate the parameters */
00820   nItem = PARAMETERLIST;
00821 
00822   /* we need not duplicate the argument in case it is a left value, because we don't
00823      alter it. (And convert to string anyway that duplicates.) */
00824   Op1 = _EVALUATEEXPRESSION(CAR(nItem));
00825   ASSERTOKE;
00826   if( memory_IsUndef(Op1) ){
00827     RESULT = NULL;
00828     RETURN;
00829     }
00830   Op1 = CONVERT2STRING(Op1);
00831   nItem = CDR(nItem);
00832   Op2 = EVALUATEEXPRESSION(CAR(nItem));
00833   ASSERTOKE;
00834   if( memory_IsUndef(Op2) )
00835     lStart = 1;
00836   else
00837     lStart = LONGVALUE(CONVERT2LONG(Op2));
00838 
00839   /* if the start value is negative then it is 
00840      the number of characters from the end of the string */
00841   if( lStart <= 0 ){
00842     lStart += STRLEN(Op1) + 1;
00843     if( lStart < 0 )lStart = 1;
00844     }
00845   nItem = CDR(nItem);
00846   if( nItem ){
00847     Op3 = EVALUATEEXPRESSION(CAR(nItem));
00848     ASSERTOKE;
00849     if( memory_IsUndef(Op3) )
00850       lLength = -1;
00851     else{
00852       lLength = LONGVALUE(CONVERT2LONG(Op3));
00853       /* if the length is negative then it counts the substring backward */
00854       if( lLength < 0 ){
00855         if( lStart < lLength ){
00856           lLength = lStart;
00857           lStart = 1;
00858           }else{
00859           lStart += lLength +1;
00860           lLength = -lLength;
00861           }
00862         }
00863       }
00864     }else
00865     lLength = -1;
00866 
00867   lStart --; /* normalize to zero */
00868 
00869   lStringLength = STRLEN(Op1);
00870   if( lStart < lStringLength ){
00871     r = STRINGVALUE(Op1) + lStart;
00872     lStringLength -= lStart;
00873     }else{
00874     r = STRINGVALUE(Op1) + lStringLength;
00875     lStringLength = 0L;
00876     }
00877   s = r;
00878   if( lLength != -1 && lLength < lStringLength )lStringLength = lLength;
00879   RESULT = NEWMORTALSTRING(lStringLength);
00880   ASSERTNULL(RESULT)
00881   r = STRINGVALUE(RESULT);
00882   while( lStringLength ){
00883     *r++ = *s++;
00884     lStringLength--;
00885     }
00886 
00887 #endif
00888 END
00889 
00935 COMMAND(LEFT)
00936 #if NOTIMP_LEFT
00937 NOTIMPLEMENTED;
00938 #else
00939 
00940 
00941   NODE nItem;
00942   VARIABLE Op1;
00943   long lLength,lStringLength;
00944   char *r,*s;
00945 
00946   /* this is an operator and not a command, therefore we do not have our own mortal list */
00947   USE_CALLER_MORTALS;
00948 
00949   /* evaluate the parameters */
00950   nItem = PARAMETERLIST;
00951   Op1 = _EVALUATEEXPRESSION(CAR(nItem));
00952   ASSERTOKE;
00953   if( memory_IsUndef(Op1) ){
00954     RESULT = NULL;
00955     RETURN;
00956     }
00957   Op1 = CONVERT2STRING(Op1);
00958   nItem = CDR(nItem);
00959   lLength = LONGVALUE(CONVERT2LONG(EVALUATEEXPRESSION(CAR(nItem))));
00960   ASSERTOKE;
00961   if( lLength < 0 )lLength = 0;
00962 
00963   s = STRINGVALUE(Op1);
00964   lStringLength = STRLEN(Op1);
00965   if( lLength < lStringLength )lStringLength = lLength;
00966   RESULT = NEWMORTALSTRING(lStringLength);
00967   ASSERTNULL(RESULT)
00968   r = STRINGVALUE(RESULT);
00969   while( lStringLength ){
00970     *r++ = *s++;
00971     lStringLength--;
00972     }
00973 
00974 #endif
00975 END
00976 
00999 COMMAND(RIGHT)
01000 #if NOTIMP_RIGHT
01001 NOTIMPLEMENTED;
01002 #else
01003 
01004 
01005   NODE nItem;
01006   VARIABLE Op1;
01007   long lLength,lStringLength;
01008   char *r,*s;
01009 
01010   /* this is an operator and not a command, therefore we do not have our own mortal list */
01011   USE_CALLER_MORTALS;
01012 
01013   /* evaluate the parameters */
01014   nItem = PARAMETERLIST;
01015   Op1 = _EVALUATEEXPRESSION(CAR(nItem));
01016   ASSERTOKE;
01017   if( memory_IsUndef(Op1) ){
01018     RESULT = NULL;
01019     RETURN;
01020     }
01021   Op1 = CONVERT2STRING(Op1);
01022   nItem = CDR(nItem);
01023   lLength = LONGVALUE(CONVERT2LONG(EVALUATEEXPRESSION(CAR(nItem))));
01024   ASSERTOKE;
01025   if( lLength < 0 )lLength = 0;
01026 
01027   s = STRINGVALUE(Op1);
01028   lStringLength = STRLEN(Op1);
01029   if( lStringLength > lLength ){
01030     s += lStringLength - lLength;
01031     lStringLength = lLength;
01032     }
01033 
01034   RESULT = NEWMORTALSTRING(lStringLength);
01035   ASSERTNULL(RESULT)
01036   r = STRINGVALUE(RESULT);
01037   while( lStringLength ){
01038     *r++ = *s++;
01039     lStringLength--;
01040     }
01041 
01042 #endif
01043 END
01044 
01051 COMMAND(SPACE)
01052 #if NOTIMP_SPACE
01053 NOTIMPLEMENTED;
01054 #else
01055 
01056 
01057   NODE nItem;
01058   long lLength;
01059   char *r;
01060 
01061   /* this is an operator and not a command, therefore we do not have our own mortal list */
01062   USE_CALLER_MORTALS;
01063 
01064   /* evaluate the parameters */
01065   nItem = PARAMETERLIST;
01066   lLength = LONGVALUE(CONVERT2LONG(EVALUATEEXPRESSION(CAR(nItem))));
01067   ASSERTOKE;
01068   if( lLength < 0 )lLength = 0;
01069 
01070   RESULT = NEWMORTALSTRING(lLength);
01071   ASSERTNULL(RESULT)
01072   r = STRINGVALUE(RESULT);
01073   while( lLength ){
01074     *r++ = ' ';
01075     lLength--;
01076     }
01077 
01078 #endif
01079 END
01080 
01090 COMMAND(STRING)
01091 #if NOTIMP_STRING
01092 NOTIMPLEMENTED;
01093 #else
01094 
01095 
01096   NODE nItem;
01097   VARIABLE Op;
01098   long lLength;
01099   char cFill;
01100   char *r;
01101 
01102   /* this is an operator and not a command, therefore we do not have our own mortal list */
01103   USE_CALLER_MORTALS;
01104 
01105   /* evaluate the parameters */
01106   nItem = PARAMETERLIST;
01107   lLength = LONGVALUE(CONVERT2LONG(EVALUATEEXPRESSION(CAR(nItem))));
01108   ASSERTOKE;
01109   if( lLength < 0 )lLength = 0;
01110   nItem = CDR(nItem);
01111   Op = EVALUATEEXPRESSION(CAR(nItem));
01112   ASSERTOKE;
01113   if( Op == NULL )
01114     cFill = 0;
01115   else
01116   if( TYPE(Op) == VTYPE_STRING ){
01117     cFill = *(STRINGVALUE(Op));
01118     }else{
01119     cFill = (char)(LONGVALUE(CONVERT2LONG(Op)));
01120     }
01121 
01122   RESULT = NEWMORTALSTRING(lLength);
01123   ASSERTNULL(RESULT)
01124   r = STRINGVALUE(RESULT);
01125   while( lLength ){
01126     *r++ = cFill;
01127     lLength--;
01128     }
01129 
01130 #endif
01131 END
01132 
01139 COMMAND(CHR)
01140 #if NOTIMP_CHR
01141 NOTIMPLEMENTED;
01142 #else
01143 
01144 
01145   long lCharCode;
01146 
01147   /* this is an operator and not a command, therefore we do not have our own mortal list */
01148   USE_CALLER_MORTALS;
01149 
01150   /* evaluate the parameters */
01151   lCharCode = LONGVALUE(CONVERT2LONG(EVALUATEEXPRESSION(CAR(PARAMETERLIST))));
01152   ASSERTOKE;
01153   lCharCode %= 256;
01154   if( lCharCode < 0 )lCharCode += 256;
01155 
01156   RESULT = NEWMORTALSTRING(1);
01157   ASSERTNULL(RESULT)
01158   *(STRINGVALUE(RESULT)) = (char)lCharCode;
01159 #endif
01160 END
01161 
01169 COMMAND(ASC)
01170 #if NOTIMP_ASC
01171 NOTIMPLEMENTED;
01172 #else
01173 
01174 
01175   unsigned long lCharCode;
01176   VARIABLE Op;
01177 
01178   /* this is an operator and not a command, therefore we do not have our own mortal list */
01179   USE_CALLER_MORTALS;
01180 
01181   Op = _EVALUATEEXPRESSION(CAR(PARAMETERLIST));
01182   ASSERTOKE;
01183   if( Op == NULL ){
01184     RESULT = NULL;
01185     RETURN;
01186     }
01187   Op = CONVERT2STRING(Op);
01188   if( STRLEN(Op) == 0 ){
01189     RESULT = NULL;
01190     RETURN;
01191     }
01192   /* evaluate the parameters */
01193   lCharCode = (unsigned char)*(STRINGVALUE(Op));
01194 
01195   RESULT = NEWMORTALLONG;
01196   ASSERTNULL(RESULT)
01197   LONGVALUE(RESULT) = lCharCode;
01198 #endif
01199 END
01200 
01207 COMMAND(STRREVERSE)
01208 #if NOTIMP_STRREVERSE
01209 NOTIMPLEMENTED;
01210 #else
01211 
01212 
01213   NODE nItem;
01214   VARIABLE Op1;
01215   long lStringLength;
01216   char *r,*s;
01217 
01218   /* this is an operator and not a command, therefore we do not have our own mortal list */
01219   USE_CALLER_MORTALS;
01220 
01221   /* evaluate the parameters */
01222   nItem = PARAMETERLIST;
01223   Op1 = _EVALUATEEXPRESSION(CAR(nItem));
01224   ASSERTOKE;
01225   if( memory_IsUndef(Op1) ){
01226     RESULT = NULL;
01227     RETURN;
01228     }
01229   Op1 = CONVERT2STRING(Op1);
01230 
01231   s = STRINGVALUE(Op1);
01232   lStringLength = STRLEN(Op1);
01233   s += lStringLength-1;
01234 
01235   RESULT = NEWMORTALSTRING(lStringLength);
01236   ASSERTNULL(RESULT)
01237   r = STRINGVALUE(RESULT);
01238   while( lStringLength ){
01239     *r++ = *s--;
01240     lStringLength--;
01241     }
01242 
01243 #endif
01244 END
01245 
01261 COMMAND(STR)
01262 #if NOTIMP_STR
01263 NOTIMPLEMENTED;
01264 #else
01265 
01266   VARIABLE Op;
01267 
01268   /* this is an operator and not a command, therefore we do not have our own mortal list */
01269   USE_CALLER_MORTALS;
01270 
01271   Op = _EVALUATEEXPRESSION(CAR(PARAMETERLIST));
01272   ASSERTOKE;
01273   if( Op == NULL ){
01274     RESULT = NULL;
01275     RETURN;
01276     }
01277   /* evaluate the parameters */
01278   RESULT = CONVERT2STRING(Op);
01279 
01280 #endif
01281 END
01282 
01292 COMMAND(HEX)
01293 #if NOTIMP_HEX
01294 NOTIMPLEMENTED;
01295 #else
01296 
01297 
01298   unsigned long lCode;
01299   unsigned long lLength,lStore;
01300   VARIABLE Op;
01301 
01302   /* this is an operator and not a command, therefore we do not have our own mortal list */
01303   USE_CALLER_MORTALS;
01304   Op = EVALUATEEXPRESSION(CAR(PARAMETERLIST));
01305   ASSERTOKE;
01306   if( Op == NULL ){
01307     RESULT = NULL;
01308     RETURN;
01309     }
01310   /* evaluate the parameters */
01311   lCode = LONGVALUE(CONVERT2LONG(Op));
01312   lStore = lCode;
01313   lLength = 0;
01314   if( lCode == 0 )lLength = 1;
01315   while( lCode ){
01316     lCode /= 16;
01317     lLength ++;
01318     }
01319 
01320   /*
01321      Note that there is a little hack in this code dealing with the terminating ZCHAR.
01322      Strings in BASIC are NOT ZCHAR terminated, but sprintf puts a ZCHAR at the end
01323      of the printed string. To avoid segmentation fault we have to allocate a one byte longer
01324      string to accomodate the terminating ZCHAR. After the sprintf has put the ZCHAR into the
01325      buffer we set the correct size of the buffer. This actually removes the ZCHAR from the
01326      buffer. If the buffer is small, then the actual size is larger than the string length
01327      anyway. If the buffer is LARGE_BLOCK_TYPE then we will release it when not in use.
01328   */
01329   RESULT = NEWMORTALSTRING(lLength+1);
01330   ASSERTNULL(RESULT)
01331   sprintf(STRINGVALUE(RESULT),"%*X",lLength,lStore);
01332   STRLEN(RESULT) = lLength;
01333 
01334 #endif
01335 END
01336 
01344 COMMAND(OCT)
01345 #if NOTIMP_OCT
01346 NOTIMPLEMENTED;
01347 #else
01348 
01349 
01350   unsigned long lCode;
01351   unsigned long lLength,lStore;
01352   char *s;
01353   VARIABLE Op;
01354 
01355   /* this is an operator and not a command, therefore we do not have our own mortal list */
01356   USE_CALLER_MORTALS;
01357   Op = EVALUATEEXPRESSION(CAR(PARAMETERLIST));
01358   ASSERTOKE;
01359   if( Op == NULL ){
01360     RESULT = NULL;
01361     RETURN;
01362     }
01363   /* evaluate the parameters */
01364   lCode = LONGVALUE(CONVERT2LONG(Op));
01365   lStore = lCode;
01366   lLength = 0;
01367   if( lCode == 0 )lLength = 1;
01368   while( lCode ){
01369     lCode /= 8;
01370     lLength ++;
01371     }
01372   RESULT = NEWMORTALSTRING(lLength);
01373   ASSERTNULL(RESULT)
01374   s = STRINGVALUE(RESULT) + lLength -1;
01375   while( lStore ){
01376     *s-- = (char)(lStore%8)+'0';
01377     lStore /= 8;
01378     }
01379 
01380 #endif
01381 END
01382 
01423 COMMAND(SPLITAQ)
01424 #if NOTIMP_SPLITAQ
01425 NOTIMPLEMENTED;
01426 #else
01427 
01428   VARIABLE WholeString,Delimiter,Quoter,ResultArray;
01429   LEFTVALUE Array;
01430   unsigned long i,lChunkCounter,iStart,iCount;
01431   long refcount;
01432   char *Temp;
01433 
01434   WholeString = CONVERT2STRING(_EVALUATEEXPRESSION(PARAMETERNODE));
01435   ASSERTOKE;
01436   NEXTPARAMETER;
01437   Delimiter = CONVERT2STRING(_EVALUATEEXPRESSION(PARAMETERNODE));
01438   ASSERTOKE;
01439   NEXTPARAMETER;
01440   Quoter = CONVERT2STRING(_EVALUATEEXPRESSION(PARAMETERNODE));
01441   ASSERTOKE;
01442   NEXTPARAMETER;
01443   /* we get the pointer to the variable that points to the value */
01444   Array = EVALUATELEFTVALUE_A(PARAMETERNODE);
01445   ASSERTOKE;
01446   DEREFERENCE(Array)
01447 
01448   /* if the string to split is empty then the result is undef */
01449   if( memory_IsUndef(WholeString) || STRLEN(WholeString) == 0L ){
01450     if( *Array )memory_ReleaseVariable(pEo->pMo,*Array);
01451     *Array = NULL;
01452     RETURN;
01453     }
01454 
01455   if( memory_IsUndef(Delimiter) || STRLEN(Delimiter) == 0 ){
01456     /* empty delimiter splits the string into characters */
01457     lChunkCounter = STRLEN(WholeString) - 1;
01458     }else{
01459     /* calculate the size of the result array */
01460     i = 0;
01461     lChunkCounter = 0;
01462     while( i < STRLEN(WholeString) ){
01463                                 if ( ( i <= STRLEN(WholeString)-STRLEN(Quoter) )
01464                                         && !strncmp(STRINGVALUE(WholeString)+i,STRINGVALUE(Quoter),STRLEN(Quoter)) ) {
01465                         i += STRLEN(Quoter);
01466                         while( ( i <= STRLEN(WholeString)-STRLEN(Quoter) )
01467                                 && ( strncmp(STRINGVALUE(WholeString)+i,STRINGVALUE(Quoter),STRLEN(Quoter)) ) ) i++;
01468                         i += STRLEN(Quoter);
01469                                 }
01470               if ( ( i <= STRLEN(WholeString)-STRLEN(Delimiter) )
01471                         &&  !strncmp(STRINGVALUE(WholeString)+i,STRINGVALUE(Delimiter),STRLEN(Delimiter)) ) {
01472                         while( ( i <= STRLEN(WholeString)-STRLEN(Delimiter) )
01473                                 && ( strncmp(STRINGVALUE(WholeString)+i,STRINGVALUE(Delimiter),STRLEN(Delimiter)) ) ) i++;
01474                                         lChunkCounter ++;
01475                                         i += STRLEN(Delimiter);
01476                                 }else{
01477                                         i++;
01478                                 }
01479                 }
01480         }
01481 
01482   ResultArray = NEWARRAY(0,lChunkCounter);
01483   if( ResultArray == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01484 
01485   Temp = ALLOC(STRLEN(WholeString));
01486 
01487   if( memory_IsUndef(Delimiter) || STRLEN(Delimiter) == 0 ){
01488     for( i=0 ; i < STRLEN(WholeString) ; i++ ){
01489       ResultArray->Value.aValue[i] = NEWSTRING(1);
01490       if( ResultArray->Value.aValue[i] == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01491       *STRINGVALUE(ResultArray->Value.aValue[i]) = STRINGVALUE(WholeString)[i];
01492       }
01493     }else{
01494     /* split the string into the array */
01495     i = 0;
01496     iStart = i;
01497     lChunkCounter = 0;
01498     iCount = 0;
01499 
01500     while( i < STRLEN(WholeString) ){
01501                         if ( ( i <= STRLEN(WholeString)-STRLEN(Quoter) )
01502                                 && !strncmp(STRINGVALUE(WholeString)+i,STRINGVALUE(Quoter),STRLEN(Quoter)) ) {
01503                 i += STRLEN(Quoter);
01504                 while( ( i <= STRLEN(WholeString)-STRLEN(Quoter) )
01505                         && ( strncmp(STRINGVALUE(WholeString)+i,STRINGVALUE(Quoter),STRLEN(Quoter)) ) ) {
01506                 memcpy(Temp + iCount,STRINGVALUE(WholeString)+i,1);
01507                         i++;
01508                                         iCount ++;
01509                                 }
01510                         i += STRLEN(Quoter);
01511                 }
01512                         if  ( i <= STRLEN(WholeString)-STRLEN(Delimiter) ) {
01513                 if ( !strncmp(STRINGVALUE(WholeString)+i,STRINGVALUE(Delimiter),STRLEN(Delimiter)) ) {
01514                                         ResultArray->Value.aValue[lChunkCounter] = NEWSTRING(iCount);
01515                                         if( ResultArray->Value.aValue[lChunkCounter] == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01516                                         memcpy(STRINGVALUE(ResultArray->Value.aValue[lChunkCounter]),Temp,iCount);
01517                                         iCount = 0;
01518                                         lChunkCounter ++;
01519                                         i += STRLEN(Delimiter);
01520                                 }else{
01521                         memcpy(Temp + iCount,STRINGVALUE(WholeString) + i,1);
01522                         i++;
01523                         iCount++;
01524                 }
01525                         }
01526                 }
01527                 
01528                         ResultArray->Value.aValue[lChunkCounter] = NEWSTRING(iCount);
01529                         if( ResultArray->Value.aValue[lChunkCounter] == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01530                         memcpy(STRINGVALUE(ResultArray->Value.aValue[lChunkCounter]),Temp,iCount);
01531 
01532                 }
01533 
01534 
01535   /* if this variable had value assigned to it then release that value */
01536   if( *Array )memory_ReleaseVariable(pEo->pMo,*Array);
01537 
01538         FREE(Temp);
01539         
01540   *Array = ResultArray;
01541 
01542 #endif
01543 END
01544 
01556 COMMAND(SPLITA)
01557 #if NOTIMP_SPLITA
01558 NOTIMPLEMENTED;
01559 #else
01560 
01561 
01562   VARIABLE WholeString,Delimiter,ResultArray;
01563   LEFTVALUE Array;
01564   unsigned long i,lChunkCounter,iStart;
01565   long refcount;
01566 
01567   WholeString = CONVERT2STRING(_EVALUATEEXPRESSION(PARAMETERNODE));
01568   ASSERTOKE;
01569   NEXTPARAMETER;
01570   Delimiter = CONVERT2STRING(_EVALUATEEXPRESSION(PARAMETERNODE));
01571   ASSERTOKE;
01572   NEXTPARAMETER;
01573   /* we get the pointer to the variable that points to the value */
01574   Array = EVALUATELEFTVALUE_A(PARAMETERNODE);
01575   ASSERTOKE;
01576   DEREFERENCE(Array)
01577 
01578   /* if the string to split is empty then the result is undef */
01579   if( memory_IsUndef(WholeString) || STRLEN(WholeString) == 0L ){
01580     if( *Array )memory_ReleaseVariable(pEo->pMo,*Array);
01581     *Array = NULL;
01582     RETURN;
01583     }
01584 
01585   if( memory_IsUndef(Delimiter) || STRLEN(Delimiter) == 0 ){
01586     /* empty delimiter splits the string into characters */
01587     lChunkCounter = STRLEN(WholeString);
01588     }else{
01589     /* calculate the size of the result array */
01590     if( !strncmp(STRINGVALUE(WholeString),STRINGVALUE(Delimiter),STRLEN(Delimiter)) ){
01591       /* if the string starts with a delimiter we do not create a starting empty string */
01592       i = STRLEN(Delimiter);
01593       }else{
01594       i = 1;
01595       }
01596     lChunkCounter =1;
01597     while( i < STRLEN(WholeString)-STRLEN(Delimiter) ){
01598       if( strncmp(STRINGVALUE(WholeString)+i,STRINGVALUE(Delimiter),STRLEN(Delimiter)) )i++;
01599       else{
01600         lChunkCounter ++;
01601         i += STRLEN(Delimiter);
01602         }
01603       }
01604     }
01605 
01606   ResultArray = NEWARRAY(0,lChunkCounter-1);
01607   if( ResultArray == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01608 
01609   if( memory_IsUndef(Delimiter) || STRLEN(Delimiter) == 0 ){
01610     for( i=0 ; i < STRLEN(WholeString) ; i++ ){
01611       ResultArray->Value.aValue[i] = NEWSTRING(1);
01612       if( ResultArray->Value.aValue[i] == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01613       *STRINGVALUE(ResultArray->Value.aValue[i]) = STRINGVALUE(WholeString)[i];
01614       }
01615     }else{
01616     /* split the string into the array */
01617     if( !strncmp(STRINGVALUE(WholeString),STRINGVALUE(Delimiter),STRLEN(Delimiter)) ){
01618       /* if the string starts with a delimiter we do not create a starting empty string */
01619       i = STRLEN(Delimiter);
01620       }else{
01621       i = 0;
01622       }
01623     iStart = i;
01624     lChunkCounter = 0;
01625     while( i <= STRLEN(WholeString)-STRLEN(Delimiter) ){
01626       if( strncmp(STRINGVALUE(WholeString)+i,STRINGVALUE(Delimiter),STRLEN(Delimiter)) )i++;
01627       else{
01628         ResultArray->Value.aValue[lChunkCounter] = NEWSTRING(i-iStart);
01629         if( ResultArray->Value.aValue[lChunkCounter] == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01630         memcpy(STRINGVALUE(ResultArray->Value.aValue[lChunkCounter]),(STRINGVALUE(WholeString)+iStart),i-iStart);
01631         lChunkCounter ++;
01632         i += STRLEN(Delimiter);
01633         iStart = i;
01634         }
01635       }
01636     if( iStart < STRLEN(WholeString) ){
01637       ResultArray->Value.aValue[lChunkCounter] = NEWSTRING(STRLEN(WholeString)-iStart);
01638       if( ResultArray->Value.aValue[lChunkCounter] == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01639       memcpy(STRINGVALUE(ResultArray->Value.aValue[lChunkCounter]),(STRINGVALUE(WholeString)+iStart),STRLEN(WholeString)-iStart);
01640       }
01641     }
01642 
01643 
01644   /* if this variable had value assigned to it then release that value */
01645   if( *Array )memory_ReleaseVariable(pEo->pMo,*Array);
01646 
01647   *Array = ResultArray;
01648 
01649 #endif
01650 END
01651 
01658 COMMAND(SPLIT)
01659 #if NOTIMP_SPLIT
01660 NOTIMPLEMENTED;
01661 #else
01662 
01663   NODE nItem;
01664   VARIABLE WholeString,Delimiter;
01665   LEFTVALUE LeftValue;
01666   unsigned long i,iStart;
01667   long refcount;
01668 
01669   /* Note that we should NOT use _EVALUATEEXPRESSION because the command may use the same variable
01670      as a target for a sub-string and by that time we still need the original string. Therefore
01671      we use EVALUATEEXPRESSION that creates a copy of the result.
01672    */
01673   WholeString = CONVERT2STRING(EVALUATEEXPRESSION(PARAMETERNODE));
01674   ASSERTOKE;
01675   NEXTPARAMETER;
01676   Delimiter = CONVERT2STRING(EVALUATEEXPRESSION(PARAMETERNODE));
01677   ASSERTOKE;
01678   NEXTPARAMETER;
01679 
01680   nItem = PARAMETERNODE;
01681 
01682   /* if the string to split is undef or empty then the results are undef */
01683   if( memory_IsUndef(WholeString) || STRLEN(WholeString) == 0L ){
01684     while( nItem ){
01685       LeftValue = EVALUATELEFTVALUE_A(CAR(nItem));
01686       ASSERTOKE;
01687       DEREFERENCE(LeftValue)
01688 
01689       if( *LeftValue != NULL )
01690         memory_ReleaseVariable(pEo->pMo,*LeftValue);
01691       *LeftValue = NULL;
01692       nItem = CDR(nItem);
01693       }
01694     RETURN;
01695     }
01696 
01697   if( memory_IsUndef(Delimiter) || STRLEN(Delimiter) == 0 ){
01698     for( i=0 ; i < STRLEN(WholeString) && nItem ; i++ ){
01699       LeftValue = EVALUATELEFTVALUE_A(CAR(nItem));
01700       ASSERTOKE;
01701       DEREFERENCE(LeftValue);
01702       if( *LeftValue != NULL )
01703         memory_ReleaseVariable(pEo->pMo,*LeftValue);
01704       nItem = CDR(nItem);
01705       if( nItem ){
01706         *LeftValue = NEWSTRING(1);
01707         if( *LeftValue == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01708         *STRINGVALUE(*LeftValue) = STRINGVALUE(WholeString)[i];
01709         }else{
01710         /* this is the last variable, it gets the rest of the string */
01711         *LeftValue = NEWSTRING(STRLEN(WholeString)-i);
01712         if( *LeftValue == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01713         memcpy(STRINGVALUE(*LeftValue),STRINGVALUE(WholeString)+i,STRLEN(WholeString)-i);
01714         }
01715       }
01716     }else{
01717     /* split the string into the parameters */
01718     if( !strncmp(STRINGVALUE(WholeString),STRINGVALUE(Delimiter),STRLEN(Delimiter)) ){
01719       /* if the string starts with a delimiter we do not create a starting empty string */
01720       i = STRLEN(Delimiter);
01721       }else{
01722       i = 0;
01723       }
01724     iStart = i;
01725     while( i <= STRLEN(WholeString)-STRLEN(Delimiter) && nItem ){
01726       if( strncmp(STRINGVALUE(WholeString)+i,STRINGVALUE(Delimiter),STRLEN(Delimiter)) )i++;
01727       else{
01728         LeftValue = EVALUATELEFTVALUE_A(CAR(nItem));
01729         ASSERTOKE;
01730         DEREFERENCE(LeftValue)
01731 
01732         if( *LeftValue != NULL )
01733           memory_ReleaseVariable(pEo->pMo,*LeftValue);
01734         nItem = CDR(nItem);
01735         if( nItem || STRLEN(WholeString)-i == STRLEN(Delimiter) ){
01736           *LeftValue = NEWSTRING(i-iStart);
01737           if( *LeftValue == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01738           memcpy(STRINGVALUE(*LeftValue),(STRINGVALUE(WholeString)+iStart),i-iStart);
01739           i += STRLEN(Delimiter);
01740           iStart = i;
01741           }else{
01742           *LeftValue = NEWSTRING(STRLEN(WholeString)-iStart);
01743           if( *LeftValue == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01744           memcpy(STRINGVALUE(*LeftValue),(STRINGVALUE(WholeString)+iStart),STRLEN(WholeString)-iStart);
01745           i += STRLEN(Delimiter);
01746           iStart = i;
01747           }
01748         }
01749       }
01750     if( iStart < STRLEN(WholeString) && nItem ){
01751       LeftValue = EVALUATELEFTVALUE_A(CAR(nItem));
01752       ASSERTOKE;
01753       DEREFERENCE(LeftValue);
01754 
01755       if( *LeftValue != NULL )
01756         memory_ReleaseVariable(pEo->pMo,*LeftValue);
01757       nItem = CDR(nItem);
01758       *LeftValue = NEWSTRING(STRLEN(WholeString)-iStart);
01759       if( *LeftValue == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01760       memcpy(STRINGVALUE(*LeftValue),(STRINGVALUE(WholeString)+iStart),STRLEN(WholeString)-iStart);
01761       }
01762     }
01763   /* if there are any variables left then undef all */
01764   while( nItem ){
01765     LeftValue = EVALUATELEFTVALUE_A(CAR(nItem));
01766     ASSERTOKE;
01767     DEREFERENCE(LeftValue)
01768 
01769     if( *LeftValue != NULL )
01770       memory_ReleaseVariable(pEo->pMo,*LeftValue);
01771     *LeftValue = NULL;
01772     nItem = CDR(nItem);
01773     }
01774 
01775 #endif
01776 END
01777 
01821 COMMAND(JOIN)
01822 #if NOTIMP_JOIN
01823 NOTIMPLEMENTED;
01824 #else
01825 
01826   NODE nItem;
01827   char *s;
01828   VARIABLE vJoiner,vStringArray;
01829   int iFirstLoop;
01830   struct _JoinItem {
01831     VARIABLE vThisItem;
01832     struct _JoinItem *next;
01833     } *JoinItem,**pJoinItem,*JoinFree;
01834   unsigned long lResultLength,lItemNumber,i;
01835 
01836   JoinItem = NULL;
01837   pJoinItem = &JoinItem;
01838 
01839   /* this is an operator and not a command, therefore we do not have our own mortal list */
01840   USE_CALLER_MORTALS;
01841 
01842   nItem = PARAMETERLIST;
01843   vJoiner = CONVERT2STRING(_EVALUATEEXPRESSION(CAR(nItem)));
01844   ASSERTOKE;
01845   nItem = CDR(nItem);
01846   if( ! nItem ){/* if there is no second argument. This should not happen, because syntax
01847                          analysis result a compile time error if there is only one or less arguments. */
01848     RESULT = NEWMORTALSTRING(0);
01849     ASSERTNULL(RESULT)
01850     RETURN;    
01851     }
01852   if( ! ( CDR(nItem) ) ){/* if there are no more arguments then
01853                                        check that this second argument is an array */
01854     vStringArray = _EVALUATEEXPRESSION_A(CAR(nItem));
01855     ASSERTOKE;
01856     iFirstLoop = 1; /* the first element is already evaluated, and is stored in vStringArray 
01857                        this variable flags the first execution of the loop and helps the program
01858                        not to evaluate the first string again when join and not joina is performed */
01859     }else{
01860     iFirstLoop = 0;       /* there are more than two arguments, therefore we perform join and not joina */
01861     vStringArray = NULL;  /* we have to set this value to a non-array. undef is non array. but because
01862                              iFirstLoop is zero this argument will be evaluated because we did not evaluate it
01863                              now */
01864     }
01865   if( vStringArray && TYPE(vStringArray) == VTYPE_ARRAY ){
01866     lItemNumber = vStringArray->ArrayHighLimit - vStringArray->ArrayLowLimit +1;
01867     lResultLength = 0;
01868     for( i=0 ; i< lItemNumber ; i++ ){
01869       *pJoinItem = ALLOC( sizeof(struct _JoinItem) );
01870       if( *pJoinItem == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01871       (*pJoinItem)->vThisItem = CONVERT2STRING(vStringArray->Value.aValue[i]);
01872       if( (*pJoinItem)->vThisItem != NULL )
01873         lResultLength += STRLEN((*pJoinItem)->vThisItem);
01874       nItem = CDR(nItem);
01875       (*pJoinItem)->next = NULL;
01876       pJoinItem = &( (*pJoinItem)->next );
01877       }
01878     }else{
01879     lResultLength = 0L;
01880     lItemNumber = 0L;
01881     while( nItem ){
01882       *pJoinItem = ALLOC( sizeof(struct _JoinItem) );
01883       if( *pJoinItem == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
01884       if( iFirstLoop ){
01885         (*pJoinItem)->vThisItem = CONVERT2STRING(vStringArray);
01886         iFirstLoop = 0;
01887         }else{
01888         (*pJoinItem)->vThisItem = CONVERT2STRING(_EVALUATEEXPRESSION(CAR(nItem)));
01889         ASSERTOKE;
01890         }
01891       if( (*pJoinItem)->vThisItem != NULL )
01892         lResultLength += STRLEN((*pJoinItem)->vThisItem);
01893       lItemNumber++;
01894       nItem = CDR(nItem);
01895       (*pJoinItem)->next = NULL;
01896       pJoinItem = &( (*pJoinItem)->next );
01897       }
01898     }
01899   if( lItemNumber )
01900     lResultLength += (lItemNumber-1) * ( vJoiner ? STRLEN(vJoiner) : 0 );
01901 
01902   RESULT = NEWMORTALSTRING(lResultLength);
01903   ASSERTNULL(RESULT)
01904 
01905   s = STRINGVALUE(RESULT);
01906   while( JoinItem ){
01907     if( JoinItem->vThisItem ){
01908       memcpy(s,STRINGVALUE(JoinItem->vThisItem),STRLEN(JoinItem->vThisItem));
01909       s += STRLEN(JoinItem->vThisItem);
01910       }
01911     /* if there is next element after this and there is separator then append the separator */
01912     if( JoinItem->next && vJoiner ){
01913       memcpy(s,STRINGVALUE(vJoiner),STRLEN(vJoiner));
01914       s += STRLEN(vJoiner);
01915       }
01916     /* and now free the allocated list element */
01917     JoinFree = JoinItem;
01918     JoinItem = JoinItem->next;
01919     FREE(JoinFree);
01920     }
01921 
01922 #endif
01923 END
01924 
01925 #define INITIALIZE   if( initialize_like(pEo) )ERROR(COMMAND_ERROR_MEMORY_LOW); \
01926                      pLastResult = (pPatternParam)PARAMPTR(CMD_LIKEOP);
01927 
01928 int initialize_like(pExecuteObject pEo){
01929   pPatternParam pLastResult;
01930 
01931   /* initialize only once */
01932   if( PARAMPTR(CMD_LIKEOP) )return 0;
01933   PARAMPTR(CMD_LIKEOP) = ALLOC(sizeof(PatternParam));
01934   if( PARAMPTR(CMD_LIKEOP) == NULL )return COMMAND_ERROR_MEMORY_LOW;
01935 
01936   pLastResult = (pPatternParam)PARAMPTR(CMD_LIKEOP);
01937 
01938   pLastResult->cArraySize = 0;
01939   pLastResult->cAArraySize = 0;
01940   pLastResult->pcbParameterArray = NULL;
01941   pLastResult->ParameterArray = NULL;
01942   pLastResult->pszBuffer = NULL;
01943   pLastResult->cbBufferSize = 0;
01944   pLastResult->pThisMatchSets = NULL;
01945   pLastResult->iMatches = 0;
01946   return 0;
01947   }
01948 
01949 static int allocate_MatchSets(pExecuteObject pEo){
01950   pPatternParam pLastResult;
01951 
01952   pLastResult = (pPatternParam)PARAMPTR(CMD_LIKEOP);
01953   if( pLastResult->pThisMatchSets )return 0;
01954   pLastResult->pThisMatchSets = ALLOC(sizeof(MatchSets));
01955   if( pLastResult->pThisMatchSets == NULL )return COMMAND_ERROR_MEMORY_LOW;
01956   match_InitSets(pLastResult->pThisMatchSets);
01957   return 0;
01958   }
01959 
01982 COMMAND(SETJOKER)
01983 #if NOTIMP_SETJOKER
01984 NOTIMPLEMENTED;
01985 #else
01986 
01987   VARIABLE Op1,Op2;
01988   pPatternParam pLastResult;
01989   char JokerCharacter;
01990   char *p;
01991   unsigned long pL;
01992 
01993   INITIALIZE;
01994 
01995   /* CONVERT2STRING never modifies the parameter, therefore it is more efficient
01996      to use _EVALUATEEXPRESSION */
01997   Op1 = CONVERT2STRING(_EVALUATEEXPRESSION(PARAMETERNODE));
01998   ASSERTOKE;
01999   NEXTPARAMETER;
02000   Op2 = CONVERT2STRING(_EVALUATEEXPRESSION(PARAMETERNODE));
02001   ASSERTOKE;
02002 
02003   if( memory_IsUndef(Op1) || ! match_index(JokerCharacter=*STRINGVALUE(Op1)) )ERROR(COMMAND_ERROR_INVALID_JOKER);
02004 
02005   if( Op2 ){
02006     p = STRINGVALUE(Op2);
02007     pL = STRLEN(Op2);
02008     }else{
02009     p = "";
02010     pL = 0;
02011     }
02012 
02013   allocate_MatchSets(pEo);
02014   match_ModifySet(pLastResult->pThisMatchSets,JokerCharacter,pL,(unsigned char *)p,MATCH_ADDC|MATCH_SSIJ|MATCH_NULS);
02015 
02016 #endif
02017 END
02018 
02040 COMMAND(SETWILD)
02041 #if NOTIMP_SETWILD
02042 NOTIMPLEMENTED;
02043 #else
02044 
02045   VARIABLE Op1,Op2;
02046   pPatternParam pLastResult;
02047   char JokerCharacter;
02048   char *p;
02049   unsigned long pL;
02050 
02051   INITIALIZE;
02052 
02053 
02054   /* CONVERT2STRING never modifies the parameter, therefore it is more efficient
02055      to use _EVALUATEEXPRESSION */
02056   Op1 = CONVERT2STRING(_EVALUATEEXPRESSION(PARAMETERNODE));
02057   ASSERTOKE;
02058   NEXTPARAMETER;
02059   Op2 = CONVERT2STRING(_EVALUATEEXPRESSION(PARAMETERNODE));
02060   ASSERTOKE;
02061 
02062   if( memory_IsUndef(Op1) || ! match_index(JokerCharacter=*STRINGVALUE(Op1)) )ERROR(COMMAND_ERROR_INVALID_JOKER);
02063 
02064   if( Op2 ){
02065     p = STRINGVALUE(Op2);
02066     pL = STRLEN(Op2);
02067     }else{
02068     p = "";
02069     pL = 0;
02070     }
02071 
02072   allocate_MatchSets(pEo);
02073   match_ModifySet(pLastResult->pThisMatchSets,JokerCharacter,pL,(unsigned char *)p,MATCH_ADDC|MATCH_SMUJ|MATCH_NULS);
02074 
02075 #endif
02076 END
02077 
02078 COMMAND(SETNOJO)
02079 #if NOTIMP_SETNOJO
02080 NOTIMPLEMENTED;
02081 #else
02082 
02083   VARIABLE Op1;
02084   pPatternParam pLastResult;
02085   char JokerCharacter;
02086 
02087   INITIALIZE;
02088 
02089   /* CONVERT2STRING never modifies the parameter, therefore it is more efficient
02090      to use _EVALUATEEXPRESSION */
02091   Op1 = CONVERT2STRING(_EVALUATEEXPRESSION(PARAMETERNODE));
02092   ASSERTOKE;
02093 
02094   if( memory_IsUndef(Op1) || ! match_index(JokerCharacter=*STRINGVALUE(Op1)) )ERROR(COMMAND_ERROR_INVALID_JOKER);
02095 
02096   allocate_MatchSets(pEo);
02097   match_ModifySet(pLastResult->pThisMatchSets,JokerCharacter,0L,NULL,MATCH_SNOJ);
02098 
02099 #endif
02100 END
02101 
02272 COMMAND(LIKEOP)
02273 #if NOTIMP_LIKEOP
02274 NOTIMPLEMENTED;
02275 #else
02276 
02277 
02278   NODE nItem;
02279   VARIABLE Op1,Op2;
02280   char *s,*p;
02281   unsigned long sL,pL,i;
02282   unsigned long cArraySize;
02283   pPatternParam pLastResult;
02284   int iError;
02285 
02286   INITIALIZE;
02287 
02288   /* this is an operator and not a command, therefore we do not have our own mortal list */
02289   USE_CALLER_MORTALS;
02290 
02291   /* evaluate the parameters */
02292   nItem = PARAMETERLIST;
02293   /* CONVERT2STRING never modifies the parameter, therefore it is more efficient
02294      to use _EVALUATEEXPRESSION */
02295   Op1 = CONVERT2STRING(_EVALUATEEXPRESSION(CAR(nItem)));
02296   ASSERTOKE;
02297   nItem = CDR(nItem);
02298   Op2 = CONVERT2STRING(_EVALUATEEXPRESSION(CAR(nItem)));
02299   ASSERTOKE;
02300 
02301   if( Op1 ){
02302     s = STRINGVALUE(Op1);
02303     sL = STRLEN(Op1);
02304     }else{
02305     s = "";
02306     sL = 0;
02307     }
02308 
02309   if( Op2 ){
02310     p = STRINGVALUE(Op2);
02311     pL = STRLEN(Op2);
02312     }else{
02313     p = "";
02314     pL = 0;
02315     }
02316 
02317   cArraySize = match_count(p,pL);
02318   if( cArraySize > pLastResult->cArraySize ){
02319     if( pLastResult->pcbParameterArray )FREE(pLastResult->pcbParameterArray);
02320     if( pLastResult->ParameterArray)FREE(pLastResult->ParameterArray);
02321     pLastResult->cArraySize = 0;
02322     pLastResult->pcbParameterArray = ALLOC(cArraySize*sizeof(unsigned long));
02323     if( pLastResult->pcbParameterArray == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
02324     pLastResult->ParameterArray    = ALLOC(cArraySize*sizeof(char *));
02325     if( pLastResult->ParameterArray == NULL ){
02326       FREE(pLastResult->pcbParameterArray);
02327       pLastResult->pcbParameterArray = NULL;
02328       ERROR(COMMAND_ERROR_MEMORY_LOW);
02329       }
02330     pLastResult->cArraySize = cArraySize;
02331     }else{
02332     /* If the array is long enough then delete the previous result otherwise
02333        fake data may remain in it and it may cause trouble. */
02334     for( i=0 ; i < pLastResult->cArraySize ; i++ ){
02335       pLastResult->pcbParameterArray[i] = 0;
02336       pLastResult->ParameterArray[i] = NULL;
02337       }
02338     }
02339   pLastResult->cAArraySize = cArraySize;
02340 
02341   if( pLastResult->cbBufferSize < sL ){
02342     pLastResult->cbBufferSize = 0;
02343     if( pLastResult->pszBuffer )FREE(pLastResult->pszBuffer);
02344     pLastResult->pszBuffer = ALLOC(sL*sizeof(char));
02345     if( pLastResult->pszBuffer == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
02346     pLastResult->cbBufferSize = sL;
02347     }
02348 
02349   iError = match_match(p,
02350                        pL,
02351                        s,
02352                        sL,
02353                        pLastResult->ParameterArray,
02354                        pLastResult->pcbParameterArray,
02355                        pLastResult->pszBuffer,
02356                        pLastResult->cArraySize,
02357                        pLastResult->cbBufferSize,
02358                        !(OPTION("compare")&1),
02359                        pLastResult->pThisMatchSets,
02360                        &(pLastResult->iMatches));
02361 
02362   if( iErrorCode )ERROR(iErrorCode);
02363 
02364   RESULT = NEWMORTALLONG;
02365   ASSERTNULL(RESULT)
02366   LONGVALUE(RESULT) = pLastResult->iMatches ? -1 : 0;
02367 
02368 #endif
02369 END
02370 
02380 COMMAND(CHOMP)
02381 #if NOTIMP_CHOMP
02382 NOTIMPLEMENTED;
02383 #else
02384 
02385   VARIABLE Op1;
02386   long StringLen;
02387 
02388   /* this is an operator and not a command, therefore we do not have our own mortal list */
02389   USE_CALLER_MORTALS;
02390 
02391   /* CONVERT2STRING never modifies the parameter, therefore it is more efficient
02392      to use _EVALUATEEXPRESSION */
02393   Op1 = CONVERT2STRING(_EVALUATEEXPRESSION(CAR(PARAMETERLIST)));
02394   ASSERTOKE;
02395   if( memory_IsUndef(Op1) ){
02396     RESULT = NULL;
02397     RETURN;
02398     }
02399   StringLen = STRLEN(Op1);
02400 
02401   if( STRINGVALUE(Op1)[StringLen-1] == '\n' )StringLen--;
02402   RESULT = NEWMORTALSTRING(StringLen);
02403   ASSERTNULL(RESULT)
02404   memcpy(STRINGVALUE(RESULT),STRINGVALUE(Op1),StringLen);
02405 #endif
02406 END
02407 
02436 COMMAND(JOKER)
02437 #if NOTIMP_JOKER
02438 NOTIMPLEMENTED;
02439 #else
02440 
02441   VARIABLE Op1;
02442   unsigned long index;
02443   pPatternParam pLastResult;
02444 
02445   INITIALIZE;
02446 
02447   /* this is an operator and not a command, therefore we do not have our own mortal list */
02448   USE_CALLER_MORTALS;
02449 
02450   Op1 = CONVERT2LONG(EVALUATEEXPRESSION(CAR(PARAMETERLIST)));
02451   ASSERTOKE;
02452   if( memory_IsUndef(Op1) || 
02453       (! pLastResult->iMatches) ||
02454       (index = LONGVALUE(Op1)) <= 0 ||
02455       index > pLastResult->cAArraySize   ){
02456     RESULT = NULL;
02457     RETURN;
02458     }
02459 
02460   index--;
02461   RESULT = NEWMORTALSTRING(pLastResult->pcbParameterArray[index]);
02462   ASSERTNULL(RESULT)
02463   memcpy(STRINGVALUE(RESULT),pLastResult->ParameterArray[index],pLastResult->pcbParameterArray[index]);
02464 
02465 #endif
02466 END
02467 
02482 COMMAND(OPTION)
02483 #if NOTIMP_OPTION
02484 NOTIMPLEMENTED;
02485 #else
02486 
02487   char *pszOptionName;
02488   long lOptionValue;
02489   VARIABLE vOptionValue;
02490 
02491   pszOptionName = pEo->StringTable+pEo->CommandArray[_ActualNode-1].Parameter.CommandArgument.Argument.szStringValue;
02492   NEXTPARAMETER;
02493   vOptionValue = CONVERT2LONG(EVALUATEEXPRESSION(PARAMETERNODE));
02494   ASSERTOKE;
02495   if( memory_IsUndef(vOptionValue) ){
02496     options_Reset(pEo,pszOptionName);
02497     RETURN;
02498     }
02499   lOptionValue = LONGVALUE(vOptionValue);
02500   options_Set(pEo,pszOptionName,lOptionValue);
02501 
02502 #endif
02503 END
02504 
02513 COMMAND(OPTIONF)
02514 #if NOTIMP_OPTIONF
02515 NOTIMPLEMENTED;
02516 #else
02517 
02518   VARIABLE Op1;
02519   unsigned long *plOptionValue;
02520   char *buffer;
02521 
02522   /* this is an operator and not a command, therefore we do not have our own mortal list */
02523   USE_CALLER_MORTALS;
02524 
02525   Op1 = CONVERT2STRING(_EVALUATEEXPRESSION(CAR(PARAMETERLIST)));
02526   ASSERTOKE;
02527   if( memory_IsUndef(Op1) ){
02528     RESULT = NULL;
02529     RETURN;
02530     }
02531 
02532   CONVERT2ZCHAR(Op1,buffer);
02533   plOptionValue = OPTIONR(buffer);
02534   FREE(buffer);
02535   if( plOptionValue ){
02536     RESULT = NEWMORTALLONG;
02537     ASSERTNULL(RESULT)
02538     LONGVALUE(RESULT) = *plOptionValue;
02539     }else RESULT = NULL;
02540 
02541 #endif
02542 END
02543 
02544 #define CHUNK_SIZE      1024
02545 #define F_MINUS         1
02546 #define F_PLUS          2
02547 #define F_ZERO          4
02548 #define F_BLANK         8
02549 #define F_SHARP         16
02550 #define FORMAT_SYNTAX_ERROR     iErrorCode = COMMAND_ERROR_ARGUMENT_RANGE; goto error_escape;
02551 #define ASSERT_PARAMETER_COUNT  if (iArg >= cParameters) {iErrorCode = COMMAND_ERROR_FEW_ARGS; goto error_escape;}
02552 #define CHECK_MEM(x)            if (!check_size(&params,(x))){iErrorCode = COMMAND_ERROR_MEMORY_LOW; goto error_escape;}
02553 #define CHECK_OPERATION(x)      if (!x){iErrorCode = COMMAND_ERROR_MEMORY_LOW; goto error_escape;}
02554 
02555 typedef struct _formatParams {
02556     char* buf;
02557     long bufSize;
02558     long bufPtr;
02559     int flags;
02560     int width;
02561     int prec;
02562     char type;
02563     long vLong;
02564     double vDouble;
02565     const char* vString;
02566     long vSize;
02567 } formatParams, *pFormatParams;
02568 
02569 int check_size(pFormatParams params, long len) {
02570     if (len + params->bufPtr > params->bufSize) {
02571         char* ptr;
02572         len += params->bufPtr + CHUNK_SIZE;
02573         ptr = (char*)realloc(params->buf, len);
02574         if (!ptr) {
02575             free(params->buf);
02576             params->buf = NULL;
02577             return 0;
02578         }
02579         params->bufSize = len;
02580     }
02581     return 1;
02582 }
02583 
02584 int printInt(pFormatParams params) {
02585     char buf[100];
02586     int width;
02587     int flags;
02588     int len = params->prec + params->width + 32;
02589     if (!check_size(params, len))
02590         return 0;
02591     width = params->width;
02592     if (width < 0)
02593         width = 0;
02594     flags = params->flags;
02595     if (params->prec < 0) {
02596         sprintf(buf, "%%%s%s%s%s%s%dl%c", (flags & F_MINUS) ? "-" : "",
02597             (flags & F_PLUS) ? "+" : "",
02598             (flags & F_SHARP) ? "#" : "",
02599             (flags & F_BLANK) ? " " : "",
02600             (flags & F_ZERO) ? "0" : "",
02601             width, params->type);
02602     }
02603     else {
02604         sprintf(buf, "%%%s%s%s%s%s%d.%dl%c", (flags & F_MINUS) ? "-" : "",
02605             (flags & F_PLUS) ? "+" : "",
02606             (flags & F_SHARP) ? "#" : "",
02607             (flags & F_BLANK) ? " " : "",
02608             (flags & F_ZERO) ? "0" : "",
02609             width, params->prec, params->type);
02610     }
02611     len = sprintf(params->buf + params->bufPtr, buf, params->vLong);
02612     params->bufPtr += len;
02613     return 1;
02614 }
02615 
02616 int printDouble(pFormatParams params) {
02617     char buf[100];
02618     int prec;
02619     int width;
02620     int flags;
02621     int len = params->prec + params->width + 320;
02622     if (!check_size(params, len))
02623         return 0;
02624     width = params->width;
02625     if (width < 0)
02626         width = 0;
02627     prec = params->prec;
02628     if (prec < 0)
02629         prec = 6;
02630     if (prec > 300)
02631         prec = 300;
02632     flags = params->flags;
02633     sprintf(buf, "%%%s%s%s%s%s%d.%d%c", (flags & F_MINUS) ? "-" : "",
02634         (flags & F_PLUS) ? "+" : "",
02635         (flags & F_SHARP) ? "#" : "",
02636         (flags & F_BLANK) ? " " : "",
02637         (flags & F_ZERO) ? "0" : "",
02638         width, prec, params->type);
02639     len = sprintf(params->buf + params->bufPtr, buf, params->vDouble);
02640     params->bufPtr += len;
02641     return 1;
02642 }
02643 
02644 int printChar(pFormatParams params) {
02645     long size;
02646     long pad;
02647     char padChar;
02648     if (params->prec < 0)
02649         size = params->vSize;
02650     else
02651         size = (params->vSize > params->prec) ? params->prec : params->vSize;
02652     pad = (params->width > size) ? params->width - size : 0;
02653     if (!check_size(params, pad + size))
02654         return 0;
02655     padChar = (params->flags & F_ZERO) ? '0' : ' ';
02656     if (params->flags & F_MINUS) {
02657         memcpy(params->buf + params->bufPtr, params->vString, size);
02658         memset(params->buf + params->bufPtr + size, ' ', pad);
02659     }
02660     else {
02661         memset(params->buf + params->bufPtr, padChar, pad);
02662         memcpy(params->buf + params->bufPtr + pad, params->vString, size);
02663     }
02664     params->bufPtr += size + pad;
02665     return 1;
02666 }
02667 
02668 /* The following code was imported from SmallBasic
02669 Hi Paulo
02670 
02671 > I'm a developer with http://sourceforge.net/projects/scriptbasic and 
02672 > I'm adding the function FORMAT to it. I've noticed that you've already 
02673 > implemented it in your product but as it's GPL and mine is LGPL I 
02674 > can't
02675 use
02676 > it without your authorization, that I'm asking for.
02677 
02678 What is the difference between GPL and LGPL ?
02679 Anyway my purpose is to let the others to use my code, but not for money.
02680 
02681 Take anything that you'll need :)
02682 
02683 I'll be happy if you just put a 'thanks' somewhere :)
02684 
02685 btw, I was saw your project before enough time. I was liked, I can say 
02686 script-basic is the only competitor to small-basic on unix-world (the others
02687 
02688 are something like VB)...
02689 
02690 Regards
02691 Nicholas
02692 
02693 */
02694 
02695 /*
02696 *       INT(x)
02697 */
02698 static double   fint(double x)
02699 {
02700     return (x < 0.0) ? -floor(-x) : floor(x);
02701 }
02702 
02703 /*
02704 *       FRAC(x)
02705 */
02706 static double   frac(double x)
02707 {
02708     return fabs(fabs(x)-fint(fabs(x)));
02709 }
02710 
02711 /*
02712 *       SGN(x)
02713 */
02714 static int              sgn(double x)
02715 {
02716     return (x < 0.0) ? -1 : 1;
02717 }
02718 
02719 /*
02720 *       ZSGN(x)
02721 */
02722 static int              zsgn(double x)
02723 {
02724     return (x < 0.0) ? -1 : ((x > 0.0) ? 1 : 0);
02725 }
02726 
02727 /*
02728 *       ROUND(x, digits)
02729 */
02730 static double   fround(double x, int dig)
02731 {
02732     double      m;
02733     
02734     m = floor(pow(10.0, dig));
02735     if  ( x < 0.0 )
02736         return -floor((-x * m) + .5) / m;
02737     return floor((x * m) + .5) / m;
02738 }
02739 
02740 /*
02741 *       Part of floating point to string (by using integers) algorithm
02742 *       where x any number 2^31 > x >= 0 
02743 */
02744 static void     fptoa(double x, char *dest)
02745 {
02746     long        l;
02747     
02748     *dest = '\0';
02749     l = (long) x;
02750     sprintf(dest, "%ld", l);    /* or l=atol(dest) */
02751 }
02752 
02753 /*
02754 *       remove rightest zeroes from the string
02755 */
02756 static void     rmzeros(char *buf)
02757 {
02758     char        *p = buf;
02759     
02760     p += (strlen(buf) - 1);
02761     while ( p > buf )   {
02762         if      ( *p != '0' )
02763             break;
02764         *p = '\0';
02765         p --;
02766     }
02767 }
02768 
02769 /*
02770 *       best float to string (lib)
02771 *
02772 *       This is the real float-to-string routine.
02773 *       It used by the routines:
02774 *               bestfta(double x, char *dest)
02775 *               expfta(double x, char *dest)
02776 */
02777 static void     bestfta_p(double x, char *dest, double minx, double maxx)
02778 {
02779     double      ipart, fpart, fdif;
02780     int         sign, i;
02781     char        *d = dest;
02782     long        power = 0;
02783     char        buf[64];
02784     
02785     if  ( fabs(x) == 0.0 )      {
02786         strcpy(dest, "0");
02787         return;
02788     }
02789     
02790     /* find sign */
02791     sign  = sgn(x);
02792     if  ( sign < 0 )
02793         *d ++ = '-';
02794     x = fabs(x);
02795     
02796     if  ( x >= 1E308 ) {
02797         *d = '\0';
02798         strcat(d, "INF");
02799         return;
02800     }
02801     else if     ( x <= 1E-307 )         {
02802         *d = '\0';
02803         strcat(d, "0");
02804         return;
02805     }
02806     
02807     /* find power */
02808     if  ( x < minx )    {
02809         for ( i = 37; i >= 0; i -- )    {
02810             if  ( x < nfta_eminus[i] )  {
02811                 x *= nfta_eplus[i];
02812                 power = -((i+1) * 8);
02813             }
02814             else
02815                 break;
02816         }
02817         
02818         while ( x < 1.0 && power > -307 )       {
02819             x *= 10.0;
02820             power --;
02821         }
02822     }
02823     else if ( x > maxx )        {
02824         for ( i = 37; i >= 0; i -- )    {
02825             if  ( x > nfta_eplus[i] )   {
02826                 x /= nfta_eplus[i];
02827                 power = ((i+1) * 8);
02828             }
02829             else
02830                 break;
02831         }
02832         
02833         while ( x >= 10.0 && power < 308 )      {
02834             x /= 10.0;
02835             power ++;
02836         }
02837     }
02838     
02839     /* format left part */
02840     ipart = fabs(fint(x));
02841     fpart = fround(frac(x), FMT_RND) * FMT_xRND;
02842     if  ( fpart >= FMT_xRND )   {       /* rounding bug */
02843         ipart = ipart + 1.0;
02844         if      ( ipart >= maxx )       {
02845             ipart = ipart / 10.0;
02846             power ++;
02847         }
02848         fpart = 0.0;
02849     }
02850     
02851     fptoa(ipart, buf);
02852     strcpy(d, buf);
02853     d += strlen(buf);
02854     
02855     if  ( fpart > 0.0 ) {
02856         /* format right part */
02857         *d ++ = '.';
02858         
02859         fdif = fpart;
02860         while ( fdif < FMT_xRND2 )      {
02861             fdif *= 10;
02862             *d ++ = '0';
02863         }
02864         
02865         fptoa(fpart, buf);
02866         rmzeros(buf);
02867         strcpy(d, buf);
02868         d += strlen(buf);
02869     }
02870     
02871     if  ( power )       {
02872         /* add the power */
02873         *d ++ = 'E';
02874         if      ( power > 0 )
02875             *d ++ = '+';
02876         fptoa(power, buf);
02877         strcpy(d, buf);
02878         d += strlen(buf);
02879     }
02880     
02881     /* finish */
02882     *d = '\0';
02883 }
02884 
02885 /*
02886 *       best float to string (user)
02887 */
02888 static void     bestfta(double x, char *dest)
02889 {
02890     bestfta_p(x, dest, FMT_xMIN, FMT_xMAX);
02891 }
02892 
02893 /*
02894 *       float to string (user, E mode)
02895 */
02896 static void     expfta(double x, char *dest)
02897 {
02898     bestfta_p(x, dest, 10.0, 10.0);
02899     if  ( strchr(dest, 'E') == NULL )
02900         strcat(dest, "E+0");
02901 }
02902 
02903 /*
02904 *       format: map number to format
02905 *
02906 *       dir = direction, 1 = left to right, -1 right to left
02907 */
02908 static void     fmt_nmap(int dir, char *dest, char *fmt, char *src)
02909 {
02910     char        *p, *d, *s;
02911     
02912     *dest = '\0';
02913     if  ( dir > 0 )     {
02914         /*      left to right */
02915         p = fmt;
02916         d = dest;
02917         s = src;
02918         while ( *p )    {
02919             switch ( *p )       {
02920             case '#':
02921             case '^':
02922                 if      ( *s )
02923                     *d ++ = *s ++;
02924                 break;
02925             case '0':
02926                 if      ( *s )
02927                     *d ++ = *s ++;
02928                 else
02929                     *d ++ = '0';
02930                 break;
02931             default:
02932                 *d ++ = *p;
02933             }
02934             
02935             p ++;
02936         }
02937         
02938         *d = '\0';
02939     }
02940     else        {
02941         /*      right to left */
02942         p = fmt+(strlen(fmt)-1);
02943         d = dest+(strlen(fmt)-1);
02944         *(d+1) = '\0';
02945         s = src+(strlen(src)-1);
02946         while ( p >= fmt )      {
02947             switch ( *p )       {
02948             case '#':
02949             case '^':
02950                 if      ( s >= src )
02951                     *d -- = *s --;
02952                 else
02953                     *d -- = ' ';
02954                 break;
02955             case '0':
02956                 if      ( s >= src )
02957                     *d -- = *s --;
02958                 else
02959                     *d -- = '0';
02960                 break;
02961             default:
02962                 if      ( *p == ',' )   {
02963                     if  ( s >= src )    {
02964                         if      ( *s == '-' )
02965                             *d -- = *s --;
02966                         else
02967                             *d -- = *p;
02968                     }
02969                     else
02970                         *d -- = ' ';
02971                 }
02972                 else
02973                     *d -- = *p;
02974             }
02975             
02976             p --;
02977         }
02978     }
02979 }
02980 
02981 /*
02982 *       format: map number-overflow to format
02983 */
02984 static void     fmt_omap(char *dest, const char *fmt)
02985 {
02986     char        *p = (char *) fmt;
02987     char        *d = dest;
02988     
02989     while ( *p )        {
02990         switch ( *p )   {
02991         case    '#':
02992         case    '0':
02993         case    '^':
02994             *d ++ = '*';
02995             break;
02996         default:
02997             *d ++ = *p;
02998         }
02999         
03000         p ++;
03001     }
03002     *d = '\0';
03003 }
03004 
03005 /*
03006 *       format: count digits
03007 */
03008 static int              fmt_cdig(char *fmt)
03009 {
03010     char        *p = fmt;
03011     int         count = 0;
03012     
03013     while ( *p )        {
03014         switch ( *p )   {
03015         case    '#':
03016         case    '0':
03017         case    '^':
03018             count ++;
03019             break;
03020         }
03021         
03022         p ++;
03023     }
03024     
03025     return count;
03026 }
03027 
03028 /*
03029 *       format: format a number
03030 *
03031 *       symbols:
03032 *               # = digit or space
03033 *               0 = digit or zero
03034 *               ^ = exponential digit/format
03035 *               . = decimal point
03036 *               , = thousands
03037 *               - = minus for negative
03038 *               + = sign of number
03039 */
03040 static int format_num(char *dest, const char *fmt_cnst, double x)
03041 {
03042     char        *p, *fmt;
03043     char        left[64], right[64];
03044     char        lbuf[64], rbuf[64];
03045     int         dp = 0, lc = 0, sign = 0;
03046     int         rsz, sco;
03047     char c;
03048     double sng;
03049     
03050     /* backup of format */
03051     fmt = (char*)malloc(strlen(fmt_cnst)+1);
03052     strcpy(fmt, fmt_cnst);
03053     
03054     
03055     if  ( strchr(fmt_cnst, '^') )       {
03056         /*      E format */
03057         p = fmt;
03058         while (*p) {
03059             if (*p == '^')
03060                 *p= '#';
03061             ++p;
03062         }
03063         sco = strcspn(fmt, "-+");
03064         if (sco < (int)strcspn(fmt, ".0#"))
03065             sco = 0;
03066         else
03067             sco = 1;
03068         if (x < 0.0) {
03069             x = -x;
03070             sng = -1.0;
03071         }
03072         else {
03073             sng = 1;
03074             sco = 0;
03075         }
03076         lc = fmt_cdig(fmt);
03077         p = strchr(fmt, '.');
03078         if (p)
03079             dp = fmt_cdig(p + 1);
03080         else
03081             dp = 0;
03082         lc -= dp;
03083         lc -= sco;
03084         if (lc < 0)
03085             lc = 0;
03086         rsz = (int)log10(x);
03087         x = x / pow(10, rsz);
03088         x *= pow(10, lc - 1);
03089         rsz -= lc - 1;
03090         format_num(dest, fmt, x * sng);
03091         c = '\0';
03092         if (strlen(dest)) {
03093             c = dest[strlen(dest) - 1];
03094         }
03095         p = dest + strlen(dest);
03096         if (c == '-' || c == '+')
03097             --p;
03098         else
03099             c = '\0';
03100         sprintf(p, "E%+04d%c", rsz, c);
03101 
03102     }
03103     else        {
03104         /* check sign */
03105         if      ( strchr(fmt, '-') || strchr(fmt, '+') )        {
03106             sign = 1;
03107             if  ( x < 0.0 )     {
03108                 sign = -1;
03109                 x = -x;
03110             }
03111         }
03112         /*      normal format */
03113         
03114         /* rounding */
03115         p = strchr(fmt, '.');
03116         if      ( p )   
03117             x = fround(x, fmt_cdig(p+1));
03118         else
03119             x = fround(x, 0);
03120         
03121         /* convert */
03122         bestfta(x, dest);
03123         if      ( strchr(dest, 'E') )   {
03124             fmt_omap(dest, fmt);
03125             free(fmt);
03126             return strlen(dest);
03127         }
03128         
03129         /* left & right parts */
03130         left[0] = right[0] = '\0';
03131         p = strchr(dest, '.');
03132         if      ( p )   {
03133             *p = '\0';
03134             strcpy(right, p+1);
03135         }
03136         strcpy(left, dest);
03137         
03138         /* map format */
03139         rbuf[0] = lbuf[0] = '\0';
03140         p = strchr(fmt, '.');
03141         if      ( p )   {
03142             dp = 1;
03143             *p = '\0';
03144             fmt_nmap(1, rbuf, p+1, right);
03145         }
03146         
03147         lc = fmt_cdig(fmt);
03148         if      ( lc < (int)strlen(left) )      {
03149             fmt_omap(dest, fmt_cnst);
03150             free(fmt);
03151             return strlen(dest);
03152         }
03153         fmt_nmap(-1, lbuf, fmt, left);
03154         
03155         strcpy(dest, lbuf);
03156         if      ( dp )  {
03157             strcat(dest, ".");
03158             strcat(dest, rbuf);
03159         }
03160        /* sign in format */
03161         if      ( sign )        {
03162             p = strchr(dest, '+');
03163             if  ( p )   
03164                 *p = (sign > 0) ? '+' : '-';
03165         
03166             p = strchr(dest, '-');
03167             if  ( p )   
03168                 *p = (sign > 0) ? ' ' : '-';
03169         }
03170     }
03171     
03172     
03173     /* cleanup */
03174     free(fmt);
03175     return strlen(dest);
03176 }
03177 
03178 
03213 COMMAND(FORMAT)
03214 #if NOTIMP_FORMAT
03215 NOTIMPLEMENTED;
03216 #else
03217     unsigned long cParameters;
03218     unsigned long iArg;
03219     char* ptr,*p;
03220     long size;
03221     formatParams params;
03222     VARIABLE vFormat,*pvArgs;
03223     NODE nItem;
03224     char fmt[128];
03225 
03226     /* this is an operator and not a command, therefore we do not have our own mortal list */
03227     USE_CALLER_MORTALS;
03228 
03229     /* evaluate the parameter */
03230     nItem = PARAMETERLIST;
03231     vFormat = CONVERT2STRING(_EVALUATEEXPRESSION(CAR(nItem)));
03232     ASSERTOKE;
03233     
03234     /* count the number of parameters */
03235     nItem = CDR(nItem);
03236     cParameters = 0;
03237     while( nItem ){
03238         cParameters ++;
03239         nItem = CDR(nItem);
03240     }
03241     if( cParameters ){
03242         pvArgs = ALLOC(sizeof(VARIABLE)*cParameters);
03243         if( pvArgs == NULL )
03244             ERROR(COMMAND_ERROR_MEMORY_LOW);
03245     }
03246     else
03247         pvArgs = NULL;
03248     
03249     /* evaluate the parameters and store the result in the pvArgs array */
03250     nItem = CDR(PARAMETERLIST);
03251     iArg = 0;
03252     while( nItem ){
03253         pvArgs[iArg] = EVALUATEEXPRESSION(CAR(nItem));
03254         /* check that the expression was evaluated without error */
03255         if( iErrorCode ){
03256             FREE(pvArgs);
03257             ERROR(iErrorCode);
03258         }
03259         nItem = CDR(nItem);
03260         iArg ++;
03261     }
03262     iArg = 0;
03263     params.buf = (char*)malloc(CHUNK_SIZE);
03264     params.bufSize = CHUNK_SIZE;
03265     params.bufPtr = 0;
03266     ptr = STRINGVALUE(vFormat);
03267     size = STRLEN(vFormat);
03268     while (size > 0) {
03269         char c;
03270         char* pFound = memchr(ptr, '%', size);
03271         if (pFound == NULL) {
03272             CHECK_MEM(size);
03273             memcpy(params.buf + params.bufPtr, ptr, size);
03274             params.bufPtr += size;
03275             break;
03276         }
03277         CHECK_MEM(pFound - ptr);
03278         memcpy(params.buf + params.bufPtr, ptr, pFound - ptr);
03279         params.bufPtr += pFound - ptr;
03280         size -= pFound - ptr;
03281         --size;
03282         ptr = pFound + 1;
03283         if (size && *ptr == '~') {
03284             --size;
03285             ++ptr;
03286             p = memchr(ptr, '~', size);
03287             if (!p || (p - ptr) >= sizeof(fmt)) {
03288                 FORMAT_SYNTAX_ERROR
03289             }
03290             memcpy(fmt, ptr, (p - ptr));
03291             fmt[p - ptr] = '\0';
03292             ++p;
03293             size -= p - ptr;
03294             ptr = p;
03295             CHECK_MEM(128 + 32);
03296             ASSERT_PARAMETER_COUNT
03297             pvArgs[iArg] = CONVERT2DOUBLE(pvArgs[iArg]);
03298             params.bufPtr += format_num(params.buf + params.bufPtr, fmt, DOUBLEVALUE(pvArgs[iArg]));
03299             ++iArg;
03300             continue;
03301         }
03302         params.flags = 0;
03303         params.prec = -1;
03304         params.width = -1;
03305         while (size-- > 0) {
03306             c = *(ptr++);
03307             switch (c) {
03308             case ' ':
03309                 params.flags |= F_BLANK;
03310                 continue;
03311             case '#':
03312                 params.flags |= F_SHARP;
03313                 continue;
03314             case '-':
03315                 params.flags |= F_MINUS;
03316                 continue;
03317             case '+':
03318                 params.flags |= F_PLUS;
03319                 continue;
03320             case '0':
03321                 params.flags |= F_ZERO;
03322                 continue;
03323             }
03324             break;
03325         }
03326         if (c == '*') {
03327             ASSERT_PARAMETER_COUNT
03328             pvArgs[iArg] = CONVERT2LONG(pvArgs[iArg]);
03329             params.width = LONGVALUE(pvArgs[iArg]);
03330             if (params.width < 0) {
03331                 params.width = -params.width;
03332                 params.flags |= F_MINUS;
03333             }
03334             ++iArg;
03335             if (size-- > 0)
03336                 c = *(ptr++);
03337         }
03338         else if (isdigit(c)) {
03339             params.width = c - '0';
03340             while (size-- > 0) {
03341                 c = *(ptr++);
03342                 if (!isdigit(c))
03343                     break;
03344                 params.width = params.width * 10 + (c - '0');
03345             }
03346         }
03347         if (c == '.') {
03348             params.prec = 0;
03349             if (size-- > 0)
03350                 c = *(ptr++);
03351             if (c == '*') {
03352                 ASSERT_PARAMETER_COUNT
03353                 pvArgs[iArg] = CONVERT2LONG(pvArgs[iArg]);
03354                 params.prec = LONGVALUE(pvArgs[iArg]);
03355                 if (params.prec < 0)
03356                     params.prec = 0;
03357                 ++iArg;
03358                 if (size-- > 0)
03359                     c = *(ptr++);
03360             }
03361             else if (isdigit(c)) {
03362                 params.prec = c - '0';
03363                 while (size-- > 0) {
03364                     c = *(ptr++);
03365                     if (!isdigit(c))
03366                         break;
03367                     params.prec = params.prec * 10 + (c - '0');
03368                 }
03369             }
03370         }
03371         if (size < 0) {
03372             FORMAT_SYNTAX_ERROR
03373         }
03374         params.type = c;
03375         switch (c) {
03376         case 'd':
03377         case 'i':
03378         case 'o':
03379         case 'X':
03380         case 'x':
03381         case 'u':
03382             ASSERT_PARAMETER_COUNT
03383             pvArgs[iArg] = CONVERT2LONG(pvArgs[iArg]);
03384             params.vLong = LONGVALUE(pvArgs[iArg]);
03385             ++iArg;
03386             CHECK_OPERATION(printInt(&params))
03387             break;
03388         case 'e':
03389         case 'E':
03390         case 'f':
03391         case 'g':
03392         case 'G':
03393             ASSERT_PARAMETER_COUNT
03394             pvArgs[iArg] = CONVERT2DOUBLE(pvArgs[iArg]);
03395             params.vDouble = DOUBLEVALUE(pvArgs[iArg]);
03396             ++iArg;
03397             CHECK_OPERATION(printDouble(&params));
03398             break;
03399         case '%':
03400             CHECK_MEM(1);
03401             params.buf[params.bufPtr++] = c;
03402             break;
03403         case 'c':
03404             ASSERT_PARAMETER_COUNT
03405             params.prec = 1;
03406             params.vSize = 1;
03407             pvArgs[iArg] = CONVERT2LONG(pvArgs[iArg]);
03408             c = (char)LONGVALUE(pvArgs[iArg]);
03409             params.vString = &c;
03410             ++iArg;
03411             CHECK_OPERATION(printChar(&params));
03412             break;
03413         case 's':
03414             ASSERT_PARAMETER_COUNT
03415             pvArgs[iArg] = CONVERT2STRING(pvArgs[iArg]);
03416             params.vSize = STRLEN(pvArgs[iArg]);
03417             params.vString = STRINGVALUE(pvArgs[iArg]);
03418             ++iArg;
03419             CHECK_OPERATION(printChar(&params));
03420             break;
03421         default:
03422             FORMAT_SYNTAX_ERROR
03423         }
03424     }
03425     FREE(pvArgs);
03426     RESULT = NEWMORTALSTRING(params.bufPtr);
03427     if (RESULT == NULL) {
03428         free(params.buf);
03429         ERROR(COMMAND_ERROR_MEMORY_LOW);
03430     }
03431     memcpy(STRINGVALUE(RESULT), params.buf, params.bufPtr);
03432     free(params.buf);
03433     RETURN;
03434 error_escape:
03435     FREE(pvArgs);
03436     if (params.buf)
03437         free(params.buf);
03438     ERROR(iErrorCode);
03439 
03440 #endif
03441 END
03442 
03443 /*
03444 This function is used to calculate the stored length of a sting in the
03445 command pack.
03446 
03447 The command pack can store string so that the length of the string is
03448 stored on 1, 2 .., 8 bytes. If the string is longer than the length storable
03449 on the number of bytes the string is stored truncated. This function returns
03450 the original length or the truncated length.
03451 */
03452 static unsigned long TruncatedLength(int lLen, unsigned long iArgStr){
03453   /* take care of long and truncated strings */
03454   switch( lLen ){
03455     case 1: if( iArgStr > 0xFF )
03456               iArgStr =   0xFF; break;
03457     case 2: if( iArgStr > 0xFFFF )
03458               iArgStr =   0xFFFF; break;
03459     case 3: if( iArgStr > 0xFFFFFF )
03460               iArgStr =   0xFFFFFF; break;
03461     case 4: if( iArgStr > 0xFFFFFFFF )
03462               iArgStr =   0xFFFFFFFF; break;
03463 /*
03464       NOTE that 32bit architectures will complain about truncation.
03465 */
03466 #pragma warning (disable:4305)
03467     case 5: if( iArgStr > (unsigned long)0xFFFFFFFFFF )
03468               iArgStr =   (unsigned long)0xFFFFFFFFFF; break;
03469     case 6: if( iArgStr > (unsigned long)0xFFFFFFFFFFFF )
03470               iArgStr =   (unsigned long)0xFFFFFFFFFFFF; break;
03471     case 7: if( iArgStr > (unsigned long)0xFFFFFFFFFFFFFF )
03472               iArgStr =   (unsigned long)0xFFFFFFFFFFFFFF; break;
03473 /* Does anyone know any 128bit architecture with ScriptBasic running on it?
03474     case 8: if( iArgStr > (unsigned long)0xFFFFFFFFFFFFFFFF )
03475               iArgStr =   (unsigned long)0xFFFFFFFFFFFFFFFF; break; */
03476 #pragma warning (default:4305)
03477     }
03478   return iArgStr;
03479   }
03480 
03481 /* just a piece of code that we use lots of times */
03482 #define GETNPARAM lLen = 0; fLen = 0;\
03483           while( iStr < STRLEN(vFormat) && isdigit(STRINGVALUE(vFormat)[iStr]) ){\
03484             lLen = 10*lLen + STRINGVALUE(vFormat)[iStr] - '0';\
03485             fLen=1;\
03486             iStr++;\
03487             }
03488 
03542 COMMAND(PACK)
03543 #if NOTIMP_PACK
03544 NOTIMPLEMENTED;
03545 #else
03546   NODE nItem;
03547   VARIABLE vFormat,*pvArgs;
03548   unsigned long cParameters,cbResult;
03549   unsigned long iArg,iStr,iArgStr,iResult;
03550   unsigned long lLen,lLenS;
03551   long lParam;
03552   unsigned long uParam;
03553   int fLen;
03554   char cChar;
03555   double dParam;
03556   unsigned char *pszD;
03557 
03558   /* this is a function and not a command, therefore we do not have our own mortal list */
03559   USE_CALLER_MORTALS;
03560 
03561   /* evaluate the parameter */
03562   nItem = PARAMETERLIST;
03563   vFormat = CONVERT2STRING(_EVALUATEEXPRESSION(CAR(nItem)));
03564   ASSERTOKE;
03565 
03566   /* count the number of parameters */
03567   nItem = CDR(nItem);
03568   cParameters = 0;
03569   while( nItem ){
03570     cParameters ++;
03571     nItem = CDR(nItem);
03572     }
03573   if( cParameters ){
03574     pvArgs = ALLOC(sizeof(VARIABLE)*cParameters);
03575     if( pvArgs == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
03576     }else pvArgs = NULL;
03577 
03578   /* evaluate the parameters and store the result in the pvArgs array */
03579   nItem = CDR(PARAMETERLIST);
03580   iArg = 0;
03581   while( nItem ){
03582     pvArgs[iArg] = EVALUATEEXPRESSION(CAR(nItem));
03583     /* check that the expression was evaluated without error */
03584     if( iErrorCode ){
03585       FREE(pvArgs);
03586       ERROR(iErrorCode);
03587       }
03588     nItem = CDR(nItem);
03589     iArg ++;
03590     }
03591 
03592   /* calculate the length of the result string */
03593   iStr = 0;
03594   iArg = 0;
03595   cbResult = 0;
03596   while( iStr < STRLEN(vFormat) ){
03597     switch( cChar = STRINGVALUE(vFormat)[iStr] ){
03598       case 'S':
03599          if( iArg < cParameters )
03600            pvArgs[iArg] = CONVERT2STRING(pvArgs[iArg]);
03601          iStr ++;
03602          switch( iStr < STRLEN(vFormat) ? STRINGVALUE(vFormat)[iStr] : (char)0 ){
03603            case 'Z':
03604              iArgStr = 0;
03605              /* non-existing parameter and undef is zero length string */
03606              if( iArg < cParameters )
03607                while( iArgStr < STRLEN(pvArgs[iArg]) ){
03608                  if( ! STRINGVALUE(pvArgs[iArg])[iArgStr] )break;
03609                  iArgStr++;
03610                  }
03611              iArgStr++; /* count the terminating zero */
03612              cbResult += iArgStr;
03613              iArg++; /* step for the next argument */
03614              iStr ++;
03615              break;
03616            case '1': case '2': case '3': case '4':
03617            case '5': case '6': case '7': case '8':
03618              iArgStr = TruncatedLength(STRINGVALUE(vFormat)[iStr] - '0',
03619                                        iArg < cParameters ? STRLEN(pvArgs[iArg]) : 0 );
03620              cbResult += STRINGVALUE(vFormat)[iStr] - '0';
03621              if( iArg < cParameters )/* non-existing parameter */
03622                cbResult += iArgStr;  /* and undef is 
03623                                             zero length string */
03624              iStr ++;
03625              iArg++;
03626              break;
03627            default : /* a single S without sub cast */
03628              cbResult += 2 + STRLEN(pvArgs[iArg]);
03629              iArg++;
03630              break;
03631            }
03632         break;
03633       case 'Z': /* fixed length string filled zero */
03634       case 'A': /* fixed length string             */
03635       case 'I': /* fixed length signed integer     */
03636       case 'U': /* fixed length unsigned integer   */
03637         iStr++;
03638         GETNPARAM
03639         /* if there is a length parameter then use it */
03640         if( fLen )
03641           cbResult += lLen;
03642         else /* if there was no length parameter use the default */
03643           switch( cChar ){
03644             case 'Z' : cbResult ++; break; /* Z is same as Z1 */
03645             case 'A' : cbResult += 20; break; /* A is same as A20 */
03646             case 'U' : /*--------------------------------------------------*/
03647             case 'I' : cbResult += 8; break; /* 64 bit long is the default */
03648             }
03649         /* take care of the argument, convert to the proper format and
03650            also step the argument index variable iArg */
03651         switch( cChar ){
03652           case 'A' :
03653             if( iArg < cParameters )
03654               pvArgs[iArg] = CONVERT2STRING(pvArgs[iArg]);
03655             iArg++;
03656             break;
03657           case 'U' :
03658           case 'I' :
03659             if( iArg < cParameters )
03660               pvArgs[iArg] = CONVERT2LONG(pvArgs[iArg]);
03661             iArg++;
03662             break;
03663           }
03664         break;
03665       case 'R': /* a double */
03666         iStr++;
03667         if( iArg < cParameters )
03668           pvArgs[iArg] = CONVERT2DOUBLE(pvArgs[iArg]);
03669         iArg++; /* go for the next argument */
03670         cbResult += sizeof(double);
03671         break;
03672 
03673       case 'C': /* a single character */
03674         iStr++;
03675         if( iArg < cParameters )
03676           pvArgs[iArg] = CONVERT2LONG(pvArgs[iArg]);
03677         iArg++; /* go for the next argument */
03678         cbResult++;
03679         break;
03680       /* any other character is ignored */
03681       default: iStr++; break;
03682       }
03683     }
03684 
03685   /* allocate space for the result string */
03686   RESULT = NEWMORTALSTRING(cbResult);
03687   if( RESULT == NULL ){
03688     FREE(pvArgs);
03689     ERROR(COMMAND_ERROR_MEMORY_LOW);
03690     }
03691 
03692   /* create the result string */
03693   iStr = 0;
03694   iArg = 0;
03695   iResult = 0;
03696 #define NEXTCHAR STRINGVALUE(RESULT)[ iResult < cbResult ? iResult++ : cbResult ]
03697   while( iStr < STRLEN(vFormat) ){
03698     switch( cChar = STRINGVALUE(vFormat)[iStr] ){
03699       case 'S':
03700          iStr ++;
03701          switch( iStr < STRLEN(vFormat) ? STRINGVALUE(vFormat)[iStr] : (char)0 ){
03702            case 'Z':
03703              iArgStr = 0;
03704              if( iArg < cParameters )
03705                while( iArgStr < STRLEN(pvArgs[iArg]) ){
03706                  if( ! STRINGVALUE(pvArgs[iArg])[iArgStr] )break;
03707                  NEXTCHAR = STRINGVALUE(pvArgs[iArg])[iArgStr];
03708                  iArgStr++;
03709                  }
03710              NEXTCHAR = (char)0;
03711              iArgStr++; /* count the terminating zero */
03712              iArg++; /* step for the next argument */
03713              iStr ++;
03714              break;
03715            case '1': case '2': case '3': case '4':
03716            case '5': case '6': case '7': case '8':
03717              iArgStr = TruncatedLength((lLen=STRINGVALUE(vFormat)[iStr] - '0'),
03718                                        iArg < cParameters ? STRLEN(pvArgs[iArg]) : 0 );
03719              lLenS = iArgStr;
03720              /* store the length in the result */
03721              while( lLen-- ){
03722                NEXTCHAR = (unsigned char)iArgStr & 0xFF;
03723                iArgStr /= 0x100;
03724                }
03725              /* store the characters in the result */
03726              iArgStr = 0;
03727              while( iArgStr < lLenS )
03728                NEXTCHAR = STRINGVALUE(pvArgs[iArg])[iArgStr++];
03729              iStr ++;
03730              iArg++;
03731              break;
03732            default : /* a single S without sub cast */
03733              lLen = 2;
03734              if( iArg < cParameters )
03735                iArgStr = STRLEN(pvArgs[iArg]);
03736              else
03737                iArgStr = 0;
03738              if( iArgStr > 0xFFFF )iArgStr = 0xFFFF;
03739              lLenS = iArgStr;
03740              while( lLen-- ){
03741                NEXTCHAR = (unsigned char)iArgStr & 0xFF;
03742                iArgStr /= 0x100;
03743                }
03744              while( iArgStr < lLenS )
03745                NEXTCHAR = STRINGVALUE(pvArgs[iArg])[iArgStr++];
03746              iStr ++;
03747              iArg++;
03748              break;
03749            }
03750         break;
03751       case 'Z': /* fixed length string filled zero */
03752         iStr++;
03753         GETNPARAM
03754         /* if there is a length parameter then use it */
03755         if( ! fLen )lLen = 1;
03756         while( lLen-- )
03757           NEXTCHAR = (char)0;
03758         break;
03759       case 'A': /* fixed length string */
03760         iStr++;
03761         GETNPARAM
03762         /* if there is a length parameter then use it */
03763         if( ! fLen )lLen = 20;
03764         iArgStr = 0;
03765         if( iArg < cParameters )
03766           lLenS = STRLEN(pvArgs[iArg]);
03767         else
03768           lLenS = 0;
03769         while( lLen && iArgStr < lLenS ){
03770           NEXTCHAR = STRINGVALUE(pvArgs[iArg])[iArgStr++];
03771           lLen--;
03772           }
03773         while( lLen ){
03774           NEXTCHAR = ' ';
03775           lLen--;
03776           }
03777         iArg++;
03778         break;
03779       case 'I': /* fixed length signed integer   */
03780         iStr++;
03781         GETNPARAM
03782         /* if there is a length parameter then use it */
03783         if( ! fLen )lLen = 8;
03784         if( iArg < cParameters && pvArgs[iArg] )
03785           lParam = LONGVALUE(pvArgs[iArg]);
03786         else
03787           lParam = 0;
03788         uParam = (unsigned)lParam;
03789         while( lLen-- ){
03790           if( uParam == 0 )
03791             if( lParam < 0 )
03792               NEXTCHAR = (unsigned char)0xFF;
03793             else
03794               NEXTCHAR = (unsigned char)0x00;
03795           else
03796             NEXTCHAR = (unsigned char)( uParam & 0xFF );
03797           uParam /= 256;
03798           }
03799         iArg++;
03800         break;
03801       case 'U': /* fixed length unsigned integer */
03802         iStr++;
03803         GETNPARAM
03804         /* if there is a length parameter then use it */
03805         if( ! fLen )lLen = 8;
03806         if( iArg < cParameters && pvArgs[iArg])
03807           uParam = LONGVALUE(pvArgs[iArg]);
03808         else
03809           uParam = 0;
03810         while( lLen-- ){
03811           NEXTCHAR = (unsigned char)( uParam & 0xFF );
03812           uParam /= 256;
03813           }
03814         iArg++;
03815         break;
03816       case 'R':
03817          iStr++;
03818          if( iArg < cParameters && pvArgs[iArg])
03819           dParam = DOUBLEVALUE(pvArgs[iArg]);
03820         else
03821           dParam = 0.0;
03822         lLen = sizeof(double);
03823         pszD = (unsigned char *)&dParam;
03824         while( lLen-- ){
03825           NEXTCHAR = *pszD++;
03826           }
03827         iArg++;
03828         break;
03829       case 'C': /* a single character */
03830         iStr++;
03831         if( iArg < cParameters && pvArgs[iArg])
03832           uParam = LONGVALUE(pvArgs[iArg]);
03833         else
03834           uParam = 0;
03835         NEXTCHAR = (unsigned char)( uParam & 0xFF );
03836         iArg++; /* go for the next argument */
03837         break;
03838       default: iStr++; break;
03839       }
03840     }
03841 
03842 #endif
03843 END
03844 
03845 #define GETLEFTVALUE if( nItem ){LeftValue = EVALUATELEFTVALUE_A(CAR(nItem));\
03846                      ASSERTOKE;\
03847                      DEREFERENCE(LeftValue);\
03848                      if( *LeftValue != NULL )\
03849                        memory_ReleaseVariable(pEo->pMo,*LeftValue);\
03850                      nItem = CDR(nItem);}else LeftValue = NULL;
03851 
03860 COMMAND(UNPACK)
03861 #if NOTIMP_UNPACK
03862 NOTIMPLEMENTED;
03863 #else
03864   NODE nItem;
03865   VARIABLE vRecord,vFormat;
03866   LEFTVALUE LeftValue;
03867   unsigned long lLen,iStr,iRec,lLenS,lMag,i;
03868   int fLen,iThisChar;
03869   long refcount;
03870 
03871   vRecord = CONVERT2STRING(EVALUATEEXPRESSION(PARAMETERNODE));
03872   ASSERTOKE;
03873   NEXTPARAMETER;
03874   vFormat = CONVERT2STRING(EVALUATEEXPRESSION(PARAMETERNODE));
03875   ASSERTOKE;
03876   NEXTPARAMETER;
03877 
03878   nItem = PARAMETERNODE;
03879 
03880   if( !memory_IsUndef(vRecord) && !memory_IsUndef(vFormat) ){
03881     iStr = 0;
03882     iRec = 0;
03883     while( iStr < STRLEN(vFormat) ){
03884       switch( STRINGVALUE(vFormat)[iStr] ){
03885         case 'R' : /* get a double */
03886           iStr++;
03887           GETLEFTVALUE
03888           if( LeftValue ){
03889             if( iRec + sizeof(double) <= STRLEN(vRecord) ){
03890               *LeftValue = NEWDOUBLE;
03891               if( *LeftValue == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
03892               memcpy(&(DOUBLEVALUE(*LeftValue)),STRINGVALUE(vRecord)+iRec,sizeof(double));
03893               }else *LeftValue = NULL;
03894             }
03895           iRec += sizeof(double);
03896           break;
03897         case 'A' : /* get n-character string from the record */
03898           iStr ++;
03899           GETNPARAM
03900           if( ! fLen )lLen = 20;
03901           GETLEFTVALUE
03902           if( LeftValue ){
03903             *LeftValue = NEWSTRING(lLen);
03904             if( *LeftValue == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
03905             for( i=0 ; i < lLen ; i++ )
03906               STRINGVALUE(*LeftValue)[i] = 
03907                 iRec < STRLEN(vRecord) ? STRINGVALUE(vRecord)[iRec++] : (char)0;
03908             }
03909           break;
03910         case 'I' : /* get signed integer from the record */
03911           iStr++;
03912           GETNPARAM
03913           if( ! fLen )lLen = 8;/* as default we store the numbers on 64bit */
03914           lLenS = 0;
03915           lMag = 1;
03916            while( lLen -- ){
03917              if( iRec >= STRLEN(vRecord) )/* if the record finishes */
03918                break;
03919             iThisChar = (unsigned char)STRINGVALUE(vRecord)[iRec++];
03920             lLenS += lMag * iThisChar;
03921             lMag *= 0x100;
03922             }
03923           GETLEFTVALUE
03924           if( LeftValue ){
03925             *LeftValue = NEWLONG;
03926             if( *LeftValue == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
03927             LONGVALUE(*LeftValue) = lLenS;
03928             }
03929           break;
03930         case 'U' : /* get unsigned integer from the record */
03931           iStr++;
03932           GETNPARAM
03933           if( ! fLen )lLen = 8;/* as default we store the numbers on 64bit */
03934           lLenS = 0;
03935           lMag = 1;
03936            while( lLen -- ){
03937              if( iRec >= STRLEN(vRecord) )/* if the record finishes */
03938                break;
03939             iThisChar = (unsigned char)STRINGVALUE(vRecord)[iRec++];
03940             lLenS += lMag * iThisChar;
03941             lMag *= 0x100;
03942             }
03943           GETLEFTVALUE
03944           if( LeftValue ){
03945             *LeftValue = NEWLONG;
03946             if( *LeftValue == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
03947             LONGVALUE(*LeftValue) = lLenS;
03948             if( LONGVALUE(*LeftValue) < 0 )LONGVALUE(*LeftValue) = LONG_MAX;
03949             }
03950           break;
03951         case 'C' : /* get character code */
03952           iStr++;
03953           lLenS = 0;
03954           if( iRec < STRLEN(vRecord) )
03955             lLenS = (unsigned char)STRINGVALUE(vRecord)[iRec++];
03956           GETLEFTVALUE
03957           if( LeftValue ){
03958             *LeftValue = NEWLONG;
03959             if( *LeftValue == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
03960             LONGVALUE(*LeftValue) = lLenS;
03961             if( LONGVALUE(*LeftValue) < 0 )LONGVALUE(*LeftValue) = LONG_MAX;
03962             }
03963           break;
03964         case 'Z' : /* skip one or more zero characters */
03965           iStr++;
03966           GETNPARAM
03967           if( ! fLen )lLen = 1;
03968           while( lLen-- )iRec++; /* just skip the characters */
03969           break;
03970         case 'S' : /* get given number of bytes of string or Z terminated string */
03971           iStr++;
03972           switch( iStr < STRLEN(vFormat) ? STRINGVALUE(vFormat)[iStr] : (char)0 ){
03973             case 'Z': /* get zero terminated string */
03974               iStr ++;
03975               lLen = 0;
03976               while( lLen < STRLEN(vRecord) - iRec && 
03977                      STRINGVALUE(vRecord)[iRec+lLen] )lLen++;
03978               GETLEFTVALUE
03979               if( LeftValue ){
03980                 *LeftValue = NEWSTRING(lLen);
03981                 if( *LeftValue == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
03982                 for( i=0 ; i < lLen ; i++ )
03983                   STRINGVALUE(*LeftValue)[i] = 
03984                     iRec < STRLEN(vRecord) ? STRINGVALUE(vRecord)[iRec++] : (char)0;
03985                 }
03986               break;
03987             case '1' : case '2' : case '3' : case '4' :
03988             case '5' : case '6' : case '7' : case '8' :
03989               lLen = STRINGVALUE(vFormat)[iStr];
03990               lLenS = 0;
03991               lMag = 1;
03992               while( lLen -- ){
03993                 if( iRec >= STRLEN(vRecord) ){/* if the record finishes before */
03994                   lLenS = 0;                  /* the length number             */
03995                   break;
03996                   }
03997                 lLenS += lMag * STRINGVALUE(vRecord)[iRec++];
03998                 lMag *= 0x100;
03999                 }
04000               /* if the length indicated by the bytes is longer than the rest
04001                  of the record */
04002               if( lLenS > STRLEN(vRecord) - iRec )lLenS = STRLEN(vRecord) - iRec;
04003               GETLEFTVALUE
04004               if( LeftValue ){
04005                 *LeftValue = NEWSTRING(lLenS);
04006                 if( *LeftValue == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
04007                 for( i=0 ; i < lLenS ; i++ )
04008                   STRINGVALUE(*LeftValue)[i] = 
04009                     iRec < STRLEN(vRecord) ? STRINGVALUE(vRecord)[iRec++] : (char)0;
04010                 }
04011               break;
04012             }
04013           break;
04014         default: iStr++; break;/* ignore any other character */
04015         }
04016       }
04017     }
04018 
04019   /* make all arguments that were not filled undef */
04020   while( nItem ){
04021     GETLEFTVALUE
04022     if( LeftValue )*LeftValue = NULL;
04023     nItem = CDR(nItem);
04024     }
04025 #endif
04026 END
04027 
04066 COMMAND(CONF)
04067 #if NOTIMP_CONF
04068 NOTIMPLEMENTED;
04069 #else
04070   char *pszConf;
04071   long lConf;
04072   double dConf;
04073   int type;
04074   int iError;
04075   char *pszKey;
04076   char *pszSecKey;
04077   VARIABLE Argument;
04078   int i,j;
04079 
04080   Argument = EVALUATEEXPRESSION(CAR(PARAMETERLIST));
04081   ASSERTOKE;
04082   Argument = CONVERT2STRING(Argument);
04083 
04084   CONVERT2ZCHAR(Argument,pszKey);
04085   pszSecKey = ALLOC(STRLEN(Argument)+2);
04086   if( pszSecKey == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
04087 
04088   /* first check if the whole key is blocked */
04089   *pszSecKey = '$';
04090   strcpy(pszSecKey+1,pszKey);
04091   for( j=1 ; pszSecKey[j] ; j++ )
04092     if( pszSecKey[j] == '.' ){
04093       pszSecKey[j] = (char)0;
04094       break;
04095       }
04096   iError = cft_GetEx(pEo->pConfig,pszSecKey,NULL,&pszConf,&lConf,&dConf,&type);
04097   /* behave like if there was no such key in the configuration (may even happen that actually
04098      there is not btw) */
04099   if( iError == COMMAND_ERROR_SUCCESS )ERROR(COMMAND_ERROR_ARGUMENT_RANGE);
04100 
04101   /* check if there is any subkey made hidden */
04102   for( i=0 ; pszKey[i] ; i++ ){
04103     if( pszKey[i] == '.' ){
04104       strcpy(pszSecKey,pszKey);
04105       pszSecKey[i+1] = '$';
04106       strcpy(pszSecKey+i+2,pszKey+i+1);
04107       for( j=i+2 ; pszSecKey[j] ; j++ )
04108         if( pszSecKey[j] == '.' ){
04109         pszSecKey[j] = (char)0;
04110         break;
04111         }
04112       iError = cft_GetEx(pEo->pConfig,pszSecKey,NULL,&pszConf,&lConf,&dConf,&type);
04113       if( iError == COMMAND_ERROR_SUCCESS )ERROR(COMMAND_ERROR_ARGUMENT_RANGE);
04114       }
04115     }
04116 
04117   iError = cft_GetEx(pEo->pConfig,pszKey,NULL,&pszConf,&lConf,&dConf,&type);
04118 
04119   FREE(pszKey);
04120 
04121   if( iError || type == CFT_NODE_BRANCH )ERROR(COMMAND_ERROR_ARGUMENT_RANGE);
04122 
04123   switch( type ){
04124     case CFT_TYPE_STRING :
04125       RESULT = NEWMORTALSTRING(strlen(pszConf));
04126       ASSERTNULL(RESULT)
04127       memcpy(STRINGVALUE(RESULT),pszConf,STRLEN(RESULT));
04128       return;
04129     case CFT_TYPE_INTEGER:
04130       RESULT = NEWMORTALLONG;
04131       ASSERTNULL(RESULT)
04132       LONGVALUE(RESULT) = lConf;
04133       return;
04134     case CFT_TYPE_REAL   :
04135       RESULT = NEWMORTALDOUBLE;
04136       ASSERTNULL(RESULT)
04137       DOUBLEVALUE(RESULT) = dConf;
04138       return;
04139     default : ERROR(COMMAND_ERROR_ARGUMENT_RANGE);
04140     }
04141 
04142 END
04143 #endif
04144 
04153 COMMAND(BIN)
04154 #if NOTIMP_BIN
04155 NOTIMPLEMENTED;
04156 #else
04157 NOTIMPLEMENTED;
04158 #endif
04159 END
04160 
04169 COMMAND(CVD)
04170 #if NOTIMP_CVD
04171 NOTIMPLEMENTED;
04172 #else
04173 NOTIMPLEMENTED;
04174 #endif
04175 END
04176 
04185 COMMAND(CVI)
04186 #if NOTIMP_CVI
04187 NOTIMPLEMENTED;
04188 #else
04189 NOTIMPLEMENTED;
04190 #endif
04191 END
04192 
04201 COMMAND(CVL)
04202 #if NOTIMP_CVL
04203 NOTIMPLEMENTED;
04204 #else
04205 NOTIMPLEMENTED;
04206 #endif
04207 END
04208 
04217 COMMAND(CVS)
04218 #if NOTIMP_CVS
04219 NOTIMPLEMENTED;
04220 #else
04221 NOTIMPLEMENTED;
04222 #endif
04223 END
04224 
04234 COMMAND(MKD)
04235 #if NOTIMP_MKD
04236 NOTIMPLEMENTED;
04237 #else
04238 NOTIMPLEMENTED;
04239 #endif
04240 END
04241 
04250 COMMAND(MKI)
04251 #if NOTIMP_MKI
04252 NOTIMPLEMENTED;
04253 #else
04254 NOTIMPLEMENTED;
04255 #endif
04256 END
04257 
04266 COMMAND(MKS)
04267 #if NOTIMP_MKS
04268 NOTIMPLEMENTED;
04269 #else
04270 NOTIMPLEMENTED;
04271 #endif
04272 END
04273 
04282 COMMAND(MKL)
04283 #if NOTIMP_MKL
04284 NOTIMPLEMENTED;
04285 #else
04286 NOTIMPLEMENTED;
04287 #endif
04288 END
04289
Generated on Sun Mar 12 23:56:27 2006 for ScriptBasic by  doxygen 1.4.6-NO