(* ------------------------------------------------------------------------ :Program. Speed :Contents. Proceduren zur schnellen Speichermanipulation. :Author. Klaus Hlawaty. :Address. Waldhof :Address. 3579 Schrecksbach :History. v1.0 - 16.Dec.90: Copy, CopyVar. :History. v1.1 - 17.Dec.90: Fill, VerGl. :History. v1.2 - 18.Dec.90: Umbau von POINTER auf ARRAY OF BYTE. :History. v2.0 - 07.Sep.91: Einbau des CopyMem aus Exec. :History. v2.1 - 09.Ocr.91: Einbau von FindByte & ReplaceByte :History. v3.0 - 15.Nov.91: Umbau auf Oberon v2.13. :History. v3.1 - 25.Nov.91: FillC. :Copyright. Freeware. :Language. Oberon v2.13 :Translator. OBERON v2.13 / OLink v2.13d :Imports. Reg. :Remarks. Fill und Copy können durch die Angabe von: :Remarks. 1.) Von[x] oder Nach[x] auch Variablenteile nutzen, :Remarks. 2.) Nach[0] auch Variablen benutzen die größer als :Remarks. 32767 sind. :Remarks. siehe Beispiele: CTest u.a. ! :Remarks. zu v2.0: Hier habe ich CopyMem aus der ExecLibrary :Remarks. direkt eingebaut und dabei 'source' und 'dest' :Remarks. von ARRAY OF BYTE auf e.ADDRESS umgeändert, :Remarks. da sonst beim Copieren von Pointern nicht ab :Remarks. und AUF die Adresse der Variablen sondern :Remarks. die Adresse der Adresse kopiert wird, womit :Remarks. ein 'indischer Heiliger' zu Besuch kommt. :Remarks. zu v3.0: Bei Oberon v2.13 konnte ich CopyMem wieder :Remarks. 'ausbauen'. ------------------------------------------------------------------------ *) MODULE Speed; (* $CopyArrays- *) IMPORT e:Exec, Reg, s:SYSTEM; CONST Byte* = 01; Word* = 02; Long* = 03; VAR exec * [4H] : e.ExecBasePtr; (* Nötig für CopyMem siehe Exec *) (* ===================================================================== *) (* ----------------------- Procedure aus Exec-Library ------------------ *) (* ===================================================================== *) PROCEDURE CopyMem *{exec,-624}(source{8} : s.ADDRESS; dest{9} : s.ADDRESS; size{0} : LONGINT); (* ------------------------------------------------------------------------ :Input. source : Adresse oder POINTER von der kopiert wird. size : Anzahl der Bytes zum Kopieren. :Output. dest : Adresse oder POINTER auf die kopiert wird. :Semantic. Kopiert schnell beliebige Speicherbereiche, siehe Exec. :Remark. Benötige ich für COPY für POINTER ab Oberon 2.0 ????? ------------------------------------------------------------------------ *) (* ===================================================================== *) PROCEDURE Copy*{exec,-624}(Von {Reg.A0} : ARRAY OF BYTE; Nach{Reg.A1} : ARRAY OF BYTE; Anz {Reg.D0} : LONGINT); (* ------------------------------------------------------------------------ :Input. Von : Variable von der kopiert wird. Anz : Anzahl der Bytes zum Kopieren. :Output. Nach : Variable auf die kopiert wird. :Semantic. Kopiert schnell beliebige Arrays. :Remark. Nicht zum Kopieren über POINTERn (Ptr^ angeben, nicht Ptr). ------------------------------------------------------------------------ *) PROCEDURE CopyVar*(VAR Von : ARRAY OF BYTE; VAR Nach : ARRAY OF BYTE); (* ------------------------------------------------------------------------ :Input. Von : Variable von der kopiert wird. :Output. Nach : Variable auf die kopiert wird. :Semantic. Kopiert schnell und sicher (!?) ganze (!) Variablen, :Semantic. da die Anzahl der copierten Bytes der der kleineren :Semantic. Variable ist. :Remark. Vorsicht: CopyVar copiert nur ganze (!) Variablen fehlerfrei. ------------------------------------------------------------------------ *) VAR LenV, LenN, Anz : LONGINT; BEGIN LenV := LEN(Von,0); LenN := LEN(Nach,0); IF(LenV < LenN)THEN e.CopyMem(Von,Nach,LenV); ELSE e.CopyMem(Von,Nach,LenN); END; END CopyVar; PROCEDURE StrCopyAss*(Von{Reg.A0} : s.ADDRESS; Nach{Reg.A1} : s.ADDRESS); (* $EntryExitCode- *) (* ------------------------------------------------------------------------ :Input. Von : String von dem kopiert wird. :Output. Nach : String auf den kopiert wird. :Semantic. Kopiert NULL terminierten C-String. ------------------------------------------------------------------------ *) BEGIN s.INLINE( 012D8H, (* StrCopy: move.b (a0)+,(a1)+ *) 066FCH, (* bne StrCopy *) 04E75H (* rts *) ); END StrCopyAss; PROCEDURE StrCopy*(VAR Von , Nach : ARRAY OF CHAR); (* ------------------------------------------------------------------------ :Input. Von : String von dem kopiert wird. :Output. Nach : String auf den kopiert wird. :Semantic. Kopiert NULL terminierten C-String. ------------------------------------------------------------------------ *) BEGIN StrCopyAss(s.ADR(Von),s.ADR(Nach)); END StrCopy; (* --------------------- Locale Assembler Module für Fill ---------------- *) PROCEDURE FillB(Was{0} : LONGINT; Anz{1} : LONGINT; Nach{8} : s.ADDRESS); (* $EntryExitCode- *) BEGIN s.INLINE( 010C0H, (* move.b D0,(A0)+ *) 051C9H,0FFFCH, (* dbra D1,.LOOP *) 04E75H (* RTS *) ); END FillB; PROCEDURE FillW(Was{0} : LONGINT; Anz{1} : LONGINT; Nach{8} : s.ADDRESS); (* $EntryExitCode- *) BEGIN s.INLINE( 030C0H, (* move.w D0,(A0)+ *) 051C9H,0FFFCH, (* dbra D1,.LOOP *) 04E75H (* RTS *) ); END FillW; PROCEDURE FillL(Was{0} : LONGINT; Anz{1} : LONGINT; Nach{8} : s.ADDRESS); (* $EntryExitCode- *) BEGIN s.INLINE( 020C0H, (* move.l D0,(A0)+ *) 051C9H,0FFFCH, (* dbra D1,.LOOP *) 04E75H (* RTS *) ); END FillL; (* $EntryExitCode- *) PROCEDURE Conv*(Was{Reg.D0} : s.ADDRESS) : LONGINT; BEGIN s.INLINE( 04E75H (* RTS *) ); END Conv; (* ----------------------------------------------------------------------- *) PROCEDURE Fill*( Filler : LONGINT; Anzahl : LONGINT; VAR Nach : ARRAY OF BYTE; Type : INTEGER); (* ------------------------------------------------------------------------ :Input. Filler : Füllwert. :Input. Anzahl : der Bytes, Worte oder Langworte zum Füllen. :Input. Type : Bestimmt ob Filler als 'Byte', 'Word' oder :Input. 'Long'word Variable interpretiert wird. .Input. siehe CONST :Output. Nach : Variable die gefüllt wird. :Semantic. Füllt Variablen (ARRAY maximal 32767). ------------------------------------------------------------------------ *) BEGIN CASE Type OF Byte : FillB(Filler, Anzahl, s.ADR(Nach)) | Word : FillW(Filler, Anzahl, s.ADR(Nach)) | Long : FillL(Filler, Anzahl, s.ADR(Nach)) ELSE (* Pech gehabt, bitte selbst aufpassen *); END(* CASE *); END Fill; PROCEDURE FillC*( Filler : CHAR; Anzahl : LONGINT; VAR Nach : ARRAY OF CHAR); (* ------------------------------------------------------------------------ :Input. Filler : FüllZeichen. :Input. Anzahl : der Zeichen zum Füllen. :Output. Nach : String der gefüllt wird. :Semantic. Füllt String (ARRAY maximal 32767). ------------------------------------------------------------------------ *) BEGIN FillB(s.VAL(SHORTINT,Filler), Anzahl, s.ADR(Nach)); END FillC; (* ------------ Assembler Module für Addressmanipulation ---------------- *) PROCEDURE IncAByte*(Adr{Reg.D0} : s.ADDRESS) : s.ADDRESS; (* ------------------------------------------------------------------------ :Input. Adr : Adresse. :Output. RETURN : Adr + 1. :Semantic. Incrementiert Adresse um 1. ------------------------------------------------------------------------ *) (* $EntryExitCode- *) BEGIN s.INLINE( (* IncA1: *) 05280H, (* ADDQ.L #1,D0 *) 04E75H (* rts *) (* END *) ) (* INLINE *); END IncAByte; (* $EntryExitCode+ *) PROCEDURE IncA*( Adr{Reg.D0} : s.ADDRESS; Offset{Reg.D1} : LONGINT) : s.ADDRESS; (* ------------------------------------------------------------------------ :Input. Adr : Adresse. :Input. Offset : Offset. :Output. RETURN : Adr + Offset. :Semantic. Addierte Offset zur Adresse. ------------------------------------------------------------------------ *) (* $EntryExitCode- *) BEGIN s.INLINE( (* IncA: *) 0D081H, (* ADD.L D1,D0 *) 04E75H (* rts *) (* END *) ) (* INLINE *); END IncA ; (* $EntryExitCode+ *) PROCEDURE DecA*( Adr{Reg.D0} : s.ADDRESS; Offset{Reg.D1} : LONGINT) : s.ADDRESS; (* ------------------------------------------------------------------------ :Input. Adr : Adresse. :Input. Offset : Offset. :Output. RETURN : Adr - Offset. :Semantic. Subtrahiere Offset von Adresse. ------------------------------------------------------------------------ *) (* $EntryExitCode- *) BEGIN s.INLINE( (* DecA: *) 09081H, (* SUB.L D1,D0 *) 04E75H (* rts *) (* END *) ) (* INLINE *); END DecA; (* $EntryExitCode+ *) (* ------------ Assembler Module für Byte/Char-Manipulationen ----------- *) PROCEDURE ReplaceChar*(Von{Reg.A0} : s.ADDRESS; Was{Reg.D1} : CHAR; Womit{Reg.A1} : CHAR); (* ------------------------------------------------------------------------ :Input. Von : String der verändert werden soll. Was : Charakter der mit ... Womit : ausgetauscht werden soll. :Output. Von : wird geändert. :Semantic. Tauscht im String 'Von' alle 'Was'-Charkters mit :Semantic. 'Womit' aus. :Remark. Der String muß mit einem Nullcharakter abgeschloßen werden. :Remark. Man darf niemals gleiche Charaktere 'austauschen', :Remark. z.B.: niemals 'e' austauschen mit 'e'. ------------------------------------------------------------------------ *) (* $EntryExitCode- *) BEGIN s.INLINE( (* ReplaceByte: *) 023C2H, 00000H,0001CH,(* move.l D2,Var *) 02409H, (* move.l A1,D2 *) (* Loop: *) 01018H, (* move.b (A0)+,D0 *) 06708H, (* beq Ende *) 0B200H, (* cmp.b D0,D1 *) 066F8H, (* bne Loop *) 01102H, (* move.b D2,-(A0) *) 060F4H, (* bra Loop *) (* Ende: *) 03439H, 00000H,0001CH,(* move Var,D2 *) 04E75H, (* rts *) (* Var: *) 00000H, 00000H, 00000H, 00000H ); END ReplaceChar; (* $EntryExitCode+ *) PROCEDURE FindChar*(Von{Reg.A0} : s.ADDRESS; Was{Reg.D1} : CHAR ) : s.ADDRESS (* Wo *); (* ------------------------------------------------------------------------ :Input. Von : String in dem gesucht wird. Was : Charakter nach dem gesucht wird. :Output. RETURN : Adresse des Charakters im RAM. :Semantic. Sucht im String 'Von' nach 'Was'-Charakter. :Remark. Der String muß mit einem Nullcharakter abgeschloßen werden. ------------------------------------------------------------------------ *) (* $EntryExitCode- *) BEGIN s.INLINE( (* FindChar: *) 01018H, (* move.b (A0)+,D0 *) 06704H, (* beq Ende *) 0B200H, (* cmp.b D0,D1 *) 066F8H, (* bne FindChar *) (* Ende: *) 02008H, (* move.l A0,D0 *) 04E75H (* rts *) ); END FindChar; (* $EntryExitCode+ *) (* ----------------------------------------------------------------------- *) PROCEDURE SearchChar*(Von : s.ADDRESS; Was : CHAR ) : s.ADDRESS; (* ------------------------------------------------------------------------ :Input. Von : String in dem gesucht wird. Was : Charakter nach dem gesucht wird. :Output. RETURN : Nummer des Charakters im String. :Semantic. Sucht im String 'Von' nach 'Was'-Charakter. :Remark. Der String muß mit einem Nullcharakter abgeschloßen werden. ------------------------------------------------------------------------ *) BEGIN RETURN DecA(FindChar(Von,Was),Von); END SearchChar; END Speed.