language-Modula2-0.1: examples/Modula-2_Libraries/andrea-m2/lib/eth-hamburg/blockio.mod
IMPLEMENTATION MODULE BlockIO;
(* J. Andrea, 1991, see the definition file for details *)
(* This code may be freely used and distributed, it may not be sold. *)
IMPORT RMSFiles;
FROM SYSTEM IMPORT BYTE, ADR, SIZE;
FROM RMSDefinitions IMPORT RMS$_EOF,RMS$_NORMAL,RMS$_CUR;
FROM RMS IMPORT FAB, NAM, RAB,
ORG$SEQ,
FACset, FOPset, RATset, RFMset, SHRset,
FACtype, FOPtype, ORGtype, RATtype, RFMtype, SHRtype,
ROPtype, ROPset;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
CONST
MaxRecordSize = 512;
TYPE
RecordSize = [0..MaxRecordSize];
BlockFile = POINTER TO FileBlock;
FileBlock = RECORD
fab: FAB;
nam: NAM;
rab: RAB;
trn: BOOLEAN;
fna: ARRAY [0..127] OF CHAR;
END;
VAR
status :CARDINAL;
lf :FileBlock;
op :ARRAY [0..9] OF CHAR; (* used by ShowStatus *)
(* ------------------------------------------------------------------ *)
PROCEDURE Done(): BOOLEAN;
BEGIN
RETURN ODD(status);
END Done;
(* ------------------------------------------------------------------ *)
PROCEDURE InitFileBlock( f :BlockFile );
BEGIN
f^.trn := FALSE;
END InitFileBlock;
(* ------------------------------------------------------------------ *)
PROCEDURE OpenIn( VAR f :BlockFile; filename: ARRAY OF CHAR );
BEGIN
NEW(f);
RMSFiles.Open( f^.fab, f^.nam, filename, FACset{FAC$BRO,FAC$GET}, FOPset{},
SHRset{}, f^.fna, status);
IF ODD(status) THEN
RMSFiles.Connect( f^.fab, f^.rab, ROPset{ROP$BIO}, status );
InitFileBlock(f);
END;
IF NOT ODD(status) THEN
lf := f^;
op := "Open";
DISPOSE(f)
END;
END OpenIn;
(* ------------------------------------------------------------------ *)
PROCEDURE Close( VAR f :BlockFile);
BEGIN
IF f <> NIL THEN
RMSFiles.Disconnect( f^.rab, status );
RMSFiles.Close( f^.fab, status );
IF NOT ODD(status) THEN
lf := f^;
op := "Close";
END;
DISPOSE(f);
ELSE
status := RMS$_NORMAL
END;
END Close;
(* ------------------------------------------------------------------ *)
PROCEDURE OpenOut( VAR f :BlockFile; filename: ARRAY OF CHAR );
(* create and open a new file *)
VAR
rfm: RFMtype;
mrs: CARDINAL;
BEGIN
rfm := RFM$FIX;
mrs := MaxRecordSize;
NEW(f);
RMSFiles.Create( f^.fab, f^.nam, filename,
FACset{FAC$BRO,FAC$PUT,FAC$TRN}, FOPset{},
SHRset{}, RATset{}, rfm, ORG$SEQ, mrs, 0, 0,
f^.fna, status );
IF ODD(status) THEN
RMSFiles.Connect( f^.fab, f^.rab, ROPset{}, status );
InitFileBlock(f);
END;
IF NOT ODD(status) THEN
lf := f^;
op := "Create";
DISPOSE(f)
END;
END OpenOut;
(* ------------------------------------------------------------------ *)
PROCEDURE Read( VAR f :BlockFile; count :CARDINAL;
VAR block :ARRAY OF BYTE; VAR size :CARDINAL );
BEGIN
size := SIZE( block );
RMSFiles.Read( f^.rab, count, ADR(block), size, status );
size := CARDINAL( f^.rab.RSZ );
IF NOT ODD(status) THEN
IF status # RMS$_EOF THEN
RMSFiles.SignalIOStatus( "Read", f^.fna, f^.rab.STS, f^.rab.STV);
END;
END;
END Read;
(* ------------------------------------------------------------------ *)
PROCEDURE Write( VAR f :BlockFile; count :CARDINAL;
block :ARRAY OF BYTE; size :CARDINAL );
(* write the count'th block *)
BEGIN
IF f^.trn THEN
RMSFiles.Truncate( f^.rab, status );
IF status = RMS$_CUR THEN (*no current record*)
RMSFiles.Find( f^.rab,status);
IF NOT ODD(status) THEN
IF status = RMS$_EOF THEN
status := RMS$_NORMAL;
ELSE
RMSFiles.SignalIOStatus( "Find",f^.fna,f^.rab.STS,f^.rab.STV);
END;
ELSE
RMSFiles.Truncate(f^.rab, status);
END;
END;
IF NOT ODD(status) THEN
RMSFiles.SignalIOStatus( "Truncate on Put",f^.fna,f^.rab.STS,f^.rab.STV)
END;
f^.trn := FALSE;
END;
IF size = 0 THEN
size := SIZE( block );
END;
RMSFiles.Write( f^.rab, count, ADR(block), size, status );
IF NOT ODD(status) THEN
RMSFiles.SignalIOStatus( "Put", f^.fna, f^.rab.STS, f^.rab.STV )
END;
END Write;
(* ------------------------------------------------------------------ *)
PROCEDURE Status(): CARDINAL;
BEGIN
RETURN status;
END Status;
(* ------------------------------------------------------------------ *)
PROCEDURE ShowStatus;
BEGIN
IF status = lf.fab.STS THEN
RMSFiles.ShowIOStatus( op, lf.fna, status, lf.fab.STV );
ELSIF status = lf.rab.STS THEN
RMSFiles.ShowIOStatus( op, lf.fna, status, lf.rab.STV );
ELSE
RMSFiles.ShowIOStatus( "", "", status, 0 );
END
END ShowStatus;
BEGIN (* BlockIO *)
END BlockIO.