From 1bdad841c777d2cd9d2867ef531000009e88310a Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Wed, 23 Oct 2013 16:04:35 +0400 Subject: [PATCH] ConstStrings initial commit Former-commit-id: d3d8ac9de6ef19185afa6bdf73a37c55c1677998 --- src/lib/ulm/ulmConstStrings.Mod | 575 ++++++++++++++++++++++++++++++++ 1 file changed, 575 insertions(+) create mode 100644 src/lib/ulm/ulmConstStrings.Mod diff --git a/src/lib/ulm/ulmConstStrings.Mod b/src/lib/ulm/ulmConstStrings.Mod new file mode 100644 index 00000000..86dd0bb2 --- /dev/null +++ b/src/lib/ulm/ulmConstStrings.Mod @@ -0,0 +1,575 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-2004 by University of Ulm, SAI, D-89069 Ulm, Germany + ---------------------------------------------------------------------------- + Ulm's Oberon Library is free software; you can redistribute it + and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version + 2 of the License, or (at your option) any later version. + + Ulm's Oberon Library is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ---------------------------------------------------------------------------- + E-mail contact: oberon@mathematik.uni-ulm.de + ---------------------------------------------------------------------------- + $Id: ConstString.om,v 1.5 2004/05/21 14:22:04 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: ConstString.om,v $ + Revision 1.5 2004/05/21 14:22:04 borchert + various performance improvements: + - support of ReadBuf interface procedure of Streams + - CreateD is no longer based on CloseD + - Write takes advantage of Streams.WritePart + (partially based on code and suggestions by Christian Ehrhardt) + + Revision 1.4 1997/04/02 07:34:53 borchert + ConstStrings are now an extension of Disciplines.Object + + Revision 1.3 1996/01/04 17:03:26 borchert + - const strings are now an extension of Disciplines.Object + - domains added + + Revision 1.2 1994/07/18 14:15:42 borchert + unused variables of Close (buf & offset) removed + + Revision 1.1 1994/02/22 20:06:38 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 10/90 + ---------------------------------------------------------------------------- +*) + +MODULE ConstStrings; + + (* WORM-device for strings *) + + IMPORT Disciplines, Events, Objects, Process, Services, Streams, Strings, + Texts, Types; + + CONST + tabsize = 1031; (* should be a prime number *) + bufsize = 512; + + TYPE + Domain* = POINTER TO DomainRec; + + TYPE + Byte = Types.Byte; + Buffer = POINTER TO BufferRec; + BufferRec = + RECORD + buf: ARRAY bufsize OF CHAR; + free: INTEGER; (* buf[free..bufsize-1] is unused *) + next: Buffer; + END; + + String = POINTER TO StringRec; + StringRec* = + RECORD + (Disciplines.ObjectRec) + (* read-only *) + len*: Streams.Count; (* length of string in bytes *) + hashval*: LONGINT; (* hash value *) + (* private part *) + domain: Domain; + length: Streams.Count; (* private copy of length *) + buf: Buffer; (* first buffer containing the string *) + offset: INTEGER; (* offset into buf *) + next: String; (* list of strings with same hash value *) + END; + + TYPE + DomainRec* = + RECORD + (Disciplines.ObjectRec) + bucket: ARRAY tabsize OF String; + head, tail: Buffer; + END; + VAR + std*: Domain; (* default domain *) + + TYPE + StreamList = POINTER TO StreamListRec; + StreamListRec = + RECORD + stream: Streams.Stream; + next: StreamList; + END; + + ReadStream = POINTER TO ReadStreamRec; + ReadStreamRec = + RECORD + (Streams.StreamRec) + string: String; + buf: Buffer; (* current buffer *) + offset: INTEGER; (* index in current buffer *) + pos: Streams.Count; (* current position *) + END; + + VAR + freelist: StreamList; (* list of unused streams *) + if: Streams.Interface; + caps: Streams.CapabilitySet; + type: Services.Type; (* ReadStream *) + + (* === internal procedures =========================================== *) + + PROCEDURE HashVal(s: Streams.Stream; len: Streams.Count; + VAR hashval, orighashval: LONGINT); + (* compute the hash value of the first `len' bytes of `s'; + the hash value is returned in two variants: + hashval: hash value MOD tabsize + orighashval: unmodified hash value + *) + CONST + shift = 4; + VAR + ordval: INTEGER; + ch: CHAR; + index: Streams.Count; + + BEGIN + Streams.SetPos(s, 0); + hashval := len; + index := 0; + WHILE (index < len) & Streams.ReadByte(s, ch) DO + IF ch >= " " THEN + ordval := ORD(ch) - ORD(" "); + ELSE + ordval := ORD(MAX(CHAR)) - ORD(" ") + ORD(ch); + END; + hashval := ASH(hashval, shift) + ordval; + INC(index); + END; + (* assert: index = len *) + orighashval := hashval; + hashval := hashval MOD tabsize; + END HashVal; + + PROCEDURE Equal(s: Streams.Stream; len: Streams.Count; + string: String) : BOOLEAN; + (* consider `s' to be a stream providing `len' bytes; + return TRUE iff the byte sequence of `s' equals that of `string' + *) + VAR + ch: CHAR; + buf: Buffer; offset: INTEGER; + index: Streams.Count; + BEGIN + Streams.SetPos(s, 0); + IF len # string.length THEN + RETURN FALSE + END; + index := 0; + buf := string.buf; offset := string.offset; + WHILE (index < len) & Streams.ReadByte(s, ch) DO + IF ch # buf.buf[offset] THEN + RETURN FALSE + END; + INC(offset); + IF offset >= bufsize THEN + buf := buf.next; offset := 0; + END; + INC(index); + END; + (* assert: index = len *) + RETURN TRUE + END Equal; + + PROCEDURE Allocate(domain: Domain; len: Streams.Count; + VAR buf: Buffer; VAR offset: INTEGER); + (* allocate space for `len' bytes; + `buf' and `offset' are returned, designating the + begin of the allocated area; note that + if the space within `buf' is not sufficient its + subsequent buffers are to be used + *) + + PROCEDURE NewBuffer; + VAR + buf: Buffer; + BEGIN + NEW(buf); + buf.free := 0; + buf.next := NIL; + IF domain.head = NIL THEN + domain.head := buf; + ELSE + domain.tail.next := buf; + END; + domain.tail := buf; + END NewBuffer; + + BEGIN (* Allocate *) + IF (domain.head = NIL) OR (domain.tail.free = bufsize) THEN + NewBuffer; + END; + buf := domain.tail; + offset := buf.free; + WHILE len > 0 DO + IF len <= bufsize - domain.tail.free THEN + INC(domain.tail.free, len); len := 0; + ELSE + DEC(len, bufsize - domain.tail.free); + domain.tail.free := bufsize; + NewBuffer; + END; + END; + END Allocate; + + PROCEDURE CopyString(s: Streams.Stream; length: Streams.Count; + buf: Buffer; offset: INTEGER); + (* copy `length' bytes from `s' to `buf' at the given offset + and its subsequent buffers + *) + VAR + ok: BOOLEAN; + bytes: Streams.Count; + BEGIN + Streams.SetPos(s, 0); + WHILE length > 0 DO + bytes := bufsize - offset; + IF bytes > length THEN + bytes := length; + END; + IF bytes > bufsize - offset THEN + bytes := bufsize - offset; + END; + ok := Streams.ReadPart(s, buf.buf, offset, bytes); ASSERT(ok); + offset := 0; + buf := buf.next; + DEC(length, bytes); + END; + END CopyString; + + PROCEDURE InternalCreateD(s: Streams.Stream; + length: Streams.Count; + domain: Domain; + VAR string: String); + (* common part of CloseD and CreateD *) + VAR + orighashval, hashval: LONGINT; + str: String; + BEGIN + HashVal(s, length, hashval, orighashval); + IF domain.bucket[hashval] # NIL THEN + str := domain.bucket[hashval]; + WHILE str # NIL DO + IF Equal(s, length, str) THEN + string := str; + RETURN + END; + str := str.next; + END; + END; + NEW(str); + str.domain := domain; + str.len := length; str.length := length; + str.hashval := orighashval; + (* enter new string into the table *) + Allocate(domain, length, str.buf, str.offset); + CopyString(s, length, str.buf, str.offset); + str.next := domain.bucket[hashval]; + domain.bucket[hashval] := str; + string := str; + END InternalCreateD; + + (* === exported procedures =========================================== *) + + PROCEDURE CreateDomain*(VAR domain: Domain); + BEGIN + NEW(domain); domain.head := NIL; domain.tail := NIL; + END CreateDomain; + + PROCEDURE Init*(VAR s: Streams.Stream); + (* open s for writing *) + BEGIN + IF freelist # NIL THEN + s := freelist.stream; + freelist := freelist.next; + Streams.SetPos(s, 0); + ELSE + Texts.Open(s); + END; + END Init; + + PROCEDURE CloseD*(s: Streams.Stream; domain: Domain; VAR string: String); + (* must be called instead of Streams.Close to get + the resulting string + *) + VAR + length: Streams.Count; + + PROCEDURE FreeText; + VAR + free: StreamList; + BEGIN + NEW(free); free.stream := s; + free.next := freelist; freelist := free; + END FreeText; + + BEGIN (* CloseD *) + Streams.GetPos(s, length); + InternalCreateD(s, length, domain, string); + FreeText; + END CloseD; + + PROCEDURE Close*(s: Streams.Stream; VAR string: String); + BEGIN + CloseD(s, std, string); + END Close; + + PROCEDURE CreateD*(VAR string: String; domain: Domain; s: ARRAY OF CHAR); + VAR + length: Streams.Count; + stream: Streams.Stream; + BEGIN + length := 0; + WHILE (length < LEN(s)) & (s[length] # 0X) DO + INC(length); + END; + Strings.Open(stream, s); + InternalCreateD(stream, length, domain, string); + END CreateD; + + PROCEDURE Create*(VAR string: String; s: ARRAY OF CHAR); + BEGIN + CreateD(string, std, s); + END Create; + + PROCEDURE Open*(VAR s: Streams.Stream; string: String); + (* open s for reading *) + VAR + rs: ReadStream; + BEGIN + NEW(rs); + Services.Init(rs, type); + Streams.Init(rs, if, caps, Streams.nobuf); + rs.string := string; + rs.buf := string.buf; + rs.offset := string.offset; + rs.pos := 0; + s := rs; + END Open; + + PROCEDURE Compare*(string1, string2: String) : INTEGER; + (* returns < 0: if string1 < string2 + = 0: if string1 = string2 (see note above) + > 0: if string1 > string2 + *) + VAR + ch1, ch2: CHAR; + buf1, buf2: Buffer; + offset1, offset2: INTEGER; + len1, len2: Streams.Count; + + PROCEDURE Next(VAR buf: Buffer; VAR offset: INTEGER; VAR ch: CHAR); + BEGIN + ch := buf.buf[offset]; + INC(offset); + IF offset >= bufsize THEN + buf := buf.next; + offset := 0; + END; + END Next; + + BEGIN (* Compare *) + IF string1 = string2 THEN + RETURN 0 + END; + len1 := string1.length; len2 := string2.length; + buf1 := string1.buf; buf2 := string2.buf; + offset1 := string1.offset; offset2 := string2.offset; + WHILE (len1 > 0) & (len2 > 0) DO + Next(buf1, offset1, ch1); + Next(buf2, offset2, ch2); + IF ch1 # ch2 THEN + RETURN ORD(ch1) - ORD(ch2) + END; + DEC(len1); DEC(len2); + END; + (* RETURN len1 - len2 does not work because of the return type *) + IF len1 < len2 THEN + RETURN -1 + ELSIF len1 > len2 THEN + RETURN 1 + ELSE + RETURN 0 + END; + END Compare; + + PROCEDURE Write*(s: Streams.Stream; string: String); + (* copy contents of `string' to `s' *) + VAR + len: Streams.Count; + buf: Buffer; + offset: INTEGER; + count: Streams.Count; + bytes: Streams.Count; + BEGIN + len := string.length; + buf := string.buf; + offset := string.offset; + count := 0; + LOOP + IF len = 0 THEN EXIT END; + bytes := len; + IF bytes > bufsize - offset THEN + bytes := bufsize - offset; + END; + IF ~Streams.WritePart(s, buf.buf, offset, bytes) THEN + INC(count, s.count); + EXIT + END; + INC(count, bytes); DEC(len, bytes); INC(offset, bytes); + IF offset >= bufsize THEN + buf := buf.next; + offset := 0; + END; + END; + s.count := count; + END Write; + + PROCEDURE Extract*(VAR s: ARRAY OF CHAR; string: String); + (* copy contents of `string' to `s' *) + VAR + len: Streams.Count; + buf: Buffer; + offset: INTEGER; + index: Streams.Count; + BEGIN + len := string.length; + buf := string.buf; + offset := string.offset; + index := 0; + WHILE (index+1 < LEN(s)) & (len > 0) DO + s[index] := buf.buf[offset]; + INC(index); + DEC(len); + INC(offset); + IF offset >= bufsize THEN + buf := buf.next; + offset := 0; + END; + END; + s[index] := 0X; + END Extract; + + (* ========= interface procedures for ReadStream ===================== *) + + PROCEDURE ReadByte(s: Streams.Stream; VAR byte: Byte) : BOOLEAN; + BEGIN + WITH s: ReadStream DO + IF s.pos >= s.string.length THEN + RETURN FALSE + END; + byte := s.buf.buf[s.offset]; + INC(s.offset); + IF s.offset >= bufsize THEN + s.offset := 0; + s.buf := s.buf.next; + END; + INC(s.pos); + RETURN TRUE + END; + END ReadByte; + + PROCEDURE ReadBuf(s: Streams.Stream; VAR buf: ARRAY OF BYTE; + off, cnt: Streams.Count) : Streams.Count; + VAR + bytes, max: Streams.Count; + BEGIN + WITH s: ReadStream DO + IF s.pos >= s.string.length THEN + RETURN 0 + END; + bytes := s.string.length - s.pos; + IF bytes > cnt THEN + bytes := cnt; + END; + IF bytes > bufsize - s.offset THEN + bytes := bufsize - s.offset; + END; + max := off + bytes; + WHILE off < max DO + buf[off] := s.buf.buf[s.offset]; + INC(off); INC(s.offset); + END; + IF s.offset >= bufsize THEN + s.offset := 0; + s.buf := s.buf.next; + END; + INC(s.pos, bytes); + RETURN bytes + END; + END ReadBuf; + + PROCEDURE Seek(s: Streams.Stream; + cnt: Streams.Count; whence: Streams.Whence) : BOOLEAN; + VAR + realpos: Streams.Count; + BEGIN + WITH s: ReadStream DO + CASE whence OF + | Streams.fromStart: realpos := cnt; + | Streams.fromPos: realpos := s.pos + cnt; + | Streams.fromEnd: realpos := s.string.length + cnt; + END; + IF (realpos < 0) OR (realpos > s.string.length) THEN + RETURN FALSE + END; + IF realpos # s.pos THEN + IF realpos < s.pos THEN + s.pos := 0; s.offset := s.string.offset; s.buf := s.string.buf; + END; + WHILE s.pos < realpos DO + IF realpos - s.pos < bufsize - s.offset THEN + INC(s.offset, realpos - s.pos); + s.pos := realpos; + ELSE + INC(s.pos, bufsize - s.offset); + s.offset := 0; + s.buf := s.buf.next; + END; + END; + END; + RETURN TRUE + END; + END Seek; + + PROCEDURE Tell(s: Streams.Stream; VAR cnt: Streams.Count) : BOOLEAN; + BEGIN + WITH s: ReadStream DO + cnt := s.pos; + RETURN TRUE + END; + END Tell; + + (* =================================================================== *) + + PROCEDURE FreeHandler(event: Events.Event); + (* set free list to NIL to return the associated storage + to the garbage collector + *) + BEGIN + freelist := NIL; + END FreeHandler; + +BEGIN + freelist := NIL; + CreateDomain(std); + caps := {Streams.read, Streams.seek, Streams.tell, Streams.bufio}; + NEW(if); + if.read := ReadByte; + if.bufread := ReadBuf; + if.seek := Seek; + if.tell := Tell; + Events.Handler(Process.startOfGarbageCollection, FreeHandler); + Services.CreateType(type, "ConstStrings.ReadStream", "Streams.Stream"); +END ConstStrings.