vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-05 22:12:24 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

added GetName function to OakFiles;

Browse source 
ported BTrees, MD5, Zip, Zlib, ZlibBuffers, ZlibDeflate, ZlibInflate, ZlibReaders, ZlibWriters to compile with voc
This commit is contained in:
Norayr Chilingarian 2013-10-31 18:51:55 +04:00
parent 8d6b0063bb
commit fcc5f1447d
11 changed files with 5463 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

13
makefile
View file

@ -9,7 +9,7 @@ RELEASE = 1.0
INCLUDEPATH = -Isrc/lib/system/$(CCOMP)/$(TARCH)
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/system:src/lib/system/$(CCOMP):src/lib/system/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(CCOMP):src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(CCOMP):src/lib/ooc:src/lib/ooc/$(CCOMP):src/lib/pow:src/lib/misc:src/voc:src/voc/$(CCOMP):src/voc/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/coco:src/test
SETPATH = CFLAGS=$(INCLUDEPATH) PATH=.:/bin:/usr/bin MODULES=.:src/lib:src/lib/v4:src/lib/system:src/lib/system/$(CCOMP):src/lib/system/$(CCOMP)/$(TARCH):src/lib/ulm:src/lib/ulm/$(CCOMP):src/lib/ulm/$(TARCH):src/lib/ooc2:src/lib/ooc2/$(CCOMP):src/lib/ooc:src/lib/ooc/$(CCOMP):src/lib/pow:src/lib/misc:src/lib/s3:src/voc:src/voc/$(CCOMP):src/voc/$(CCOMP)/$(TARCH):src/tools/ocat:src/tools/browser:src/tools/vocparam:src/tools/coco:src/test
VOC = voc
VOCSTATIC0 = $(SETPATH) ./vocstatic.$(TOS).$(CCOMP).$(TARCH)
@ -202,6 +202,17 @@ stage6:
$(VOCSTATIC) -sP MultiArrayRiders.Mod
$(VOCSTATIC) -sP MersenneTwister.Mod
#s3 libs
$(VOCSTATIC) -sP BTrees.Mod
$(VOCSTATIC) -sP MD5.Mod
$(VOCSTATIC) -sP Zlib.Mod
$(VOCSTATIC) -sP ZlibBuffers.Mod
$(VOCSTATIC) -sP ZlibInflate.Mod
$(VOCSTATIC) -sP ZlibDeflate.Mod
$(VOCSTATIC) -sP ZlibReaders.Mod
$(VOCSTATIC) -sP ZlibWriters.Mod
$(VOCSTATIC) -sP Zip.Mod
stage7:
#objects := $(wildcard *.o)

1134
src/lib/s3/BTrees.Mod Normal file
View file

File diff suppressed because it is too large Load diff

295
src/lib/s3/MD5.Mod Normal file
View file

@ -0,0 +1,295 @@
(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
MODULE MD5; (** portable *) (* ejz *)
IMPORT SYSTEM;
(** The MD5 Message-Digest Algorithm (RFC1321)
The algorithm takes as input a message of arbitrary length and produces
as output a 128-bit "fingerprint" or "message digest" of the input. It is
conjectured that it is computationally infeasible to produce two messages
having the same message digest, or to produce any message having a
given prespecified target message digest. The MD5 algorithm is intended
for digital signature applications, where a large file must be "compressed"
in a secure manner before being encrypted with a private (secret) key
under a public-key cryptosystem such as RSA. *)
TYPE
Context* = POINTER TO ContextDesc;
ContextDesc = RECORD
buf: ARRAY 4 OF LONGINT;
bits: LONGINT;
in: ARRAY 64 OF CHAR
END;
Digest* = ARRAY 16 OF CHAR;
(** Begin an MD5 operation, with a new context. *)
PROCEDURE New*(): Context;
VAR cont: Context;
BEGIN
NEW(cont);
cont.buf[0] := 067452301H;
cont.buf[1] := 0EFCDAB89H;
cont.buf[2] := 098BADCFEH;
cont.buf[3] := 010325476H;
cont.bits := 0;
RETURN cont
END New;
PROCEDURE ByteReverse(VAR in: ARRAY OF SYSTEM.BYTE; VAR out: ARRAY OF LONGINT; longs: LONGINT);
VAR
adr, t, i: LONGINT;
bytes: ARRAY 4 OF CHAR;
BEGIN
adr := SYSTEM.ADR(in[0]); i := 0;
WHILE i < longs DO
SYSTEM.MOVE(adr, SYSTEM.ADR(bytes[0]), 4);
t := ORD(bytes[3]);
t := 256*t + ORD(bytes[2]);
t := 256*t + ORD(bytes[1]);
t := 256*t + ORD(bytes[0]);
out[i] := t;
INC(adr, 4); INC(i)
END
END ByteReverse;
PROCEDURE F1(x, y, z: LONGINT): LONGINT;
BEGIN
RETURN SYSTEM.VAL(LONGINT, (SYSTEM.VAL(SET, x)*SYSTEM.VAL(SET, y)) + ((-SYSTEM.VAL(SET, x))*SYSTEM.VAL(SET, z)))
END F1;
PROCEDURE F2(x, y, z: LONGINT): LONGINT;
BEGIN
RETURN SYSTEM.VAL(LONGINT, (SYSTEM.VAL(SET, x)*SYSTEM.VAL(SET, z)) + (SYSTEM.VAL(SET, y)*(-SYSTEM.VAL(SET, z))))
END F2;
PROCEDURE F3(x, y, z: LONGINT): LONGINT;
BEGIN
RETURN SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, x) / SYSTEM.VAL(SET, y) / SYSTEM.VAL(SET, z))
END F3;
PROCEDURE F4(x, y, z: LONGINT): LONGINT;
BEGIN
RETURN SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, y) / (SYSTEM.VAL(SET, x)+(-SYSTEM.VAL(SET, z))))
END F4;
PROCEDURE STEP1(VAR w: LONGINT; x, y, z, data, s: LONGINT);
BEGIN
w := w+F1(x, y, z)+data;
w := SYSTEM.ROT(w, s);
INC(w, x)
END STEP1;
PROCEDURE STEP2(VAR w: LONGINT; x, y, z, data, s: LONGINT);
BEGIN
w := w+F2(x, y, z)+data;
w := SYSTEM.ROT(w, s);
INC(w, x)
END STEP2;
PROCEDURE STEP3(VAR w: LONGINT; x, y, z, data, s: LONGINT);
BEGIN
w := w+F3(x, y, z)+data;
w := SYSTEM.ROT(w, s);
INC(w, x)
END STEP3;
PROCEDURE STEP4(VAR w: LONGINT; x, y, z, data, s: LONGINT);
BEGIN
w := w+F4(x, y, z)+data;
w := SYSTEM.ROT(w, s);
INC(w, x)
END STEP4;
PROCEDURE Transform(VAR buf, in: ARRAY OF LONGINT);
VAR a, b, c, d: LONGINT;
BEGIN
a := buf[0]; b := buf[1]; c := buf[2]; d := buf[3];
STEP1(a, b, c, d, in[0]+0D76AA478H, 7);
STEP1(d, a, b, c, in[1]+0E8C7B756H, 12);
STEP1(c, d, a, b, in[2]+0242070DBH, 17);
STEP1(b, c, d, a, in[3]+0C1BDCEEEH, 22);
STEP1(a, b, c, d, in[4]+0F57C0FAFH, 7);
STEP1(d, a, b, c, in[5]+04787C62AH, 12);
STEP1(c, d, a, b, in[6]+0A8304613H, 17);
STEP1(b, c, d, a, in[7]+0FD469501H, 22);
STEP1(a, b, c, d, in[8]+0698098D8H, 7);
STEP1(d, a, b, c, in[9]+08B44F7AFH, 12);
STEP1(c, d, a, b, in[10]+0FFFF5BB1H, 17);
STEP1(b, c, d, a, in[11]+0895CD7BEH, 22);
STEP1(a, b, c, d, in[12]+06B901122H, 7);
STEP1(d, a, b, c, in[13]+0FD987193H, 12);
STEP1(c, d, a, b, in[14]+0A679438EH, 17);
STEP1(b, c, d, a, in[15]+049B40821H, 22);
STEP2(a, b, c, d, in[1]+0F61E2562H, 5);
STEP2(d, a, b, c, in[6]+0C040B340H, 9);
STEP2(c, d, a, b, in[11]+0265E5A51H, 14);
STEP2(b, c, d, a, in[0]+0E9B6C7AAH, 20);
STEP2(a, b, c, d, in[5]+0D62F105DH, 5);
STEP2(d, a, b, c, in[10]+02441453H, 9);
STEP2(c, d, a, b, in[15]+0D8A1E681H, 14);
STEP2(b, c, d, a, in[4]+0E7D3FBC8H, 20);
STEP2(a, b, c, d, in[9]+021E1CDE6H, 5);
STEP2(d, a, b, c, in[14]+0C33707D6H, 9);
STEP2(c, d, a, b, in[3]+0F4D50D87H, 14);
STEP2(b, c, d, a, in[8]+0455A14EDH, 20);
STEP2(a, b, c, d, in[13]+0A9E3E905H, 5);
STEP2(d, a, b, c, in[2]+0FCEFA3F8H, 9);
STEP2(c, d, a, b, in[7]+0676F02D9H, 14);
STEP2(b, c, d, a, in[12]+08D2A4C8AH, 20);
STEP3(a, b, c, d, in[5]+0FFFA3942H, 4);
STEP3(d, a, b, c, in[8]+08771F681H, 11);
STEP3(c, d, a, b, in[11]+06D9D6122H, 16);
STEP3(b, c, d, a, in[14]+0FDE5380CH, 23);
STEP3(a, b, c, d, in[1]+0A4BEEA44H, 4);
STEP3(d, a, b, c, in[4]+04BDECFA9H, 11);
STEP3(c, d, a, b, in[7]+0F6BB4B60H, 16);
STEP3(b, c, d, a, in[10]+0BEBFBC70H, 23);
STEP3(a, b, c, d, in[13]+0289B7EC6H, 4);
STEP3(d, a, b, c, in[0]+0EAA127FAH, 11);
STEP3(c, d, a, b, in[3]+0D4EF3085H, 16);
STEP3(b, c, d, a, in[6]+04881D05H, 23);
STEP3(a, b, c, d, in[9]+0D9D4D039H, 4);
STEP3(d, a, b, c, in[12]+0E6DB99E5H, 11);
STEP3(c, d, a, b, in[15]+01FA27CF8H, 16);
STEP3(b, c, d, a, in[2]+0C4AC5665H, 23);
STEP4(a, b, c, d, in[0]+0F4292244H, 6);
STEP4(d, a, b, c, in[7]+0432AFF97H, 10);
STEP4(c, d, a, b, in[14]+0AB9423A7H, 15);
STEP4(b, c, d, a, in[5]+0FC93A039H, 21);
STEP4(a, b, c, d, in[12]+0655B59C3H, 6);
STEP4(d, a, b, c, in[3]+08F0CCC92H, 10);
STEP4(c, d, a, b, in[10]+0FFEFF47DH, 15);
STEP4(b, c, d, a, in[1]+085845DD1H, 21);
STEP4(a, b, c, d, in[8]+06FA87E4FH, 6);
STEP4(d, a, b, c, in[15]+0FE2CE6E0H, 10);
STEP4(c, d, a, b, in[6]+0A3014314H, 15);
STEP4(b, c, d, a, in[13]+04E0811A1H, 21);
STEP4(a, b, c, d, in[4]+0F7537E82H, 6);
STEP4(d, a, b, c, in[11]+ 0BD3AF235H, 10);
STEP4(c, d, a, b, in[2]+02AD7D2BBH, 15);
STEP4(b, c, d, a, in[9]+0EB86D391H, 21);
INC(buf[0], a); INC(buf[1], b);
INC(buf[2], c); INC(buf[3], d)
END Transform;
(** Continues an MD5 message-digest operation, processing another
message block, and updating the context. *)
PROCEDURE Write*(context: Context; ch: CHAR);
VAR
in: ARRAY 16 OF LONGINT;
t, len: LONGINT;
BEGIN
t := context.bits; len := 1;
context.bits := t + 8;
t := (t DIV 8) MOD 64;
IF t > 0 THEN
t := 64-t;
IF 1 < t THEN
context.in[64-t] := ch;
RETURN
END;
ASSERT(len = 1);
context.in[64-t] := ch;
ByteReverse(context.in, in, 16);
Transform(context.buf, in);
DEC(len, t)
END;
IF len > 0 THEN
context.in[0] := ch
END
END Write;
(** Continues an MD5 message-digest operation, processing another
message block, and updating the context. *)
PROCEDURE WriteBytes*(context: Context; VAR buf: ARRAY OF CHAR; len: LONGINT);
VAR
in: ARRAY 16 OF LONGINT;
beg, t: LONGINT;
BEGIN
beg := 0; t := context.bits;
context.bits := t + len*8;
t := (t DIV 8) MOD 64;
IF t > 0 THEN
t := 64-t;
IF len < t THEN
SYSTEM.MOVE(SYSTEM.ADR(buf[beg]), SYSTEM.ADR(context.in[64-t]), len);
RETURN
END;
SYSTEM.MOVE(SYSTEM.ADR(buf[beg]), SYSTEM.ADR(context.in[64-t]), t);
ByteReverse(context.in, in, 16);
Transform(context.buf, in);
INC(beg, t); DEC(len, t)
END;
WHILE len >= 64 DO
SYSTEM.MOVE(SYSTEM.ADR(buf[beg]), SYSTEM.ADR(context.in[0]), 64);
ByteReverse(context.in, in, 16);
Transform(context.buf, in);
INC(beg, 64); DEC(len, 64)
END;
IF len > 0 THEN
SYSTEM.MOVE(SYSTEM.ADR(buf[beg]), SYSTEM.ADR(context.in[0]), len)
END
END WriteBytes;
(** Ends an MD5 message-digest operation, writing the message digest. *)
PROCEDURE Close*(context: Context; VAR digest: Digest);
VAR
in: ARRAY 16 OF LONGINT;
beg, i, count: LONGINT;
BEGIN
count := (context.bits DIV 8) MOD 64;
beg := count;
context.in[beg] := CHR(128); INC(beg);
count := 64-1-count;
IF count < 8 THEN
i := 0;
WHILE i < count DO
context.in[beg+i] := 0X; INC(i)
END;
ByteReverse(context.in, in, 16);
Transform(context.buf, in);
i := 0;
WHILE i < 56 DO
context.in[i] := 0X; INC(i)
END
ELSE
i := 0;
WHILE i < (count-8) DO
context.in[beg+i] := 0X; INC(i)
END
END;
ByteReverse(context.in, in, 14);
in[14] := context.bits; in[15] := 0;
Transform(context.buf, in);
ByteReverse(context.buf, in, 4);
SYSTEM.MOVE(SYSTEM.ADR(in[0]), SYSTEM.ADR(digest[0]), 16)
END Close;
PROCEDURE HexDigit(i: LONGINT): CHAR;
BEGIN
IF i < 10 THEN
RETURN CHR(ORD("0")+i)
ELSE
RETURN CHR(ORD("a")+i-10)
END
END HexDigit;
(** Convert the digest into an hexadecimal string. *)
PROCEDURE ToString*(digest: Digest; VAR str: ARRAY OF CHAR);
VAR i: LONGINT;
BEGIN
FOR i := 0 TO 15 DO
str[2*i] := HexDigit(ORD(digest[i]) DIV 16);
str[2*i+1] := HexDigit(ORD(digest[i]) MOD 16)
END;
str[32] := 0X
END ToString;
END MD5.

745
src/lib/s3/Zip.Mod Normal file
View file

@ -0,0 +1,745 @@
(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
MODULE Zip; (** Stefan Walthert **)
IMPORT
Files := OakFiles, Zlib, ZlibReaders, ZlibWriters;
CONST
(** result codes **)
Ok* = 0; (** operation on zip-file was successful **)
FileError* = -1; (** file not found **)
NotZipArchiveError* = -2; (** file is not in zip format **)
EntryNotFound* = -3; (** specified file was not found in zip-file **)
EntryAlreadyExists* = -4; (** file is already stored in zip-file -> can not add specified file to zip-file **)
NotSupportedError* = -5; (** can not extract specified file (compression method not supported/file is encrypted) **)
DataError* = -6; (** file is corrupted **)
BadName* = -7; (** bad file name *)
ReaderError* = -8; (** e.g. Reader not opened before Read **)
(** compression levels **)
DefaultCompression* = ZlibWriters.DefaultCompression;
NoCompression* = ZlibWriters.NoCompression;
BestSpeed* = ZlibWriters.BestSpeed;
BestCompression* = ZlibWriters.BestCompression;
(** compression strategies **)
DefaultStrategy* = ZlibWriters.DefaultStrategy;
Filtered* = ZlibWriters.Filtered;
HuffmanOnly* = ZlibWriters.HuffmanOnly;
(* support *)
Supported = 0; (* can extract file *)
IncompatibleVersion = 1; (* version needed to extract < PKZIP 1.00 *)
Encrypted = 2; (* file is encrypted *)
UnsupCompMethod = 3; (* file not stored or deflated *)
Stored = 0; (* file is stored (no compression) *)
Deflated = 8; (* file is deflated *)
SupportedCompMethods = {Stored, Deflated};
CompatibleVersions = 1; (* versions >= CompatibleVersions are supported *)
(* headers *)
LocalFileHeaderSignature = 04034B50H;
CentralFileHeaderSignature = 02014B50H;
EndOfCentralDirSignature = 06054B50H;
TYPE
Entry* = POINTER TO EntryDesc; (** description of a file stored in the zip-archive **)
EntryDesc* = RECORD
name-: ARRAY 256 OF CHAR; (** name of file stored in the zip-archive **)
method: INTEGER; (* compression method *)
time-, date-: LONGINT; (** (Oberon) time and date when file was last modified **)
crc32: LONGINT; (* checksum of uncompressed file data *)
compSize-, uncompSize-: LONGINT; (** size of compressed / uncompressed file **)
intFileAttr: INTEGER; (* internal file attributes, not used in this implementation *)
extFileAttr: LONGINT; (* external file attributes, not used in this implementation *)
extraField (* for future expansions *), comment-: POINTER TO ARRAY OF CHAR; (** comment for this file **)
genPurpBitFlag: INTEGER;
support: SHORTINT;
dataDescriptor: BOOLEAN; (* if set, data descriptor after (compressed) file data *)
offsetLocal: LONGINT; (* offset of file header in central directory *)
offsetFileData: LONGINT; (* offset of (compressed) file data *)
offsetCentralDir: LONGINT; (* offset of local file header *)
next: Entry
END;
Archive* = POINTER TO ArchiveDesc; (** description of a zipfile **)
ArchiveDesc* = RECORD
nofEntries-: INTEGER; (** total number of files stored in the zipfile **)
comment-: POINTER TO ARRAY OF CHAR; (** comment for zipfile **)
file: Files.File; (* pointer to the according zip-file *)
offset: LONGINT; (* offset of end of central dir record *)
firstEntry, lastEntry: Entry (* first and last Entry of Archive *)
END;
Reader* = POINTER TO ReaderDesc;
ReaderDesc* = RECORD (** structure for reading from a zip-file into a buffer **)
res-: LONGINT; (** result of last operation **)
open: BOOLEAN;
ent: Entry
END;
UncompReader = POINTER TO UncompReaderDesc;
UncompReaderDesc = RECORD (ReaderDesc) (* structur for reading from a uncompressed entry *)
fr: Files.Rider;
crc32: LONGINT; (* crc32 of uncomressed data *)
END;
DefReader = POINTER TO DefReaderDesc;
DefReaderDesc = RECORD (ReaderDesc) (* structure for reading from a deflated entry *)
zr: ZlibReaders.Reader
END;
(* length of str *)
PROCEDURE StringLength(VAR str(* in *): ARRAY OF CHAR): LONGINT;
VAR i, l: LONGINT;
BEGIN
l := LEN(str); i := 0;
WHILE (i < l) & (str[i] # 0X) DO
INC(i)
END;
RETURN i
END StringLength;
(* Converts Oberon time into MS-DOS time *)
PROCEDURE OberonToDosTime(t: LONGINT): INTEGER;
BEGIN
RETURN SHORT(t DIV 1000H MOD 20H * 800H + t DIV 40H MOD 40H * 20H + t MOD 40H DIV 2)
END OberonToDosTime;
(* Converts Oberon date into MS-DOS time *)
PROCEDURE OberonToDosDate(d: LONGINT): INTEGER;
BEGIN
RETURN SHORT((d DIV 200H + 1900 - 1980) * 200H + d MOD 200H)
END OberonToDosDate;
(* Converts MS-DOS time into Oberon time *)
PROCEDURE DosToOberonTime(t: INTEGER): LONGINT;
BEGIN
RETURN LONG(t) DIV 800H MOD 20H * 1000H + t DIV 20H MOD 40H * 40H + t MOD 20H * 2
END DosToOberonTime;
(* Converts MS-DOS date into Oberon date *)
PROCEDURE DosToOberonDate(d: INTEGER): LONGINT;
BEGIN
RETURN (LONG(d) DIV 200H MOD 80H + 1980 - 1900) * 200H + d MOD 200H
END DosToOberonDate;
(* Copy len bytes from src to dst; if compCRC32 is set, then the crc 32-checksum is computed *)
PROCEDURE Copy(VAR src, dst: Files.Rider; len: LONGINT; compCRC32: BOOLEAN; VAR crc32: LONGINT);
CONST
BufSize = 4000H;
VAR
n: LONGINT;
buf: ARRAY BufSize OF CHAR;
BEGIN
IF compCRC32 THEN crc32 := Zlib.CRC32(0, buf, -1, -1) END;
REPEAT
IF len < BufSize THEN n := len
ELSE n := BufSize
END;
Files.ReadBytes(src, buf, n);
IF compCRC32 THEN crc32 := Zlib.CRC32(crc32, buf, 0, n - src.res) END;
Files.WriteBytes(dst, buf, n - src.res);
DEC(len, n)
UNTIL len = 0
END Copy;
(* Reads an Entry, r must be at the start of a file header; returns NIL if read was not successful *)
PROCEDURE ReadEntry(VAR r: Files.Rider): Entry;
VAR
ent: Entry;
intDummy, nameLen, extraLen, commentLen: INTEGER;
longDummy: LONGINT;
bufDummy: ARRAY 256 OF CHAR;
BEGIN
Files.ReadLInt(r, longDummy);
IF longDummy = CentralFileHeaderSignature THEN
NEW(ent);
ent.offsetCentralDir := Files.Pos(r) - 4;
ent.support := 0;
Files.ReadInt(r, intDummy); (* version made by *)
Files.ReadInt(r, intDummy); (* version needed to extract *)
IF (intDummy MOD 100H) / 10 < CompatibleVersions THEN
ent.support := IncompatibleVersion
END;
Files.ReadInt(r, ent.genPurpBitFlag); (* general purpose bit flag *)
IF ODD(intDummy) THEN
ent.support := Encrypted (* bit 0: if set, file encrypted *)
END;
ent.dataDescriptor := ODD(intDummy DIV 8); (* bit 3: data descriptor after (compressed) file data *)
Files.ReadInt(r, ent.method); (* compression method *)
IF (ent.support = Supported) & ~(ent.method IN SupportedCompMethods) THEN
ent.support := UnsupCompMethod
END;
Files.ReadInt(r, intDummy); ent.time := DosToOberonTime(intDummy); (* last mod file time *)
Files.ReadInt(r, intDummy); ent.date := DosToOberonDate(intDummy); (* last mod file date *)
Files.ReadLInt(r, ent.crc32); (* crc-32 *)
Files.ReadLInt(r, ent.compSize); (* compressed size *)
Files.ReadLInt(r, ent.uncompSize); (* uncompressed size *)
Files.ReadInt(r, nameLen); (* filename length *)
Files.ReadInt(r, extraLen); (* extra field length *)
Files.ReadInt(r, commentLen); (* file comment length *)
Files.ReadInt(r, intDummy); (* disk number start *)
Files.ReadInt(r, ent.intFileAttr); (* internal file attributes *)
Files.ReadLInt(r, ent.extFileAttr); (* external file attributes *)
Files.ReadLInt(r, ent.offsetLocal); (* relative offset of local header *)
Files.ReadBytes(r, ent.name, nameLen); (* filename *)
IF extraLen # 0 THEN
NEW(ent.extraField, extraLen);
Files.ReadBytes(r, ent.extraField^, extraLen) (* extra field *)
END;
IF commentLen > 0 THEN
NEW(ent.comment, commentLen);
Files.ReadBytes(r, ent.comment^, commentLen) (* file comment *)
END;
(* read extra field length in the local file header (can be different from extra field length stored in the file header...) *)
longDummy := Files.Pos(r); (* store actual position of file reader *)
Files.Set(r, Files.Base(r), ent.offsetLocal + 28); (* set r to position of extra field length in local file header *)
Files.ReadInt(r, extraLen); (* extra field length *)
ent.offsetFileData := ent.offsetLocal + 30 + nameLen + extraLen; (* compute offset of file data *)
Files.Set(r, Files.Base(r), longDummy); (* set position of file reader to previous position *)
IF r.eof THEN (* if file is a zip-archive, r is not at end of file *)
ent := NIL
END
END;
RETURN ent;
END ReadEntry;
(* Writes a local file header *)
PROCEDURE WriteLocalFileHeader(ent: Entry; VAR r: Files.Rider);
BEGIN
Files.WriteLInt(r, LocalFileHeaderSignature); (* local file header signature *)
Files.WriteInt(r, CompatibleVersions * 10); (* version needed to extract *)
Files.WriteInt(r, ent.genPurpBitFlag); (* general purpose bit flag *)
Files.WriteInt(r, ent.method); (* compression method *)
Files.WriteInt(r, OberonToDosTime(ent.time)); (* last mod file time *)
Files.WriteInt(r, OberonToDosDate(ent.date)); (* last mod file date *)
Files.WriteLInt(r, ent.crc32); (* crc-32 *)
Files.WriteLInt(r, ent.compSize); (* compressed size *)
Files.WriteLInt(r, ent.uncompSize); (* uncompressed size *)
Files.WriteInt(r, SHORT(StringLength(ent.name))); (* filename length *)
IF ent.extraField # NIL THEN
Files.WriteInt(r, SHORT(LEN(ent.extraField^))) (* extra field length *)
ELSE
Files.WriteInt(r, 0)
END;
Files.WriteBytes(r, ent.name, StringLength(ent.name)); (* filename *)
IF ent.extraField # NIL THEN
Files.WriteBytes(r, ent.extraField^, LEN(ent.extraField^)) (* extra field *)
END
END WriteLocalFileHeader;
(* Writes file header in central directory, updates ent.offsetCentralDir *)
PROCEDURE WriteFileHeader(ent: Entry; VAR r: Files.Rider);
BEGIN
ent.offsetCentralDir := Files.Pos(r);
Files.WriteLInt(r, CentralFileHeaderSignature); (* central file header signature *)
Files.WriteInt(r, CompatibleVersions * 10); (* version made by *)
Files.WriteInt(r, CompatibleVersions * 10); (* version needed to extract *)
Files.WriteInt(r, ent.genPurpBitFlag); (* general purpose bit flag *)
Files.WriteInt(r, ent.method); (* compression method *)
Files.WriteInt(r, OberonToDosTime(ent.time)); (* last mod file time *)
Files.WriteInt(r, OberonToDosDate(ent.date)); (* last mod file date *)
Files.WriteLInt(r, ent.crc32); (* crc-32 *)
Files.WriteLInt(r, ent.compSize); (* compressed size *)
Files.WriteLInt(r, ent.uncompSize); (* uncompressed size *)
Files.WriteInt(r, SHORT(StringLength(ent.name))); (* filename length *)
IF ent.extraField = NIL THEN
Files.WriteInt(r, 0)
ELSE
Files.WriteInt(r, SHORT(LEN(ent.extraField^))); (* extra field length *)
END;
IF ent.comment = NIL THEN
Files.WriteInt(r, 0)
ELSE
Files.WriteInt(r, SHORT(LEN(ent.comment^))); (* file comment length *)
END;
Files.WriteInt(r, 0); (* disk number start *)
Files.WriteInt(r, ent.intFileAttr); (* internal file attributes *)
Files.WriteLInt(r, ent.extFileAttr); (* external file attributes *)
Files.WriteLInt(r, ent.offsetLocal); (* relative offset of local header *)
Files.WriteBytes(r, ent.name, StringLength(ent.name)); (* filename *)
IF ent.extraField # NIL THEN
Files.WriteBytes(r, ent.extraField^, LEN(ent.extraField^)) (* extra field *)
END;
IF ent.comment # NIL THEN
Files.WriteBytes(r, ent.comment^, LEN(ent.comment^)) (* file comment *)
END
END WriteFileHeader;
(* Writes end of central directory record *)
PROCEDURE WriteEndOfCentDir(arc: Archive; VAR r: Files.Rider);
VAR
size: LONGINT;
BEGIN
Files.WriteLInt(r, EndOfCentralDirSignature); (* end of central dir signature *)
Files.WriteInt(r, 0); (* number of this disk *)
Files.WriteInt(r, 0); (* number of the disk with the start of the central directory *)
Files.WriteInt(r, arc.nofEntries); (* total number of entries in the central dir on this disk *)
Files.WriteInt(r, arc.nofEntries); (* total number of entries in the central dir *)
IF arc.firstEntry # NIL THEN
Files.WriteLInt(r, arc.offset - arc.firstEntry.offsetCentralDir) (* size of the central directory (without end of central dir record) *)
ELSE
Files.WriteLInt(r, 0)
END;
IF arc.firstEntry = NIL THEN
Files.WriteLInt(r, arc.offset) (* offset of start of central directory with respect to the starting disk number *)
ELSE
Files.WriteLInt(r, arc.firstEntry.offsetCentralDir) (* offset of start of central directory with respect to the starting disk number *)
END;
IF arc.comment = NIL THEN
Files.WriteInt(r, 0) (* zipfile comment length *)
ELSE
Files.WriteInt(r, SHORT(LEN(arc.comment^))); (* zipfile comment length *)
Files.WriteBytes(r, arc.comment^, LEN(arc.comment^)) (* zipfile comment *)
END
END WriteEndOfCentDir;
(* Writes central directory + end of central directory record, updates arc.offset and offsetCentralDir of entries *)
PROCEDURE WriteCentralDirectory(arc: Archive; VAR r: Files.Rider);
VAR
ent: Entry;
BEGIN
ent := arc.firstEntry;
WHILE ent # NIL DO
WriteFileHeader(ent, r);
ent := ent.next
END;
arc.offset := Files.Pos(r);
WriteEndOfCentDir(arc, r)
END WriteCentralDirectory;
(** Returns an Archive data structure corresponding to the specified zipfile;
possible results:
- Ok: operation was successful
- FileError: file with specified name does not exist
- NotZipArchiveError: file is not a correct zipfile **)
PROCEDURE OpenArchive*(name: ARRAY OF CHAR; VAR res: LONGINT): Archive;
VAR
arc: Archive;
ent: Entry;
f: Files.File;
r: Files.Rider;
longDummy: LONGINT;
intDummy: INTEGER;
BEGIN
res := Ok;
f := Files.Old(name);
IF f = NIL THEN
res := FileError
ELSIF Files.Length(f) < 22 THEN
res := NotZipArchiveError
ELSE
longDummy := 0;
Files.Set(r, f, Files.Length(f) - 17);
WHILE (longDummy # EndOfCentralDirSignature) & (Files.Pos(r) > 4) DO
Files.Set(r, f, Files.Pos(r) - 5);
Files.ReadLInt(r, longDummy)
END;
IF longDummy # EndOfCentralDirSignature THEN
res := NotZipArchiveError
ELSE
NEW(arc);
arc.file := f;
arc.offset := Files.Pos(r) - 4;
Files.ReadInt(r, intDummy); (* number of this disk *)
Files.ReadInt(r, intDummy); (* number of the disk with the start of the central directory *)
Files.ReadInt(r, intDummy); (* total number of entries in the central dir on this disk *)
Files.ReadInt(r, arc.nofEntries); (* total number of entries in the central dir *)
Files.ReadLInt(r, longDummy); (* size of the central directory *)
Files.ReadLInt(r, longDummy); (* offset of start of central directory with respect to the starting disk number *)
Files.ReadInt(r, intDummy); (* zipfile comment length *)
IF intDummy # 0 THEN
NEW(arc.comment, intDummy);
Files.ReadBytes(r, arc.comment^, intDummy) (* zipfile comment *)
END;
IF Files.Pos(r) # Files.Length(f) THEN
res := NotZipArchiveError;
arc := NIL
ELSE
Files.Set(r, f, longDummy); (* set r on position of first file header in central dir *)
arc.firstEntry := ReadEntry(r); arc.lastEntry := arc.firstEntry;
ent := arc.firstEntry; intDummy := 0;
WHILE ent # NIL DO
arc.lastEntry := ent; INC(intDummy); (* count number of entries *)
ent.next := ReadEntry(r);
ent := ent.next
END;
IF intDummy # arc.nofEntries THEN
res := NotZipArchiveError;
arc := NIL
END
END;
Files.Close(f)
END
END;
RETURN arc
END OpenArchive;
(** Returns an Archive that corresponds to a file with specified name;
if there is already a zip-file with the same name, this already existing archive is returned;
possible results: cf. OpenArchive **)
PROCEDURE CreateArchive*(VAR name: ARRAY OF CHAR; VAR res: LONGINT): Archive;
VAR
f: Files.File;
r: Files.Rider;
arc: Archive;
BEGIN
f := Files.Old(name);
IF f # NIL THEN
RETURN OpenArchive(name, res)
ELSE
f := Files.New(name);
NEW(arc);
arc.file := f;
arc.nofEntries := 0;
arc.offset := 0;
Files.Set(r, f, 0);
WriteEndOfCentDir(arc, r);
Files.Register(f);
res := Ok;
RETURN arc
END
END CreateArchive;
(** Returns the first entry of the Archive arc (NIL if there is no Entry) **)
PROCEDURE FirstEntry*(arc: Archive): Entry;
BEGIN
IF arc = NIL THEN
RETURN NIL
ELSE
RETURN arc.firstEntry
END
END FirstEntry;
(** Returns the next Entry after ent **)
PROCEDURE NextEntry*(ent: Entry): Entry;
BEGIN
RETURN ent.next
END NextEntry;
(** Returns the Entry that corresponds to the file with the specified name and that is stored in the Archive arc;
possible results:
- Ok: Operation was successful
- NotZipArchiveError: arc is not a valid Archive
- EntryNotFound: no Entry corresponding to name was found **)
PROCEDURE GetEntry*(arc: Archive; VAR name: ARRAY OF CHAR; VAR res: LONGINT): Entry;
VAR
ent: Entry;
BEGIN
IF arc = NIL THEN
res := NotZipArchiveError
ELSE
ent := arc.firstEntry;
WHILE (ent # NIL) & (ent.name # name) DO
ent := ent.next
END;
IF ent = NIL THEN
res := EntryNotFound
ELSE
res := Ok
END
END;
RETURN ent
END GetEntry;
(** Uncompresses and writes the data of Entry ent to Files.Rider dst;
possible results:
- Ok: Data extracted
- NotZipArchiveError: arc is not a valid zip-archive
- EntryNotFound: ent is not an Entry of arc
- NotSupportedError: data of ent are encrypted or compression method is not supported
- DataError: zipfile is corrupted
- BadName: entry has a bad file name **)
PROCEDURE ExtractEntry*(arc: Archive; ent: Entry; VAR dst: Files.Rider; VAR res: LONGINT);
VAR
src: Files.Rider; crc32: LONGINT;
BEGIN
IF arc = NIL THEN
res := NotZipArchiveError
ELSIF Files.Base(dst) = NIL THEN
res := BadName
ELSIF (ent = NIL) OR (ent # GetEntry(arc, ent.name, res)) THEN
res := EntryNotFound
ELSIF ~(ent.method IN SupportedCompMethods) OR (ent.support > Supported) THEN
res := NotSupportedError
ELSE
CASE ent.method OF
| Stored:
Files.Set(src, arc.file, ent.offsetFileData);
Copy(src, dst, ent.uncompSize, TRUE, crc32);
IF crc32 = ent.crc32 THEN
res := Ok
ELSE
res := DataError
END
| Deflated:
Files.Set(src, arc.file, ent.offsetFileData);
ZlibReaders.Uncompress(src, dst, crc32, res);
IF (res = ZlibReaders.Ok) & (crc32 = ent.crc32) THEN
res := Ok
ELSE
res := DataError
END
END;
IF res = Ok THEN
Files.Close(Files.Base(dst));
END
END
END ExtractEntry;
(** Reads and compresses len bytes from Files.Rider src with specified level and strategy
and writes them to a new Entry in the Archive arc;
possible results:
- Ok: file was added to arc
- NotZipArchiveError: arc is not a valid zip-archive
- EntryAlreadyExists: there is already an Entry in arc with the same name
- DataError: error during compression
- BadName: src is not based on a valid file **)
PROCEDURE AddEntry*(arc: Archive; VAR name: ARRAY OF CHAR; VAR src: Files.Rider; len: LONGINT; level, strategy: SHORTINT; VAR res: LONGINT);
VAR
dst: Files.Rider; ent: Entry; start: LONGINT;
BEGIN
IF arc = NIL THEN
res := NotZipArchiveError
ELSIF Files.Base(src) = NIL THEN
res := BadName
ELSIF (GetEntry(arc, name, res) # NIL) & (res = Ok) THEN
res := EntryAlreadyExists
ELSE
NEW(ent);
COPY(name, ent.name);
ent.genPurpBitFlag := 0;
IF level = NoCompression THEN
ent.method := Stored
ELSE
ent.method := Deflated
END;
Files.GetDate(Files.Base(src), ent.time, ent.date);
ent.uncompSize := len;
ent.intFileAttr := 0;
ent.extFileAttr := 0;
ent.comment := NIL;
ent.support := Supported;
ent.dataDescriptor := FALSE;
IF arc.firstEntry # NIL THEN
ent.offsetLocal := arc.firstEntry.offsetCentralDir
ELSE
ent.offsetLocal := 0
END;
Files.Set(dst, arc.file, ent.offsetLocal);
WriteLocalFileHeader(ent, dst);
ent.offsetFileData := Files.Pos(dst);
Files.Close(arc.file);
start := Files.Pos(src);
IF level = 0 THEN
Copy(src, dst, len, TRUE, ent.crc32);
ent.compSize := len;
res := Ok
ELSE
ZlibWriters.Compress(src, dst, len, ent.compSize, level, strategy, ent.crc32, res);
IF res # ZlibWriters.Ok THEN
res := DataError
ELSE
res := Ok
END
END;
IF res = Ok THEN
ent.uncompSize := Files.Pos(src) - start;
Files.Close(arc.file);
Files.Set(dst, arc.file, ent.offsetLocal + 14);
Files.WriteLInt(dst, ent.crc32);
Files.WriteLInt(dst, ent.compSize);
Files.Close(arc.file);
IF arc.lastEntry # NIL THEN
arc.lastEntry.next := ent
ELSE (* archive has no entries *)
arc.firstEntry := ent
END;
arc.lastEntry := ent;
INC(arc.nofEntries);
Files.Set(dst, arc.file, ent.offsetFileData + ent.compSize);
WriteCentralDirectory(arc, dst);
Files.Close(arc.file);
res := Ok
END;
END
END AddEntry;
(** Deletes Entry ent from Archive arc;
Possible results:
- Ok: ent was deleted, ent is set to NIL
- NotZipArchiveError: arc is not a valid zip-archive
- EntryNotFound: ent is not an Entry of Archive arc **)
PROCEDURE DeleteEntry*(arc: Archive; VAR ent: Entry; VAR res: LONGINT);
CONST
BufSize = 4000H;
VAR
f: Files.File; r1, r2: Files.Rider;
ent2: Entry;
arcname: ARRAY 256 OF CHAR;
buf: ARRAY BufSize OF CHAR;
offset, diff: LONGINT;
BEGIN
IF arc = NIL THEN
res := NotZipArchiveError
ELSIF arc.firstEntry = NIL THEN
res := EntryNotFound
ELSIF arc.firstEntry = ent THEN
offset := arc.firstEntry.offsetLocal; (* arc.firstEntry.offsetLocal = 0 *)
IF arc.lastEntry = arc.firstEntry THEN
arc.lastEntry := arc.firstEntry.next (* = NIL *)
END;
arc.firstEntry := arc.firstEntry.next;
ent2 := arc.firstEntry;
res := Ok
ELSE
ent2 := arc.firstEntry;
WHILE (ent2.next # NIL) & (ent2.next # ent) DO
ent2 := ent2.next
END;
IF ent2.next = NIL THEN
res := EntryNotFound
ELSE
IF arc.lastEntry = ent2.next THEN
arc.lastEntry := ent2
END;
offset := ent2.next.offsetLocal;
ent2.next := ent2.next.next;
ent2 := ent2.next;
res := Ok
END
END;
IF res = Ok THEN
Files.GetName(arc.file, arcname);
f := Files.New(arcname);
Files.Set(r2, f, 0);
Files.Set(r1, arc.file, 0);
Copy(r1, r2, offset, FALSE, diff); (* no crc 32-checksum is computed -> diff used as dummy *)
Files.Close(f);
ASSERT(ent2 = ent.next);
IF ent2 # NIL THEN
Files.Set(r1, arc.file, ent2.offsetLocal);
Copy(r1, r2, arc.firstEntry.offsetCentralDir - ent2.offsetLocal, FALSE, diff); (* arc.firstEntry can not be NIL because ent # NIL *)
Files.Close(f);
diff := ent2.offsetLocal - offset
ELSE
diff := arc.offset - offset
END;
WHILE (ent2 # NIL) DO (* update offsets of entries *)
DEC(ent2.offsetLocal, diff); DEC(ent2.offsetFileData, diff); DEC(ent2.offsetCentralDir, diff);
ent2 := ent2.next
END;
DEC(arc.offset, diff);
DEC(arc.nofEntries);
WriteCentralDirectory(arc, r2);
Files.Register(f); arc.file := f; ent := NIL
END
END DeleteEntry;
(** open a Reader to read uncompressed data from a zip entry directly to memory **)
PROCEDURE OpenReader*(arc: Archive; ent: Entry): Reader;
VAR
dummyBuf: ARRAY 1 OF CHAR;
fr: Files.Rider;
r: Reader;
ur: UncompReader;
dr: DefReader;
BEGIN
IF ent.support = Supported THEN
IF ent.method = Stored THEN
NEW(ur);
ur.crc32 := Zlib.CRC32(0, dummyBuf, -1, -1);
Files.Set(ur.fr, arc.file, ent.offsetFileData);
r := ur;
r.open := TRUE;
r.res := Ok
ELSIF ent.method = Deflated THEN
Files.Set(fr, arc.file, ent.offsetFileData);
NEW(dr);
ZlibReaders.Open(dr.zr, FALSE, fr);
dr.res := dr.zr.res;
r := dr;
r.open := TRUE
ELSE
NEW(r);
r.open := FALSE;
r.res := NotSupportedError
END;
ELSE
NEW(r);
r.open := FALSE;
r.res := NotSupportedError
END;
r.ent := ent;
RETURN r;
END OpenReader;
(** read len bytes of uncompressed data into buf[offset] and return number of bytes actually read; Reader must be opened **)
PROCEDURE ReadBytes*(r: Reader; VAR buf: ARRAY OF CHAR; offset, len: LONGINT; VAR read: LONGINT);
VAR
bufp: POINTER TO ARRAY OF CHAR; i: LONGINT;
BEGIN
IF r.open THEN
IF r IS UncompReader THEN
IF offset = 0 THEN
Files.ReadBytes(r(UncompReader).fr, buf, len);
ELSE
NEW(bufp, len);
Files.ReadBytes(r(UncompReader).fr, bufp^, len);
FOR i := 0 TO len - 1 DO
buf[offset + i] := bufp[i]
END
END;
read := len - r(UncompReader).fr.res;
r(UncompReader).crc32 := Zlib.CRC32(r(UncompReader).crc32, buf, offset, read)
ELSIF r IS DefReader THEN
ZlibReaders.ReadBytes(r(DefReader).zr, buf, offset, len, read);
r.res := r(DefReader).zr.res
END
ELSE
r.res := ReaderError
END
END ReadBytes;
(** read decompressed byte **)
PROCEDURE Read*(r: Reader; VAR ch: CHAR);
VAR
buf: ARRAY 1 OF CHAR; read: LONGINT;
BEGIN
ReadBytes(r, buf, 0, 1, read);
ch := buf[0];
END Read;
(** close Reader **)
PROCEDURE Close*(r: Reader);
BEGIN
IF r.open THEN
IF r IS UncompReader THEN
IF r(UncompReader).crc32 # r.ent.crc32 THEN
r.res := DataError
ELSE
r.res := Ok
END
ELSIF r IS DefReader THEN
ZlibReaders.Close(r(DefReader).zr);
IF r(DefReader).zr.crc32 # r.ent.crc32 THEN
r.res := DataError
ELSE
r.res := r(DefReader).zr.res
END
ELSE
r.res := ReaderError
END;
r.open := FALSE
ELSE
r.res := ReaderError
END
END Close;
END Zip.

160
src/lib/s3/Zlib.Mod Normal file
View file

@ -0,0 +1,160 @@
(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
MODULE Zlib; (** Stefan Walthert **)
IMPORT
SYSTEM;
CONST
(** Result codes for compression/decompression functions **)
(** regular termination **)
Ok* = 0; (** some progress has been made (more input processed or more output produced **)
StreamEnd* = 1; (** all input has been consumed and all output has been produced (only when flush is set to Finish) **)
NeedDict* = 2;
(** errors **)
StreamError* = -2; (** stream state was inconsistent (for example stream.in.next or stream.out.next was 0) **)
DataError* = -3;
MemError* = -4;
BufError* = -5; (** no progress is possible (for example stream.in.avail or stream.out.avail was zero) **)
(** Flush values (Flushing may degrade compression for some compression algorithms and so it should be used only
when necessary) **)
NoFlush* = 0;
PartialFlush* = 1; (** will be removed, use SyncFlush instead **)
SyncFlush* = 2; (** pending output is flushed to the output buffer and the output is aligned on a byte boundary,
so that the compressor/decompressor can get all input data available so far. (In particular stream.in.avail
is zero after the call if enough output space has been provided before the call.) **)
FullFlush* = 3; (** all output is flushed as with SyncFlush, and the compression state is reset so that
decompression can restart from this point if previous compressed data has been damaged of if random access
is desired. Using FullFlush too often can seriously degrade the compression. **)
Finish* = 4; (** pending input is processed, pending output is flushed.
If Deflate/Inflate returns with StreamEnd, there was enough space.
If Deflate/Inflate returns with Ok, this function must be called again with Finish and more output space
(updated stream.out.avail) but no more input data, until it returns with StreamEnd or an error.
After Deflate has returned StreamEnd, the only possible operations on the stream are Reset or Close
Finish can be used immediately after Open if all the compression/decompression is to be done in a single step.
In case of compression, the out-Buffer (respectively stream.out.avail) must be at least 0.1% larger than the
in-Buffer (respectively stream.in.avail) plus 12 bytes. **)
(** compression levels **)
DefaultCompression* = -1;
NoCompression* = 0;
BestSpeed* = 1;
BestCompression* = 9;
(** compression strategies; the strategy only affects the compression ratio but not the correctness of the
compressed output even if it is not set appropriately **)
DefaultStrategy* = 0; (** for normal data **)
Filtered* = 1; (** for data produced by a filter (or predictor); filtered data consists mostly of small values with a
somewhat random distribution. In this case, the compression algorithm is tuned to compress them better.
The effect of Filtered is to force more Huffman coding and less string matching; it is somewhat intermediate
between DefaultStrategy and HuffmanOnly. **)
HuffmanOnly* = 2; (** to force Huffman encoding only (no string match) **)
(** data type **)
Binary* = 0;
Ascii* = 1;
Unknown* = 2;
DeflateMethod* = 8;
VAR
CRCTable: ARRAY 256 OF LONGINT;
PROCEDURE Adler32*(adler: LONGINT; VAR buf: ARRAY OF CHAR; offset, len: LONGINT): LONGINT;
CONST
base = 65521; (* largest prim smaller than 65536 *)
nmax = 5552; (* largest n such that 255n(n + 1) / 2 + (n + 1)(base - 1) <= 2^32 - 1 *)
VAR
s1, s2, k, offset0, len0: LONGINT;
BEGIN
offset0 := offset; len0 := len;
IF len < 0 THEN
RETURN 1
ELSE
s1 := adler MOD 10000H;
s2 := SYSTEM.LSH(adler, -16) MOD 10000H;
WHILE len > 0 DO
IF len < nmax THEN k := len ELSE k := nmax END;
DEC(len, k);
REPEAT
INC(s1, LONG(ORD(buf[offset])));
INC(s2, s1);
INC(offset);
DEC(k)
UNTIL k = 0;
s1 := s1 MOD base;
s2 := s2 MOD base
END;
RETURN SYSTEM.LSH(s2, 16) + s1
END
END Adler32;
(** Generate a table for a byte-wise 32-bit CRC calculation on the polynomial:
x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1.
Polynomials over GF(2) are represented in binary, one bit per coefficient,
with the lowest powers in the most significant bit. Then adding polynomials
is just exclusive-or, and multiplying a polynomial by x is a right shift by
one. If we call the above polynomial p, and represent a byte as the
polynomial q, also with the lowest power in the most significant bit (so the
byte 0xb1 is the polynomial x^7+x^3+x+1), then the CRC is (q*x^32) mod p,
where a mod b means the remainder after dividing a by b.
This calculation is done using the shift-register method of multiplying and
taking the remainder. The register is initialized to zero, and for each
incoming bit, x^32 is added mod p to the register if the bit is a one (where
x^32 mod p is p+x^32 = x^26+...+1), and the register is multiplied mod p by
x (which is shifting right by one and adding x^32 mod p if the bit shifted
out is a one). We start with the highest power (least significant bit) of
q and repeat for all eight bits of q.
The table is simply the CRC of all possible eight bit values. This is all
the information needed to generate CRC's on data a byte at a time for all
combinations of CRC register values and incoming bytes. **)
PROCEDURE InitCRCTable*();
CONST
poly = 0EDB88320H;
VAR
n, c, k: LONGINT;
BEGIN
FOR n := 0 TO 255 DO
c := n;
FOR k := 0 TO 7 DO
IF ODD(c) THEN c := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, poly)/SYSTEM.VAL(SET, SYSTEM.LSH(c, -1)))
ELSE c := SYSTEM.LSH(c, -1)
END
END;
CRCTable[n] := c
END
END InitCRCTable;
PROCEDURE CRC32*(crc: LONGINT; VAR buf: ARRAY OF CHAR; offset, len: LONGINT): LONGINT;
VAR idx: LONGINT;
BEGIN
IF offset < 0 THEN
crc := 0
ELSE
crc := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, crc)/{0..31});
WHILE len > 0 DO
idx := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, crc)/SYSTEM.VAL(SET, LONG(ORD(buf[offset])))) MOD 100H;
crc := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, CRCTable[idx])/SYSTEM.VAL(SET, SYSTEM.LSH(crc, -8)));
DEC(len); INC(offset)
END;
crc := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, crc)/{0..31})
END;
RETURN crc
END CRC32;
BEGIN
InitCRCTable();
END Zlib.

116
src/lib/s3/ZlibBuffers.Mod Normal file
View file

@ -0,0 +1,116 @@
(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
MODULE ZlibBuffers; (** Stefan Walthert **)
IMPORT
SYSTEM;
(*
should be portable even if SYSTEM is imported:
- PUT and GET only with byte sized operands
- no overlapping MOVEs (unless malignant client passes buffer memory to buffer operations)
*)
TYPE
(** input/output buffer **)
Address = LONGINT;
Buffer* = RECORD
avail-: LONGINT; (** number of bytes that can be produced/consumed **)
size-: LONGINT; (** total number of bytes in buffer memory **)
totalOut-, totalIn-: LONGINT; (** total number of bytes produced/consumed **)
next: Address; (* address of next byte to produce/consume **)
adr: Address; (* buffer memory *)
END;
(** set buf.totalIn and buf.totalOut to zero **)
PROCEDURE Reset*(VAR buf: Buffer);
BEGIN
buf.totalIn := 0; buf.totalOut := 0
END Reset;
(** initialize buffer on memory in client space **)
PROCEDURE Init* (VAR buf: Buffer; VAR mem: ARRAY OF CHAR; offset, size, avail: LONGINT);
BEGIN
ASSERT((0 <= offset) & (0 < size) & (offset + size <= LEN(mem)), 100);
ASSERT((0 <= avail) & (avail <= size),101);
buf.avail := avail; buf.size := size; buf.adr := SYSTEM.ADR(mem[offset]); buf.next := buf.adr;
END Init;
(** read byte from (input) buffer **)
PROCEDURE Read* (VAR buf: Buffer; VAR ch: CHAR);
BEGIN
ASSERT(buf.avail > 0, 100);
SYSTEM.GET(buf.next, ch);
INC(buf.next); DEC(buf.avail); INC(buf.totalIn)
END Read;
(** read len bytes from (input) buffer **)
PROCEDURE ReadBytes* (VAR buf: Buffer; VAR dst: ARRAY OF CHAR; offset, len: LONGINT);
BEGIN
ASSERT((0 <= offset) & (0 < len) & (offset + len <= LEN(dst)) & (len <= buf.avail), 100);
SYSTEM.MOVE(buf.next, SYSTEM.ADR(dst[offset]), len);
INC(buf.next, len); DEC(buf.avail, len); INC(buf.totalIn, len)
END ReadBytes;
(** write byte into (output) buffer **)
PROCEDURE Write* (VAR buf: Buffer; ch: CHAR);
BEGIN
ASSERT(buf.avail > 0, 100);
SYSTEM.PUT(buf.next, ch);
INC(buf.next); DEC(buf.avail); INC(buf.totalOut)
END Write;
(** write len bytes into (output) buffer **)
PROCEDURE WriteBytes* (VAR buf: Buffer; VAR src: ARRAY OF CHAR; offset, len: LONGINT);
BEGIN
ASSERT((0 <= offset) & (0 < len) & (offset + len <= LEN(src)) & (len <= buf.avail), 100);
SYSTEM.MOVE(SYSTEM.ADR(src[offset]), buf.next, len);
INC(buf.next, len); DEC(buf.avail, len); INC(buf.totalOut, len)
END WriteBytes;
(** rewind previously empty input buffer to first position after it has been filled with new input **)
PROCEDURE Rewind* (VAR buf: Buffer; avail: LONGINT);
BEGIN
ASSERT(buf.avail = 0, 100);
ASSERT((0 <= avail) & (avail <= buf.size), 101);
buf.next := buf.adr; buf.avail := avail
END Rewind;
(** move position of next read for -offset bytes **)
PROCEDURE Reread* (VAR buf: Buffer; offset: LONGINT);
BEGIN
ASSERT((0 <= offset) & (buf.avail + offset <= buf.size), 101);
DEC(buf.next, offset); INC(buf.avail, offset)
END Reread;
(** restart writing at starting position of output buffer after it has been emptied **)
PROCEDURE Rewrite* (VAR buf: Buffer);
BEGIN
buf.next := buf.adr; buf.avail := buf.size
END Rewrite;
(** fill input buffer with new bytes to consume **)
PROCEDURE Fill* (VAR buf: Buffer; VAR src: ARRAY OF CHAR; offset, size: LONGINT);
BEGIN
ASSERT((0 <= offset) & (0 < size) & (offset + size <= LEN(src)), 100);
ASSERT(buf.avail + size <= buf.size, 101);
IF buf.avail # 0 THEN
SYSTEM.MOVE(buf.next, buf.adr, buf.avail)
END;
buf.next := buf.adr + buf.avail;
SYSTEM.MOVE(SYSTEM.ADR(src[offset]), buf.next, size);
INC(buf.avail, size)
END Fill;
(** extract bytes from output buffer to make room for new bytes **)
PROCEDURE Drain* (VAR buf: Buffer; VAR dst: ARRAY OF CHAR; offset, size: LONGINT);
BEGIN
ASSERT((0 <= offset) & (0 < size) & (offset + size <= LEN(dst)), 100);
ASSERT(buf.avail + size <= buf.size, 101); (* can't consume more than is in buffer *)
SYSTEM.MOVE(buf.adr, SYSTEM.ADR(dst[offset]), size);
SYSTEM.MOVE(buf.adr + size, buf.adr, buf.size - buf.avail - size);
INC(buf.avail, size); DEC(buf.next, size);
END Drain;
END ZlibBuffers.

1492
src/lib/s3/ZlibDeflate.Mod Normal file
View file

File diff suppressed because it is too large Load diff

1230
src/lib/s3/ZlibInflate.Mod Normal file
View file

File diff suppressed because it is too large Load diff

113
src/lib/s3/ZlibReaders.Mod Normal file
View file

@ -0,0 +1,113 @@
(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
MODULE ZlibReaders; (** Stefan Walthert **)
IMPORT
Files := OakFiles, Zlib, ZlibBuffers, ZlibInflate;
CONST
(** result codes **)
Ok* = ZlibInflate.Ok; StreamEnd* = ZlibInflate.StreamEnd;
FileError* = -1; StreamError* = ZlibInflate.StreamError; DataError* = ZlibInflate.DataError; BufError* = ZlibInflate.BufError;
BufSize = 4000H;
TYPE
(** structure for reading from a file with deflated data **)
Reader* = RECORD
res-: LONGINT; (** current stream state **)
crc32-: LONGINT; (* crc32 of uncompressed data *)
wrapper-: BOOLEAN; (** if set, a zlib header and a checksum are present **)
eof: BOOLEAN; (* set if at end of input file and input buffer empty *)
r: Files.Rider;
in: POINTER TO ARRAY BufSize OF CHAR; (* input buffer space *)
s: ZlibInflate.Stream; (* decompression stream *)
END;
(** open reader on a Rider for input; is wrapper is not set, no zlib header and no checksum are present **)
PROCEDURE Open*(VAR r: Reader; wrapper: BOOLEAN; VAR fr: Files.Rider);
BEGIN
r.wrapper := wrapper;
r.eof := fr.eof;
ZlibInflate.Open(r.s, wrapper);
IF r.s.res.code = ZlibInflate.Ok THEN
NEW(r.in); ZlibBuffers.Init(r.s.in, r.in^, 0, BufSize, 0);
r.crc32 := Zlib.CRC32(0, r.in^, -1, -1);
r.r := fr;
r.res := Ok
ELSE
r.res := r.s.res.code
END
END Open;
(** read specified number of bytes into buffer and return number of bytes actually read **)
PROCEDURE ReadBytes*(VAR r: Reader; VAR buf: ARRAY OF CHAR; offset, len: LONGINT; VAR read: LONGINT);
BEGIN
ASSERT((0 <= offset) & (0 <= len) & (offset + len <= LEN(buf)), 100);
IF ~r.s.open THEN
r.res := StreamError; read := 0
ELSIF (r.res < Ok) OR (r.res = StreamEnd) OR (len <= 0) THEN
read := 0
ELSE
ZlibBuffers.Init(r.s.out, buf, offset, len, len);
WHILE (r.s.out.avail # 0) & (r.res = Ok) DO
IF r.s.in.avail = 0 THEN
Files.ReadBytes(r.r, r.in^, BufSize);
ZlibBuffers.Rewind(r.s.in, BufSize - r.r.res);
IF r.s.in.avail = 0 THEN
r.eof := TRUE;
IF r.r.res < 0 THEN
r.res := FileError
END
END
END;
IF r.res = Ok THEN
ZlibInflate.Inflate(r.s, ZlibInflate.NoFlush);
r.res := r.s.res.code
END
END;
r.crc32 := Zlib.CRC32(r.crc32, buf, offset, len - r.s.out.avail);
read := len - r.s.out.avail
END
END ReadBytes;
(** read decompressed byte **)
PROCEDURE Read*(VAR r: Reader; VAR ch: CHAR);
VAR
buf: ARRAY 1 OF CHAR; read: LONGINT;
BEGIN
ReadBytes(r, buf, 0, 1, read);
ch := buf[0]
END Read;
(** close reader **)
PROCEDURE Close*(VAR r: Reader);
BEGIN
ZlibInflate.Close(r.s);
r.in := NIL;
IF r.res = StreamEnd THEN
r.res := Ok
END
END Close;
(** uncompress deflated data from scr and write them to dst **)
PROCEDURE Uncompress*(VAR src, dst: Files.Rider; VAR crc32: LONGINT; VAR res: LONGINT);
VAR
r: Reader; buf: ARRAY BufSize OF CHAR; read: LONGINT;
BEGIN
Open(r, FALSE, src);
IF r.res = Ok THEN
REPEAT
ReadBytes(r, buf, 0, BufSize, read);
Files.WriteBytes(dst, buf, read)
UNTIL (r.res # Ok) OR (read = 0);
crc32 := r.crc32;
Close(r)
END;
res := r.res
END Uncompress;
END ZlibReaders.

161
src/lib/s3/ZlibWriters.Mod Normal file
View file

@ -0,0 +1,161 @@
(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
MODULE ZlibWriters; (** Stefan Walthert **)
IMPORT
Files := OakFiles, Zlib, ZlibBuffers, ZlibDeflate;
CONST
(** result codes **)
Ok* = ZlibDeflate.Ok; StreamEnd* = ZlibDeflate.StreamEnd;
StreamError* = ZlibDeflate.StreamError; DataError* = ZlibDeflate.DataError; BufError* = ZlibDeflate.BufError;
(** flush values **)
NoFlush* = ZlibDeflate.NoFlush;
SyncFlush* = ZlibDeflate.SyncFlush;
FullFlush* = ZlibDeflate.FullFlush;
(** compression levels **)
DefaultCompression* = ZlibDeflate.DefaultCompression; NoCompression* = ZlibDeflate.NoCompression;
BestSpeed* = ZlibDeflate.BestSpeed; BestCompression* = ZlibDeflate.BestCompression;
(** compression strategies **)
DefaultStrategy* = ZlibDeflate.DefaultStrategy; Filtered* = ZlibDeflate.Filtered; HuffmanOnly* = ZlibDeflate.HuffmanOnly;
BufSize = 10000H;
TYPE
(** structure for writing deflated data in a file **)
Writer* = RECORD
res-: LONGINT; (** current stream state **)
flush-: SHORTINT; (** flush strategy **)
wrapper-: BOOLEAN; (** if set, zlib header and checksum are generated **)
r: Files.Rider; (* file rider *)
pos: LONGINT; (* logical position in uncompressed input stream *)
crc32-: LONGINT; (** crc32 of uncompressed data **)
out: POINTER TO ARRAY BufSize OF CHAR; (* output buffer space *)
s: ZlibDeflate.Stream (* compression stream *)
END;
(** change deflate parameters within the writer **)
PROCEDURE SetParams*(VAR w: Writer; level, strategy, flush: SHORTINT);
BEGIN
IF flush IN {NoFlush, SyncFlush, FullFlush} THEN
ZlibDeflate.SetParams(w.s, level, strategy);
w.flush := flush;
w.res := w.s.res
ELSE
w.res := StreamError
END
END SetParams;
(** open writer on a Files.Rider **)
PROCEDURE Open*(VAR w: Writer; level, strategy, flush: SHORTINT; wrapper: BOOLEAN; r: Files.Rider);
BEGIN
IF flush IN {NoFlush, SyncFlush, FullFlush} THEN
w.flush := flush;
w.wrapper := wrapper;
ZlibDeflate.Open(w.s, level, strategy, FALSE);
IF w.s.res = Ok THEN
NEW(w.out); ZlibBuffers.Init(w.s.out, w.out^, 0, BufSize, BufSize);
w.crc32 := Zlib.CRC32(0, w.out^, -1, -1);
w.r := r;
w.res := Ok
ELSE
w.res := w.s.res
END
ELSE
w.res := StreamError
END
END Open;
(** write specified number of bytes from buffer into and return number of bytes actually written **)
PROCEDURE WriteBytes*(VAR w: Writer; VAR buf: ARRAY OF CHAR; offset, len: LONGINT; VAR written: LONGINT);
BEGIN
ASSERT((0 <= offset) & (0 <= len) & (len <= LEN(buf)), 110);
IF ~w.s.open THEN
w.res := StreamError; written := 0
ELSIF (w.res < Ok) OR (len <= 0) THEN
written := 0
ELSE
ZlibBuffers.Init(w.s.in, buf, offset, len, len);
WHILE (w.res = Ok) & (w.s.in.avail # 0) DO
IF (w.s.out.avail = 0) THEN
Files.WriteBytes(w.r, w.out^, BufSize);
ZlibBuffers.Rewrite(w.s.out)
END;
IF w.res = Ok THEN
ZlibDeflate.Deflate(w.s, w.flush);
w.res := w.s.res
END
END;
w.crc32 := Zlib.CRC32(w.crc32, buf, offset, len - w.s.in.avail);
written := len - w.s.in.avail
END;
END WriteBytes;
(** write byte **)
PROCEDURE Write*(VAR w: Writer; ch: CHAR);
VAR
buf: ARRAY 1 OF CHAR;
written: LONGINT;
BEGIN
buf[0] := ch;
WriteBytes(w, buf, 0, 1, written)
END Write;
(** close writer **)
PROCEDURE Close*(VAR w: Writer);
VAR
done: BOOLEAN;
len: LONGINT;
BEGIN
ASSERT(w.s.in.avail = 0, 110);
done := FALSE;
LOOP
len := BufSize - w.s.out.avail;
IF len # 0 THEN
Files.WriteBytes(w.r, w.out^, len);
ZlibBuffers.Rewrite(w.s.out)
END;
IF done THEN EXIT END;
ZlibDeflate.Deflate(w.s, ZlibDeflate.Finish);
IF (len = 0) & (w.s.res = BufError) THEN
w.res := Ok
ELSE
w.res := w.s.res
END;
done := (w.s.out.avail # 0) OR (w.res = StreamEnd);
IF (w.res # Ok) & (w.res # StreamEnd) THEN EXIT END
END;
ZlibDeflate.Close(w.s);
w.res := w.s.res
END Close;
(** compress srclen bytes from src to dst with specified level and strategy. dstlen returns how many bytes have been written. **)
PROCEDURE Compress*(VAR src, dst: Files.Rider; srclen: LONGINT; VAR dstlen: LONGINT; level, strategy: SHORTINT; VAR crc32: LONGINT; VAR res: LONGINT);
VAR
w: Writer; buf: ARRAY BufSize OF CHAR; totWritten, written, read: LONGINT;
BEGIN
Open(w, level, strategy, NoFlush, FALSE, dst);
IF w.res = Ok THEN
totWritten := 0;
REPEAT
IF (srclen - totWritten) >= BufSize THEN read := BufSize
ELSE read := srclen - totWritten
END;
Files.ReadBytes(src, buf, read);
WriteBytes(w, buf, 0, read - src.res, written);
INC(totWritten, written)
UNTIL (w.res # Ok) OR (totWritten >= srclen);
Close(w);
crc32 := w.crc32;
dstlen := Files.Pos(w.r) - Files.Pos(dst);
END;
res := w.res
END Compress;
END ZlibWriters.

5
src/lib/v4/OakFiles.Mod
View file

@ -626,6 +626,11 @@ Especially Length would become fairly complex.
Write(R, CHR(x MOD 128))
END WriteNum;
PROCEDURE GetName*(f: File; VAR name: ARRAY OF CHAR);
BEGIN
COPY (f.workName, name);
END GetName;
PROCEDURE Finalize(o: SYSTEM.PTR);
VAR f: File; res: LONGINT;
BEGIN