mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 00:32:24 +00:00
575 lines
15 KiB
Modula-2
575 lines
15 KiB
Modula-2
(* 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.
|