Announcement

Collapse
No announcement yet.

Could somebody verify this please.

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Could somebody verify this please.

    I've been fiddling with directly accessing dynamic strings. From
    clues gleaned in POFFs and a few tests I've run I'm pretty sure
    that they start on (at least) DWORD-aligned boundaries.
    Granularity isn't important for what I have in mind but I it
    appears to be a rather odd 24 bytes.

    Can anybody confirm/deny this?

    Thanks
    -Ian

    ------------------
    [SIZE="1"]Reprinted with correections.[/SIZE]

  • #2
    I've looked at this a couple of times, and I could never find any promises re where the data are located. I tend to 'obey' the rules ("use only the string manipulation functions...") anyway, so it really never mattered to me.

    What is your goal here? You want to allocate some memory which is guaranteed to be DWORD-aligned? The HeapAlloc and VirtualAlloc functions provide this on a documented basis.



    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

    Comment


    • #3
      Actually, my interest lies in the other end of the string - if I
      can be sure that the next 1, 2 or 3 bytes after the end of the
      string are unused (or mere padding) I can save some overhead on
      unrolling a loop.

      I recently found some code changing for a *very* fast Uppercase
      function (including converting characters above ASCII 127). My
      initial playing with it resulted in speeds about 2.3 times
      faster than the intrinsic UCase$() function - and (you're going
      to love this) that is just with the pure PB version (see below).

      The assembler version runs ~4.5 times faster on short strings
      (< ~256 bytes) and about 8.5 times faster on longer strings.

      Here is the "pure" version:
      (Adapted especially for MCM from code found on
      http://www.azillionmonkeys.com/qed/asmexample.html

      Code:
      Function Upper(ByVal sStr As String) As String
      	Dim i  As Local Long
      	Dim iP As Local Long Ptr
        Dim iLen   As Local Long
      
        iLen = Len(sStr)
        iP = StrPtr(sStr) 
        For i = 1 To iLen Step 4
          @iP = @iP - ((((((@iP And &H7F7F7F7F) + &h05050505) And &H7F7F7F7F) + &h1a1a1a1a) \ 4) And &h20202020)
          iP = iP + 4
        Next
        Upper = sStr
      End Function
      ------------------
      [SIZE="1"]Reprinted with correections.[/SIZE]

      Comment


      • #4
        > if I can be sure that the next 1, 2 or 3 bytes after the end of the string are unused (or mere padding)
        > I can save some overhead on unrolling a loop.

        Now that I know you may not assume. All you may assume is that the string data will have a (one) null character following it, a character not counted in the string length.

        But that is not dependent on starting address, it's dependent on granularity.If you need reliable granularity you can measure, VirtualAlloc allocates only in multiples of the page size (getSystemInfo, dwPageSIze member of returned SYSTEM_INFO structure). For that matter, you can get close to knowing with heapAlloc by allocating one (1) byte and then interrogating the returned pointer with HeapSize() function.

        But going back to address... I've never seen any data allocation on Win/32 which was NOT DWORD-aligned.

        Of course, you could always modify your assembly-language function to do 4 byte blocks then handle any leftover bytes..
        Code:
          L = LEN(String)
          WholeBlock = L \ 4
          OddBytes   = L MOD 4
          FOR Z = 1 to WholeBlock
             do four bytes at at time
          NEXT
          FOR Z =1 to OddNytes
             do a byte at a time
          NEXT
        All in all, sure seems like a lot of effort to tell the PowerBASIC people their UCASE function is - in your opinion - no good.

        Besides, if you function is using OLE strings anyway, you've already paid the vast majority of the overhead cost.


        MCM


        Michael Mattias
        Tal Systems (retired)
        Port Washington WI USA
        [email protected]
        http://www.talsystems.com

        Comment


        • #5
          I am getting old, however if I remember correctly loweer case
          to caps just requires stripped the 8th bit off. That is
          set bit eight to zero. No test, nothing just step and set.
          Old tty days....

          ------------------
          Roy Cline
          Roy Cline

          Comment


          • #6
            As for as alignment goes in strings, only the first byte is
            aligned - the rest is in byte order. I would guess.

            ------------------
            Roy Cline
            Roy Cline

            Comment


            • #7
              In the regular US ASCII charset, cap/no cap is just bit 5 (or 6?) on (lowercase)/off(uppercase). But you have to test that your character is 'in range' of the letter to do that.

              Don't know about 'extended' chars ( x'7F'< X < x'FF')

              Michael Mattias
              Tal Systems (retired)
              Port Washington WI USA
              [email protected]
              http://www.talsystems.com

              Comment


              • #8
                > if I can be sure that the next 1, 2 or 3 bytes after the end of the string are unused (or mere padding)
                > I can save some overhead on unrolling a loop.

                Now that I know you may not assume. All you may assume is that the string data will have a (one) null character following it, a character not counted in the string length.
                ...

                But going back to address... I've never seen any data allocation on Win/32 which was NOT DWORD-aligned.
                The starting on a DWORD boundary is what is important to me here -
                it means that a new string is not going to start in the 1, 2 or
                3 bytes that can be left over between the end of a string and
                the next DWORD boundary.

                The bit of code I posted is already unrolling loop four times;
                the "nice" thing about a positive answer to my question is that
                it would then be unnecessary to write a special section to handle
                any odd bytes at the end - they can be ignored (and the Null
                remains Nil).

                All in all, sure seems like a lot of effort to tell the PowerBASIC people their UCASE function is - in your opinion - no good.
                I don't know how you arrive at that conclusion but from it it
                seems the you think it is impossible to improve upon an existing
                algorithm or implementation (even if for specific tasks) and, by
                implication, no other code is possible to improve upon.

                I, and many others here, are tinkerers who enjoy experimenting
                - at no time time does this cause harm and occasionally it does
                some good. If the Assembler version of the above can perform
                the sane function as the intrinsic one 8 times faster I'm
                sure I'll not be the only one to use.

                Roy, a quick and dirty method is to toggle the sixth bit (2^5)
                to flip case but that also modifies the 12 non-alphabetical
                characters in the two 32 character ranges. The complete standard
                ASCII character set only need 7 bits, what you may be remembering
                tricks used to create markers in early DOS days (e.g. WordStar
                would mark the beginning of each word by toggling it's 8th bit
                high.

                The separation of upper/lower by 32 has been carried over into
                the &h80 to &hFF range. This is useful to know if you ever need
                to create a character set with additional upper and lower case
                letters and want word processors to be able to change case.



                ------------------
                [SIZE="1"]Reprinted with correections.[/SIZE]

                Comment


                • #9
                   Ian,
                  thank for sharing this code, it is really fascinating,
                  I did some testing, and, unfornunatly some international characters
                  refuse to cooperate, I think the routine will need a little tweak...
                  Note that I did also used the assembler version to confirm the results.

                  Pierre

                  Code:
                  See code below...

                  [This message has been edited by Pierre Bellisle (edited December 12, 2006).]

                  Comment


                  • #10
                    Russian chars à-224 ,û-251,ü-252,ý-253,þ-254,ÿ-255
                    is not uppercased

                    and one thing in asm-routine
                    you increment esi-pointer to string by one
                    but work with data as dword,
                    imho better change
                    inc esi
                    to
                    add esi,4
                    Code:
                     sBuffer    = sBuff
                     pBuffer    = STRPTR(sBuffer)
                     pBufferEnd = pBuffer + LEN(sBuffer) - 1
                     
                     ! mov esi, pBuffer
                     MoreDWORD:
                     ! mov eax, [esi]
                     
                     ! mov  ebx, &h7f7f7f7f
                     ! mov  edx, &h7f7f7f7f
                     ! and  ebx, eax          '; 61-7a | 00-60,7b-7f
                     ! mov  ecx, eax
                     ! add  ebx, &h05050505   '; 66-7f | 05-65,80-84
                     ! not  ecx               '; flip top bits
                     ! and  ebx, edx          '; 66-7f | 00-65
                     ! add  ebx, &h1a1a1a1a   '; 80-99 | 1a-7f
                    '! and  ebx, ecx          '; turn off top bit for non-ASCII
                     ! shr  ebx, 2
                     ! and  ebx, &h20202020   '; 20 | 00
                     ! sub  eax, ebx
                     
                     ! mov [esi], eax
                    ' ! inc esi  ;<------------------
                     ! add esi,4 ;<--- speed*4  [img]http://www.powerbasic.com/support/forums/wink.gif[/img]
                     ! cmp esi, pBufferEnd
                     ! jb MoreDWORD
                    Nice code, thanks

                    ------------------
                    -=Alex=-
                    -=Alex=-

                    Comment


                    • #11
                      The starting on a DWORD boundary is what is important to me here -
                      it means that a new string is not going to start in the 1, 2 or
                      3 bytes that can be left over between the end of a string and
                      the next DWORD boundary.
                      Ok, I see.

                      But that means granularity *is* important, too. Your code wants to assume it owns those odd bytes and may safely operate on them, even though your application is ignoring them.

                      That I think *is* safe. I cannot imagine that Win/32 would allocate memory in other than multiples of 32-bit words.

                      Michael Mattias
                      Tal Systems (retired)
                      Port Washington WI USA
                      [email protected]
                      http://www.talsystems.com

                      Comment


                      • #12
                         Aleksandr, thank, you are right, code have been updated.
                         -
                         Now, for those who like fast algo,
                        here is an interesting test...
                        Note: Added a routine using xlatb...

                        Pierre

                        Code:
                        See code below...



                        [This message has been edited by Pierre Bellisle (edited December 12, 2006).]

                        Comment


                        • #13
                          Originally posted by Pierre Bellisle:
                          Ian, ... to confirm the results.
                          My results with Brazilian Portuguese XP Pro SP2 and PB-Win 8.03
                          are here 1st and here 2nd.

                          Best regards,

                          ------------------
                          Arthur Gomide
                          Como diria nosso profeta da bola, Dadá Maravilha: "Para toda Problemática existe uma Solucionática!"



                          [This message has been edited by Arthur Gomide (edited December 12, 2006).]
                          "The trouble with quotes on the Internet is that you can never know if they are genuine." - Abraham Lincoln.

                          Comment


                          • #14
                            But that means granularity *is* important, too. Your code wants to assume it owns those odd bytes and may safely operate on them, even though your application is ignoring them.

                            That I think *is* safe. I cannot imagine that Win/32 would allocate memory in other than multiples of 32-bit words.
                            My reasoning had been along these lines meaning I too could not
                            imagine a boundary less the 4 bytes (but then were are dealing
                            with MS) meaning that the granularity would be a multiple of 4
                            and, as I don't care if it is bigger than 4, it is not important
                            to me.

                            Pierre, Aleks: The original algorithm was meant for 7-bit ASCII
                            and even though it can be easly modified for 8 bits, there are
                            more than 26 letters with uppercase variants. These border on
                            the others so a bit of bit fiddling may be possible.

                            Pierre, on my machine (AMD64) the translate routine is actually
                            slower.

                            ------------------
                            [SIZE="1"]Reprinted with correections.[/SIZE]

                            Comment


                            • #15
                               Ian,
                              the asm algo I used is the second one on Paul's web page
                              it is meant, if I understand correctly,
                              to be able to convert the full range.

                              from Paul's web page...
                              <<The need to be able to support non-ASCII (i.e., include the range [80h, FFh])
                              has come up. One of the bonuses of being able to do the whole range is that ...>>
                               -

                              As I see, if one want to convert characters only up to 127,
                              the asmUpper is by far the fastest (Some modification needed for full range).

                              On my computer, for full range,
                              the Translate routine is the fastest (until somebody provide a better one).

                               -

                              To avoid code pollution I did mix my code above in only one piece...

                              Pierre

                              Code:
                               
                              'Here are my results...
                              'Upper           : 0.186153826813184357
                              'asmUpper 0-127  : 0.006497194475834219
                              'CharUpper 0-127 : 0.089960036820322136
                              'Translate       : 0.026898949447485644
                              'UCASE$          : 0.081334359534521846
                               
                              #COMPILE EXE '#Win 8.03#
                              #DIM ALL
                              #INCLUDE "WIN32API.INC" '#2005-01-27#
                              '______________________________________________________________________________
                               
                              FUNCTION Translate(BYREF sBuff AS STRING) AS STRING
                               LOCAL  sBuffer    AS STRING
                               STATIC CharTable  AS STRING
                               STATIC pCharTable AS DWORD
                               LOCAL  pBuffer    AS DWORD
                               LOCAL  LenBuffer  AS DWORD
                               
                               IF Len(CharTable) = 0 THEN
                                 CharTable = CHR$(0 TO 255)
                                 pCharTable = STRPTR(CharTable)
                                 CharUpper(BYVAL pCharTable + 1)
                               END IF
                               
                               LenBuffer = LEN(sBuff)
                               IF LenBuffer THEN
                                 sBuffer = sBuff
                                 pBuffer = STRPTR(sBuffer)
                                                              'Thank to Börje Hagsten 
                                 ! mov esi, pBuffer          ;'Pointer to string data
                                 ! mov ecx, LenBuffer        ;'Move length of string into ecx
                                 ! mov ebx, pCharTable       ;'Move pointer to translation table into ebx
                                   Accent_Loop:               'Loop label
                                 ! mov al, [esi]             ;'Move current character into al
                                 ! xlatb                     ;'Translate character
                                 ! mov [esi], al             ;'Move translated character back into string
                                 ! inc esi                   ;'Next character
                                 ! dec ecx                   ;'Decr counter
                                 ! jnz Accent_Loop           ;'Exit when ecx = 0
                               
                                 FUNCTION = sBuffer
                               END IF
                               
                              END FUNCTION
                              '______________________________________________________________________________
                               
                              FUNCTION Upper(BYREF sBuff AS STRING) AS STRING
                               'Attention: This routine won't convert every characters above 127.
                               LOCAL sBuffer AS STRING
                               LOCAL pBuffer AS DWORD POINTER
                               LOCAL Looper  AS LONG
                               
                               sBuffer = Sbuff
                               pBuffer = STRPTR(sBuffer)
                               FOR Looper = 1 TO LEN(sBuffer) STEP 4
                                 @pBuffer = @pBuffer - ((((((@pBuffer AND &H7F7F7F7F) + &h05050505) _
                                                             AND &H7F7F7F7F) + &h1a1a1a1a) \ 4) AND &h20202020)
                                 pBuffer = pBuffer + 4
                               NEXT
                               FUNCTION = sBuffer
                               'Attention: This routine won't convert every characters above 127.
                               
                              END FUNCTION
                              '______________________________________________________________________________
                               
                              FUNCTION asmUpper(BYREF sBuff AS STRING) AS STRING
                               'Attention: This routine won't convert every characters above 127.
                               LOCAL sBuffer    AS STRING
                               LOCAL pBuffer    AS DWORD
                               LOCAL pBufferEnd AS DWORD
                               LOCAL dw4Bytes   AS DWORD
                               
                               sBuffer    = sBuff
                               pBuffer    = STRPTR(sBuffer)
                               pBufferEnd = pBuffer + LEN(sBuffer) - 1
                               
                               ! mov esi, pBuffer
                               MoreDWORD:
                               ! mov eax, [esi]
                               
                               ! mov  ebx, &h7f7f7f7f
                               ! mov  edx, &h7f7f7f7f
                               ! and  ebx, eax          '; 61-7a | 00-60,7b-7f
                               ! mov  ecx, eax                                             ';Remed for 7 bit version
                               ! add  ebx, &h05050505   '; 66-7f | 05-65,80-84
                               ! not  ecx               '; flip top bits                   ';Remed for 7 bit version
                               ! and  ebx, edx          '; 66-7f | 00-65
                               ! add  ebx, &h1a1a1a1a   '; 80-99 | 1a-7f
                              '! and  ebx, ecx          '; turn off top bit for non-ASCII  ';Remed always
                               ! shr  ebx, 2
                               ! and  ebx, &h20202020   '; 20 | 00
                               ! sub  eax, ebx
                                
                               ! mov [esi], eax
                               ! add esi, 4             ';Changed to "add esi, 4" instaed of "inc esi", thank Aleksandr...
                               ! cmp esi, pBufferEnd
                               ! jb MoreDWORD
                               
                               FUNCTION = sBuffer
                               'Attention: This routine won't convert every characters above 127.
                               
                              END FUNCTION
                              '______________________________________________________________________________
                               
                              FUNCTION PBMAIN() AS LONG
                               LOCAL Buffer        AS STRING
                               LOCAL Buffer1       AS STRING
                               LOCAL Buffer2       AS STRING
                               LOCAL Buffer3       AS STRING
                               LOCAL Buffer4       AS STRING
                               LOCAL Message       AS STRING
                               LOCAL PerfFrequency AS QUAD
                               LOCAL PerfStart     AS QUAD
                               LOCAL PerfEnd       AS QUAD
                               LOCAL Looper        AS LONG
                               LOCAL LoopEnd       AS LONG
                               
                               Buffer1 = CHR$(32 TO 63)   : CharUpper(BYVAL(STRPTR(Buffer1)))
                               Buffer2 = CHR$(64 TO 127)  : CharUpper(BYVAL(STRPTR(Buffer2)))
                               Buffer3 = CHR$(128 TO 191) : CharUpper(BYVAL(STRPTR(Buffer3)))
                               Buffer4 = CHR$(192 TO 255) : CharUpper(BYVAL(STRPTR(Buffer4)))
                               
                               Buffer = CHR$(32 TO 63)                         & $TAB & "Source"    & $CRLF & _
                                        Upper(CHR$(32 TO 63))                  & $TAB & "Upper"     & $CRLF & _
                                        asmUpper(CHR$(32 TO 63))               & $TAB & "asmUpper"  & $CRLF & _
                                        Buffer1                                & $TAB & "CharUpper" & $CRLF & _
                                        Translate(CHR$(32 TO 63))              & $TAB & "Translate" & $CRLF & _
                                        UCASE$(CHR$(32 TO 63))                 & $TAB & "UCASE$"    & $CRLF & $CRLF & _
                                        _
                                        CHR$(64 TO 127)                        & $TAB & "Source"    & $CRLF & _
                                        Upper(CHR$(64 TO 127))                 & $TAB & "Upper"     & $CRLF & _
                                        asmUpper(CHR$(64 TO 127))              & $TAB & "asmUpper"  & $CRLF & _
                                        Buffer2                                & $TAB & "CharUpper" & $CRLF & _
                                        Translate(CHR$(64 TO 127))             & $TAB & "Translate" & $CRLF & _
                                        UCASE$(CHR$(64 TO 127))                & $TAB & "UCASE$"    & $CRLF & $CRLF & _
                                        _
                                        CHR$(128 TO 191)                       & $TAB & "Source"    & $CRLF & _
                                        Upper(CHR$(128 TO 191))                & $TAB & "Upper"     & $CRLF & _
                                        asmUpper(CHR$(128 TO 191))             & $TAB & "asmUpper"  & $CRLF & _
                                        Buffer3                                & $TAB & "CharUpper" & $CRLF & _
                                        Translate(CHR$(128 TO 191))            & $TAB & "Translate" & $CRLF & _
                                        UCASE$(CHR$(128 TO 191))               & $TAB & "UCASE$"    & $CRLF & $CRLF & _
                                        _
                                        CHR$(192 TO 255)                       & $TAB & "Source"    & $CRLF & _
                                        Upper(CHR$(192 TO 255))                & $TAB & "Upper"     & $CRLF & _
                                        asmUpper(CHR$(192 TO 255))             & $TAB & "asmUpper"  & $CRLF & _
                                        Buffer4                                & $TAB & "CharUpper" & $CRLF & _
                                        Translate(CHR$(192 TO 255))            & $TAB & "Translate" & $CRLF & _
                                        UCASE$(CHR$(192 TO 255))               & $TAB & "UCASE$"    & $CRLF & _
                                        $CRLF & "To handle International characters, UCASE$ must be from PowerBASIC 8.02 or newer"
                               MessageBox %HWND_DESKTOP, BYCOPY Buffer, _
                                          "Upper and asmUpper won't convert some characters above 127 !", _
                                          %MB_ICONINFORMATION OR %MB_OK
                               
                               Buffer1 = CHR$(224) & CHR$(251 TO 253) & CHR$(255)
                               CharUpper(BYVAL(STRPTR(Buffer1)))
                               Buffer = CHR$(224) & CHR$(251 TO 253) & CHR$(255)           & $TAB & "Source"   & $CRLF & _
                                        Upper(CHR$(224) & CHR$(251 TO 253) & CHR$(255))    & $TAB & "Upper"    & $CRLF & _
                                        asmUpper(CHR$(224) & CHR$(251 TO 253) & CHR$(255)) & $TAB & "asmUpper" & $CRLF & _
                                        Buffer1                                            & $TAB & "CharUpper" & $CRLF & _
                                        Translate(CHR$(224) & CHR$(251 TO 253) & CHR$(255))& $TAB & "Translate" & $CRLF & _
                                        UCASE$(CHR$(224) & CHR$(251 TO 253) & CHR$(255))   & $TAB & "UCASE$"    & $CRLF & $CRLF & _
                                        "Upper and asmUpper won't convert those characters !"                   & $CRLF & _
                                        $CRLF & "Need UCASE$ from PowerBASIC 8.02 or newer"
                               MessageBox %HWND_DESKTOP, BYCOPY Buffer, "Those won't convert", %MB_ICONEXCLAMATION OR %MB_OK
                               
                               
                               'Test speed ------------------------------------------------------------------
                               
                               Buffer1 = REPEAT$(10, CHR$(1 TO 255))
                               LoopEnd = 2000
                               QueryPerformanceFrequency PerfFrequency
                               
                               'Upper - - - - - - - - - - - - -
                               QueryPerformanceCounter PerfStart
                               FOR Looper = 1 TO LoopEnd
                                 Buffer2 = Upper(Buffer1)
                               NEXT
                               QueryPerformanceCounter PerfEnd
                               Message = Message & "Upper : " & $TAB & $TAB & FORMAT$(((PerfEnd - PerfStart) / _
                                                   PerfFrequency), "#,.000000000000000000") & $CRLF
                               
                               'asmUpper - - - - - - - - - - - - -
                               QueryPerformanceCounter PerfStart
                               FOR Looper = 1 TO LoopEnd
                                 Buffer2 = asmUpper(Buffer1)
                               NEXT
                               QueryPerformanceCounter PerfEnd
                               Message = Message & "asmUpper 0-127 : " & $TAB & FORMAT$(((PerfEnd - PerfStart) / _
                                                   PerfFrequency), "#,.000000000000000000") & $CRLF
                               
                               'CharUpper - - - - - - - - - - -
                               QueryPerformanceCounter PerfStart
                               FOR Looper = 1 TO LoopEnd
                                 Buffer2 = Buffer1
                                 CharUpper(BYVAL(STRPTR(Buffer2)))
                               NEXT
                               QueryPerformanceCounter PerfEnd
                               Message = Message & "CharUpper 0-127 : " & $TAB & FORMAT$(((PerfEnd - PerfStart) / _
                                                   PerfFrequency), "#,.000000000000000000") & $CRLF
                               
                               'Translate - - - - - - - - - - -
                               QueryPerformanceCounter PerfStart
                               FOR Looper = 1 TO LoopEnd
                                 Buffer2 = Translate(Buffer1)
                               NEXT
                               QueryPerformanceCounter PerfEnd
                               Message = Message & "Translate : " & $TAB & FORMAT$(((PerfEnd - PerfStart) / _
                                                   PerfFrequency), "#,.000000000000000000") & $CRLF
                               
                               'UCASE$ - - - - - - - - - - - - -
                               QueryPerformanceCounter PerfStart
                               FOR Looper = 1 TO LoopEnd
                                 Buffer2 = UCASE$(Buffer1)
                               NEXT
                               QueryPerformanceCounter PerfEnd
                               Message = Message & "UCASE$ : " & $TAB & FORMAT$(((PerfEnd - PerfStart) / _
                                                   PerfFrequency), "#,.000000000000000000") & $CRLF
                               
                               'Result - - - - - - - - - - - - -
                               MessageBox %HWND_DESKTOP, BYCOPY Message, "Uppercase speed", %MB_ICONINFORMATION OR %MB_OK
                               
                               
                              END FUNCTION
                              '______________________________________________________________________________


                              [This message has been edited by Pierre Bellisle (edited December 12, 2006).]

                              Comment


                              • #16
                                Originally posted by Ian Webling:
                                ... meaning that the granularity would be a multiple of 4 and, as I don't care if it is bigger than 4, it is not important to me.
                                Ian,

                                AFAIK the boundary is always 4 bytes - look this!
                                Code:
                                #COMPILE EXE
                                #DIM ALL
                                
                                FUNCTION PBMAIN () AS LONG
                                    LOCAL text1,text2,text3,text4 AS STRING
                                    LOCAL str1,str2,str3,str4,str5,str6,str7,str8,str9,msg AS STRING
                                    LOCAL ini1,ini2,ini3,ini4,ini5,ini6,ini7,ini8,ini9 AS LONG
                                    
                                    str1 = STRING$(1,32)
                                    str2 = STRING$(2,32)
                                    str3 = STRING$(7,32)
                                    str4 = STRING$(9,32)
                                    str5 = STRING$(255,32)
                                    str6 = STRING$(333,32)
                                    str7 = STRING$(1025,32)
                                    str8 = STRING$(32769,32)
                                    str9 = CHR$(32)
                                    
                                    ini1 = STRPTR(str1)
                                    ini2 = STRPTR(str2)
                                    ini3 = STRPTR(str3)
                                    ini4 = STRPTR(str4)
                                    ini5 = STRPTR(str5)
                                    ini6 = STRPTR(str6)
                                    ini7 = STRPTR(str7)
                                    ini8 = STRPTR(str8)
                                    ini9 = STRPTR(str9)
                                    
                                    text1 = "Lenght / Start of STR"
                                    text2 = "  Distance STR"
                                    text3 = " to STR"
                                    text4 = "  Boundary:"
                                
                                    msg =       text1+"1: "+STR$(LEN(str1))+" / "+HEX$(ini1,8)+text2+"1"+text3+"2:"+STR$(ini2-ini1)+text4+STR$(ini1 MOD 4)+$CRLF
                                    msg = msg + text1+"2: "+STR$(LEN(str2))+" / "+HEX$(ini2,8)+text2+"2"+text3+"3:"+STR$(ini3-ini2)+text4+STR$(ini2 MOD 4)+$CRLF
                                    msg = msg + text1+"3: "+STR$(LEN(str3))+" / "+HEX$(ini3,8)+text2+"3"+text3+"4:"+STR$(ini4-ini3)+text4+STR$(ini3 MOD 4)+$CRLF
                                    msg = msg + text1+"4: "+STR$(LEN(str4))+" / "+HEX$(ini4,8)+text2+"4"+text3+"5:"+STR$(ini5-ini4)+text4+STR$(ini4 MOD 4)+$CRLF
                                    msg = msg + text1+"5: "+STR$(LEN(str5))+" / "+HEX$(ini5,8)+text2+"5"+text3+"6:"+STR$(ini6-ini5)+text4+STR$(ini5 MOD 4)+$CRLF
                                    msg = msg + text1+"6: "+STR$(LEN(str6))+" / "+HEX$(ini6,8)+text2+"6"+text3+"7:"+STR$(ini7-ini6)+text4+STR$(ini6 MOD 4)+$CRLF
                                    msg = msg + text1+"7: "+STR$(LEN(str7))+" / "+HEX$(ini7,8)+text2+"7"+text3+"8:"+STR$(ini8-ini7)+text4+STR$(ini7 MOD 4)+$CRLF
                                    msg = msg + text1+"8: "+STR$(LEN(str8))+" / "+HEX$(ini8,8)+text2+"8"+text3+"9:"+STR$(ini9-ini8)+text4+STR$(ini8 MOD 4)+$CRLF
                                    msg = msg + text1+"9: "+STR$(LEN(str9))+" / "+HEX$(ini9,8)
                                
                                    MSGBOX msg
                                
                                END FUNCTION
                                ------------------
                                Arthur Gomide
                                Como diria nosso profeta da bola, Dadá Maravilha: "Para toda Problemática existe uma Solucionática!"

                                [This message has been edited by Arthur Gomide (edited December 12, 2006).]
                                "The trouble with quotes on the Internet is that you can never know if they are genuine." - Abraham Lincoln.

                                Comment


                                • #17
                                  Pierre,

                                  it is meant, if I understand correctly,
                                  to be able to convert the full range.
                                  You understand correctly but the code doesn't

                                  I think the author assumed that there would be another 26
                                  characters starting at [Char] + 128. See the line below.

                                  ! add ebx, &h1a1a1a1a
                                  Unfortunately there are 31 characters with upper/lower pairs so
                                  only the 26 in the range 'a' + 128 to 'z' + 128 are converted.

                                  As you say - it is very fast for 7-bit ASCII and I'll definitely
                                  use it for that.




                                  ------------------
                                  [SIZE="1"]Reprinted with correections.[/SIZE]

                                  Comment

                                  Working...
                                  X