The ModulAtor

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

Nr. 90, Oct-2015

ModulaTor logo, 7.8KB

G. Dotzel: Directory List Utility 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 Dir; 
(* 
 >
 > (c) Copyright (1984) by Gunter Dotzel, ModulaWare.com
 >
  Simple directory list utility, needs (DIRUTI,DIRECT).(DEF,MOD) 
  Sep-1982 
*)

  FROM DIRUTILITY IMPORT DirUtility  ;

CONST
  DefaultName = 'DK       MOD';

  (* device handler should be loaded *)

BEGIN DirUtility   (DefaultName); 
END Dir.

DEFINITION MODULE DIRUTILITY; FROM Files IMPORT FileName; PROCEDURE DirUtility (FN: FileName); (* Directory Query/Listing. FN is the default file specification. ( device | filename | extension ) *) END DIRUTILITY.
IMPLEMENTATION MODULE DIRUTILITY; (* > > (c) Copyright (1984) by Gunter Dotzel, ModulaWare.com > Directory Query/List Utility Revisions: Sep-1982, Sep-1985 *) FROM Directory IMPORT DisplayFiles; FROM SYSTEM IMPORT TSIZE, ADR, SIZE, WORD; FROM Files IMPORT FileName; FROM UnivFileName IMPORT ReadFileName; FROM TTIO IMPORT Read, Write; FROM UnivOutput IMPORT Writeln, WriteString; FROM ASCII IMPORT ESC; (*FROM VideoTerminal IMPORT CONTROL, EraseToEOL, EraseToEOS, Home;*) PROCEDURE DirUtility (FN: FileName); VAR c: CHAR; FNE: FileName; mode: BITSET; BEGIN (*CONTROL (Home); CONTROL (EraseToEOS);*) LOOP Writeln(Write); WriteString (Write, " DIRectory list utility (default extension ."); Write(FN[09]);Write(FN[10]);Write(FN[11]); WriteString(Write, ", < ESC > to escape) "); Writeln(Write); WriteString (Write, ' Type [Device:][FileName|" "][.(Ext|" ")] < RET > | < ESC > >'); ReadFileName(Read, Write, FNE, FN, mode, c); IF (c=ESC) THEN WriteString(Write, " exit."); Writeln(Write); EXIT END; Writeln(Write); (* FNE = "DEV xxx" | "DEVxxxxxx " | "DEV " | "xxx " | "xxxxxxxxx " | "xxx " | "DEVxxxxxxxxx" | "xxxxxxxxxxxx" *) DisplayFiles (FNE); END; END DirUtility; END DIRUTILITY.
DEFINITION MODULE Directory; FROM Files IMPORT FileName; PROCEDURE DisplayFiles (FN: FileName); (* make a directory listing. if FN = 'xxx ' then all files of logical unit xxx are listed, if FN[3.. 8] = ' ' the all files with extension FN[9..11] are listed. *) END Directory.
IMPLEMENTATION MODULE Directory; (* $T- *) (* > > (c) Copyright (1984) by Gunter Dotzel, ModulaWare.com > Revision: Sep-1982, Feb-1985: SharePlus adaption, Dec-1986: RT11X. An experimental excursion through the RT-11 directory structure. RT-11 disk directory structure, conversions and directory list, with very simple wildcard operations. Reference: Jim Williams, Software Engineer, DEC -- Central Engineering -- Maynard, Paper: RT-11 Directory Structure Internals, DECUS Europe Symposium, Warwick, UK, Sep. 1982 ---------------------------------------------------------------- RT-11 FILES: o contigous o allocated in 512 byte units o direct access o non-extensible (sometimes possible using CREATE/EXTEND) These characteristics are reflected in simplicity of the directory structure. The Directory: o 1..31 segments per directory o 2 blocks (1024 Bytes) per segment o Each active segment has a header and 1 or more entries The Directory is modified by: o USR -- user service routines o DUP -- disk utility program o BUP -- backup utility program o JOAT -- RTEM Jack off all trades o FIT -- RSTS file transfer o FLX -- RSX/VMS file (x)transfer o and last but not least (perhaps) by Modula-2 directory modules and other dirty user written programs. The USR file operations: .CLOSE make file permanent .DELETE make file empty .ENTER allocate file space .FPROT [Un]protect file .LOOKUP find file .PURGE do NOT make file permanent .RENAME change file name/type .SFDATE change creation date *) FROM SYSTEM IMPORT TSIZE, ADR, SIZE, WORD, ADDRESS; FROM TTIO IMPORT Write; FROM UnivOutput IMPORT Writeln, WriteInt, WriteCard, WriteString, WriteStringPart, WriteOct; FROM UnivDate IMPORT WriteDate; FROM Clock IMPORT Time, GetTime; 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 INTEGER; (* in Rad50 format *) (* Rad50name includes device name *) (* To get the device name (of logical unit), fetch the handler. *) FileNaExt = ARRAY [0..8] OF CHAR; (* in ASCII format *) CONST (* file entry STATUS BITS in FileEntry.StatusWord: *) permanent = {10}; protected = {15}; filler = permanent + protected; (* 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 *) JobChannel: CARDINAL; (* reserved (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; VAR CH: CHAR; Device: FILE; DeviceSize, WordCount, i,j, k: INTEGER; FEptr: FileEntryPtrType; NEbyte: CARDINAL; PROCEDURE DecodeRad50 (file: FileNameAndExtension; VAR name: FileNaExt); (* To be simplified ! *) TYPE ShortString = ARRAY [0..2] OF CHAR; PROCEDURE DecRad50 (word: INTEGER; VAR ascii: ShortString); VAR i: CARDINAL; neg: BOOLEAN; BEGIN neg := word < 0; IF neg THEN INC(word, 32768); END; ascii [2] := CHR (word MOD 50B); IF neg THEN word := word DIV 50B + 1463B; IF ascii [2] >= 40C THEN INC(word); END; ascii [2] := CHR ( (ORD(ascii[2]) + 10B) MOD 50B ); ELSE word := word DIV 50B; END; ascii [1] := CHR (word MOD 50B); ascii [0] := CHR (word DIV 50B); FOR i := 0 TO 2 DO word := ORD (ascii[i]); IF word = 0 THEN word := ORD(' '); ELSIF word <= 32B THEN INC (word, 100B); ELSIF word >= 36B THEN INC (word, 22B); ELSE (* error, change to blank: *) word := ORD (' '); END; ascii [i] := CHR (word); END; END DecRad50; VAR i,j: CARDINAL; s: ShortString; BEGIN (* DecodeRad50 *) FOR i := 0 TO HIGH(file) DO DecRad50 (file [i], s ); FOR j := 0 TO HIGH(s) DO name [i * (HIGH(file)+1) + j] := s [j] END; END; END DecodeRad50; VAR fne: FileNaExt; nf, nftotal, bl: CARDINAL; LogicalDeviceName: FileName; Wild: Rad50name; newline: BOOLEAN; PROCEDURE DisplayFiles(FN: FileName); VAR w1, w2, w3: BOOLEAN; t: Time; n1, n2, n3: BOOLEAN; VAR SegBuffer: Segment; BEGIN newline := TRUE; LogicalDeviceName := FN; (* get device only: *) FOR i := 3 TO HIGH(LogicalDeviceName) DO LogicalDeviceName [i] := ' '; END; Writeln(Write); Radix50 (FN, (*--->*) Wild); (* get rad50 format of default extension *) GetFileNumber (Device); Lookup (Device, LogicalDeviceName, DeviceSize); (* For a valid device: DeviceSize=-19442 with SharePlus (02/85) *) (* WriteString (" DeviceCode = "); WriteInt (Write, DeviceSize, 1);*) IF DeviceSize = -255 THEN WriteString (Write, " Device not available or handler not loaded."); ELSE w1 := (Wild [1] = 0); w2 := (Wild [2] = 0); w3 := (Wild [3] = 0); k := FirstDirectoryBlock; nf := 0; Writeln(Write); GetTime(t); WriteDate(Write, t); (* actual date *) LOOP ReadBlock (Device, ADR(SegBuffer), k, SIZE(SegBuffer) DIV 2, WordCount); IF WordCount < SIZE(SegBuffer) DIV 2 THEN IF WordCount = -1 THEN WriteString (Write, " Error reading directory block "); WriteCard (Write, k, 1); ELSIF WordCount = -2 THEN WriteString (Write, " Invalid device"); END; (* something wrong: ... *) EXIT; ELSE (* ok. *) WITH SegBuffer DO bl := SegHeader.FirstDataBlockNumber; (* Writeln(Write); WriteString (Write, " Data of segment starts at block "); WriteCard (Write, bl, 6); *) NEbyte := SegHeader.NumberOfExtraBytesPerEntry; i := 0; FEptr:=ADR(SegBuffer.File); WHILE (i <= HIGH(File)) & (NOT (EndOfSegmentMark <= (*File [i]*)FEptr^.StatusWord)) DO WITH FEptr^ DO (*WITH File [i] DO*) n1 := (Name[0] = Wild[1]); n2 := (Name[1] = Wild[2]); n3 := (Name[2] = Wild[3]); IF (permanent <= StatusWord) & (* wild card spec ? *) ((w1 & w2 & w3 (* super default *) ) OR (w1 & w2 & n3 (* wild file *)) OR (w3 & n1 & n2 (* wild extension *)) OR (n1 & n2 & n3 (* explicit spec *)) ) THEN IF Length <> 0 THEN INC ( nf); IF newline THEN Writeln(Write); ELSE WriteString (Write, " "); END; newline := NOT newline; DecodeRad50 (Name, fne); WriteStringPart (Write, fne, 6); IF Name [2] <> 0 THEN Write('.'); Write (fne [6]);Write (fne [7]);Write (fne [8]); ELSE WriteString (Write, " "); (* no extension available *) END; (* WriteString(Write, " Length = "); *) WriteCard(Write, Length, 6); IF protected <= StatusWord THEN Write ('P'); ELSE Write (' '); END; (* get date (* RT11 date format ! *) : *) (* WriteString (' Date: '); *) Write(' '); IF Date <> 0 THEN t.day:=((Date MOD 40B + 72)*20B (*y*) +Date DIV 2000B MOD 20B)*40B (*m*) +Date DIV 40B MOD 40B; (*d*) t.minute:=0; WriteDate(Write, t); ELSE WriteString (Write, ' '); END; (* WriteString (Write, " at "); WriteCard(Write, bl, 6); *) ELSE (* tentative or filler or empty entry *) END; END; (* IF permanent ... *) INC (bl, Length); END; (* WITH *) INC (i); FEptr := ADDRESS(CARDINAL(FEptr) + TSIZE(FileEntry)+NEbyte); END; WITH SegHeader DO IF NextSeg=0 THEN EXIT END; k := FirstDirectoryBlock + (NextSeg-1)*2; END; END; (* WITH *) END; END; (* LOOP *) Writeln(Write); WriteCard (Write, nf, 6); WriteString (Write, " Files"); Writeln(Write); END; Release (Device); (* .PURGE *) END DisplayFiles; END Directory. (* 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; *)
DEFINITION MODULE Clock; (* LG 23.04.80 *) EXPORT QUALIFIED Time, GetTime; TYPE Time = RECORD day : CARDINAL; (* ((y-1900) * 20B + m) * 40B + d *) minute : CARDINAL; millisecond : CARDINAL; END; PROCEDURE GetTime(VAR tim : Time); (* get computer time *) END Clock.
DEFINITION MODULE Files; (* Ch. Jacobi 17.9.78 for RT-11 *) FROM SYSTEM IMPORT ADDRESS, WORD; IMPORT SystemTypes; EXPORT QUALIFIED FILE, FileName, Lookup, Create, Delete, Release, Close, WriteBlock, ReadBlock, Rename, SetBlock, TransmitBlock, Rad50name, Radix50, Errcode; (* Procedure name corresponding function RT-11 request Lookup .LOOKUP lookup file in dictionnary Create .ENTER create a new file Delete .DELETE delete file and entry from dictionnary Release .PURGE release file, no dictionnary entry Close .CLOSE close file and register in dictionnary WriteBlock .WRITEW write ReadBlock .READW read Rename .RENAME rename a file *) TYPE FILE = [0..15]; FileName = SystemTypes.FileName; (* ARRAY [0..11] OF CHAR *) PROCEDURE Lookup(f: FILE; fn: FileName; VAR reply: INTEGER); (* lookup file f in dictionnary reply: >=0 = done, file length <0 = error -1 = channel used -2 = file not found *) PROCEDURE Create(f: FILE; fn: FileName; VAR reply: INTEGER); (* create a new file f reply: >=0 = done, file length <0 = error -1 = channel used -2 = no space *) PROCEDURE Delete(f: FILE; fn: FileName; VAR reply: INTEGER); (* delete file f and entry from dictionnary reply: >=0 = done, file length <0 = error -1 = channel used -2 = file not found *) PROCEDURE Close(f: FILE); (* close file f and register in dictionnary *) PROCEDURE Release(f: FILE); (* release file f, no entry in dictionnary *) PROCEDURE ReadBlock(f: FILE; p: ADDRESS; blknr, wcount: CARDINAL; VAR reply: INTEGER); (* read from file f p: address of buffer blknr: blocknumber of first block to read wcount: number of words to read reply: >=0 = number of words transferred <0 = error -1 = hard error -2 = channel not open *) PROCEDURE WriteBlock(f: FILE; p: ADDRESS; blknr, wcount: CARDINAL; VAR reply: INTEGER); (* write to file f p: address of buffer blknr: blocknumber of first block to write wcount: number of words to write reply: >=0 = number of words transferred <0 = error -1 = hard error -2 = channel not open *) PROCEDURE Rename(f: FILE; new, old: FileName; VAR reply: INTEGER); (* renames file f which must not be open reply: 0 = done <0 = error -1 = channel used -2 = file not found; *) (*--------------------------------------------------------------*) TYPE Rad50name = ARRAY [0..3] OF INTEGER; VAR Errcode[52B]: CHAR; (* RT-11 error location, for detection of further errors *) PROCEDURE Radix50(VAR name: FileName; VAR name50: Rad50name); PROCEDURE SetBlock(f: FILE; VAR fn: FileName; func, l: CARDINAL; VAR reply: INTEGER); (* func: function code: 0 = Delete; 1 = Lookup; 2 = Create l: file length code for Create reply: >=0 = done, file length <0 = error -1 = channel used -2 = file not found/no space *) PROCEDURE TransmitBlock(f: FILE; func: CARDINAL; PtrToBuf: ADDRESS; blknr, wcount: WORD; VAR reply: INTEGER); (* func: 10B = Read; 11B = Write reply: >=0 = number of words transferred <0 = error -1 = hard error -2 = channel not open *) END Files.
DEFINITION MODULE FilePool; (* LG 05.06.80 *) (* for RT-11 operating system *) EXPORT QUALIFIED GetFileNumber; PROCEDURE GetFileNumber(VAR filenum: CARDINAL); (* get file number of free channel *) END FilePool.
(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