|
Многопоточность
|
|
| haav | Дата: Вторник, 09.01.2018, 09:31 | Сообщение # 16 |
 Генералиссимус
Группа: Администраторы
Сообщений: 1373
Статус: Offline
| Цитата TimurAR (  ) Некоторые блоки обрабатываются неверно.
Ты опять используешь общие данные для всех потоков (в данном случае общими данными у тебя выступают массивы m1 , m2 , m3). Я уже писал, что в потоках без мьютексов не должно быть общих данных, иначе данные затираются.
-------------------
Я взял код из 3 поста без потоков:
Код Dim Pfile1 As String*260
Dim Pfile2 As String*260
Dim As Integer i,moi
Dim bsim As UByte
Dim m1(0 To 10) As UByte
Dim m2(0 To 10) As UByte
Dim Shared m3(0 To 10) As UByte
Const MAX_THREADS = 4
Dim Shared As Any Ptr ttylock
Data 13,11,7,9,3,5,19,17,27,23
For i=1 To 10
Read m3(i)
Next
Sub Proced(m1() As UByte,m2() As UByte,ByVal moi As Integer)
Dim i As Integer
For i=1 To 10
m2(i)=(m1(i)*moi+m3(i)) Mod 256
Next
End Sub
Open "1.txt" For Binary Access Read As #1 'файл содержит 40 байт
Open "2.txt" For Binary Access Write As #2
Dim As Double t1,t2,t3
While EOF(1)=0
moi=1
Var t0 = Timer
While Eof(1)=0 And moi<10
Get #1,,bsim
m1(moi)=bsim
moi=moi+1
Wend
t1 += Timer-t0
t0 = Timer
Proced(m1(),m2(),moi)
t2 += Timer-t0
t0 = Timer
For i=1 To 10
Put #2,,m2(i)
Next
t3 += Timer-t0
Wend
Close #1
Close #2
? t1
? t2
? t3
sleep
и замерил время:
Цитата 0.008090525685435335
0.0001077625589820386
0.00103849691991309
Как видишь, время на обработку данных при размере файла 12кб в 10 раз быстрее чем на любую операцию чтения или записи файла. Возможно реальный алгоритм обработки данных совсем другой...
Если честно я не вижу смысла в потоках при таком алгоритме, как ты написал в первом посте и пытаешься его реализовать на практике:
Цитата - читаем блоками данные из первого файла в массив
- через процедуру производим манипуляции с данными массива и сохраняем полученный результат в другой массив
- сохраняем полученный массив во второй файл
При этом алгоритме , всегда скорость будет не выше, чем (скорость чтения файла + скорость обработки данных + скорость записи файла) * (на кол-во разделенных обрабатываемых данных) . Потоки тут не помогут , поскольку сам алгоритм все равно остается линейным.
Я предлагал решение , когда считывается сразу весь файл , потом обрабатывается в потоках, потом пишется. В этом случае потоки имеют место. В крайнем случае можно при очень большом размере файла поделить его на несколько частей (скажем файл 500 мб , делим на 5 частей по 100 мб) и каждую часть опять же грузим полностью, обрабатываем и сохраняем. Алгоритм в данном случае для большого буфера такой:
Получаем весь файл или большую его часть в большой буфер (buf)
Если обрабатываем в процедуре только по 10 байт , то
отсылаем в 1 поток указатель на данные 0....9 (buf + 0)
отсылаем во 2 поток указатель на данные 10....19 (buf + 10)
отсылаем в 3 поток указатель на данные 20....29 (buf + 20)
отсылаем в 4 поток указатель на данные 30....39 (buf + 30 )
отсылаем во 5 поток указатель на данные 40....49 (buf + 40 )
отсылаем в 6 поток указатель на данные 50....59 (buf + 50 )
......
ждем когда все потоки завершатся и сохраняем буфер полностью в файл.
Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
|
| |
| |
| haav | Дата: Вторник, 09.01.2018, 11:35 | Сообщение # 17 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 1373
Статус: Offline
| Вот я написал простенький пример с многопоточностью:
Код #Include "file.bi"
Const maxthreads = 100
Dim As Any Ptr handles(maxthreads)
Dim bGetData As Byte Ptr ' буфер для получения всего файла
Dim sFileNameRead As String = "1.txt" ' имя файла для чтения
Dim sFileNameWrite As String = "2.txt" ' имя файла для записи
Dim iLength As Integer ' длина файла
iLength = FileLen(sFileNameRead)
bGetData = Callocate (iLength+10)
Sub theardproc(p As Byte Ptr)
Dim As UByte bm(9) = {13,11 ,7,9,3,5,19,17,27,23}
For i As Integer = 0 To 9
p[i] Xor= bm(i)
Next
End Sub
Dim As Integer pFileRead , pFileWrite
pFileRead = FreeFile
Open sFileNameRead For Binary Access Read As #pFileRead
pFileWrite = FreeFile
Open sFileNameWrite For Binary Access Write As #pFileWrite
Get #pFileRead,,*bGetData , iLength
Dim As Integer j
For i As Integer = 0 To iLength-1 Step 10
handles (j) = ThreadCreate (Cast(Any Ptr,@theardproc()) , bGetData+i)
j+=1
If j > maxthreads Then
For i As Integer = 0 To maxthreads
If handles (i) <> 0 Then
ThreadWait(handles (i))
Else
Exit for
EndIf
Next
j = 0
EndIf
Next
If j Then
For i As Integer = 0 To j
If handles (i) <> 0 Then
ThreadWait(handles (i))
Else
Exit for
EndIf
Next
EndIf
put #pFileWrite,,*bGetData , iLength
Close #pFileRead
Close #pFileWrite
Данный пример читает файл , шифрует данные и сохраняет во второй файл. Если зашифрованный файл снова обработать программой, то файл расшифруется. TimurAR , я надеюсь , что это поможет хоть немного тебе понять принцип. В процедуре theardproc должен быть реально серьезный алгоритм обработки данных , а не как у меня "пару команд" , иначе многопоточность не имеет смысла!
Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
|
| |
| |
| TimurAR | Дата: Вторник, 09.01.2018, 20:49 | Сообщение # 18 |
|
Рядовой
Группа: Пользователи
Сообщений: 14
Статус: Offline
| Ответа в сообщении №17 сперва не заметил и написал ниже следующее:
Перечитав сообщения выше, стало понятно что надо сделать как в данном совете
Цитата haav ( ) 2a) Делим длину файла на нужное кол-во частей. Например если файл размером 1000 байт, то поделив на 10 частей , мы отправляем в поток указатель на каждую часть типа bPtr+0 , bPtr+100 , bPtr + 200 , и т.д. Однако я думаю, что размер файла заранее неизвестен , поэтому лучше создать структуру вроде такой:
Код
Type TData
As Byte Ptr bPtr ' указатель на часть данных
As Long iLen ' длина этих данных
End Type
и уже деля общую длину на определенное кол-во байт , заполнять структуру с указанием адреса и длины каждого куска. Затем указатель на структуру отправлять в поток. Придется выделять память под каждую структуру перед отправкой указателя в многопоточную процедуру , а в самой процедуре можно освобождать память указателя.
3) Сохраняем в файл опять же весь блок данных целиком
Видоизменил программу так
Код Dim Pfile1 As String*260
Dim Pfile2 As String*260
Dim As Integer a,moi,i,c
Dim As UByte b
Dim iii As Integer Ptr
Dim As Integer bb1,bb2
Dim As Double ttt
Dim bsim As UByte
Const M_T = 20
Const M_B = 10
Dim As UByte m1(0 To 200)
Dim As UByte m2(0 To 200)
Dim As UByte m3(0 To 200)
Dim As UByte idl(0 To 20)
Dim As Integer ii
Type tM
mm1 As UByte Ptr
mm2 As UByte Ptr
mm3 As UByte Ptr
idlm As UByte Ptr
iim As Integer Ptr
End Type
Dim As tM Ptr tMM = New tM
Dim Shared As Any Ptr ttylock
Dim As Any Ptr handles(0 To M_T-1)
'Этот массив пока временно не использую
Data 13,11,7,9,3,5,19,17,27,23
For a=1 To 10
Read m3(a)
Next
'=====================================================
Sub Proced(MM As tM Ptr)
Dim As Integer a, b,c
b=MM->iim
c=MM->idlm[0]
For a=0 To c-1
MM->mm2[a]=(MM->mm1[a]) Mod 256'Пока без преобразований для отслеживания адекватности
Next
Sleep 500'Замена реальных действтй
End Sub
'=====================================================
Open "File1.txt" For Binary Access Read As #1
Open "File2.txt" For Binary Access Write As #2
While EOF(1)=0'- - - - - -
ttt=Timer
'читаю файл
For i=0 To 19
moi=1
While Eof(1)=0 And moi<11
Get #1,,bsim
m1(moi-1+i*10)=bsim
moi=moi+1
Wend
ii=i
If moi>1 Then bb1=i:idl(i)=moi-1
Next
'ставлю указатель на область памяти и отправляю в поток
For i=0 To bb1
tMM->mm1=@m1(i*10)
tMM->mm2=@m2(i*10)
tMM->idlm=@idl(i)
tMM->iim=@ii
If idl(i)>0 Then handles(i) = ThreadCreate(@Proced,tMM)
Next
'Жду завершения потоков
For i = 0 To bb1
If handles(i) <> 0 Then
ThreadWait(handles(i))
End If
Next
Print Timer-ttt
'Записываю в файл
For i = 0 To bb1
c=idl(i)
For a=1 To c
b=m2(a-1+i*10)
Put #2,,b
Next
Next
Wend'- - - - - - - - - -
Close #1
Close #2
Print "Gotovo"
Sleep
Но что то делаю не так. Часть данных испорчена. Ясно что указатель надо создавать перед отправлением в поток и удалять после потока, но как это сделать непонятно.
После прочтения сообщения №17
Спасибо за пример с многопоточностью. В первом коде в процедуре забыл поставить "Sleep 500" в замен реальных действий.
Буду вникать и пробовать вписать в базовый код.
Как привязать архив сюда?
Сообщение отредактировал TimurAR - Вторник, 09.01.2018, 22:18 |
| |
| |
| TimurAR | Дата: Воскресенье, 14.01.2018, 08:33 | Сообщение # 19 |
|
Рядовой
Группа: Пользователи
Сообщений: 14
Статус: Offline
| Понял в чем проблема.
В последнем коде у меня проблема в переменной "iim" отвечающей за номер потока, так как область памяти для этой переменной в разных потоках использовалась одна и та же.
Для передачи трех массивов, номера потока и длинны фрагмента все разместил в (колбасу) один массив, разбитый на участки по 50 элементов.
Так как третий массив не изменяется, то и область памяти он занимает одну, а обращаюсь к ней исходя из номера потока.
Код Dim Pfile1 As String*260
Dim Pfile2 As String*260
Dim As Integer a,moi,i,c
Dim As UByte b
Dim As Integer bb1
Dim As Double ttt
Dim buff As UByte Ptr
Dim bsim As UByte
Const M_T = 20
Const M_B = 10
buff=Callocate(1001, SizeOf(UByte))
Dim Shared As Any Ptr ttylock
Dim As Any Ptr handles(0 To M_T-1)
Data 13,11,7,9,3,5,19,17,27,23
For a=1 To 10
Read buff[990+a]
Next
'=====================================================
Sub Proced(buff2 As UByte Ptr)' As tM Ptr)
Dim As Integer a,b,c
Dim As Integer ind
b=buff2[30]
c=buff2[31]
ind=990-b*50
For a=0 To c-1
buff2[10+a]=(buff2[a]+buff2[ind+a])Mod 256
'buff2[10+a]=(buff2[a]-buff2[ind+a]+256)Mod 256
Next
Sleep 500
End Sub
'=====================================================
Open "File1.txt" For Binary Access Read As #1
Open "File2.txt" For Binary Access Write As #2
While EOF(1)=0'- - - - - -
ttt=Timer
bb1=0
'читаю данные
For i=0 To 19
moi=1
While Eof(1)=0 And moi<11
Get #1,,bsim
buff[moi-1+i*50]=bsim
moi=moi+1
Wend
If moi>1 Then bb1=i:buff[31+i*50]=moi-1
Next
'сохраняю номер потока и отправляю в поток
For i=0 To bb1
buff[30+i*50]=i
If buff[31+i*50]>0 Then handles(i) = ThreadCreate(Cast(Any Ptr,@Proced()),buff+i*50)
Next
'Ожидание завершения потоков
For i = 0 To bb1
If handles(i) <> 0 Then ThreadWait(handles(i))
Next
Print Timer-ttt
'Запись в файл
For i = 0 To bb1
c=buff[31+i*50]
For a=0 To c-1
b=buff[10+a+i*50]
Put #2,,b
Next
Next
Wend'- - - - - - - - - -
Close #1
Close #2
Print "Gotovo"
Sleep
Все работает, еще один вопрос остался. При запуске программы некоторые части цикла обрабатываются довольно долго, судя по всему это связано с ожиданием завершения работы отдельных потоков.
 
Еще раз спасибо "haav".
Все, тестовый код работает теперь буду внедрять в базовый, прошу прощения но его выложить не могу.Добавлено (14.01.2018, 08:33)
---------------------------------------------
Вот код из сообщения №13 с использованием глобальных массивов.
Код Dim Pfile1 As String*260
Dim Pfile2 As String*260
Dim As Integer a,moi,i
Dim As Integer bb1,bb2
Dim As Double ttt
Dim bsim As UByte
Const M_T = 20
Const M_B = 10
Dim Shared m1(0 To 200) As UByte
Dim Shared m2(0 To 200) As UByte
Dim Shared m3(1 To 10) As UByte ={10,27,4,5,8,25,6,28,2,92}
Dim Shared idl(0 To 20) As Integer
Dim Shared iii(0 To 20) As Integer
Dim Shared As Any Ptr ttylock
Dim As Any Ptr handles(0 To M_T-1)
'- - - - - - - - - - - - - - - - - - - - - - -
Sub Proced(ByVal ii As Integer)
Dim a As Integer
For a=1 To idl(ii)
m2(a+ii*10)=(m1(a+ii*10)-m3(a)+256) Mod 256
Next
Sleep 500
End Sub
'- - - - - - - - - - - - - - - - - - - - - - -
Open "File3.txt" For Binary Access Read As #1
Open "File2.txt" For Binary Access Write As #2
While EOF(1)=0'- - - - - -
ttt=timer
For i=0 To 19
moi=1
While Eof(1)=0 And moi<11
Get #1,,bsim
m1(moi+i*10)=bsim
moi=moi+1
Wend
iii(i)=i
If moi>1 Then bb1=i:idl(i)=moi-1:handles(i) = ThreadCreate(Cast(Any Ptr,@Proced()),Cast(Any Ptr,iii(i)))
Next
For i = 0 To bb1
If handles(i) <> 0 Then
ThreadWait(handles(i))
End If
Next
Print Timer-ttt
For i = 0 To bb1
For a=1 To idl(i)
If bb1>=i And a<=idl(i) Then Put #2,,m2(a+i*10)
Next
Next
Wend'- - - - - - - - - -
Close #1
Close #2
Print "Gotovo"
Sleep
Как я и писал проблема была в передаче номера потока. Как только я стал передавать элемент массива с номером потока, проблема решилась.
Сообщение отредактировал TimurAR - Четверг, 11.01.2018, 21:58 |
| |
| |
|
