BBCruncher V3.0 (FilePacker) zum Download bereit!

Anwendungen, Tools, Userlibs und anderes nützliches.
Antworten
Benutzeravatar
al90
Beiträge: 1103
Registriert: 06.01.2005 23:15
Kontaktdaten:
Kontaktdaten von al90

Beitrag von al90 »

@ts-soft

Achso das meinst Du. :lol:
Sorry wenn ich jetzt lachen muss, aber darauf wäre ich nie gekommen. Im ernst.
Ich dachte eher an sowas wie daß das HauptFenster nicht mit verkleinert
wird wenn man das neue minimiert. Also nix für ungut. Ist schon ok, ich
werde es mir für die nächste version merken. :wink:

@Andre

Jauw danke Dir dafür. :allright:
Hab mich schon gewundert warum es am selben platz blieb. Die option
muss ich irgendwie übersehen haben. :oops:
Nach oben
Benutzeravatar
al90
Beiträge: 1103
Registriert: 06.01.2005 23:15
Kontaktdaten:
Kontaktdaten von al90

Beitrag von al90 »

So habe jetzt mal was vorbereitet. Dies ist aber erstmal nur eine der
rechenintensiven Routinen des Crunchers. Zur Erklärung:
Die Procedure sucht den häufigst vorkommenden 16-Bit wert inerhalb
eines Speicherbereiches und gibt diesen dann mittels ProcReturn zurück.
Das war's eigentlich auch schon. Bin mal gepannt ob noch jemand
was "rauskitzeln" kann. Was mich betrifft, so weis ich nicht mehr weiter. :?

Code: Alles auswählen

Procedure.l FindMostWords(Mem,Length)
Dim founds.w(65535)
For z=0 To Length-1
  bits=PeekW(Mem+z) & $FFFF
  founds.w(bits)+1
  If founds.w(bits)>summe:summe=founds.w(bits):word=bits:EndIf
  If PeekW(Mem+z+1) & $FFFF=bits:z+1:EndIf
Next
ProcedureReturn word
EndProcedure

filesize=1048576 ; 1MB durchsuchen!
Memory=AllocateMemory(filesize)

For i=0 To filesize-1:PokeB(Memory+i,255):Next ; Memory mit $FF Füllen!

StartTime = ElapsedMilliseconds()
word=FindMostWords(Memory,filesize)
ElapsedTime = ElapsedMilliseconds()-StartTime 
MessageRequester("Info","Benötigte Zeit: "+Str(ElapsedTime/1000)+" Sekunden!"+Chr(13)+"Häufigster 16Bit-Wert = $"+Hex(word),#MB_OK|#MB_ICONINFORMATION)
Nach oben
Friedhelm
Beiträge: 43
Registriert: 29.08.2004 08:50

Beitrag von Friedhelm »

al90 hat geschrieben:So habe jetzt mal was vorbereitet. Dies ist aber erstmal nur eine der
rechenintensiven Routinen des Crunchers. Zur Erklärung:
Die Procedure sucht den häufigst vorkommenden 16-Bit wert inerhalb
eines Speicherbereiches und gibt diesen dann mittels ProcReturn zurück.
Das war's eigentlich auch schon. Bin mal gepannt ob noch jemand
was "rauskitzeln" kann. Was mich betrifft, so weis ich nicht mehr weiter. :?

Code: Alles auswählen

Procedure.l FindMostWords(Mem,Length)
Dim founds.w(65535)
For z=0 To Length-1
  bits=PeekW(Mem+z) & $FFFF
  founds.w(bits)+1
  If founds.w(bits)>summe:summe=founds.w(bits):word=bits:EndIf
  If PeekW(Mem+z+1) & $FFFF=bits:z+1:EndIf
Next
ProcedureReturn word
EndProcedure

filesize=1048576 ; 1MB durchsuchen!
Memory=AllocateMemory(filesize)

For i=0 To filesize-1:PokeB(Memory+i,255):Next ; Memory mit $FF Füllen!

StartTime = ElapsedMilliseconds()
word=FindMostWords(Memory,filesize)
ElapsedTime = ElapsedMilliseconds()-StartTime 
MessageRequester("Info","Benötigte Zeit: "+Str(ElapsedTime/1000)+" Sekunden!"+Chr(13)+"Häufigster 16Bit-Wert = $"+Hex(word),#MB_OK|#MB_ICONINFORMATION)
Mein vorschag

Code: Alles auswählen

Procedure.l FindMostWordsNeu(Mem,Length) 
Dim founds.w(65535)
 
For z=Mem To Mem + Length-1 ;mur einmal Brchnung 
  bits=PeekW(z)& $FFFF 
  found=founds(bits)+1; : found= founds(bits) 
  If found >summe
    summe=found
    word=bits
  EndIf 
  
  Gleche_wie_zu_vor:
  If PeekW(z+1) & $FFFF = bits
    z+1
  Goto Gleche_wie_zu_vor:
  EndIf 
  
Next 
ProcedureReturn word 
EndProcedure 



filesize=1048576 ; 1MB durchsuchen! 
Memory=AllocateMemory(filesize) 

For i=0 To filesize-1:PokeB(Memory+i,255):Next ; Memory mit $FF Füllen! 


StartTime = ElapsedMilliseconds() 
For i= 1 To 1000
word=FindMostWordsNeu(Memory,filesize) 
Next
ElapsedTime = ElapsedMilliseconds()-StartTime 

MessageRequester("Info","Benötigte Zeit: "+Str(ElapsedTime/1000)+" Sekunden!"+Chr(13)+"Häufigster 16Bit-Wert = $"+Hex(word),#MB_OK|#MB_ICONINFORMATION) 


For i=0 To filesize-1:PokeB(Memory+i,Random(255)):Next ; Memory mit $FF Füllen! 


StartTime = ElapsedMilliseconds() 
For i= 1 To 1000
word=FindMostWordsNeu(Memory,filesize) 
Next
ElapsedTime = ElapsedMilliseconds()-StartTime 

MessageRequester("Info","Benötigte Zeit: "+Str(ElapsedTime/1000)+" Sekunden!"+Chr(13)+"Häufigster 16Bit-Wert = $"+Hex(word),#MB_OK|#MB_ICONINFORMATION)
Nach oben
Benutzeravatar
al90
Beiträge: 1103
Registriert: 06.01.2005 23:15
Kontaktdaten:
Kontaktdaten von al90

Beitrag von al90 »

Hallo Friedhelm,

Da gibt es noch einen fehler.

Code: Alles auswählen

 [...]
  Gleche_wie_zu_vor: 
  If PeekW(z+1) & $FFFF = bits 
    z+1 
  Goto Gleche_wie_zu_vor: 
  EndIf
müsste aber normalerweise noch "founds.w(bits)+1" mit da zwichen,
da Du sonst nur ganze bereiche überspringen würdest ohne den
wert weiter hoch zu zählen. Ich hatte es mal angepasst und getestet,
aber leider war's auch nicht schneller wie meine jetzige methode.

Trotzdem Danke für den versuch. :allright:
Nach oben
Benutzeravatar
MLK
Beiträge: 267
Registriert: 01.11.2004 13:17
Wohnort: Hamburg

Beitrag von MLK »

ok..
nachdem ich gestern morgen völlig übernächtigt schon mal einen code postete, ihn aber kurz danach wegen fehlern zurückzog, hier nun mein vorläufiges ergebnis.
es liefert nach ausgiebigen tests genau die gleichen werte zurück, wie die originalprozedur, ist aber mehr als 30 mal schneller. leider funktioniert das ganze nur mit dateien bis zu einer größe von 65535 Bytes. möge jemand der sich damit auskennt mir dieses verhalten erklären. auch auf sonstige fehler/verbesserungen würde ich gerne hingewiesen werden. ansonsten war es eine herausforderung, die ich nicht gedacht hätte soweit zu meistern :-)

Code: Alles auswählen

Procedure.l FindMostWords(Mem,Length) 
   Dim founds.w(65535) 
;    For z=0 To Length-1 
;       bits=PeekW(Mem+z) & $FFFF 
;       founds.w(bits)+1 
;       If founds.w(bits)>summe
;          summe=founds.w(bits)
;          word=bits
;       EndIf 
;       If PeekW(Mem+z+1) & $FFFF=bits
;          z+1
;       EndIf
;    Next 
	
	;zum testen, genau wie FindMostWords2() rückwärts suchen lassen, um bei 
	;gleichen vorkommen von werten keine unterschiedlichen ergebnisse zu bekommen
   For z=Length-1 To 0 Step -1
      bits=PeekW(Mem+z) & $FFFF 
      founds.w(bits)+1 
      If founds.w(bits)>summe
         summe=founds.w(bits)
         word=bits
      EndIf 
      If PeekW(Mem+z-1) & $FFFF=bits
         z-1
      EndIf
   Next 

   ProcedureReturn word 
EndProcedure 

Procedure FindMostWords2(*Mem.l) 
	!Mem 		equ esp
	!Result equ esp + 4
	!Len		equ esp + 8
	!Founds equ esp + 12

	;-#

	!if ~ defined _PB_AllocateMemory@4 | defined @f
		!extrn _PB_AllocateMemory@4
		!@@:
	!end if
	;
	!if ~ defined _PB_FreeMemory@4 | defined @f
		!extrn _PB_FreeMemory@4
		!@@:
	!end if
	;
	!if ~ defined _PB_Memory_Heap | defined @f
		!extrn _PB_Memory_Heap
		!@@:
	!end if
  ;
	!if ~ defined _HeapSize@12 | defined @f
		!extrn _HeapSize@12
		!@@:
	!end if
	
	;-#
	
	;Len herausfinden
	!MOV	Eax, dword [Mem]
	!OR		Eax, Eax
	!JNZ	@f
  ProcedureReturn -1
	!@@:
	!PUSH	Eax
	!PUSH	0
	!PUSH	dword [_PB_Memory_Heap]
	!CALL	_HeapSize@12
	!CMP	Eax, 0
	!JA		@f
  ProcedureReturn -1
	!@@:  
	!MOV	dword [Len], Eax
	
	;*founds = AllocateMemory(65535 * #SizeOf_Long)
	!PUSH 65535 * 4
	!CALL _PB_AllocateMemory@4	
	!MOV 	dword [Founds], Eax

	;Ecx = *Mem + Len
	!MOV Ecx, dword [Mem]
	!ADD Ecx, dword [Len]
	
	;Edx = summe.l
	!MOV Edx, 0
	
	;-#

	!DEC	Ecx	;um bei der ersten abfrage nicht den speicherbereich zu überschreiten
	
	!@@:
		!DEC		Ecx
		!CMP		Ecx, dword [Mem]
		!JL			@f
		!MOVSX	Eax, word [Ecx]			;Eax = Bits = PeekW(*Mem + übrigeLen)				
		!AND		Eax, $FFFF					;Bits = Bits & $FFFF
		!MOV		Ebx, Eax						;backup für evtl neues result
		!SHL		Eax, 2							;Bits * #SizeOf_Long
		!ADD		Eax, dword [Founds]	;Bits + *Founds
		!INC		dword [Eax]					;-->*Founds+(Bits*#SizeOf_Long)\l + 1
		!CMP		dword [Eax], Edx			
		!JLE		@b									;if *Founds+(Bits*#SizeOf_Long)\l > summe THEN:
		!INC		Edx									;summe + 1
		!MOV		dword [Result], Ebx	;neues result
		!JMP		@b
	!@@:		
	
	;-#
	
	!PUSH   dword [Founds]
	!CALL   _PB_FreeMemory@4  

	ProcedureReturn Result	
	!Restore Mem
	!Restore Len
	!Restore Result
	!Restore Founds
EndProcedure 


;-#


filesize =  65535	;crash ab 65536
Memory   =  AllocateMemory(filesize) 

For i = 0 To filesize 
	PokeB(memory + i, Random($FF))
Next

StartTime   =   ElapsedMilliseconds() 
word        =   FindMostWords(Memory,filesize) 
ElapsedTime =   ElapsedMilliseconds()-StartTime 

StartTime   =  	ElapsedMilliseconds() 
word2       =  	FindMostWords2(Memory) 
ElapsedTime2=  	ElapsedMilliseconds()-StartTime 

MessageRequester("Info","Benötigte Zeit: " + Str(ElapsedTime) + " ms!"+Chr(13)+"Häufigster 16Bit-Wert = $"+Hex(word) + #CRLF$ + Str(ElapsedTime2) + " ms!"+Chr(13)+"Häufigster 16Bit-Wert = $"+Hex(word2),#MB_OK|#MB_ICONINFORMATION)
(die einrückungen sind hier leider wieder total daneben, liegt aber irgendwie an der PB-IDE, denn mit japbe hatte ich das problem nie)


Edit: code korrigiert. dürfte dadurch auch noch mal schneller laufen.
Zuletzt geändert von MLK am 11.10.2005 13:32, insgesamt 1-mal geändert.
Nach oben
Friedhelm
Beiträge: 43
Registriert: 29.08.2004 08:50

Beitrag von Friedhelm »

@MLK
Ich messe etwa doppelt schnell??? :? :? :? :?

Code: Alles auswählen

Procedure.l FindMostWords(Mem,Length) 
   Dim founds.w(65535) 
   For z=0 To Length-1 
      bits=PeekW(Mem+z) & $FFFF 
      founds.w(bits)+1 
      If founds.w(bits)>summe 
         summe=founds.w(bits) 
         word=bits 
      EndIf 
      If PeekW(Mem+z+1) & $FFFF=bits 
         z+1 
      EndIf 
   Next 
    
;   zum testen, genau wie FindMostWords2() rückwärts suchen lassen, um bei 
;   gleichen vorkommen von werten keine unterschiedlichen ergebnisse zu bekommen 
;    For z=Length-1 To 0 Step -1 
;       bits=PeekW(Mem+z) & $FFFF 
;       founds.w(bits)+1 
;       If founds.w(bits)>summe 
;          summe=founds.w(bits) 
;          word=bits 
;       EndIf 
;       If PeekW(Mem+z-1) & $FFFF=bits 
;          z-1 
;       EndIf 
;    Next 

   ProcedureReturn word 
EndProcedure 

Procedure FindMostWords2(*Mem.l) 
   !Mem       equ esp 
   !Result equ esp + 4 
   !Len      equ esp + 8 
   !Founds equ esp + 12 

   ;-# 

   !if ~ defined _PB_AllocateMemory@4 | defined @f 
      !extrn _PB_AllocateMemory@4 
      !@@: 
   !end If 
   ; 
   !if ~ defined _PB_FreeMemory@4 | defined @f 
      !extrn _PB_FreeMemory@4 
      !@@: 
   !end If 
   ; 
   !if ~ defined _PB_Memory_Heap | defined @f 
      !extrn _PB_Memory_Heap 
      !@@: 
   !end If 
  ; 
   !if ~ defined _HeapSize@12 | defined @f 
      !extrn _HeapSize@12 
      !@@: 
   !end If 
    
   ;-# 
    
   ;Len herausfinden 
   !MOV   Eax, dword [Mem] 
   !OR      Eax, Eax 
   !JNZ   @f 
  ProcedureReturn -1 
   !@@: 
   !PUSH   Eax 
   !PUSH   0 
   !PUSH   dword [_PB_Memory_Heap] 
   !CALL   _HeapSize@12 
   !CMP   Eax, 0 
   !JA      @f 
  ProcedureReturn -1 
   !@@:  
   !MOV   dword [Len], Eax 
    
   ;*founds = AllocateMemory(65535 * #SizeOf_Long) 
   !PUSH 65535 * 4 
   !CALL _PB_AllocateMemory@4    
   !MOV    dword [Founds], Eax 

   ;Ecx = *Mem + Len 
   !MOV Ecx, dword [Mem] 
   !ADD Ecx, dword [Len] 
    
   ;Edx = summe.l  (mit dx = summe.w gehts noch schneller) 
   !MOV Edx, 0 
    
   ;-# 

   !DEC   Ecx   ;um bei der ersten abfrage nicht den speicherbereich zu überschreiten 
    
   !@@: 
      !DEC      Ecx 
      !CMP      Ecx, dword [Mem] 
      !JL         @f 
      !MOVSX   Eax, word [Ecx]         ;Eax = Bits = PeekW(*Mem + übrigeLen)             
      !AND      Eax, $FFFF               ;Bits = Bits & $FFFF 
      !MOV      Ebx, Eax                  ;backup für evtl neues result 
      !SHL      Eax, 2                     ;Bits * #SizeOf_Long 
      !ADD      Eax, dword [Founds]   ;Bits + *Founds 
      !INC      word [Eax]               ;-->*Founds+(Bits*#SizeOf_Long)\w + 1 
      !MOVSX   Eax, word [Eax] 
      !CMP      Eax, Edx          
      !JLE      @b                           ;if *Founds+(Bits*#SizeOf_Long)\w > summe THEN: 
      !INC      Edx                           ;summe + 1 
      !MOV      dword [Result], Ebx   ;neues result 
      !JMP      @b 
   !@@:       
    
   ;-# 
    
   !PUSH   dword [Founds] 
   !CALL   _PB_FreeMemory@4  

   ProcedureReturn Result    
   !Restore Mem 
   !Restore Len 
   !Restore Result 
   !Restore Founds 
EndProcedure 


;-# 


filesize =  65535   ;crash ab 65536 
Memory   =  AllocateMemory(filesize) 

For i = 0 To filesize 
   PokeB(memory + i, Random($FF)) 
Next 

StartTime   =   ElapsedMilliseconds() 
For i= 1 To 16 * 1024
word        =   FindMostWords(Memory,filesize) 
Next

ElapsedTime =   ElapsedMilliseconds()-StartTime

StartTime   =     ElapsedMilliseconds() 
For i= 1 To 16*1024
word2       =     FindMostWords2(Memory) 
Next
ElapsedTime2=     ElapsedMilliseconds()-StartTime 

MessageRequester("Info","Benötigte Zeit: " + Str(ElapsedTime) + " ms!"+Chr(13)+"Häufigster 16Bit-Wert = $"+Hex(word) + #CRLF$ + Str(ElapsedTime2) + " ms!"+Chr(13)+"Häufigster 16Bit-Wert = $"+Hex(word2),#MB_OK|#MB_ICONINFORMATION)
Nach oben
Benutzeravatar
al90
Beiträge: 1103
Registriert: 06.01.2005 23:15
Kontaktdaten:
Kontaktdaten von al90

Beitrag von al90 »

Jauw Danke! :allright:
Ich werd's mal testen und dann teile ich Euch das ergebniss mit. :wink:

Nachtrag:
------------

So, nachdem ich und MLK es genaustens getestet haben, kamen wir zu dem
schluss das es nur geringfügig schneller war. Das zeigt wohl auch wie gut
optimiert und Assembler nahe PB seine Codes Compiliert. Da bleibt kaum
noch "luft" für eigene optimierungen. Deshalb muss ich mich wohl etwas
anderes ausdenken um es noch schneller zu bekommen. Jetzt steht
jedenfalls erstmal die ArchiveVersion 2.9 so gut wie in den startlöchern,
und mit der 3.0 werde ich mir etwas mehr zeit lassen um verschiedene
möglichkeiten auszutesten.
Nach oben
Benutzeravatar
al90
Beiträge: 1103
Registriert: 06.01.2005 23:15
Kontaktdaten:
Kontaktdaten von al90

Beitrag von al90 »

V2.9
-----
- Updated: CrunchEngine (SourceCode) für BlitzBasic läuft nun 60%+ schneller.
- Updated: CrunchEngine, DeCrunchEngine & ExtractEngine (SourceCodes) für BlitzMax Optimiert.
- Hinzugefügt: BlitzPlus hat nun eigene Engines (SourceCodes) und benutzt das BlitzPlus GUI.
- Hinzugefügt: DeCrunchFromMemoryEngine & ExtractFromMemoryEngine für PureBasic.
- Updated: Alle DeCrunchEngines & ExtractEngines für PureBasic laufen jetzt ca 35% schneller.
- Updated: CruncherEngine.DLL ist nun ebenfalls um einiges schneller beim DeCrunchen/Extracten.
- Einige Fixes im GUI Cruncher.
Nach oben
Benutzeravatar
al90
Beiträge: 1103
Registriert: 06.01.2005 23:15
Kontaktdaten:
Kontaktdaten von al90

Beitrag von al90 »

Neuigkeiten in V3.0:
-----------------------

V3.0

- Updated: MiscEngine3D für Blitz3D unterstützt nun auch .DDS-Files.
- Hinzugefügt: Alle PureBasic 3.94 Sources sind nun auch in einer PB 4.0 version vorhanden.
- Hinzugefügt: Eine "Extract File" Option wurde zu den Archiv-Optionen hinzugefügt.
- Einige Fixes im GUI-Cruncher.
Die komplette History kann hier eingesehen werden.

Downloaden kann man das Tool hier

oder von PureArea.net
Nach oben
Antworten

Zurück zu „Feedback - Anwendungen“