Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
'PB10 but will work on 9 and maybe even 8 without TXT.xxxxx updating.
#Compile Exe
#Dim All
#Compiler PBWin 10
#Register None
'#DEBUG ERROR ON
Macro putStr(s) 'this basically does PRINT #1, RTRIM$(record). Not optimized much yet
MacroTemp x2,s2,top,top2,gotSize,done,tooBig
Local x2 As Long, s2 As String
x2 = VarPtr(s)
!mov ecx, %MAXwIDTH-1 ;0 thru 99 we use, so -1, tho that is 100 long
!mov eax, x2
top:
!movzx edx, byte ptr[eax+ecx] ;go backward looking for a non-space
!cmp edx, 32 ;is it a space?
!jne short gotSize ;if not, 's our len in ecx
!sub ecx, 1
!jnc short top
Exit Macro 'it's a null string if we get here, so remove it. (u could do $crlf instead to keep it)
gotSize:
!push ebx
!push esi
!mov ebx, L2pos
!mov esi, L2ptr
!add esi, ebx
!lea edx, [ebx+ecx+3] ;is LEN(s2)(in ecx) + 2(len crlf) that 're about to write at L2pos(ebx)...
!cmp edx, 65536 ;gonna fit in line2?
!jnb short tooBig ;jmp if it 't fit
!mov L2pos, edx ;save new L2pos for line2 next write position
!mov byte ptr[esi+ecx+1], &h0d ;cr
!mov byte ptr[esi+ecx+2], &h0a ;lf
top2:
!movzx edx, byte ptr[eax+ecx] ;byte to write to line2
!mov [esi+ecx], dl
!sub ecx, 1
!jc short done
!movzx edx, byte ptr[eax+ecx] ;byte to write to line2
!mov [esi+ecx], dl
!sub ecx, 1
!jc short done
!movzx edx, byte ptr[eax+ecx] ;byte to write to line2
!mov [esi+ecx], dl
!sub ecx, 1
!jc short done
!movzx edx, byte ptr[eax+ecx] ;byte to write to line2
!mov [esi+ecx], dl
!sub ecx, 1
!jc short done
!jmp short top2
done:
!pop esi
!pop ebx
Exit Macro
tooBig:
!pop esi
!pop ebx
!mov ecx, L2pos
!mov eax, line2
!mov [eax-4], ecx
Put$ #1, line2
!mov eax, line2
!mov dword ptr[eax-4], &h10000
' above 5 asm lines do PUT$ #1, LEFT$(line2, L2pos) 67% faster by this asm
s2 = RTrim$(s)
nextPos = Len(s2) + 2
L2pos = 0
Poke$ L2ptr, s2 & $CrLf
L2pos += nextPos
End Macro
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~These values you set before running~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
%FILEScREATED = 1 'set to 1 if your datafile is already created
%MAXwIDTH = 45 'maximum record width of your data
%CPUsPEED = 2463550000 'for timing accuracy, enter your cpu speed tix/sec
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~End values you set before running~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function PBMain () As Long
Local ii3, x, sizeOfA, sizeOfB, L2pos, nextPos, cnt, cnt2, L2ptr, totRecs As Long
Local lineo, line2, line3 As String, rCnt As Long, t, t2 As Quad
Register ii As Long, ii2 As Long
Randomize 8.664418e12
Txt.Window("MergeSort Progress in Seconds",400,300,15,30) To x
line2 = Space$(&h10000) 'string to hold results
L2ptr = StrPtr(line2)
L2pos = 0
rCnt = 0
sizeOfA = Rnd(1127242, 1127442):Incr rCnt 'choose array sizes. Here it makes ~160MB file with ~45 to 100 byte records
sizeOfB = Rnd(1097241, 1097441):Incr rCnt
Tix t
t2 = t\%CPUsPEED
#If %FILEScREATED = 0
Open "words_raw.idx" For Output As #4
#EndIf
ReDim b(sizeOfB) As String * %MAXwIDTH
#If %FILEScREATED
Txt.Print("fileScan";)
Open "words_raw.idx" For Input Access Read Lock Write As #4
FileScan #4, Records To totRecs
Tix t
Txt.Print (t\%CPUsPEED - t2)
sizeOfB = totRecs \ 2
sizeOfA = totRecs - sizeOfB
Decr sizeOfB
Decr sizeOfA
ReDim b(sizeOfB) As String * %MAXwIDTH
For ii = 0 To sizeOfB
Line Input #4, b(ii)
Next
GoTo passFillB
#EndIf
'fill arrays with arbitrary data for demo
Local lineo100 As String * %MAXwIDTH
ReDim bLarr(%MAXwIDTH-1) As Byte At VarPtr(lineo100)
For ii = 0 To sizeOfB 'create test data
lineo100 = " "
For ii2 = 0 To Rnd(45, %MAXwIDTH-1)
bLarr(ii2) = Rnd(65, 67):Incr rCnt 'arbitrary numbers or letters or both
Next
Print #4, RTrim$(lineo100)
If (ii And &h01ffff) = 0 Then 'make a few dupes to be sure code is correct
Print #4, RTrim$(lineo100)
b(ii) = lineo100
Incr ii
If ii > sizeOfB Then Exit For
End If
b(ii) = lineo100
Next
passFillB:
loaded:
Txt.Print("bLoaded ";)
Tix t
Txt.Print (t\%CPUsPEED - t2)
!;===========================================================================================================
!;===========================================================================================================
'ok, now to the important part...
'combine a() and b(), including dupes
Array Sort b() 'sort the 2 arrays one at a time
Kill "pbArrSortTstB.dat"
Open "pbArrSortTstB.dat" For Binary As #2
Txt.Print("bSorted ";)
Tix t
Txt.Print (t\%CPUsPEED - t2)
Put #2,, b()
Txt.Print("bPut ";)
Erase b()
Tix t
Txt.Print (t\%CPUsPEED - t2)
ReDim a(sizeOfA) As String * %MAXwIDTH
#If %FILEScREATED
ReDim a(sizeOfA) As String * %MAXwIDTH 'datafile is present, so read it
For ii = 0 To sizeOfA
Line Input #4, a(ii)
Next
GoTo passFillA
#EndIf
For ii = 0 To sizeOfA 'create test data
lineo100 = " "
For ii2 = 0 To Rnd(45, %MAXwIDTH-1)
bLarr(ii2) = Rnd(65, 67):Incr rCnt 'arbitrary numbers, letters or both
Next
Print #4, RTrim$(lineo100)
If (ii And &h01ffff) = 0 Then 'make a few dupes to be sure code is correct
Print #4, RTrim$(lineo100)
a(ii) = lineo100
Incr ii
If ii > sizeOfA Then Exit For
End If
a(ii) = lineo100
Next
passFillA:
Close #4
Txt.Print("aLoaded ";)
Tix t
Txt.Print (t\%CPUsPEED - t2)
Array Sort a()
Txt.Print("aSorted ";)
ReDim b(sizeOfb) As String * %MAXwIDTH
Seek #2, 1
Get #2,, b()
Tix t
Txt.Print (t\%CPUsPEED - t2)
Txt.Print("merging a&b";)
Close
Kill "pbArrSortTstA&Bsort.txt"
Open "pbArrSortTstA&Bsort.txt" For Binary As #1
ii = 0: ii2 = 0 'reset indexes
Do 'and here is the merge algo
'-----------------------uncomment these 2 lines if you want match to be case insensitive-----------------
' a(ii) = LCASE$(a(ii)) 'note: not optimized. will slow merge algorithm
' b(ii2) = LCASE$(b(ii2))
'-------------------end uncomment these 2 lines if you want match to be case insensitive-----------------
If a(ii) < b(ii2) Then
putStr(a(ii)) 'a() record is smaller so save it in line2
Incr ii 'next a()
If ii > sizeOfA Then 'reached end of a() so write out the rest of b()
For x = ii2 To sizeOfB
putStr(b(x))
Next
Exit Do
End If
Else
putStr(b(ii2)) 'b() is smaller so save it in line2
Incr ii2 'next b()
If ii2 > sizeOfB Then 'reached end of b() so write out the rest of a()
For x = ii To sizeOfA
putStr(a(x))
Next
Exit Do
End If
End If
Loop 'loop until we are past end of a()
Put$ #1, Left$(line2, L2pos)
Close
Tix t
Txt.Print (t\%CPUsPEED - t2)
? "done"
End Function
'gbs_01213
'Date: 05-11-2013
http://www.garybeene.com/sw/gbsnippets.htm