前回、ファイルを探すモジュール"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"モジュールが無くてもコンパイル できるようにしました。