Category : Modula II Source Code
Archive   : BLOCKIO.ZIP
Filename : BLOCKIO.MOD

 
Output of file : BLOCKIO.MOD contained in archive : BLOCKIO.ZIP


IMPLEMENTATION MODULE blockio;

FROM FileSystem IMPORT
(* type *) File,
(* proc *) Length, Reset, SetOpen, ReadNBytes, Delete,
Lookup, SetWrite, SetRead, WriteNBytes,
Close;

FROM Storage IMPORT
(* proc *) ALLOCATE;

CONST
maxbufferin = 800; (* Size of the input buffer *)
maxbufferin2 = 100; (* Size of the backup buffer *)
maxbufferout = 800; (* Size of the ouput buffer *)
maxbufferout2 = 100; (* Size of the backup buffer *)
endofinput = 01C;

TYPE
inarray = ARRAY[ 1 .. maxbufferin ] OF CHAR;

inarray2 = ARRAY[ 1 .. maxbufferin2 ] OF CHAR;

outarray = ARRAY[ 1 .. maxbufferout ] OF CHAR;

outarray2 = ARRAY[ 1 .. maxbufferout2 ] OF CHAR;

VAR
in : File;
out : File;
outbuffer : POINTER TO outarray;
outbuffer2 : POINTER TO outarray2;
inbuffer : POINTER TO inarray;
inbuffer2 : POINTER TO inarray2;
inptr : CARDINAL;
inptr2 : CARDINAL;
outptr : CARDINAL;
outptr2 : CARDINAL;
numbuffers : CARDINAL; (* Number of buffers left to
fill *)
remainder : CARDINAL; (* Number of bytes in last
buffer *)
firstbuffin : BOOLEAN; (* True if in buffer1 *)
firstbuffout : BOOLEAN; (* True if in buffer1 *)
inbackup : BOOLEAN; (* True if in buffer2 *)
outbackup : BOOLEAN; (* True if in buffer2 *)


PROCEDURE openinput
( filename : ARRAY OF CHAR );

VAR
size : REAL;
temp : REAL;
high,
low : CARDINAL;
new : BOOLEAN;

BEGIN
Lookup( in, filename, new );
SetOpen( in );
SetRead( in );
Length( in, high, low );
size := FLOAT( high ) * 65535.0 + FLOAT( low );
temp := size / FLOAT( maxbufferin );
numbuffers := TRUNC( temp ) + 1;
temp := size - ( FLOAT( numbuffers ) - 1.0 ) * FLOAT(
maxbufferin );
remainder := TRUNC( temp );
IF numbuffers > 1
THEN
ReadNBytes( in, inbuffer, maxbufferin, inptr );
ELSE
ReadNBytes( in, inbuffer, remainder, inptr );
inbuffer^[ inptr ] := endofinput;
END (* if then *);
DEC( numbuffers );
inptr := 1;
firstbuffin := TRUE;
inbackup := FALSE;
END openinput;


PROCEDURE resetinput;

VAR
high,
low : CARDINAL;
size,
temp : REAL;

BEGIN
Reset( in );
SetRead( in );
Length( in, high, low );
size := FLOAT( high ) * 65535.0 + FLOAT( low );
temp := size / FLOAT( maxbufferin );
numbuffers := TRUNC( temp ) + 1;
temp := size - ( FLOAT( numbuffers ) - 1.0 ) * FLOAT(
maxbufferin );
IF numbuffers > 1
THEN
ReadNBytes( in, inbuffer, maxbufferin, inptr );
ELSE
ReadNBytes( in, inbuffer, remainder, inptr );
inbuffer^[ inptr ] := endofinput;
END (* if then *);
DEC( numbuffers );
inptr := 1;
firstbuffin := TRUE;
inbackup := FALSE;
END resetinput;


PROCEDURE backupinput;

BEGIN
IF inptr > 0
THEN
DEC( inptr );
IF ( NOT firstbuffin ) AND ( inptr = 0 )
THEN
inbackup := TRUE;
inptr := maxbufferin2;
END (* if then *);
END (* if inptr *);
END backupinput;


PROCEDURE getnextchar
( VAR c : CHAR );

VAR
i : CARDINAL;

BEGIN
IF inbackup
THEN
c := inbuffer2^[ inptr ];
ELSE
c := inbuffer^[ inptr ];
END (* if then *);
IF c # endofinput
THEN
INC( inptr );
IF ( inbackup ) AND ( inptr > maxbufferin2 )
THEN
inbackup := FALSE;
inptr := 1;
END (* if then *);
IF inptr > maxbufferin
THEN
firstbuffin := FALSE;
inptr := 1;
(* Keep last maxbufferin2 bytes of previous inbuffer
so backup from new inbuffer is possible. *)
FOR i := maxbufferin - maxbufferin2 + 1 TO
maxbufferin DO
inbuffer2^[ inptr ] := inbuffer^[ i ];
INC( inptr );
END (* for loop *);
IF numbuffers > 1
THEN
ReadNBytes( in, inbuffer, maxbufferin, inptr );
ELSE
ReadNBytes( in, inbuffer, remainder, inptr );
inbuffer^[ inptr ] := endofinput;
END (* if then *);
DEC( numbuffers );
inptr := 1;
END (* if then *);
END (* if c *);
END getnextchar;


PROCEDURE openoutput
( filename : ARRAY OF CHAR );

VAR
new : BOOLEAN;

BEGIN
outptr := 0;
firstbuffout := TRUE;
outbackup := FALSE;
Delete( filename, out );
Lookup( out, filename, new );
SetOpen( out );
SetWrite( out );
END openoutput;


PROCEDURE closeoutput();

VAR
i : CARDINAL;

BEGIN
IF outbackup
THEN
WriteNBytes( out, outbuffer2, outptr, i );
ELSE
IF NOT firstbuffout
THEN
WriteNBytes( out, outbuffer2, maxbufferout2, i );
END (* if then *);
WriteNBytes( out, outbuffer, outptr, i );
END (* if then *);
Close( out );
END closeoutput;


PROCEDURE putchar
( c : CHAR );

VAR
ch : CHAR;
i : CARDINAL;

BEGIN
INC( outptr );
IF ( outbackup ) AND ( outptr > maxbufferout2 )
THEN
outbackup := FALSE;
outptr := 1;
END (* if then *);
IF outptr > maxbufferout
THEN
IF NOT firstbuffout
THEN
WriteNBytes( out, outbuffer2, maxbufferout2, i );
END (* if then *);
WriteNBytes( out, outbuffer, maxbufferout -
maxbufferout2, i );
(* Keep last maxbufferout2 bytes of previous buffer so
backup from new buffer is possible. *)
outptr := 1;
FOR i := maxbufferout - maxbufferout2 + 1 TO
maxbufferout DO
outbuffer2^[ outptr ] := outbuffer^[ i ];
INC( outptr );
END (* for loop *);
outptr := 1;
firstbuffout := FALSE;
END (* if then *);
IF outbackup
THEN
outbuffer2^[ outptr ] := c;
ELSE
outbuffer^[ outptr ] := c;
END (* if then *);
END putchar;


PROCEDURE backupoutput;

BEGIN
DEC( outptr );
IF ( NOT firstbuffout ) AND ( outptr = 0 )
THEN
outbackup := TRUE;
outptr := maxbufferout2;
END (* if then *);
END backupoutput;


BEGIN
NEW( outbuffer );
NEW( outbuffer2 );
NEW( inbuffer );
NEW( inbuffer2 );
END blockio.

  3 Responses to “Category : Modula II Source Code
Archive   : BLOCKIO.ZIP
Filename : BLOCKIO.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/