home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
549a.lha
/
M2P_v1.0
/
mods.lzh
/
FIO.mod
< prev
next >
Wrap
Text File
|
1991-08-10
|
16KB
|
743 lines
(*======================================================================*)
(* Amiga Modula-2 support routines *)
(*======================================================================*)
IMPLEMENTATION MODULE FIO;
(*----------------------------------------------------------------------*
* Imports *** SOME IMPLEMENTATION DEPENDENT *** *
*----------------------------------------------------------------------*)
IMPORT
SYSTEM;
IMPORT
FStorage;
IMPORT
ASCII;
IMPORT
Strings;
(*----------------------------------------------------------------------*
* Constants for configuring to personal preferences *
*----------------------------------------------------------------------*)
CONST
BufferSize = 4096;
MaxFileName = 256;
MaxPrompt = 80;
(*----------------------------------------------------------------------*)
(* The IMPLEMENTATION DEPENDENT 'real' file type. *)
(*----------------------------------------------------------------------*)
TYPE
RealFileType =
(* insert implementation specific type here *)
(*----------------------------------------------------------------------*)
(* The buffered FILE structure *)
(*----------------------------------------------------------------------*)
TYPE
Access = (Closed,Read,Write);
AccessSet = SET OF Access;
FILE = POINTER TO FHBlock;
FHBlock = RECORD
Next: FILE;
Handle: RealFileType;
Mode: Access;
CharsRead: CARDINAL;
Count: CARDINAL;
Prompt: ARRAY [0..MaxPrompt] OF CHAR;
Info: ARRAY [0..BufferSize] OF CHAR;
END;
(*----------------------------------------------------------------------*)
TYPE
Chars = [00C..37C];
Terms = SET OF Chars;
CONST
Space = ' ';
Terminators = Terms{ASCII.NUL,ASCII.EOL,ASCII.EOF};
WhiteSpace = Terms{ASCII.EOL,ASCII.HT};
(*----------------------------------------------------------------------*)
VAR
Files: FILE; (* the tracking list *)
VAR
InpBLK: FHBlock; (* predefined structures *)
OutBLK: FHBlock; (* for INPUT and OUTPUT *)
VAR
WB: BOOLEAN; (* started from workbench?*)
process:ProcessPtr;
(*----------------------------------------------------------------------*)
(*----------------------------------------------------------------------*)
(* Adds a file to the file list with the given permissions. If it *)
(* could not allocate storage, it closes the file and exits. Otherwise *)
(* it returns a pointer to the file structure. *)
(*----------------------------------------------------------------------*)
PROCEDURE AddFile(VAR F: RealFileType; Permission: Access):FILE;
VAR
file: FILE;
BEGIN
FStorage.ALLOCATE(file,SYSTEM.TSIZE(FHBlock));
IF file # NIL THEN
WITH file^ DO
Mode:=Permission;
(* init. file struc *)
Handle:=F;
Count:=0; (* buffer empty *)
CharsRead:=BufferSize+999;
(* forces read *)
Prompt[0]:=ASCII.NUL;
Next:=Files;
END;
Files:=file;
ELSE
OSClose(F);
END;
RETURN file;
END AddFile;
(*----------------------------------------------------------------------*)
(* Opens a read-only file. *)
(*----------------------------------------------------------------------*)
PROCEDURE Open(FileName: ARRAY OF CHAR):FILE;
VAR
handle: RealFileType;
BEGIN
IF OSOpen(handle,FileName) THEN
RETURN AddFile(handle,Read);
ELSE
RETURN NIL;
END;
END Open;
(*----------------------------------------------------------------------*)
(* Opens a write-only file which writing is to begin after the last *)
(* position of the file. *)
(*----------------------------------------------------------------------*)
PROCEDURE Append(FileName: ARRAY OF CHAR):FILE;
VAR
handle: RealFileType;
BEGIN
IF OSAppend(handle,FileName) THEN
RETURN AddFile(handle,Write);
ELSE
RETURN NIL;
END;
END Append;
(*----------------------------------------------------------------------*)
(* Creates or overwrites a file. *)
(*----------------------------------------------------------------------*)
PROCEDURE Create(FileName: ARRAY OF CHAR):FILE;
VAR
handle: RealFileType;
BEGIN
IF OSCreate(handle,FileName) THEN
RETURN AddFile(handle,Write);
ELSE
RETURN NIL;
END;
END Create;
(*----------------------------------------------------------------------*
* Flushes a file's output buffer if it had Write access, OSCloses the *
* file, deallocates file header block, and removes file from File list *
* If the file is not on list, it will do nothing. *
*----------------------------------------------------------------------*)
PROCEDURE Close(VAR F: FILE);
VAR
lead: FILE;
follow: FILE;
BEGIN
lead:=Files; (* get head of tracking list *)
follow:=lead;
WHILE (lead # NIL) AND (lead # F) DO;
follow:=lead;
lead:=lead^.Next; (* postcondition: *)
END;
(* lead=NIL or lead=F *)
IF (lead # NIL) AND GoodFILE(F) THEN
(* only close it if the FILE *)
WITH lead^ DO (* is on the list and active *)
IF lead=Files THEN
Files:=Next;
ELSE
follow^.Next:=Next;
END;
IF Mode = Write THEN
Flush(lead);
END;
Mode:=Closed;
OSClose(Handle);
END;
FStorage.DEALLOCATE(lead,SYSTEM.TSIZE(FHBlock));
END;
END Close;
(*----------------------------------------------------------------------*
* Determines whether a FILE is a valid pointer or not. *
*----------------------------------------------------------------------*)
PROCEDURE GoodFILE(F: FILE):BOOLEAN;
BEGIN
RETURN ((F#NIL) AND (F^.Mode IN AccessSet{Read,Write})) ;
END GoodFILE;
(*----------------------------------------------------------------------*
* Set the prompt string for input FILEs. *
*----------------------------------------------------------------------*)
PROCEDURE SetPrompt(F: FILE; prompt: ARRAY OF CHAR);
BEGIN
IF ((F#NIL) AND (F^.Mode IN AccessSet{Read,Write})) THEN
Strings.Assign(prompt,F^.Prompt);
END END SetPrompt;
(************************************************************************)
(* Input Procedures *)
(************************************************************************)
(*----------------------------------------------------------------------*
* ReadChar reads the next charactor from the input buffer. ReadChar *
* calls ReadInfo to fill the buffer when the contents OF the buffer *
* have been depleted. It returns the next character IN the buffer *
* which has not been read. * *
*----------------------------------------------------------------------*)
PROCEDURE ReadChar(Input: FILE):CHAR;
BEGIN
IF ((Input#NIL) AND (Input^.Mode IN AccessSet{Read,Write})) THEN
WITH Input^ DO
IF Mode = Read THEN
IF CharsRead >= Count THEN
CharsRead:=0;
ReadInfo(Input);
END;
IF CharsRead < Count THEN
INC(CharsRead);
RETURN Info[CharsRead-1];
END;
ELSE
RETURN ASCII.NUL;
END;
END;
ELSE
RETURN ASCII.NUL;
END;
END ReadChar;
(*----------------------------------------------------------------------*
* ReadString reads a string into the array given. It reads characters *
* into the array until either the array is full, or the EOL charactor *
* is reached. It will not read past the end of line. *
*----------------------------------------------------------------------*)
PROCEDURE ReadString(Input: FILE; VAR str:ARRAY OF CHAR);
VAR
index,size : CARDINAL;
ch : CHAR;
BEGIN
index:=0;
size:=HIGH(str);
LOOP
IF index > size THEN
IF NextChar(Input) IN Terminators THEN
ch:=ReadChar(Input);
END;
EXIT;
END;
ch := ReadChar(Input);
IF ch IN Terminators THEN
str[index] := ASCII.NUL;
EXIT;
ELSE
str[index] := ch;
INC(index);
END;
END;
END ReadString;
(*----------------------------------------------------------------------*
* ReadLn reads all the characters on the current line. ReadLn calls *
* ReadChar and simply discards everything until it sees a EOL char. *
*----------------------------------------------------------------------*)
PROCEDURE ReadLn(Input: FILE);
BEGIN
WHILE NOT(ReadChar(Input) IN Terminators) DO
END;
END ReadLn;
(*----------------------------------------------------------------------*
* NextChar returns the next of any pending characters, If there are no *
* pending characters, it will call ReadInfo to get some. CAVEAT *
* EMPTOR!!! A poorly controlled NextChar, could cause a user to be *
* prompted for input. *
*----------------------------------------------------------------------*)
PROCEDURE NextChar(Input: FILE):CHAR;
BEGIN
IF ((Input#NIL) AND (Input^.Mode IN AccessSet{Read,Write})) THEN
WITH Input^ DO
IF Mode = Read THEN
IF CharsRead >= Count THEN
CharsRead:=0;
ReadInfo(Input);
END;
IF CharsRead < Count THEN
RETURN Info[CharsRead];
END;
ELSE
RETURN ASCII.NUL;
END;
END;
ELSE
RETURN ASCII.NUL;
END;
END NextChar;
(************************************************************************)
(* Output Procedures *)
(************************************************************************)
(*----------------------------------------------------------------------*
* WriteChar writes charactors TO the standard output channel. *
*----------------------------------------------------------------------*)
PROCEDURE WriteChar(Output: FILE; ch:CHAR);
BEGIN
IF ((Output#NIL) AND (Output^.Mode IN AccessSet{Read,Write})) THEN
WITH Output^ DO
IF Mode = Write THEN
Info[Count]:=ch;
INC(Count);
IF (Count > BufferSize) THEN
Flush(Output);
END;
END;
END;
END;
END WriteChar;
(*----------------------------------------------------------------------*
* WriteLn writes a line feed to the standard output channel. It *
* relies on the error checking performed by WriteChar. *
*----------------------------------------------------------------------*)
PROCEDURE WriteLn(Output: FILE);
BEGIN
WriteChar(Output,ASCII.EOL);
IF Output = OUTPUT THEN
Flush(Output);
END;
END WriteLn;
(*----------------------------------------------------------------------*
* WriteString writes strings to the standard output channel. The *
* amount which it writes is determined by whether it finds a string *
* terminator (NUL) or the actual length of the string. *
*----------------------------------------------------------------------*)
PROCEDURE WriteString(Output: FILE; str: ARRAY OF CHAR);
VAR
len,I: CARDINAL;
BEGIN
len:=Strings.Length(str);
I:=0;
WHILE I < len DO
WriteChar(Output,str[I]);
INC(I);
END;
END WriteString;
(*----------------------------------------------------------------------*)
(* Writes an unsigned integer recursively, neat no? *)
(*----------------------------------------------------------------------*)
PROCEDURE WriteCard(Output: FILE; c:CARDINAL);
BEGIN
IF c>9 THEN
WriteCard(Output,c DIV 10);
END;
WriteChar(Output,CHR(ORD('0')+(c MOD 10)));
END WriteCard;
(*----------------------------------------------------------------------*)
(* Termination PROCEDURE -- Closes out all open files *)
(*----------------------------------------------------------------------*)
PROCEDURE CloseAllFiles;
BEGIN
WHILE Files # NIL DO
Close(Files);
END;
Flush(OUTPUT);
IF WB THEN
OSClose(OUTPUT^.Handle) END;
END CloseAllFiles;
(************************************************************************)
(* Implementation dependent procedures *)
(************************************************************************)
(*----------------------------------------------------------------------*)
(* Opens a file for read access. If unsuccessful, it returns false and *)
(* F is left undefined *)
(*----------------------------------------------------------------------*)
PROCEDURE OSOpen(VAR F: RealFileType; FileName: ARRAY OF CHAR):BOOLEAN;
VAR
BEGIN
(* insert machine dependent stuff here *)
RETURN ;
END OSOpen;
(*----------------------------------------------------------------------*)
(* Opens a file for writing and seeks to the end of that file. *)
(*----------------------------------------------------------------------*)
PROCEDURE OSAppend(VAR F: RealFileType; FileName: ARRAY OF CHAR):BOOLEAN;
VAR
VAR stat: LONGINT;
BEGIN
(* insert machine dependent stuff here *)
IF THEN
(* insert implementation dependent stuff here *)
END;
RETURN ;
END OSAppend;
(*----------------------------------------------------------------------*)
(* Opens a file for writing. If unsuccessful, it returns false and *)
(* F is left undefined *)
(*----------------------------------------------------------------------*)
PROCEDURE OSCreate(VAR F: RealFileType; FileName: ARRAY OF CHAR):BOOLEAN;
VAR
BEGIN
(* insert machine dependent stuff here *)
RETURN ;
END OSCreate;
(*----------------------------------------------------------------------*)
(* Closes a FILE *)
(*----------------------------------------------------------------------*)
PROCEDURE OSClose(VAR F: RealFileType);
BEGIN
(* insert implementation defined close here *)
END OSClose;
(*----------------------------------------------------------------------*
* Flush pending writes out from output buffer. *
* *
* *** IMPLEMENTATION DEPENDENT *** *
*----------------------------------------------------------------------*)
PROCEDURE Flush(Output: FILE);
VAR
len: LONGINT;
BEGIN
WITH Output^ DO
IF Count <> 0 THEN
(* here's where you add stuff for other platforms *)
Count:=0;
END;
END;
END Flush;
(*----------------------------------------------------------------------*
* ReadInfo *** IMPLEMENTATION DEPENDENT *** *
* *
* ReadInfo reads info from the standard input, AND stores it in the *
* input buffer. It is local to this module and will require changing *
* for different implementations. This implementation utilizes the *
* standard AmigaDOS library read routine to fill the buffer. When it *
* hits EOF, it will tack the EOF charactor onto the end of the buffer. *
* This way it will be detected by other procedures properly. *
*----------------------------------------------------------------------*)
PROCEDURE ReadInfo(Input: FILE);
BEGIN
WITH Input^ DO
IF Input=INPUT THEN
WriteString(OUTPUT,Prompt);
Flush(OUTPUT);
END;
(* here's where you add other platforms *)
IF Count = 0 THEN
Info[0]:=ASCII.EOF;
INC(Count);
END;
END;
END ReadInfo;
(************************************************************************)
(* Initialization for IO *)
(************************************************************************)
BEGIN
Window := 'CON:40/50/600/150/FIO';
Files:=NIL;
(* insert compiler dependent stuff here *)
INPUT :=SYSTEM.ADR(InpBLK);
WITH INPUT^ DO;
IF WB THEN
(* insert machine dependent stuff here *)
ELSE
(* IMPLEMENTATION DEPENDENT *)
(* for other platforms *)
END;
Next:=NIL;
Mode:=Read;
Count:=0;
CharsRead:=BufferSize+999;
Prompt:='> ';
END;
OUTPUT:=SYSTEM.ADR(OutBLK);
WITH OUTPUT^ DO;
IF WB THEN
Handle:=INPUT^.Handle;
ELSE
(* IMPLEMENTATION DEPENDENT *)
(* for other platforms *)
END;
Next:=NIL;
Mode:=Write;
Count:=0;
CharsRead:=BufferSize+999;
END;
END FIO.