The ModulAtor

Ublantis' 1st Independent Oberon & Modula-2 Technical Publication

Nr. 91, Oct-2015

ModulaTor logo, 7.8KB

G. Dotzel: Directory Walker in Modula-2 for DEC PDP-11/RT-11 Operating System

Copyright © (2015) by Guenter Dotzel, modulAware.com

Here are the imported Uni* definition modules.

MODULE UseGetDir; (* GD 20-Aug-1986 *)
(* Application example for module GetDirectory *)

FROM GetDirectory IMPORT OpenDir, GetNext, ReleaseDir, Time, FileName;
FROM UnivOutput IMPORT WriteString, Writeln, WriteCard, WriteInt;
FROM UnivFileName IMPORT ReadFileName;
FROM UnivDate IMPORT WriteDate, WriteTime;
FROM TTIO IMPORT Read, Write;
FROM ASCII IMPORT ESC;

VAR ch: CHAR; ok, prot: BOOLEAN;
  fn: FileName; typed: BITSET;
  flen, ds, size, start, nf, nbl: CARDINAL; t: Time;

BEGIN
  LOOP
    Writeln (Write); WriteString (Write, 
    'Device (default DK) or name of subdir file:');
    ReadFileName (Read, Write, fn, 'DK          ', typed, ch);
    IF ch = ESC THEN EXIT END;
    OpenDir(fn, ds, ok);
    WriteString (Write, ', device size ');WriteInt(Write, ds, 1);
    Writeln (Write);
    LOOP
      GetNext (fn, prot, size, start, t, ok);
      Writeln (Write);
      IF ok THEN
        Write (fn[ 3]); Write (fn[ 4]);Write (fn[ 5]); Write (fn[ 6]);
        Write (fn[ 7]); Write (fn[ 8]);Write ('.');
        Write (fn[ 9]);Write (fn[10]);Write (fn[11]);
        WriteCard(Write, size, 6);
        IF prot THEN Write('P') ELSE Write(' '); END; Write(' ');
        WriteDate(Write, t); (*Write(' '); WriteTime(Write, t);*)
        WriteCard(Write, start, 6);
      ELSE
        ReleaseDir (nf,nbl);
        WriteString (Write, 'Files ');WriteCard(Write, nf, 1);
        WriteString (Write, ' Blocks ');WriteCard(Write, nbl, 1);
        EXIT;
      END;
    END;
  END;
  Writeln (Write);
END UseGetDir.

DEFINITION MODULE GetDirectory; (* Directory access for RT11A/RT11X directories, example: UseGet.MOD > > (c) Copyright (1984) by Gunter Dotzel, ModulaWare.com > Started: Aug-1986 by R. Singer Revisions: comments 20-Aug-1986 GD.~}~) *) IMPORT Files, Clock; TYPE FileName = Files.FileName; Time = Clock.Time; (* for future extensions: FileMode = (permanent, tentative, protected, filler, empty, illegal); FileModes = SET OF FileMode; *) PROCEDURE OpenDir (dev: FileName; VAR devSize: CARDINAL; VAR ok: BOOLEAN); (* Directory on logical dev [0..2] is opened. dev [3..11] should be filled with " "; in this case devSize will be 0. If the file name of a logical disk is specified in dev[3..11] then device size in blocks is returned. If ok, the the directory channel is open and files names in the directory may be accessed calling GetNext. *) PROCEDURE ReleaseDir (VAR totalFiles, totalBlocks: CARDINAL); (* release directory channel *) PROCEDURE GetNext (VAR fn: FileName; VAR protected: BOOLEAN; VAR size, start: CARDINAL; VAR t: Time; VAR ok: BOOLEAN); (* get next permanent (protected or unprotected) file name and it's attributes from device specified in OpenDir *) END GetDirectory.
IMPLEMENTATION MODULE GetDirectory; (* $T+ *) (* > > (c) Copyright (1984) by Gunter Dotzel, ModulaWare.com > > Revisions: Sep-1982, Feb-1985 by GD. > Derived from module Directory modulaware.com/mdlt/?n=90 > in 20-Aug-1986 by GD. *) FROM SYSTEM IMPORT TSIZE, ADR, SIZE, WORD, ADDRESS; FROM Files IMPORT FileName, ReadBlock, Lookup, FILE, Release, Close, Radix50, Rad50name; FROM FilePool IMPORT GetFileNumber; CONST FirstDirectoryBlock= 6; CONST ExtraBytes = 0; (* see number of extra bytes field in segment header *) FilesPerSegment = 72; (* only if NumberOfExtraBytes = 0 *) BlockSize = 512; (* BYTE *) TYPE BYTE = CHAR; DiskBlock = ARRAY [0..BlockSize-1] OF BYTE; FileNameAndExtension = ARRAY [0..2] OF CARDINAL; (* in Rad50 format *) (* Rad50name includes device name. To get the physical device name of logical unit, must fetch the handler. *) FileNaExt = ARRAY [0..8] OF CHAR; (* in ASCII format *) CONST (* file entry STATUS BITs in FileEntry.StatusWord: *) perm = {10}; prot = {15}; filler = perm + prot; (* and Length=0, Name is unused *) (* created by JOAT for "VS" *) EndOfSegmentMark = {11}; (* see end of segment entry *) tentative = {8}; empty = {9}; (* Name & Date is unused *) TYPE FileEntry = RECORD (* TSIZE(FileEntry) = 7 words without ExtraInfo *) StatusWord: BITSET; (* entry type *) Name: FileNameAndExtension; Length: CARDINAL; (* in blocks *) Tim: CARDINAL; (* used by SHAREplus *) Date: CARDINAL; (* year - month - day *) (* ExtraInfo: ARRAY [1..ExtraBytes] OF BYTE; *) END; FileEntryPtrType = POINTER TO FileEntry; SegmentHeader= RECORD (* TSIZE(SegmentHeader) = 5 words *) Segments: CARDINAL; (* number of available segments *) NextSeg: CARDINAL; (* segment link or 0, the first directory segment number is 1. It is located at block 6 on device. The segment size is 512 words. Hence the device block number for the segment i (1 <= i <= Segments) is FirstDirectoryBlock + (i-1)*2. *) HighestActiveSeg: CARDINAL; (* used in first segment only *) NumberOfExtraBytesPerEntry: CARDINAL; (* 0 *) FirstDataBlockNumber: CARDINAL; END; FilesOfSegment = ARRAY [0..FilesPerSegment-1] OF FileEntry; EndOfSegmentEntry = RECORD (* TSIZE = 1 up to TSIZE(FileEntry) words *) StatusWord: CARDINAL; (* 4000B fixed *) (* plus 2 words (if no extra words): *) Unused: ARRAY [1..2] OF WORD; (* ASCII blanks (020040B) *) END; Segment = RECORD (* TSIZE(Segment) = 512 words *) SegHeader: SegmentHeader; File: FilesOfSegment; Filler: EndOfSegmentEntry; END; CONST NotFound = " XXXXXXxxx"; (* returned if no next file name exists *) VAR opendir: BOOLEAN; Device: FILE; nf, nbl, bl, i, NEbyte, segm: CARDINAL; nextSegm: BOOLEAN; Dev: FileName; FEptr: FileEntryPtrType; VAR SegBuffer: Segment; PROCEDURE OpenDir (dev: FileName; VAR devSize: CARDINAL; VAR ok: BOOLEAN); VAR ds, WordCount: INTEGER; BEGIN opendir:=FALSE; ok:=FALSE; Dev := dev; (*Dev := 'xxx '; allow Dev:xxxxxx.DSK files also Dev[0]:=dev[0];Dev[1]:=dev[1];Dev[2]:=dev[2]; *) IF Dev[0]#0C THEN IF Dev[1]=0C THEN Dev[1]:=' '; END; IF Dev[2]=0C THEN Dev[2]:=' '; END; GetFileNumber (Device); Lookup (Device, Dev, ds); devSize := ds; ok := NOT ((-255 <= ds) & (ds < 0)); (* SHAREplus gives 0 for devices *) IF ok THEN segm:=FirstDirectoryBlock; (* NEW (SegBuffer) *) ReadBlock (Device, ADR(SegBuffer), segm, SIZE(SegBuffer) DIV 2, WordCount); WITH SegBuffer.SegHeader DO ok := (WordCount = SIZE(SegBuffer) DIV 2) & (NextSeg <= 31) & (0 <= NumberOfExtraBytesPerEntry)&(NumberOfExtraBytesPerEntry <= 6) & NOT (ODD(NumberOfExtraBytesPerEntry)) & (0 < HighestActiveSeg) & (HighestActiveSeg <= 31) & (0 < Segments) & (Segments <= 31) & (FirstDataBlockNumber >= ((Segments * 2) + 6)); NEbyte := NumberOfExtraBytesPerEntry; END; IF ok THEN nf := 0; nbl:=0; nextSegm := FALSE; (* first seg already read *) opendir := TRUE; i := 0; FEptr:=ADR(SegBuffer.File); bl := SegBuffer.SegHeader.FirstDataBlockNumber; ELSE Release(Device); END; ELSE Release(Device); END; END; END OpenDir; PROCEDURE ReleaseDir (VAR totalFiles, totalBlocks: CARDINAL); BEGIN IF opendir THEN Release (Device); (* .PURGE *) opendir:=FALSE; (*DISPOSE (SegBuffer);*) END; totalFiles := nf; totalBlocks := nbl; END ReleaseDir; PROCEDURE GetNext (VAR fn: FileName; VAR protected: BOOLEAN; VAR size, start: CARDINAL; VAR t: Time; VAR ok: BOOLEAN); VAR d,m,y: CARDINAL; WordCount: INTEGER; BEGIN ok:=FALSE; REPEAT IF NOT opendir THEN fn := NotFound; RETURN END; IF nextSegm THEN ReadBlock (Device, ADR(SegBuffer), segm, SIZE(SegBuffer) DIV 2, WordCount); IF NOT (WordCount = SIZE(SegBuffer) DIV 2) THEN fn := NotFound; ReleaseDir (d,m); ok:=FALSE; RETURN END; i := 0; FEptr:=ADR(SegBuffer.File); bl := SegBuffer.SegHeader.FirstDataBlockNumber; END; WITH SegBuffer DO WITH FEptr^ DO (*WITH File[i] DO*) IF (perm <= StatusWord) THEN protected:= prot <= StatusWord; size := Length; start := bl; INC (nf); INC (nbl, Length); DecodeRad50 (Name, fn); d := Date DIV 40B MOD 40B; m := Date DIV 2000B MOD 20B; y := (Date MOD 40B + 72)(*+1900*); t.day := ((y(*-1900*)) * 20B + m) * 40B + d; t.minute := 0; (* Tim DIV 60; SHAREplus time hh:mm:ss in binary is good to a second*) t.millisecond:=0*1000; ok := TRUE; ELSE (* tentative or filler or empty entry *) END; (* IF perm *) INC (bl, Length); FEptr := ADDRESS(CARDINAL(FEptr) + TSIZE(FileEntry)+NEbyte); INC (i); nextSegm := (i = HIGH(File)) OR (EndOfSegmentMark <= (*File [i]*)FEptr^.StatusWord); END; IF nextSegm THEN WITH SegBuffer.SegHeader DO IF NextSeg=0 THEN ReleaseDir (d,m); ELSE segm := FirstDirectoryBlock + (NextSeg-1)*2; END; END; END; END; (* WITH *) UNTIL ok; END GetNext; PROCEDURE DecodeRad50 (file: FileNameAndExtension; VAR name: FileName); (* To be simplified ! *) PROCEDURE DecRad50 (word: CARDINAL; VAR c1,c2,c3: CHAR); PROCEDURE CardtoRad50 (i: CARDINAL): CHAR; BEGIN IF i = 0 THEN RETURN ' '; ELSIF (1<=i) & (i<=26) THEN RETURN CHR (i+64); ELSIF i = 27 THEN RETURN '$'; ELSIF (30<=i) & (i<=39) THEN RETURN CHR (i+18); ELSE RETURN CHR (0); END; END CardtoRad50; BEGIN c1 := CardtoRad50 (word DIV 1600); c2 := CardtoRad50 ((word MOD 1600) DIV 40); c3 := CardtoRad50 (word MOD 40); END DecRad50; VAR c1,c2,c3: CHAR; BEGIN (* DecodeRad50 *) name[0] := Dev[0];name[1] := Dev[1];name[2] := Dev[2]; DecRad50 (file [0], c1, c2, c3); name[3] := c1;name[4] := c2;name[5] := c3; DecRad50 (file [1], c1, c2, c3); name[6] := c1;name[7] := c2;name[8] := c3; DecRad50 (file [2], c1, c2, c3); name[9] := c1;name[10] := c2;name[11] := c3; END DecodeRad50; BEGIN opendir := FALSE; END GetDirectory. (* TYPE HomeBlockFormat = RECORD BadBlockReplacementTable: ARRAY [0B .. 101B] OF WORD; InitializeRestoreData: ARRAY [102B .. 125B] OF WORD; BUPData:(*backup utilit.*)ARRAY [126B .. 136B] OF WORD; Filler1: ARRAY [137B .. 337B] OF WORD; RTEMData:(*RT emulator*) ARRAY [340B .. 341B] OF WORD; Filler2: ARRAY [342B .. 350B] OF WORD; PackClusterSize: ARRAY [351B .. 351B] OF WORD; (* 1 *) FirstDirectoryBlock: ARRAY [352B .. 352B] OF WORD; (* 6 *) SystemVersion: (* Rad50 *)ARRAY [353B .. 353B] OF WORD; (* "Vxx" *) VolumeId: ARRAY [354B .. 361B] OF WORD; (* "RT11A" *) OwnerName: ARRAY [362B .. 367B] OF WORD; (* *) SystemId: ARRAY [370B .. 375B] OF WORD; (* DECRT11A *) CheckSum: ARRAY [376B .. 377B] OF WORD; (* ? *) END; (* disk structure: Disk = RECORD BootBlock: DiskBlock; (* block 0 *) HomeBlock: HomeBlockFormat; (* block 1 *) Reserved: ARRAY[1..4] OF DiskBlock; (* block 2 .. 5 *) Directory: ARRAY[1 ..1 (* ..n *)] OF Segment; (* starts at block 6 *) (* n = Disk.Directory [1].SegHeader.Segments *) DataBlocks: ARRAY[n+1 .. DeviceSize-1] OF DiskBlock; END; *)*)
(Last revised 27-Oct-2015)
IMPRESSUM: The ModulAtor is an unrefereed journal. Technical papers are to be taken as working papers and personal rather than organizational statements; all source code is experimental — use at your own risk. Articles are published at the discretion of the Editor based upon his judgement on the interest and relevancy to the readership. Letters, announcements, and other items of professional interest are selected on the same basis. You're welcome to submit articles for publication by writing to the Editor

ModulaWare.com website navigator

[ Home | Site_index | Contact | Legal | OpenVMS_compiler | Alpha_Oberon_System | ModulAtor | Bibliography | Oberon[-2]_links | Modula-2_links | modulAware.com's Alpha Oberon System home page (Alignment Trap) | General book recommendations ]

Copyright © (2002-2016) by modulAware.com