Category : Modula II Source Code
Archive   : PATTERN.ZIP
Filename : FAINPUT.MOD

 
Output of file : FAINPUT.MOD contained in archive : PATTERN.ZIP
IMPLEMENTATION MODULE FAInput;
FROM FileSystem IMPORT Close,File,Lookup,ReadNBytes;
FROM SYSTEM IMPORT ADR,SIZE;
FROM Terminal IMPORT WriteLn,WriteString;

IMPORT ASCII,FileSystem;

CONST
ModuleName = "FAInput";

TYPE
Position = RECORD
buffer,index : CARDINAL;
END; (* Position *)

BufferRecord = RECORD
fill,index,valid : CARDINAL;
text : ARRAY [0..511] OF CHAR;
END; (* BufferRecord *)

VAR
curBuffer,fillNumber : CARDINAL;
inputFileOpened : BOOLEAN;
buffers : ARRAY [0..1] OF BufferRecord;
in : File;

PROCEDURE BackTrackPosition (VAR pos : Position);
BEGIN (* BackTrackPosition *)
WITH pos DO
IF index > 0 THEN
DEC (index);
ELSE
buffer := 1 - buffer;
index := buffers [buffer].valid - 1;
END; (* IF *)
END; (* WITH *)
END BackTrackPosition;

PROCEDURE CloseInputFile;
BEGIN (* CloseInputFile *)
IF NOT (inputFileOpened) THEN
TerminalError (ModuleName,"Invalid attempt to close input file.");
END; (* IF *)

inputFileOpened := FALSE;

Close (in);
END CloseInputFile;

PROCEDURE DeterminePosition (VAR pos : Position);
BEGIN (* DeterminePosition *)
WITH pos DO
buffer := curBuffer;
index := buffers [curBuffer].index;
END; (* WITH *)
END DeterminePosition;

PROCEDURE FillBuffer (num : CARDINAL);
BEGIN (* FillBuffer *)
WITH buffers [num] DO
IF fillNumber <> fill THEN
INC (fillNumber);

IF NOT (in.eof) THEN
ReadNBytes (in,ADR (text),SIZE (text),valid);
ELSE
text [0] := 32C;
valid := 1;
END; (* IF *)

index := 0;
fill := fillNumber;
END; (* IF *)
END; (* WITH *)
END FillBuffer;

PROCEDURE OpenInputFile (name : ARRAY OF CHAR; VAR done : BOOLEAN);
BEGIN (* OpenInputFile *)
IF inputFileOpened THEN
TerminalError (ModuleName,"Invalid attempt to open input file.");
END; (* IF *)

Lookup (in,name,FALSE);

IF in.res = FileSystem.done THEN
buffers [0].fill := MAX (CARDINAL);
buffers [1].fill := MAX (CARDINAL);

inputFileOpened := TRUE;
fillNumber := 0;
curBuffer := 0;
done := TRUE;

FillBuffer (0);
ELSE
done := FALSE;
END; (* IF*)
END OpenInputFile;

PROCEDURE NextChar () : CHAR;
VAR
change : BOOLEAN;
ch : CHAR;

BEGIN (* NextChar *)
WITH buffers [curBuffer] DO
ch := text [index];
INC (index);

change := (index = valid);
END; (* WITH *)

IF change THEN
curBuffer := 1 - curBuffer;
FillBuffer (curBuffer);
END; (* IF *)

RETURN (ch);
END NextChar;

PROCEDURE ReturnLexeme (start,end : Position; VAR lex : ARRAY OF CHAR);
VAR
index : CARDINAL;

PROCEDURE MoveRight (VAR pos : Position);
BEGIN (* MoveRight *)
WITH pos DO
INC (index);

IF index >= buffers [buffer].valid THEN
buffer := 1 - buffer;
index := 0;
END; (* IF *)
END; (* WITH *)
END MoveRight;

PROCEDURE ReturnChar (pos : Position; VAR ch : CHAR);
BEGIN (* ReturnChar *)
WITH buffers [pos.buffer] DO
ch := text [pos.index];
END; (* WITH *)
END ReturnChar;

PROCEDURE SamePosition (pos1,pos2 : Position) : BOOLEAN;
BEGIN (* SamePosition *)
RETURN ((pos1.buffer = pos2.buffer) AND (pos1.index = pos2.index));
END SamePosition;

BEGIN (* ReturnLexeme *)
index := 0;

WHILE (NOT (SamePosition (start,end)) AND (index <= HIGH (lex))) DO
ReturnChar (start,lex [index]);
MoveRight (start);

INC (index);
END; (* WHILE *)

IF index <= HIGH (lex) THEN
lex [index] := ASCII.nul;
END; (* IF *)
END ReturnLexeme;

PROCEDURE SetPosition (pos : Position);
BEGIN (* SetPosition *)
buffers [pos.buffer].index := pos.index;
curBuffer := pos.buffer;
END SetPosition;

(*

The procedure TerminalError should actually come from my library.
It's normally a procedure variable which can be set to a number of
routines designed to halt the system in varying ways. I didn't
want to include the library module because it drags in all sorts
of other things.

*)

PROCEDURE TerminalError (module,error : ARRAY OF CHAR);
BEGIN (* TerminalError *)
WriteString (module);
WriteString (" ===> ");
WriteString (error);
WriteLn;

HALT;
END TerminalError;

BEGIN (* FAInput *)
inputFileOpened := FALSE;
END FAInput.


  3 Responses to “Category : Modula II Source Code
Archive   : PATTERN.ZIP
Filename : FAINPUT.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/