(*
    Title: 	HeapStream- Implementation
    LastEdit:	"Tue Sep 11 09:45:24 1984"
    Author: 	Mick Jordan
		Cambridge University Computer Laboratory

    In-Store I/O system for temporary data.
*)

(* $T-, $R- *)

IMPLEMENTATION MODULE HeapStream;

FROM SYSTEM IMPORT WORD, BYTESPERWORD, ADDRESS;
FROM SystemTypes IMPORT LongINTEGER, LongCARDINAL;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
IMPORT Slist;

FROM Streams IMPORT 
    Create, Stream, StreamProcs, ErrorCode, SeekMode, OptionalFunction;
FROM StreamRep IMPORT
    DefaultProcs, NullFlush, SetStreamError, 
    PutProc, Procs;


CONST chbufupb = 1023;
CONST chbuflength = chbufupb+1;

VAR procs: Procs;

TYPE BUFFERLENGTH = [0 .. chbuflength];
TYPE BUFFER = ARRAY [0 .. chbufupb] OF CHAR;
    BUFFERPTR = POINTER TO BUFFER;

TYPE BLOCKPTR = POINTER TO BLOCK;
TYPE BLOCK = RECORD
        link: BLOCKPTR;
        buf: BUFFER;
    END (* record *);

TYPE StreamDATA = POINTER TO
RECORD
    bufsize: BUFFERLENGTH;(* size of current buffer *)
    streambufno: CARDINAL;              (* data pair specifying *)
    streambufoffset: BUFFERLENGTH;      (* position on stream *)
    hwmbufno: CARDINAL;                 (* high water mark *)
    hwmbufoffset: BUFFERLENGTH;
    blocklist: BLOCKPTR;                (* chain of data block headers *)
    currentblock: BLOCKPTR;             (* current block header *)
    stream: Stream;                     (* back pointer *)
END;

PROCEDURE CurPos(b: StreamDATA; VAR cp: LongCARDINAL);
    (*  Combines the buffer count and byte count into a character pointer *)
BEGIN
    WITH b^ DO
        cp := streambufno * chbuflength + streambufoffset;
    END;
END CurPos;

PROCEDURE SetBufSize(b: StreamDATA);
BEGIN
    WITH b^ DO
        IF currentblock^.link = NIL THEN
            bufsize := hwmbufoffset;
        ELSE
            bufsize := chbuflength;
        END (* if *);
    END (* with *);
END SetBufSize;

PROCEDURE WriteBuffer(b: StreamDATA);
VAR
    bl: BLOCKPTR;
BEGIN
    WITH b^ DO
        INC(streambufno);
        streambufoffset := 0;
        IF currentblock^.link = NIL THEN
            NEW(bl);
            Slist.AddE(blocklist, bl);
            INC(hwmbufno);
            hwmbufoffset := 0;
        END (* if *);
        currentblock := currentblock^.link;
        SetBufSize(b);
    END (* with *);
END WriteBuffer;

PROCEDURE ReadBuffer(b: StreamDATA): INTEGER;
VAR r: INTEGER;
BEGIN
    WITH b^ DO
        IF currentblock^.link = NIL THEN
            b^.stream^.status := EndOfStream;
            RETURN 0;
        ELSE
            currentblock := currentblock^.link;
            INC(streambufno);
            streambufoffset := 0;
            SetBufSize(b);
            RETURN 1;
        END (* if *);
    END; (* with *)
END ReadBuffer;

PROCEDURE Implements(s: Stream; f: OptionalFunction): BOOLEAN;
BEGIN
    RETURN TRUE;
END Implements;

PROCEDURE Get(s: Stream): WORD;
VAR
    b: StreamDATA;
    r: INTEGER;
BEGIN
    b := StreamDATA(s^.instanceData);
    WITH b^ DO
        IF (streambufoffset >= bufsize) THEN
            r := ReadBuffer(b);
            IF r<=0 THEN RETURN WORD(0); END;
        END (* if *);
        INC(streambufoffset);
        RETURN WORD(currentblock^.buf[streambufoffset-1]);
    END (* with *);
END Get;

PROCEDURE GetN(s: Stream; a: ADDRESS; n: CARDINAL): CARDINAL;
VAR
    b: StreamDATA;
    i, bytesLeft, toGet, totalGet: CARDINAL;
    getNBuf: BUFFERPTR;
BEGIN
    b := StreamDATA(s^.instanceData);
    WITH b^ DO
        getNBuf := BUFFERPTR(a);
        totalGet := 0;
        WHILE n > 0 DO
            IF streambufoffset >= bufsize THEN
                IF ReadBuffer(b) <= 0 THEN
                    RETURN totalGet;
                END (* if *);
            END (* if *);
            bytesLeft := bufsize - streambufoffset;
            IF bytesLeft < n THEN
                toGet := bytesLeft
            ELSE
                toGet := n;
            END (* if *);
            FOR i := 0 TO toGet-1 DO
                getNBuf^[totalGet+i] := currentblock^.buf[streambufoffset+i];
            END (* for *);
            INC(streambufoffset, toGet);
            DEC(n, toGet); INC(totalGet, toGet);
        END (* while *);
    END (* with *);
    RETURN totalGet;
END GetN;

PROCEDURE Put(s: Stream; word: WORD);
VAR
    b: StreamDATA;
BEGIN
    b := StreamDATA(s^.instanceData);
    WITH b^ DO
        currentblock^.buf[streambufoffset] := CHAR(word);
        INC(streambufoffset);
        IF streambufoffset > chbufupb THEN
            WriteBuffer(b);
        ELSIF currentblock^.link = NIL THEN
            hwmbufoffset := streambufoffset;
        END (* if *);
    END (* with *);
END Put;

PROCEDURE PutN(s: Stream; a: ADDRESS; n: CARDINAL): CARDINAL;
VAR
    b: StreamDATA;
    r: INTEGER;
    i, freeBytes, toPut, totalPut: CARDINAL;
    putNBuf: BUFFERPTR;
BEGIN
    b := StreamDATA(s^.instanceData);
    WITH b^ DO
        putNBuf := BUFFERPTR(a);
        totalPut := 0; r := 0;
        WHILE (n > 0) AND (r >= 0) DO
            freeBytes := chbuflength - streambufoffset;
            IF freeBytes < n THEN
                toPut := freeBytes
            ELSE
                toPut := n;
            END (* if *);
            IF toPut > 0 THEN
                FOR i := 0 TO toPut-1 DO
                    currentblock^.buf[streambufoffset+i] := putNBuf^[totalPut+i]
                END (* for *);
                INC(streambufoffset, toPut);
            END (* if *);
            IF streambufoffset > chbufupb THEN
                WriteBuffer(b);
            ELSIF currentblock^.link = NIL THEN
                hwmbufoffset := streambufoffset;
            END (* if *);
            DEC(n, toPut);
            INC(totalPut, toPut);
        END (* while *);
    END (* with *);
    RETURN totalPut;
END PutN;

PROCEDURE Delete(s: Stream);
VAR
    b: StreamDATA;
    thisBlock, nextBlock: BLOCKPTR;
BEGIN
    b := StreamDATA(s^.instanceData);
    WITH b^ DO
        thisBlock := blocklist;
        WHILE thisBlock # NIL DO
            nextBlock := thisBlock^.link;
            DISPOSE(thisBlock);
            thisBlock := nextBlock;
        END (* while *);
        DISPOSE(b);
    END (* with *);
END Delete;

PROCEDURE Backspace(s: Stream);
BEGIN
    Seek(s, Current, -1);
END Backspace;

PROCEDURE Tell(s: Stream; VAR p: LongCARDINAL);
VAR
    b: StreamDATA;
BEGIN
    b := StreamDATA(s^.instanceData);
    CurPos(b, p);
END Tell;

PROCEDURE Seek(s: Stream; sm: SeekMode; offset: LongINTEGER);
VAR
    trueoffset: LongINTEGER;
    i, curpos: LongCARDINAL;
    b: StreamDATA;
BEGIN
    b := StreamDATA(s^.instanceData);
    CASE sm OF
      Beginning:
        trueoffset := offset;
    | Current:
        CurPos(b, curpos);
        trueoffset := LongINTEGER(curpos) + offset;
    | End:
        trueoffset := LongINTEGER(b^.hwmbufno * chbuflength +
          b^.hwmbufoffset) + offset;
    END (* case *);

    WITH b^ DO
        streambufno := trueoffset DIV chbuflength;
        streambufoffset := trueoffset MOD chbuflength;
        currentblock := blocklist;
        FOR i := 1 TO streambufno DO
            currentblock := currentblock^.link;
        END (* for *);
        SetBufSize(b);
    END (* with *)
END Seek;

PROCEDURE CreateInOutput(): Stream;
VAR 
    b: StreamDATA;
    s: Stream;
BEGIN
    NEW(b); (* allocate bufferdata record *)
    WITH b^  DO
        streambufno := 0; streambufoffset := 0;
        hwmbufno := 0; hwmbufoffset := 0;
        NEW(blocklist);
        blocklist^.link := NIL;
        currentblock := blocklist;
        bufsize := 0;
    END (* with *);
    s := Create(StreamProcs(procs), b);
    b^.stream := s;
    RETURN s;
END CreateInOutput;

BEGIN
    procs := DefaultProcs(8);
    procs^.Get := Get; procs^.Put := Put;
    procs^.GetN := GetN; procs^.PutN := PutN;
    procs^.Backspace := Backspace;
    procs^.Seek := Seek; procs^.Tell := Tell;
    procs^.Implements := Implements;
    procs^.Flush := NullFlush;
    procs^.Delete := Delete;
END HeapStream .