(*
    Title: 	StreamRep: Implementation
    LastEdit:	"Fri May 25 16:42:34 1984"
    Author: 	Mick Jordan
		Acorn Research Centre;  hacked by LDS.
*)

IMPLEMENTATION MODULE StreamRep;

FROM SYSTEM      IMPORT WORD, ADDRESS;
FROM SystemTypes IMPORT LongINTEGER, LongCARDINAL;
FROM Storage     IMPORT ALLOCATE, DEALLOCATE;
FROM Streams     IMPORT Stream, StreamProcs, ErrorCode, StreamErrorCodeType,
                        SeekMode, OptionalFunction;
                 IMPORT Slist;
FROM Exceptions  IMPORT RAISE;

PROCEDURE DefaultProcs(xelementSize: CARDINAL): Procs;
    VAR
        p: Procs;
    BEGIN
        NEW(p);
        WITH p^ DO
            elementSize := xelementSize;
            Put := DefaultPut; Get := DefaultGet;
            Backspace := DefaultBackspace;
            Flush := DefaultFlush; Delete := DefaultDelete;
            Implements := DefaultImplements;
            PutN := DefaultPutN; GetN := DefaultGetN;
            Seek := DefaultSeek; Tell := DefaultTell;
        END (* with *);
        RETURN p;
    END DefaultProcs;

PROCEDURE SetStreamError(s: Stream; error: StreamErrorCodeType);
    BEGIN
        s^.status := StreamError;
        s^.streamError := error;
    END SetStreamError;

PROCEDURE NullFlush(s: Stream);
    BEGIN
        
    END NullFlush;

MODULE DefaultProcImpls;
IMPORT
    WORD, ADDRESS, LongINTEGER, LongCARDINAL, ErrorCode,
    OptionalFunction, Stream, SeekMode, Procs;
IMPORT RAISE;

EXPORT
    DefaultGet, DefaultPut, DefaultDelete, DefaultBackspace,
    DefaultPutN, DefaultGetN, DefaultSeek, DefaultTell, DefaultFlush, 
    DefaultImplements;

TYPE BYTEPTR = POINTER TO ARRAY [0..0] OF CHAR;
(*  just to turn an ADDRESS into a pointer to a
    packed character array.
*)

CONST FunctionNotImplemented = "FunctionNotImplemented";

PROCEDURE DefaultGet(s: Stream): WORD;
    BEGIN
        RAISE(FunctionNotImplemented);
    END DefaultGet;

PROCEDURE DefaultPut(s: Stream; n: WORD);
    BEGIN
        RAISE(FunctionNotImplemented);
    END DefaultPut;

PROCEDURE DefaultDelete(s: Stream);
    BEGIN
        RAISE(FunctionNotImplemented);
    END DefaultDelete;

PROCEDURE DefaultBackspace(s: Stream);
    BEGIN
        RAISE(FunctionNotImplemented);
    END DefaultBackspace;

PROCEDURE DefaultImplements(s: Stream; f: OptionalFunction): BOOLEAN;
    BEGIN
        RAISE(FunctionNotImplemented);
    END DefaultImplements;

PROCEDURE DefaultFlush(s: Stream);
    BEGIN
        RAISE(FunctionNotImplemented);
    END DefaultFlush;

PROCEDURE DefaultGetN(s: Stream; a: ADDRESS; nreq: CARDINAL): CARDINAL;
    VAR
        pt: Procs;
        i: CARDINAL;
        byteptr: BYTEPTR;
    BEGIN
        (* $T-,$R- *)
        pt := Procs(s^.procs);
        IF pt^.elementSize = 8 THEN
            byteptr := BYTEPTR(a);
            FOR i := 0 TO nreq-1 DO
                byteptr^[i] := CHAR( pt^.Get(s) );
                IF s^.status # Success THEN
                    RETURN i;
                END (* if *);
            END (* for *);
        ELSE
            RAISE(FunctionNotImplemented);
        END (* if *);
        RETURN nreq;
        (* $T=,$R= *)
    END DefaultGetN;

PROCEDURE DefaultPutN(s: Stream; a: ADDRESS; nreq: CARDINAL): CARDINAL;
    VAR
        pt: Procs;
        i: CARDINAL;
        byteptr: BYTEPTR;
    BEGIN
    (* $T-,$R- *)
        pt := Procs(s^.procs);
        IF pt^.elementSize = 8 THEN
            byteptr := BYTEPTR(a);
            FOR i := 0 TO nreq-1 DO
                pt^.Put(s, byteptr^[i]);
                IF s^.status # Success THEN
                    RETURN i
                END (* if *);
            END (* for *);
        ELSE
            RAISE(FunctionNotImplemented);
        END (* if *);
        RETURN nreq;
    (* $T=,$R= *)
    END DefaultPutN;

PROCEDURE DefaultSeek(s: Stream; sm: SeekMode; l: LongINTEGER);
    BEGIN
        RAISE(FunctionNotImplemented);
    END DefaultSeek;

PROCEDURE DefaultTell(s: Stream; VAR p: LongCARDINAL);
    BEGIN
        RAISE(FunctionNotImplemented);
    END DefaultTell;

END DefaultProcImpls;

END StreamRep .