From 0c771ad7a692093cb64d51296669c0456caece7f Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Wed, 23 Oct 2013 15:58:22 +0400 Subject: [PATCH] ulmStrings first commit --- src/lib/ulm/ulmStrings.Mod | 382 +++++++++++++++++++++++++++++++++++++ 1 file changed, 382 insertions(+) create mode 100644 src/lib/ulm/ulmStrings.Mod diff --git a/src/lib/ulm/ulmStrings.Mod b/src/lib/ulm/ulmStrings.Mod new file mode 100644 index 00000000..3947e13b --- /dev/null +++ b/src/lib/ulm/ulmStrings.Mod @@ -0,0 +1,382 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-1994 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: Strings.om,v 1.3 1995/01/04 16:44:31 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: Strings.om,v $ + Revision 1.3 1995/01/04 16:44:31 borchert + some fixes because streams are now an extension of Services.Object + + Revision 1.2 1994/07/05 08:27:25 borchert + Flush operation added to stream interface to support Streams.Touch + + Revision 1.1 1994/02/22 20:10:56 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 9/89 + ---------------------------------------------------------------------------- +*) + +MODULE Strings; + + IMPORT Events, Priorities, RelatedEvents, Services, Streams, + SYS := SYSTEM, Types; + + TYPE + Address = Types.Address; + Count = Types.Count; + Byte = Types.Byte; + Stream* = POINTER TO StreamRec; + StreamRec* = + RECORD + (Streams.StreamRec) + (* private part *) + addr: Address; (* SYS.ADR(string[0]) *) + len: Count; (* LEN(string) *) + termindex: Count; (* position of 0X *) + pos: Count; (* 0 <= pos <= termindex < len *) + END; + VAR + type: Services.Type; (* Strings.Stream *) + + CONST + (* error codes *) + endOfStringReached* = 0; (* write failure: end of string reached *) + outOfRange* = 1; (* seek failure: position out of range *) + badParameter* = 2; (* illegal parameter value (eg whence) *) + posOutside* = 3; (* trunc failure: position beyond trunc pos *) + errorcodes* = 4; + TYPE + ErrorCode* = SHORTINT; + Event* = POINTER TO EventRec; + EventRec* = + RECORD + (Events.EventRec) + stream*: Streams.Stream; + errorcode*: ErrorCode; + END; + VAR + errormsg*: ARRAY errorcodes OF Events.Message; + error*: Events.EventType; + (* raised on errorneous stream operations; + ignored by default + *) + VAR + if: Streams.Interface; + caps: Streams.CapabilitySet; + + (* 1st parameter: destination + 2nd parameter: source + + resulting strings are guaranteed to be 0X-terminated + *) + + (* ======= string to stream operations =========================== *) + + PROCEDURE WritePart*(stream: Streams.Stream; string: ARRAY OF CHAR; + sourceIndex: LONGINT); + (* seek to position 0 of `stream' and + copy string[sourceIndex..] to it; + the file pointer of `stream' is left on position 0 + *) + VAR + index: LONGINT; + BEGIN + IF ~Streams.Seek(stream, 0, Streams.fromStart) OR + ~Streams.Trunc(stream, 0) THEN + RETURN + END; + index := sourceIndex; + WHILE (index < LEN(string)) & (string[index] # 0X) DO + INC(index); + END; + IF ~Streams.WritePart(stream, string, sourceIndex, index-sourceIndex) OR + ~Streams.Seek(stream, 0, Streams.fromStart) THEN + END; + END WritePart; + + PROCEDURE Write*(stream: Streams.Stream; string: ARRAY OF CHAR); + (* seek to position 0 of `stream' and + copy 0X-terminated string to `stream' + *) + BEGIN + WritePart(stream, string, 0); + END Write; + + (* ======= stream to string operations =========================== *) + + PROCEDURE ReadPart*(VAR string: ARRAY OF CHAR; destIndex: LONGINT; + stream: Streams.Stream); + (* like `Read' but fill string[destIndex..] *) + VAR + len: LONGINT; + endIndex: LONGINT; + BEGIN + len := LEN(string); + IF Streams.Seek(stream, 0, Streams.fromStart) & (destIndex < len) THEN + IF ~Streams.ReadPart(stream, string, destIndex, len-destIndex) THEN + (* ReadPart fails if less than len-destIndex can be read *) + END; + endIndex := destIndex + stream.count; + IF endIndex >= len THEN + endIndex := len-1; + END; + IF ~Streams.Seek(stream, 0, Streams.fromStart) THEN + END; + ELSE + endIndex := 0; + END; + string[endIndex] := 0X; + END ReadPart; + + PROCEDURE Read*(VAR string: ARRAY OF CHAR; stream: Streams.Stream); + (* copy contents of `stream' from position 0 until end of file; + `string' is guaranteed to be 0X-terminated; + the file pointer of `stream' is left on position 0 + *) + BEGIN + ReadPart(string, 0, stream); + END Read; + + (* ======= string to string operations =========================== *) + + PROCEDURE Copy*(VAR destination: ARRAY OF CHAR; + source: ARRAY OF CHAR); + VAR + index: LONGINT; + minlen: LONGINT; + BEGIN + minlen := LEN(destination); + IF minlen > LEN(source) THEN + minlen := LEN(source); + END; + (* minlen is guaranteed to be positive here + because "ARRAY 0 OF CHAR" is not a legal type + *) + DEC(minlen); + + index := 0; + WHILE (index < minlen) & (source[index] # 0X) DO + destination[index] := source[index]; + INC(index); + END; + destination[index] := 0X; + END Copy; + + PROCEDURE PartCopy*(VAR destination: ARRAY OF CHAR; destIndex: LONGINT; + source: ARRAY OF CHAR; sourceIndex: LONGINT); + (* copy source[sourceIndex..] to destination[destIndex..] *) + BEGIN + WHILE (destIndex+1 < LEN(destination)) & + (sourceIndex < LEN(source)) & + (source[sourceIndex] # 0X) DO + destination[destIndex] := source[sourceIndex]; + INC(destIndex); INC(sourceIndex); + END; + IF destIndex < LEN(destination) THEN + destination[destIndex] := 0X; + END; + END PartCopy; + + PROCEDURE Len*(string: ARRAY OF CHAR) : LONGINT; + (* returns the number of characters (without terminating 0X) *) + VAR + len: LONGINT; + BEGIN + len := 0; + WHILE (len < LEN(string)) & (string[len] # 0X) DO + INC(len); + END; + RETURN len + END Len; + + PROCEDURE Concatenate*(VAR destination: ARRAY OF CHAR; + source: ARRAY OF CHAR); + (* append source to destination; + PartCopy(destination, Len(destination), source, 0); + *) + BEGIN + PartCopy(destination, Len(destination), source, 0); + END Concatenate; + + (* ======= strings as streams ==================================== *) + + PROCEDURE Error(stream: Streams.Stream; code: ErrorCode); + VAR + event: Event; + BEGIN + NEW(event); + event.type := error; + event.message := errormsg[code]; + event.stream := stream; + event.errorcode := code; + RelatedEvents.Raise(stream, event); + END Error; + + PROCEDURE ReadByte(stream: Streams.Stream; VAR byte: Byte) : BOOLEAN; + BEGIN + WITH stream: Stream DO + IF stream.pos < stream.termindex THEN + SYS.GET(stream.addr + stream.pos, byte); + INC(stream.pos); + RETURN TRUE + ELSE + RETURN FALSE + END; + END; + END ReadByte; + + PROCEDURE WriteByte(stream: Streams.Stream; byte: Byte) : BOOLEAN; + BEGIN + WITH stream: Stream DO + IF ORD(byte) = 0 THEN RETURN FALSE END; + IF stream.pos < stream.termindex THEN + SYS.PUT(stream.addr + stream.pos, byte); + INC(stream.pos); + ELSIF (stream.pos = stream.termindex) & + (stream.termindex+1 < stream.len) THEN + SYS.PUT(stream.addr + stream.pos, byte); + INC(stream.pos); + INC(stream.termindex); + SYS.PUT(stream.addr + stream.termindex, 0X); + ELSE + Error(stream, endOfStringReached); + RETURN FALSE + END; + RETURN TRUE + END; + END WriteByte; + + PROCEDURE Seek(stream: Streams.Stream; + offset: Streams.Count; whence: Streams.Whence) : BOOLEAN; + VAR + newpos: Streams.Count; + BEGIN + WITH stream: Stream DO + CASE whence OF + | Streams.fromStart: newpos := offset; + | Streams.fromPos: newpos := stream.pos + offset; + | Streams.fromEnd: newpos := stream.termindex + offset; + ELSE + Error(stream, badParameter); + RETURN FALSE + END; + IF (newpos < 0) OR (newpos > stream.termindex) THEN + Error(stream, outOfRange); + RETURN FALSE + END; + stream.pos := newpos; + RETURN TRUE + END; + END Seek; + + PROCEDURE Tell(stream: Streams.Stream; VAR pos: Streams.Count) : BOOLEAN; + BEGIN + WITH stream: Stream DO + pos := stream.pos; + RETURN TRUE + END; + END Tell; + + PROCEDURE Trunc(stream: Streams.Stream; length: Streams.Count) : BOOLEAN; + BEGIN + WITH stream: Stream DO + IF (length >= 0) & (length <= stream.termindex) & + (stream.pos <= length) THEN + stream.termindex := length; + SYS.PUT(stream.addr + stream.termindex, 0X); + RETURN TRUE + ELSE + IF (length >= 0) & (length <= stream.termindex) THEN + Error(stream, outOfRange); + ELSE + Error(stream, posOutside); + END; + RETURN FALSE + END; + END; + END Trunc; + + PROCEDURE Flush(s: Streams.Stream) : BOOLEAN; + VAR + len: LONGINT; + ch: CHAR; + BEGIN + WITH s: Stream DO + len := 0; + LOOP + IF len = s.len THEN EXIT END; + SYS.GET(s.addr + len, ch); + IF ch = 0X THEN EXIT END; + INC(len); + END; + s.termindex := len; + IF s.termindex = s.len THEN + (* enforce 0X-termination *) + DEC(s.termindex); + SYS.PUT(s.addr + s.termindex, 0X); + END; + IF s.pos > s.termindex THEN + s.pos := s.termindex; + END; + END; + RETURN TRUE + END Flush; + + PROCEDURE Open*(VAR stream: Streams.Stream; VAR string: ARRAY OF CHAR); + (* opens string for reading and writing; seek & tell are permitted; + 0X-termination of string is guaranteed; + *) + VAR + newstream: Stream; + BEGIN + NEW(newstream); + Services.Init(newstream, type); + Streams.Init(newstream, if, caps, Streams.nobuf); + newstream.addr := SYS.ADR(string); + newstream.len := LEN(string); + newstream.termindex := Len(string); + IF newstream.termindex = LEN(string) THEN + (* enforce 0X-termination *) + DEC(newstream.termindex); + string[newstream.termindex] := 0X; + END; + newstream.pos := 0; + RelatedEvents.QueueEvents(newstream); + stream := newstream; + END Open; + +BEGIN + NEW(if); + if.read := ReadByte; if.write := WriteByte; + if.seek := Seek; if.tell := Tell; if.trunc := Trunc; if.flush := Flush; + caps := {Streams.read, Streams.write, Streams.seek, Streams.tell, + Streams.trunc, Streams.flush}; + Services.CreateType(type, "Strings.Stream", "Streams.Stream"); + + errormsg[endOfStringReached] := "end of string reached"; + errormsg[outOfRange] := "position out of range"; + errormsg[badParameter] := "illegal parameter value"; + errormsg[posOutside] := "current position beyond intended trunc position"; + + Events.Define(error); + Events.SetPriority(error, Priorities.liberrors); + Events.Ignore(error); +END Strings.