Modula-2 でプログラミング -- 文字列探索プログラム find の製作 (その3) --2025年01月05日 21:19

前回紹介したfindプログラムは、FileSearchモジュールの不備で、ファイル一覧の構造が 丸見えになっていました。FileSearchモジュールに2つ手続きを追加して不具合を解消しました。

新しいFileSearchモジュールの定義モジュールは以下の通り。

DEFINITION MODULE FileSearch;

FROM OpSys IMPORT FCB,FCBFileName;

EXPORT QUALIFIED pFileList,FileNameNode,
	GetNextFile,GetFileName,LoginDisk,MakeFileList,DumpFileList;

CONST
	DMABufferSize = 128;
	FileNameSize = 14;

TYPE
	pFileList = POINTER TO FileNameNode;
	FileNameNode = RECORD
		FileName: ARRAY [0..FileNameSize] OF CHAR;
		Next: pFileList
	END;
        DMA = ARRAY [0..DMABufferSize-1] OF CHAR;

PROCEDURE GetNextFile(FileLIst: pFileList): pFileList;
PROCEDURE GetFileName(FileList: pFileList;VAR FileName: ARRAY OF CHAR);
PROCEDURE LoginDisk(FCBBuf: FCB): CHAR;
PROCEDURE MakeFileList(FIleMatch: ARRAY OF CHAR): pFileList;
PROCEDURE DumpFileList(pList: pFileList);
END FileSearch.
手続き、次のファイルを取り出すGetNextFileとファイル名を取り出すGetFileNameを追加しました。 実現モジュールは以下の通り。
IMPLEMENTATION MODULE FileSearch;
FROM InOut IMPORT WriteHex,Write,WriteString,WriteLn;
FROM OpSys IMPORT FCB,FCBFileName,BdosFunctions,Bdos;
FROM SYSTEM IMPORT ALLOCATE,TSIZE,ADR,WORD;
FROM FileNames IMPORT StrToFCB,FCBToStr,NameState;

CONST
	EOS = 0C;

PROCEDURE GetNextFile(FileList: pFileList): pFileList;
BEGIN
	RETURN FileList^.Next
END GetNextFile;

PROCEDURE GetFileName(FileList: pFileList; VAR FileName: ARRAY OF CHAR);
VAR
	i: CARDINAL; 
BEGIN
	i := 0;
	WHILE ( FileList^.FileName[i] # EOS ) DO
		FileName[i] := FileList^.FileName[i];
		INC(i)
	END;
	FileName[i] := EOS
END GetFileName;

PROCEDURE LoginDisk(FCBBuf: FCB): CHAR;
VAR
	DiskCode: CARDINAL;
	Junk: WORD;

BEGIN
	IF FCBBuf.name.disk = 0C THEN
		Bdos(retCDsk,Junk,DiskCode);
		RETURN (CHR(ORD(DiskCode)+ORD('A')));
	ELSE
		RETURN (CHR(ORD(FCBBuf.name.disk)+ORD('A')-1));
	END;
END LoginDisk;

PROCEDURE MakeFileList(FileMatch: ARRAY OF CHAR): pFileList;
VAR
	Disk: CHAR;
	FCBBuffer: FCB;
	BdosRc: CARDINAL;
	DMABuffer: DMA;
	CPos: CARDINAL;
	NameStatus: NameState;
	pList: pFileList;
	pNewFileName: pFileList;
	FCBFile: FCBFileName;
	Formatted: BOOLEAN;
	Junk: WORD;

BEGIN
	pList := NIL;

	(* Clear FCB Buffer and set file name *)
	FCBBuffer.name.text := '';
	FCBBuffer.rest := '';
	NameStatus := StrToFCB(FileMatch,FCBBuffer.name);

	Disk := LoginDisk(FCBBuffer);

	(* set DMA Bufer *)
	Bdos(setDMA,ADR(DMABuffer),Junk);

	(* find first much file *)
	Bdos(searchFst,ADR(FCBBuffer),BdosRc);
	WHILE BdosRc # 255 DO
		ALLOCATE(pNewFileName,TSIZE(FileNameNode));
		FOR CPos := 0 TO 11 DO
			FCBFile.text[CPos]
				:= DMABuffer[CPos+BdosRc*32]
		END;
		FCBFile.disk := CHR(ORD(Disk) - ORD('A') + 1);
		FCBToStr(FCBFile,pNewFileName^.FileName,FALSE);
		pNewFileName^.Next := pList;
		pList := pNewFileName;

		(* find next file *)
		Bdos(searchNxt,Junk,BdosRc);
	END;	
	RETURN pList
END MakeFileList;

PROCEDURE WriteFileName(FileName: ARRAY OF CHAR);
BEGIN
	WriteString(FileName);
	WriteLn
END WriteFileName;

PROCEDURE DumpFileList(pList: pFileList);
BEGIN
	WHILE pList # NIL DO
		WriteFileName(pList^.FileName);
		pList := pList^.Next;
	END;
END DumpFileList;
END FileSearch.

これらの変更を反映したfindは、以下のとおり。

MODULE Find;
FROM InOut IMPORT Write,WriteCard,WriteString,WriteLn;
FROM Files IMPORT FILE,FileState,Open,Close,Read;
FROM CmdArgs IMPORT Argc,Argv;
FROM FileSearch IMPORT GetFileName,GetNextFile,
	FileNameNode,MakeFileList,pFileList;
FROM BasicFileIO IMPORT FileIOStruct,pFileIOStruct,
	OpenFile,CloseFile,EOFFile,FileIOStatus;
FROM StdFileIO IMPORT GetLine;

CONST
	EOS = 0C;
	MAXLINE = 128;
	FILENAMESIZE = 14;
	EOFMARK = 32C;

VAR
	FileName: ARRAY [0..FILENAMESIZE] OF CHAR;
	FileMatch: ARRAY [0..FILENAMESIZE] OF CHAR;
	Target: ARRAY [0..MAXLINE] OF CHAR;
	CPos,FileNumber,LineNumber,nArgc: CARDINAL;
	pList: pFileList;

PROCEDURE putLine(FileName:ARRAY OF CHAR;Line:CARDINAL;
		Buffer: ARRAY OF CHAR);
BEGIN
	WriteString(FileName);
	Write(' ');WriteCard(Line,1);Write(':');
	WriteString(Buffer);
	WriteLn
END putLine;

PROCEDURE findTarget(Target,Line:ARRAY OF CHAR): BOOLEAN;
VAR
	t,l: CARDINAL;
	found: BOOLEAN;
BEGIN
	found := FALSE;
	t := 0; l := 0;
	WHILE (Line[l] # EOS) AND (NOT found) DO
		IF Line[l] = Target[0] THEN
			t := 1;
			WHILE Line[l+t] = Target[t] DO
				INC(t);
			END;
			IF Target[t] = EOS THEN
				found := TRUE;
			END;
		END;
		INC(l);
	END;
	RETURN found
END findTarget;

PROCEDURE Usage();
BEGIN
	WriteString('find');WriteLn;
	WriteString('      TargetString File1 File2 FIle3,,,,');WriteLn 
END Usage;

PROCEDURE MatchLines(FileName,TargetString: ARRAY OF CHAR);
VAR
	pFileIO: pFileIOStruct;
	Line: ARRAY [0..MAXLINE-1] OF CHAR;
	Chars: CARDINAL;
	NLines: CARDINAL;
	Junk: FileIOStatus;

BEGIN
	IF OpenFile(FileName,pFileIO) = Success THEN
		NLines := 1;
		WHILE NOT EOFFile(pFileIO) DO
			Chars := GetLine(pFileIO,Line);
			IF findTarget(TargetString,Line) THEN
				putLine(FileName,NLines,Line);
			END;
			INC(NLines);
		END;
		Junk := CloseFile(pFileIO)
	END
END MatchLines;

BEGIN
	nArgc := Argc();
	IF nArgc < 1 THEN
		Usage();
		HALT
	END;
	Argv(0,Target);
	FileNumber := 1;
	WHILE FileNumber < nArgc DO
		Argv(FileNumber,FileMatch);
		pList := MakeFileList(FileMatch);
		WHILE pList # NIL DO
			GetFileName(pList,FileName);
			MatchLines(FileName,Target);
			pList := GetNextFile(pList)
		END;
		INC(FileNumber)
	END
END Find.

これで、FileSearchモジュール内部のデータ構造をFindが知る必要がなくなりました。

Modula-2でプログラミング -- 文字列探索プログラム find の制作(その1)2024年12月28日 21:00

指定された文字列を 指定されたファイルの中から探し出すプログラム find を紹介します。 このように使います。

C0#find

arguments>GetLine *.def *.mod

C:STDFILEI.DEF 6:       GetLine;
C:STDFILEI.DEF 8:PROCEDURE GetLine(VAR pFileIO: pFileIOStruct;
C:STDFILEI.MOD 10:PROCEDURE GetLine(VAR pFileIO: pFileIOStruct;
C:STDFILEI.MOD 36:END GetLine;
C:FIND.MOD 8:FROM StdFileIO IMPORT GetLine;
C:FIND.MOD 71:                  Chars := GetLine(pFileIO,Line);


63K QP/M VER 2.7   (BIOS VER 1.0)

                   (C) 1988.12.1.  K.YOSHIDA

             2018.10.28.  MODEFIED BY H.KIDA
C0#find

arguments>GetChar *.def *.mod

C:BASICFIL.DEF 7:       ReadFile,GetChar;
C:BASICFIL.DEF 28:PROCEDURE GetChar(VAR pFileIO: pFileIOStruct): CHAR;
C:STDFILEI.MOD 3:       pFileIOStruct,GetChar;
C:STDFILEI.MOD 20:              C := GetChar(pFileIO);
C:BASICFIL.MOD 65:PROCEDURE GetChar(VAR pFileIO: pFileIOStruct): CHAR;
C:BASICFIL.MOD 89:END GetChar;


63K QP/M VER 2.7   (BIOS VER 1.0)

                   (C) 1988.12.1.  K.YOSHIDA

             2018.10.28.  MODEFIED BY H.KIDA
C0#

find は、ファイルを読みますので、ファイルアクセスのルーチンが必要になります。 Bdosを直接使うことができるので、かんたんなファイル読み込みモジュール BasicFileIO を作成しました。 更に、行単位のファイル読み出しが必要なので、上位のモジュール StdFileIO を作成しました。StdFileIOは、 Bdosとは、独立しています。

まず、 BasicFileIO です。基本的なファイルアクセスルーチンの集まりです。 今回は、読み出せれば良いので、書き込み関係のルーチンは作成していません。基本的なファイルのアクセスは、 一文字単位です、 定義モジュールは、以下のとおりです。

DEFINITION MODULE BasicFileIO;
FROM OpSys IMPORT FCB,FCBFileName;

EXPORT QUALIFIED 
	FileIOStatus,FileIOStruct,pFileIOStruct,
	OpenFile,CloseFile,EOFFile,
	ReadFile,GetChar;

CONST
	DMASize = 128;
TYPE
	FileIOStatus = (Success,InvalidFileName,
		OpenError,CloseError,IOError);
	DMA = ARRAY [0..DMASize-1] OF CHAR;
	pFileIOStruct = POINTER TO FileIOStruct;
	FileIOStruct = RECORD
		FCBBuf: FCB;
		DMABuf: DMA;
		ReadPos: CARDINAL;
		WritePos: CARDINAL;
		EOFFlag: BOOLEAN;
	END;

PROCEDURE OpenFile(FileName: ARRAY OF CHAR;
	VAR pFileIO: pFileIOStruct): FileIOStatus;
PROCEDURE CloseFile(VAR pFileIO: pFileIOStruct): FileIOStatus;
PROCEDURE ReadFile(VAR pFileIO: pFileIOStruct): FileIOStatus;
PROCEDURE GetChar(VAR pFileIO: pFileIOStruct): CHAR;
PROCEDURE EOFFile(pFileIO: pFileIOStruct): BOOLEAN;
END BasicFileIO.

実装モジュールは、以下のとおりです。手続き GetChar では、CR LF と連続した場合、 LF を読み飛ばします。

IMPLEMENTATION MODULE BasicFileIO;
FROM InOut IMPORT Write,WriteString,WriteLn;
FROM OpSys IMPORT BdosFunctions,FCBFileName,Bdos,FCB;
FROM FileNames IMPORT StrToFCB,NameState;
FROM SYSTEM IMPORT ALLOCATE,ADR,TSIZE,WORD;

CONST
	CR = 15C;
	LF = 12C;
	EOFMARK = 32C;

PROCEDURE OpenFile(FileName: ARRAY OF CHAR;
	VAR pFileIO: pFileIOStruct): FileIOStatus;
VAR
	BdosRc: CARDINAL;
	Junk: WORD;

BEGIN
	(* Allocate FCB and DMA / pre-Set *)
	ALLOCATE(pFileIO,TSIZE(FileIOStruct));
	pFileIO^.FCBBuf.name.text := '';
	pFileIO^.FCBBuf.rest := '';
	pFileIO^.DMABuf := '';
	IF StrToFCB(FileName,pFileIO^.FCBBuf.name) # NameOK THEN
		RETURN InvalidFileName
	END;
	Bdos(setDMA,ADR(pFileIO^.DMABuf),Junk);
	Bdos(openF,ADR(pFileIO^.FCBBuf),BdosRc);
	IF BdosRc # 255 THEN
		pFileIO^.ReadPos := DMASize;
		pFileIO^.WritePos := 0;
		pFileIO^.EOFFlag := FALSE;
		RETURN Success
	ELSE
		RETURN OpenError
	END
END OpenFile;

PROCEDURE CloseFile(VAR pFileIO: pFileIOStruct): FileIOStatus;
VAR
	BdosRc: CARDINAL;

BEGIN
	Bdos(closeF,ADR(pFileIO^.FCBBuf),BdosRc);
	IF BdosRc = 0 THEN
		RETURN Success
	ELSE
		RETURN CloseError
	END
END CloseFile;

PROCEDURE ReadFile(VAR pFileIO: pFileIOStruct): FileIOStatus;
VAR
	BdosRc: CARDINAL;

BEGIN
	Bdos(readSeq,ADR(pFileIO^.FCBBuf),BdosRc);
	IF BdosRc = 0 THEN
		RETURN Success
	ELSE
		RETURN IOError
	END
END ReadFile;

PROCEDURE GetChar(VAR pFileIO: pFileIOStruct): CHAR;
VAR
	C: CHAR;

BEGIN
	IF DMASize = pFileIO^.ReadPos THEN
		IF ReadFile(pFileIO) = Success THEN
			pFileIO^.ReadPos := 0
		ELSE
			pFileIO^.ReadPos := 0;
			pFileIO^.DMABuf[pFileIO^.ReadPos] := EOFMARK
		END
	END;
	C := pFileIO^.DMABuf[pFileIO^.ReadPos];
	IF C = CR THEN
		IF pFileIO^.DMABuf[pFileIO^.ReadPos+1] = LF THEN
			INC(pFileIO^.ReadPos)
		END
	END;
	INC(pFileIO^.ReadPos);
	IF C = EOFMARK THEN
		pFileIO^.EOFFlag := TRUE
	END;
	RETURN C
END GetChar;

PROCEDURE EOFFile(pFileIO: pFileIOStruct): BOOLEAN;
BEGIN
	RETURN pFileIO^.EOFFlag
END EOFFile;
END BasicFileIO.

GetChar で、 LF を読み飛ばす以外は、面倒くさいところは、ないでしょう。

この、 BasicFileIO モジュールをつかって、行単位の読み出しルーチンを作ってます。 StdFileIO モジュールです。 このモジュールは、 CP/M のファイル構造と独立です。必要最低限の行単位の読み出ししか作成していません。

定義モジュールは、以下の通り。

DEFINITION MODULE StdFileIO;
FROM BasicFileIO IMPORT
	pFileIOStruct;

EXPORT QUALIFIED 
	GetLine;

PROCEDURE GetLine(VAR pFileIO: pFileIOStruct;
		VAR LineBuffer: ARRAY OF CHAR): CARDINAL;
END StdFileIO.

実装モジュールは、以下の通りです。

IMPLEMENTATION MODULE StdFileIO;
FROM BasicFileIO IMPORT
	pFileIOStruct,GetChar;

CONST
	EOS = 0C;
	EOFMARK = 32C;
	CR = 15C;

PROCEDURE GetLine(VAR pFileIO: pFileIOStruct;
		VAR LineBuffer: ARRAY OF CHAR): CARDINAL;

VAR
	C: CHAR;
	CPos: CARDINAL;

BEGIN
	CPos := 0;
	LOOP
		C := GetChar(pFileIO);
		CASE C OF
			EOFMARK:
				LineBuffer[CPos] := EOS;
				RETURN CPos
		|	CR:
				LineBuffer[CPos] := EOS;
				RETURN CPos
		END;
		LineBuffer[CPos] := C;
		INC(CPos);
		IF CPos = HIGH(LineBuffer) THEN
			LineBuffer[CPos] := EOS;
			RETURN CPos
		END
	END
END GetLine;
END StdFileIO.

GetLine は、一文字読み出しを繰り返し、 CR または EOF が来たら、その一文字前の文字までを一行とします。 また、バッファーのサイズ以上に読み取ろうとした場合は、強制的に一行にしてしまいます。溢れてしまうと困りますので。

find 本体の紹介は次回にします。

Modula-2でプログラミング -- FileFindの制作2024年11月02日 11:36

FIleSearche"モジュールを利用した、ファイマッチで指定されたファイル一覧を書き出すプログラム "FileFind"を作ってみました。

使い方は、このようにします。

C0#filefind
arguments>f*.mod *.def
C:FIND.MOD
C:FILEFIND.MOD
C:FILESEAR.MOD
C:CONIO.DEF
C:ADD16.DEF
C:SILLY.DEF
C:FILESEAR.DEF
C:STDFILEI.DEF
C:BDOSSTRU.DEF
C:BASICFIL.DEF
C:CMDARGS.DEF
C:SCREEN.DEF     

探すファイル名は、ファイルマッチを指定できます。複数指定できます。 この引数を受け取るには、以前紹介した自作の"CmdArgs"モジュール を使用しています。

プログラムは、このようになりました。

MODULE FileFind;
FROM InOut IMPORT WriteString,WriteLn;
FROM CmdArgs IMPORT Argc,Argv;
FROM FileSearch IMPORT MakeFileList,DumpFileList;

CONST
	MAXLINE = 128;

VAR
	FileMatch: ARRAY [0..MAXLINE-1] OF CHAR;
	nArgc: CARDINAL;
	NthFile: CARDINAL;

PROCEDURE Usage();
BEGIN
	WriteString('Usage: filefind filematch');WriteLn;
END Usage;

BEGIN
	nArgc := Argc();
	IF nArgc < 1 THEN
		Usage();
		HALT;
	END;

	NthFile := 0;
	WHILE NthFile < nArgc DO 
		Argv(NthFile,FileMatch);
		DumpFileList(MakeFileList(FileMatch));
		INC(NthFile);
	END;
END FileFind.


次々にファイルマッチを取り出し、該当するファイル名のリストを"MakeFileList"で作成し、 そのリストを"DumpFileLIst"で書き出します。"DumpFileList"は、"FileSearch"モジュールに実装しました。 こうすることで、ファイル名の保持のしかたをメインルーチンが知る必要がありません。

Modula-2でプログラミング -- FileSearch ファイルを探すモジュールの修正2024年11月02日 10:29

前回、ファイルを探すモジュール"FileSearch"を制作しました。これを利用したプログラムを いくつか作成して見た所、ファイル名リストのデータ構造の使い勝手が良くないことがわかりました ので"FileSearch"モジュールを修正しました。

修正した"FileSearch"モジュールのDefinition Moduleです。

DEFINITION MODULE FileSearch;

FROM OpSys IMPORT FCB,FCBFileName;

EXPORT QUALIFIED pFileList,FileNameNode,DMA,
	LoginDisk,MakeFileList,DumpFileList;

CONST
	DMABufferSize = 128;
	FileNameSize = 14;

TYPE
	pFileList = POINTER TO FileNameNode;
	FileNameNode = RECORD
		FileName: ARRAY [0..FileNameSize] OF CHAR;
		Next: pFileList
	END;
        DMA = ARRAY [0..DMABufferSize-1] OF CHAR;

PROCEDURE LoginDisk(FCBBuf: FCB): CHAR;
PROCEDURE MakeFileList(FIleMatch: ARRAY OF CHAR): pFileList;
PROCEDURE DumpFileList(pList: pFileList);
END FileSearch.


大きな変更点は、ファイル名の持ち方をべたな文字列にした点です。

修正したImprementation Moduleは、このとおり。

IMPLEMENTATION MODULE FileSearch;
FROM InOut IMPORT WriteHex,Write,WriteString,WriteLn;
FROM OpSys IMPORT FCB,FCBFileName,BdosFunctions,Bdos;
FROM SYSTEM IMPORT ALLOCATE,TSIZE,ADR,WORD;
FROM FileNames IMPORT StrToFCB,FCBToStr,NameState;

CONST
	EOS = 0C;

PROCEDURE LoginDisk(FCBBuf: FCB): CHAR;
VAR
	DiskCode: CARDINAL;
	Junk: WORD;

BEGIN
	IF FCBBuf.name.disk = 0C THEN
		Bdos(retCDsk,Junk,DiskCode);
		RETURN (CHR(ORD(DiskCode)+ORD('A')));
	ELSE
		RETURN (CHR(ORD(FCBBuf.name.disk)+ORD('A')-1));
	END;
END LoginDisk;

PROCEDURE MakeFileList(FileMatch: ARRAY OF CHAR): pFileList;
VAR
	Disk: CHAR;
	FCBBuffer: FCB;
	BdosRc: CARDINAL;
	DMABuffer: DMA;
	CPos: CARDINAL;
	NameStatus: NameState;
	pList: pFileList;
	pNewFileName: pFileList;
	FCBFile: FCBFileName;
	Formatted: BOOLEAN;
	Junk: WORD;

BEGIN
	pList := NIL;

	(* Clear FCB Buffer and set file name *)
	FCBBuffer.name.text := '';
	FCBBuffer.rest := '';
	NameStatus := StrToFCB(FileMatch,FCBBuffer.name);

	Disk := LoginDisk(FCBBuffer);

	(* set DMA Bufer *)
	Bdos(setDMA,ADR(DMABuffer),Junk);

	(* find first much file *)
	Bdos(searchFst,ADR(FCBBuffer),BdosRc);
	WHILE BdosRc # 255 DO
		ALLOCATE(pNewFileName,TSIZE(FileNameNode));
		FOR CPos := 0 TO 11 DO
			FCBFile.text[CPos]
				:= DMABuffer[CPos+BdosRc*32]
		END;
		FCBFile.disk := CHR(ORD(Disk) - ORD('A') + 1);
		FCBToStr(FCBFile,pNewFileName^.FileName,FALSE);
		pNewFileName^.Next := pList;
		pList := pNewFileName;

		(* find next file *)
		Bdos(searchNxt,Junk,BdosRc);
	END;	
	RETURN pList
END MakeFileList;

PROCEDURE WriteFileName(FileName: ARRAY OF CHAR);
BEGIN
	WriteString(FileName);
	WriteLn
END WriteFileName;

PROCEDURE DumpFileList(pList: pFileList);
BEGIN
	WHILE pList # NIL DO
		WriteFileName(pList^.FileName);
		pList := pList^.Next;
	END;
END DumpFileList;
END FileSearch.


大きな修正点は、見つかったファイルの名前をFCB形式からべたな文字列のファイル名に変換し、 それを保存している点です。 ファイル名の持ち方をべたな文字列にしたので、ファイル名を書き出すPROCEDURE "WriteFileName"を 修正しています。

他には、"BdosStruct"モジュールの使用をやめました。処理系が提供する Bdos関連機能の"OpSys"モジュールを一部修正し、"BdosStruct"モジュールが無くてもコンパイル できるようにしました。

Modula-2でプログラミング -- FileSearch ファイルを探すモジュールの制作2024年10月19日 09:49

ファイルを探すことは、結構よくあることです。CP/Mでプログラムを作る場合でも同じこと。 今回は、Modula-2からBDOSの機能を呼び出し、ファイルを探す"FileSearch"モジュールを紹介します。

"FileSearch"モジュールは、処理系が提供するモジュールをいくつか使用しています。

  • "OpSys"モジュールは、BDOSやBIOSを呼び出すためのBdos手続きやFCBなどのレコード型などを提供しています。
  • "FileNames"モジュールは、FCBのファイル名領域にファイル名を設定する手続きや、その手続きの戻り値の型を提供しています。
  • "SYSTEM"モジュールは、メモリーの動的確保や変数のサイズなどを調べる手続きを提供しています。

このほかに自作モジュール"BdosStruct"があります。これは、BDOSを呼び出すBdos手続きがちょっと使いにくかったので、 処理系を騙す仕組みを作り込みました。

"FileSearch"モジュールのDefinition Moduleです。

DEFINITION MODULE FileSearch;

FROM InOut IMPORT Write,WriteString,WriteLn;
FROM OpSys IMPORT FCB,CPMStringBuffer,BdosFunctions,Bdos;
FROM SYSTEM IMPORT ALLOCATE,SIZE,ADR,WORD;
FROM FileNames IMPORT StrToFCB,NameState;
FROM BdosStruct IMPORT BdosCommand,BdosReturn;

EXPORT QUALIFIED pFileList,FileList,FileStruct,DMA,
        LoginDisk,MakeFileList,DumpFileList;

CONST
        DMABufferSize = 128;

TYPE
        FileStruct = RECORD
                CASE BOOLEAN OF
                        TRUE:   Disk: CHAR;
                                Fill1: CHAR;
                                Name: ARRAY [0..7] OF CHAR;
                                Fill2: CHAR;
                                Extention: ARRAY [0..2] OF CHAR;
                |       FALSE:  Text: ARRAY [0..13] OF CHAR;
                END;
        END;
        pFileList = POINTER TO FileList;
        FileList = RECORD
                File: FileStruct;
                Next: pFileList;
        END;
        DMA = ARRAY [0..DMABufferSize-1] OF CHAR;

PROCEDURE LoginDisk(FCBBuf: FCB): CHAR;
PROCEDURE MakeFileList(FileMatch: ARRAY OF CHAR): pFileList;
PROCEDURE DumpFileList(pList: pFileList);
END FileSearch.

Imprementation Moduleは、このとおり。

IMPLEMENTATION MODULE FileSearch;

FROM InOut IMPORT Write,WriteString,WriteLn;
FROM OpSys IMPORT FCB,BdosFunctions,Bdos;
FROM SYSTEM IMPORT ALLOCATE,SIZE,ADR,WORD;
FROM FileNames IMPORT StrToFCB,NameState;
FROM BdosStruct IMPORT BdosCommand,BdosReturn,FileStruct,DMA;

PROCEDURE LoginDisk(FCBBuf: FCB): CHAR;
VAR
        BdosCmd: BdosCommand;
        Junk: WORD;
        DiskCode: BdosReturn;

BEGIN
        IF FCBBuf.name.disk = 0C THEN
                BdosCmd.Func := retCDsk;
                Bdos(BdosCmd.Cmd,Junk,DiskCode.Rc);
                RETURN (CHR(ORD(DiskCode.Cc)+ORD('A')));
        ELSE
                RETURN (CHR(ORD(FCBBuf.name.disk)+ORD('A')-1));
        END;
END LoginDisk;

PROCEDURE MakeFileList(FileMatch: ARRAY OF CHAR): pFileList;
VAR
        Disk: CHAR;
        FCBBuffer: FCB;
        BdosFunc: BdosCommand;
        BdosRc: BdosReturn;
        DMABuffer: DMA;
        ToPos, FromPos: CARDINAL;
        NameStatus: NameState;
        pList: pFileList;
        pNewFile: pFileList;
        NewFile: FileList;
        Junk: WORD;

BEGIN
        (* Clear FCB Buffer and set file name *)
        FCBBuffer.name.text := '';
        FCBBuffer.rest := '';
        NameStatus := StrToFCB(FileMatch,FCBBuffer.name);

        (* get target disk *)
        Disk := LoginDisk(FCBBuffer);

        (* set DMA Bufer *)
        BdosFunc.Func := setDMA;
        Bdos(BdosFunc.Cmd,ADR(DMABuffer),Junk);

        (* initialize File Name List pointer *)
        pList := NIL;

        (* find first much file *)
        BdosFunc.Func := searchFst;
        Bdos(BdosFunc.Cmd,ADR(FCBBuffer),BdosRc.Rc);
        WHILE BdosRc.Cc # 255 DO
                (* copy from FCB buffer to file struct *)
                ALLOCATE(pNewFile,SIZE(NewFile));
                pNewFile^.File.Disk := Disk;
                pNewFile^.File.Fill1 := ':';
                ToPos := 0;
                FOR FromPos := 1 TO 8 DO
                        pNewFile^.File.Name[ToPos] 
                                := DMABuffer[FromPos+BdosRc.Cc*32];
                        INC(ToPos);
                END;

                pNewFile^.File.Fill2 := '.';
                ToPos := 0;
                FOR FromPos := 9 TO 11 DO
                        pNewFile^.File.Extention[ToPos]
                                := DMABuffer[FromPos+BdosRc.Cc*32];
                        INC(ToPos);
                END;
                (* insert new one *)
                pNewFile^.Next := pList;
                pList := pNewFile;

                (* find next file *)
                BdosFunc.Func := searchNxt;
                Bdos(BdosFunc.Cmd,Junk,BdosRc.Rc);
        END;    
        RETURN pList
END MakeFileList;

PROCEDURE WriteFileStruc(FileStruc: FileStruct);
BEGIN
        Write(FileStruc.Disk);
        Write(FileStruc.Fill1);
        WriteString(FileStruc.Name);

        Write(FileStruc.Fill2);
        WriteString(FileStruc.Extention);
        WriteLn;
END WriteFileStruc;

PROCEDURE DumpFileList(pList: pFileList);
BEGIN
        WHILE pList # NIL DO
                WriteFileStruc(pList^.File);
                pList := pList^.Next;
        END;
END DumpFileList;

END FileSearch.

MakeFileList手続きが処理の中心です。ファイルを探すにはBDOSの機能番号16 最初のデータを探す(SearchFirst)、 機能番号17 次にデータを探す(SearchNext)を使います。 はじめに、FCBとDMAを準備します。そして、FCB領域を初期化します。

        (* Clear FCB Buffer and set file name *)
        FCBBuffer.name.text := '';
        FCBBuffer.rest := '';
        NameStatus := StrToFCB(FileMatch,FCBBuffer.name);
ここで躓きました。"FCBBuffer.rest"を初期化をしなかったために、 最初のデータを取得できたりできなかったりと、動作が不安定でした。 アセンブラでテストルーチンを書くとうまく動作します。悩みました。 使用したアセンブラでは、確保したデータ領域を自動的に0を埋め込んでいました。 しかし、Modula-2処理系では領域内の値は不定になるため、動作がおかしくなった様です。

最初のデータを見つけてしまえば、後は順に見つけることができました。

見つけたファイル名をリスト構造にして、返します。

DumpFileList手続きは、ファイル名リストを表示します。下受けルーチンとして、WriteFileStruc手続きを 使っています。

特に難しいロジックはありません。

BdosStructは、Definition Moduleだけです。以下のようになっています。

DEFINITION MODULE BdosStruct;

FROM OpSys IMPORT BdosFunctions;
FROM SYSTEM IMPORT WORD;

EXPORT QUALIFIED
        BdosCommand,BdosReturn;2

TYPE
        BdosCommand = RECORD
                CASE BOOLEAN OF
                        TRUE:   Func: BdosFunctions;
                |       FALSE:  Cmd: WORD;
                END;
        END;
        BdosReturn = RECORD
                CASE BOOLEAN OF
                        TRUE:   Rc: WORD;
                |       FALSE:  Cc: CARDINAL;
                END;
        END;
END BdosStruct.                     

次回は、これを応用したファイルマッチで指定されたファイルをリストするコマンド"FileFind"紹介します。

TRN-8にEEPROMを搭載する2023年08月11日 15:36

私のCP/M機 TRN-8のROM-BIOSは、UVEPROMの27C256互換品を使っています。実験などで ROM を 書き換えることもあります。コードを書いては、アセンブリし、UVEPROMに書き込んでテストするという、手順を 繰り返します。書き込む前に、紫外線でUVEPROMをイレーズする必要があります。これには、10分から15分かかります。 テストの繰り返しの中で、結構な待ち時間になります。というわけで、EEPROMを使用してみることを計画していました。

最近、27C256の互換品のEEPROM 28C256を入手できましたので、早速、27C256の内容をダンプして、28C256に 書き込み、置き換えてみました。結果、動きません。ROMライターを変えてもだめでした。当然、書き込みエラーは起きません。 こなったら、初心に戻り、データシートを比較してみました。アクセス速度は200nsecで問題なしです。ピン接続を確認すると、 おぉっと、1番ピンと27番ピンに違いがありました。違いは以下のごとくです。

PIN#27C25628C257
1VppA14
27A14/WE

このままでは、EEPROM 28C256を使ってテストをして、本番にはUV-EPROM 27C256を使ってという、 当初の目論見が実現できません。苦肉の策として、このような下駄を作りました。

本来のPROMソケットにこの下駄を差し、テスト中は下駄にEEPROMを刺します。テストが完了したら、下駄を取り外し UVEPROMを直接、PROMソケットに刺すわけです。こんな感じです。

これで、効率よくテストする環境が揃いました。

久しぶりに、Modula-2でプログラミング --その4-- CmdArgsの修正2023年01月30日 15:50

先に公開した"CmdArgs"モジュールに危ないところがありました。エクスポートしている変数"Argc"は、 インポートしたモジュールで変更できます。変えられてしまうと、"CmdArgs"モジュールが誤作動します。これを さけるために、引数の数を手続き"Argc()"で返すようにしました。 これで、不用意に"CmdArgs"モジュールにダメージを 与えることがなくなりました。

修正版の定義モジュール"CmdArgs.def"は、以下の通り。

DEFINITION MODULE CmdArgs;

EXPORT QUALIFIED Argv,Argc;

PROCEDURE Argc(): CARDINAL;
PROCEDURE Argv(n: CARDINAL;VAR ArgString: ARRAY OF CHAR);

END CmdArgs.

修正版の実装モジュール"CmdArgs.mod"は、以下の通り。

IMPLEMENTATION MODULE CmdArgs;
FROM ASCII IMPORT nul,ht,lf,cr;
FROM SYSTEM IMPORT ADR,WORD;
FROM OpSys IMPORT BdosFunctions,Bdos,CPMStringBuffer;

CONST
        SPACE = ' ';
        TAB = ht;
        COMMA = ',';
        SQUORT = "'";
        DQUORT = '"';
        EOS = nul;
        MAXARGS = 20;
        EMPTY = -1;

VAR
        ArgList: ARRAY [0..MAXARGS-1] OF INTEGER;
        CommandLine: CPMStringBuffer;
        QChar: CHAR;
        c,s: CARDINAL;
        CommaFlag: BOOLEAN;
        nArgc: CARDINAL;
        Msg: ARRAY [0..80] OF CHAR;

PROCEDURE Argc(): CARDINAL;
BEGIN
        RETURN nArgc;
END Argc;

PROCEDURE Argv(n: CARDINAL;VAR ArgString: ARRAY OF CHAR);
VAR
        s,d: CARDINAL;
BEGIN
        IF nArgc < n THEN
                ArgString[0] := EOS;
        ELSIF ArgList[n] = EMPTY THEN
                ArgString[0] := EOS;
        ELSE
                s := ArgList[n];
                d := 0;
                WHILE CommandLine.text[s] # EOS DO
                        ArgString[d] := CommandLine.text[s];
                        INC(s);INC(d);
                END;
                ArgString[d] := EOS;
        END;
END Argv;

PROCEDURE skipBlanks();
BEGIN
        WHILE isBlankChar(CommandLine.text[c]) DO
                INC(c);
        END;
END skipBlanks;

PROCEDURE skipSeparator();
BEGIN
        WHILE isSeparator(CommandLine.text[c]) DO
                INC(c);
        END;
END skipSeparator;

PROCEDURE isBlankChar(ch: CHAR): BOOLEAN;
BEGIN
        IF (ch = SPACE) OR (ch = TAB) THEN
                RETURN TRUE;
        END;
        RETURN FALSE;
END isBlankChar;

PROCEDURE nextQuort();
BEGIN
        WHILE (CommandLine.text[c] # EOS)
                AND (CommandLine.text[c] # QChar) DO
                INC(c);
        END;
END nextQuort;

PROCEDURE nextSeparator();
BEGIN
        WHILE (CommandLine.text[c] # EOS)
                AND (NOT isSeparator(CommandLine.text[c])) DO
                INC(c);
        END;
END nextSeparator;

PROCEDURE getOneArg(): CARDINAL;
VAR
        s: CARDINAL;
BEGIN
        IF CommandLine.text[c] # EOS THEN
                IF isQuort(CommandLine.text[c]) THEN
                        QChar := CommandLine.text[c];
                        INC(c);
                        s := c;
                        nextQuort();
                ELSE
                        s := c;
                        nextSeparator();
                END;
                CommaFlag := FALSE;
                IF CommandLine.text[c] # EOS THEN
                        IF CommandLine.text[c] # COMMA THEN
                                CommandLine.text[c] := EOS;
                                INC(c);
                                skipBlanks();
                        END;
                        IF CommandLine.text[c] = COMMA THEN
                                CommaFlag := TRUE;
                                CommandLine.text[c] := EOS;
                                INC(c);
                        END;
                END;
        ELSE
                s := 0;
        END;
        RETURN s;
END getOneArg;

PROCEDURE isQuort(ch: CHAR): BOOLEAN;
BEGIN
        IF (ch = SQUORT) OR (ch = DQUORT) THEN
                RETURN TRUE;
        END;
        RETURN FALSE;
END isQuort;

PROCEDURE isSeparator(ch: CHAR): BOOLEAN;
BEGIN
        CASE ch OF
        SPACE: RETURN TRUE;
        | TAB: RETURN TRUE;
        | COMMA: RETURN TRUE;
        ELSE
                RETURN FALSE;
        END;
END isSeparator;

PROCEDURE getCmdLine();
VAR
        BDOSCmd: RECORD
                CASE BOOLEAN OF
                TRUE: Func: BdosFunctions;
                | FALSE: Cmd: WORD;
                END;
        END;
        junk: WORD;
BEGIN
        BDOSCmd.Func := prtStr;
        Msg := 'arguments>$';
        Bdos(BDOSCmd.Cmd,ADR(Msg),junk);

        CommandLine.maxLen := CHR(255);
        CommandLine.curLen := CHR(0);
        BDOSCmd.Func := rdCBuf;
        Bdos(BDOSCmd.Cmd,ADR(CommandLine),junk);
        CommandLine.text[ORD(CommandLine.curLen)] := EOS;

        BDOSCmd.Func := prtStr;
        Msg[0] := cr; Msg[1] := lf; Msg[2] := '$';
        Bdos(BDOSCmd.Cmd,ADR(Msg),junk);

        FOR nArgc := 0 TO MAXARGS-1 DO
                ArgList[nArgc] := EMPTY;
        END;

        nArgc := 0;
        c := 0;
        CommaFlag := FALSE;
        skipBlanks();
        WHILE (CommandLine.text[c] # EOS) AND (nArgc < MAXARGS) DO
                ArgList[nArgc] := getOneArg();
                skipBlanks();
        INC(nArgc);
        END;
        IF (CommandLine.text[c] = EOS) AND CommaFlag THEN
                ArgList[nArgc] := c;
                INC(nArgc);
        END;
END getCmdLine;

BEGIN
        getCmdLine();
END CmdArgs.

この修正にあわせて、"Find"モジュールの変更をしました。

久しぶりに、Modula-2でプログラミング -- その3 -- "CmdLine.mod"モジュールの応用"Find.mod"の紹介2023年01月26日 11:18

先に公開しました"CmdLine.mod"モジュールを使った応用を紹介します。

応用モジュール"Find.mod"は、指定された文字列をファイル中から探し表示します。このような感じです。

文字列"WriteLn"をファイル"find.mod"、"cmdargs.def"、"tstargs.mod"から探して表示します。

C0#find
arguments>WriteLn find.mod cmdargs.def tstargs.mod
find.mod[3]FROM InOut IMPORT Write,WriteCard,WriteString,WriteLn;
find.mod[35]    WriteLn;
find.mod[87]    WriteString('find');WriteLn;
find.mod[88]    WriteString('      TargetString File1 File2 FIle3,,,,');WriteLn; 
tstargs.mod[2]FROM InOut IMPORT Write,WriteInt,WriteLn,WriteString;
tstargs.mod[13] WriteString('Argc:=');WriteInt(Argc,3);WriteLn;
tstargs.mod[20]         Write(']');WriteLn;

このように、ファイル名、出現した行番号、出現した行を表示します。"CmdArgs.def"には、該当する文字列がありませんでした。

では、"Find.mod"モジュールの内容です。文字列の検索は"FindTarget()"手続きでします。 ストレートに書き下しましたので、ロジックを追えることと思います。

Find.mod

MODULE Find;
FROM CmdArgs IMPORT Argc,Argv;
FROM InOut IMPORT Write,WriteCard,WriteString,WriteLn;
FROM ASCII IMPORT nul,lf;
FROM Files IMPORT FILE,FileState,Open,Close,Read;
FROM OpSys IMPORT Bdos,BdosFunctions;
FROM SYSTEM IMPORT WORD;

CONST
        EOS = nul;
        MAXLINE = 128;
        FILENAMESIZE = 15;
        EOFMARK = 32C;

VAR
        FileName: ARRAY [0..FILENAMESIZE] OF CHAR;
        Target: ARRAY [0..MAXLINE] OF CHAR;
        LineBuffer: ARRAY [0..MAXLINE] OF CHAR;
        FileNumber,LineNumber: CARDINAL;
        inFile: FILE;
        EndOfFile: BOOLEAN;
        fs: FileState;
        BdosCmd: RECORD
                CASE BOOLEAN OF
                        TRUE: Func: BdosFunctions;
                        | FALSE: Cmd: WORD;
                END;
        END;

PROCEDURE putLine(Name:ARRAY OF CHAR;Line:CARDINAL;Buffer:ARRAY OF CHAR);
BEGIN
        WriteString(Name);
        Write('[');WriteCard(Line,1);Write(']');
        WriteString(Buffer);
        WriteLn;
END putLine;

PROCEDURE ReBoot();
VAR
        junk: WORD;
BEGIN
        BdosCmd.Func := boot;
        Bdos(BdosCmd.Cmd,junk,junk);
END ReBoot;

PROCEDURE findTarget(Target,Line:ARRAY OF CHAR): BOOLEAN;
VAR
        t,l: CARDINAL;
        found: BOOLEAN;
BEGIN
        found := FALSE;
        t := 0; l := 0;
        WHILE (Line[l] # EOS) AND (NOT found) DO
                IF Line[l] = Target[0] THEN
                        t := 1;
                        WHILE Line[l+t] = Target[t] DO
                                INC(t);
                        END;
                        IF Target[t] = EOS THEN
                                found := TRUE;
                        END;
                END;
                INC(l);
        END;
        RETURN found;
END findTarget;

PROCEDURE ReadLine(f:FILE;VAR Line:ARRAY OF CHAR);
VAR
        c: CARDINAL;
BEGIN
        c := 0;
        Read(f,Line[c]);
        WHILE (Line[c] # lf) AND (NOT EndOfFile) DO
                IF Line[c] = EOFMARK THEN
                        EndOfFile := TRUE;
                ELSE
                        INC(c);
                        Read(f,Line[c]);
                END;
        END;
        Line[c] := EOS;
END ReadLine;

PROCEDURE Usage();
BEGIN
        WriteString('find');WriteLn;
        WriteString('      TargetString File1 File2 FIle3,,,,');WriteLn; 
END Usage;

BEGIN
        IF Argc < 1 THEN
                Usage();
                ReBoot();
        END;
        Argv(0,Target);
        FileNumber := 1;
        WHILE FileNumber < Argc DO
                Argv(FileNumber,FileName);
                fs := Open(inFile,FileName);
                IF fs = FileOK THEN
                        EndOfFile := FALSE;
                        LineNumber := 1;
                        WHILE NOT EndOfFile DO
                                ReadLine(inFile,LineBuffer);
                                IF findTarget(Target,LineBuffer) THEN
                                        putLine(FileName,LineNumber,
                                                LineBuffer);
                                END;
                                INC(LineNumber);
                        END;
                        fs := Close(inFile);
                END;
                INC(FileNumber);
        END;
END Find.

久しぶりに、Modula-2でプログラミング--その2 CmdLineモジュールの紹介--2023年01月23日 20:58

コマンドライン・パラメーターを読みとり、分解する仕組みを実現したモジュールを公開します。 Modula-2で作成しました。Modula-2では、コンパイル単位を「モジュール」と呼びます。モジュールは3種類あり、 「定義モジュール(DEFINITION MODULE)」、「実現モジュール(IMPLEMENTATION MODULE)」、 「モジュール(MODULE") です。

「定義モジュール」は、モジュールのインターフェイスを記述したもので、他のモジュールに公開する定数や手続きを記述します。

「実現モジュール」は、名前の通り、モジュールの機能を書き下したプログラムです。

「モジュール」は、いわゆるメインプログラムです。

まずは、定義モジュール"CmdArgs.def"です。

DEFINITION MODULE CmdArgs;

EXPORT QUALIFIED Argv,Argc;

VAR
        Argc: CARDINAL;

PROCEDURE Argv(n: CARDINAL;VAR ArgString: ARRAY OF CHAR);

END CmdArgs.

モジュール"CmdArgs"が提供(EXPORT)する手続き"Argv"と変数"Argc"を定義しています。 これを事前コンパイルしておき、このモジュールを利用するモジュールをコンパイルする際に読み込まれ、 妥当性のチェックに使われます。

おつぎは、実現モジュール"CmdArgs.mod"です。

CmdArgs.mod

IMPLEMENTATION MODULE CmdArgs;
FROM ASCII IMPORT nul,ht,lf,cr;
FROM SYSTEM IMPORT ADR,WORD;
FROM OpSys IMPORT BdosFunctions,Bdos,CPMStringBuffer;

CONST
        SPACE = ' ';
        TAB = ht;
        COMMA = ',';
        SQUORT = "'";
        DQUORT = '"';
        EOS = nul;
        MAXARGS = 20;
        EMPTY = -1;

VAR
        ArgList: ARRAY [0..MAXARGS-1] OF INTEGER;
        CommandLine: CPMStringBuffer;
        QChar: CHAR;
        c,s: CARDINAL;
        CommaFlag: BOOLEAN;
(*      Argc: CARDINAL; defined in CmdArgs.Def  *)
        Msg: ARRAY [0..80] OF CHAR;

PROCEDURE skipBlanks();
BEGIN
        WHILE isBlankChar(CommandLine.text[c]) DO
                INC(c);
        END;
END skipBlanks;

PROCEDURE skipSeparator();
BEGIN
        WHILE isSeparator(CommandLine.text[c]) DO
                INC(c);
        END;
END skipSeparator;

PROCEDURE isBlankChar(ch: CHAR): BOOLEAN;
BEGIN
        IF (ch = SPACE) OR (ch = TAB) THEN
                RETURN TRUE;
        END;
        RETURN FALSE;
END isBlankChar;

PROCEDURE Argv(n: CARDINAL;VAR ArgString: ARRAY OF CHAR);
VAR
        s,d: CARDINAL;
BEGIN
        IF Argc < n THEN
                ArgString[0] := EOS;
        ELSIF ArgList[n] = EMPTY THEN
                ArgString[0] := EOS;
        ELSE
                s := ArgList[n];
                d := 0;
                WHILE CommandLine.text[s] # EOS DO
                        ArgString[d] := CommandLine.text[s];
                        INC(s);INC(d);
                END;
                ArgString[d] := EOS;
        END;
END Argv;

PROCEDURE nextQuort();
BEGIN
        WHILE (CommandLine.text[c] # EOS)
                AND (CommandLine.text[c] # QChar) DO
                INC(c);
        END;
END nextQuort;

PROCEDURE nextSeparator();
BEGIN
        WHILE (CommandLine.text[c] # EOS)
                AND (NOT isSeparator(CommandLine.text[c])) DO
                INC(c);
        END;
END nextSeparator;

PROCEDURE getOneArg(): CARDINAL;
VAR
        s: CARDINAL;
BEGIN
        IF CommandLine.text[c] # EOS THEN
                IF isQuort(CommandLine.text[c]) THEN
                        QChar := CommandLine.text[c];
                        INC(c);
                        s := c;
                        nextQuort();
                ELSE
                        s := c;
                        nextSeparator();
                END;
                CommaFlag := FALSE;
                IF CommandLine.text[c] # EOS THEN
                        IF CommandLine.text[c] # COMMA THEN
                                CommandLine.text[c] := EOS;
                                INC(c);
                                skipBlanks();
                        END;
                        IF CommandLine.text[c] = COMMA THEN
                                CommaFlag := TRUE;
                                CommandLine.text[c] := EOS;
                                INC(c);
                        END;
                END;
        ELSE
                s := 0;
        END;
        RETURN s;
END getOneArg;

PROCEDURE isQuort(ch: CHAR): BOOLEAN;
BEGIN
        IF (ch = SQUORT) OR (ch = DQUORT) THEN
                RETURN TRUE;
        END;
        RETURN FALSE;
END isQuort;

PROCEDURE isSeparator(ch: CHAR): BOOLEAN;
BEGIN
        CASE ch OF
        SPACE: RETURN TRUE;
        | TAB: RETURN TRUE;
        | COMMA: RETURN TRUE;
        ELSE
                RETURN FALSE;
        END;
END isSeparator;

PROCEDURE getCmdLine();
VAR
        BDOSCmd: RECORD
                CASE BOOLEAN OF
                TRUE: Func: BdosFunctions;
                | FALSE: Cmd: WORD;
                END;
        END;
        junk: WORD;
BEGIN
        BDOSCmd.Func := prtStr;
        Msg := 'arguments>$';
        Bdos(BDOSCmd.Cmd,ADR(Msg),junk);

        CommandLine.maxLen := CHR(255);
        CommandLine.curLen := CHR(0);
        BDOSCmd.Func := rdCBuf;
        Bdos(BDOSCmd.Cmd,ADR(CommandLine),junk);
        CommandLine.text[ORD(CommandLine.curLen)] := EOS;

        BDOSCmd.Func := prtStr;
        Msg[0] := cr; Msg[1] := lf; Msg[2] := '$';
        Bdos(BDOSCmd.Cmd,ADR(Msg),junk);

        FOR Argc := 0 TO MAXARGS-1 DO
                ArgList[Argc] := EMPTY;
        END;

        Argc := 0;
        c := 0;
        CommaFlag := FALSE;
        skipBlanks();
        WHILE (CommandLine.text[c] # EOS) AND (Argc < MAXARGS) DO
                ArgList[Argc] := getOneArg();
                skipBlanks();
        INC(Argc);
        END;
        IF (CommandLine.text[c] = EOS) AND CommaFlag THEN
                ArgList[Argc] := c;
                INC(Argc);
        END;
END getCmdLine;

BEGIN
        getCmdLine();
END CmdArgs.

手続き"getCmdLine()"は、このモジュールが初期化されるときに動きます。"getCmdLine()"は、プロンプト "arguments>"を表示し、引数を読みとります。その後、前回示したルールに従って引数を分解します。

変数"Argc"は、分解後の引数の数です。

手続き"Argv(n,Param)"は、"n"番目の引数(nilで終わる文字列)を "Param"にコピーして返します。 存在しない引数の時は、"Param"は、長さ0の文字列になります。第一引数は引数は、"n=0"です。

何の変哲のない下請け手続きで書き下しましたので、ロジックを簡単に追えると思います。

次回は、"CmdArgs"モジュールを使用した例を紹介します。

久しぶりに、Modula-2でプログラミング2023年01月18日 06:46

CP/Mは、よくできたDOSですが、いくつか不満があります。そのひとつに、コマンド行パラメーターが すべて大文字になってしまうのです。これでは、findやsedのような文字列を検索したり、置換したりする アプリケーションで小文字を入力できないので、困ってしまいます。CP/Mが盛んに使われた時代を考えると 仕方のないことですが、何とかしたいものです。

入力されたコマンド行パラメーター入力をすべて小文字にするのは乱暴すぎます。折衷案として パラメータの入力を促し読みとる仕組みを作ることにしました。ついでに、少し賢い引数分解の仕組みを 組み込みました。

作成した仕組み"CmdArgs"は以下のルールで、引数を分解します。

  • 引数は、区切り文字(コンマ、スペース、タブ)で区切られる。
  • 最初のコンマの前が、スペース、タブである場合は、第一番目の引数は、ヌル文字列とみなす。
  • 最後の文字がコンマの場合は、最後に、ヌル文字列があるものとみなす。
  • 引数は、クオート文字('、または、")でくくることができる。 コンマ、スペース、タブを含むことができる。
  • クオート文字で始まる引数は、行末までにクオート文字が出現しない場合、行末末までのすべての文字を 含む。

プログラムは、"MODULA-2 Compiler for Z80-CP/M Version 2.01"で作成しました。

まずは、テストプログラム"TstArgs.mod"で、実際に引き数の入力や分解をみてください。

C0#tstargs
arguments>one  , two three "ONE TWO  ", '   THREE FOUR' four
Argc:=  6
  0[one]
  1[two]
  2[three]
  3[ONE TWO  ]
  4[   THREE FOUR]
  5[four]            

C0#tstargs
arguments>  , one two three   ,      <---カンマ直後に改行
Argc:=  5
  0[]
  1[one]
  2[two]
  3[three]
  4[] 

C0#tstargs
arguments> one  two 'Three,Four Five   <--- Fiveの後ろにはスペースがある
Argc:=  3
  0[one]
  1[two]
  2[Three,Four Five     ]

テストプログラム"TstArgs.mod"は、このようになります。

MODULE TstArgs;
FROM InOut IMPORT Write,WriteInt,WriteLn,WriteString;
FROM CmdArgs IMPORT Argc,Argv;   <--- コマンド行の引数を処理するモジュールを取り込む

CONST
        MAXSTRINGLENGTH = 80;

VAR
        Arg: ARRAY [0..MAXSTRINGLENGTH] OF CHAR;
        nArgs: CARDINAL;

BEGIN
        WriteString('Argc:=');WriteInt(Argc,3);WriteLn;
        nArgs := 0;
        WHILE nArgs < Argc DO
                WriteInt(nArgs,3);
                Write('[');
                Argv(nArgs, Arg);
                WriteString(Arg);
                Write(']');WriteLn;
                INC(nArgs);
        END;
END TstArgs.

コマンド行を処理するモジュール"CmdArgs.mod"については、分量があるので、次回に公開します。