-- SubrImpl.Mesa
-- last edit March 28, 1983 4:29 pm
-- last edit May 22, 1983 5:28 pm, Russ Atkinson
 -- changed short STRING to LONG STRING
-- General purpose procedures
-- the Defs file is Subr.Mesa

    
DIRECTORY
Ascii: TYPE USING [ControlZ],
CWF: TYPE USING [WFC, WFCR, WF0, WF1, WF2],
DCSFileTypes: TYPE USING [tLeaderPage],
Directory: TYPE USING [CreateFile, Error, GetNext, GetProperty, Handle, ignore, Lookup,
 PropertyType, PutProperty, UpdateDates],
Environment: TYPE USING [wordsPerPage],
File: TYPE USING [Capability, Permissions, SetSize],
FileStream: TYPE USING [Create, GetLeaderPropertiesForCapability, Subtype],
Heap: TYPE USING [systemZone],
Inline: TYPE USING [BytePair, LongCOPY, LowHalf],
IO: TYPE USING[CreateEditedStream, GetChar, GetSequence, Handle, Signal, UserAbort],
LongString: TYPE USING [AppendChar],
Rope: TYPE USING[Concat, FromChar, ROPE, Text],
RopeInline: TYPE USING[InlineFlatten],
Runtime: TYPE USING [GetBcdTime],
Space: TYPE USING [CopyIn, Create, CreateUniformSwapUnits, Delete, Error, ForceOut,
 GetAttributes, GetHandle, Handle, Kill, LongPointer, Map, nullHandle,
  PageFromLongPointer, Unmap, virtualMemory],
Stream: TYPE USING [EndOfStream, GetChar, Handle],
Subr: TYPE USING [FileErrorType, NameType, PackedTime, Read, ReadWrite, TTYProcs,
 TTYProcsRecord, Write],
System: TYPE USING [GreenwichMeanTime],
UnsafeStorage: TYPE USING[FreeUZone, NewUZone],
UserCredentialsUnsafe: TYPE USING[GetUserCredentials, SetUserCredentials];

SubrImpl: PROGRAM
IMPORTS CWF, Directory, File, FileStream, Heap, Inline, IO, LongString,
 Rope, RopeInline, Runtime, Space, Stream, UnsafeStorage, UserCredentialsUnsafe
EXPORTS Subr = {

-- MDS USAGE !!!
errorflg: PUBLIC BOOL ← FALSE;
debugflg: PUBLIC BOOL ← FALSE;
numberofleaders: PUBLIC CARDINAL ← 0;
ncharsallocated: INT ← 0;
-- zone stuff
longzone: UNCOUNTED ZONE ← NIL; -- default long zone
hugezone: UNCOUNTED ZONE ← NIL; -- default huge zone
szprocs: UZProcs ← [alloc: SZAlloc, dealloc: SZDeAlloc];
szobject: UZObject ← [procs: @szprocs, data: NIL];
spacezonehandle: UZHandle ← @szobject;
-- endof MDS USAGE !!!

-- SIGNALS
AbortMyself: PUBLIC SIGNAL = CODE; -- raised usually by something that calls
    -- Exec.CheckForAbort[] or TypeScript.UserAbort[]
-- PROCS

MakeTTYProcs: PUBLIC PROC[in, out: IO.Handle, data: REF ANY,
  Confirm: PROC[in, out: IO.Handle, data: REF ANY, msg: Rope.ROPE, dch: CHAR]
   RETURNS[CHAR]]
 RETURNS[h: Subr.TTYProcs] = {
  RETURN[NEW[Subr.TTYProcsRecord ← [in, out, data, Confirm]]];
 };
 
-- long strings
AllocateString: PUBLIC PROC[nchars: CARDINAL, zone: UNCOUNTED ZONE ← NIL]
 RETURNS[s: LONG STRING] = {
IF zone = NIL THEN {
 IF longzone = NIL THEN SubrInit[];
 zone ← longzone;
 };
IF zone = longzone THEN
 ncharsallocated ← ncharsallocated + nchars;
s ← zone.NEW[StringBody[nchars]
 ← StringBody[length: 0, maxlength: nchars, text:]];
};

FreeString: PUBLIC PROC[str: LONG STRING, zone: UNCOUNTED ZONE ← NIL] = {
IF str = NIL THEN RETURN;
IF zone = NIL THEN {
 IF longzone = NIL THEN ERROR;
 zone ← longzone;
 };
IF zone = longzone THEN
 ncharsallocated ← ncharsallocated - str.maxlength;
zone.FREE[@str];
};

AllocateWords: PUBLIC PROC[nwords: CARDINAL] RETURNS[ptr: LONG POINTER] = {
seq: TYPE = RECORD[
 body: SEQUENCE maxsize: CARDINAL OF WORD
 ];
IF nwords > 32000 THEN ERROR;
IF longzone = NIL THEN SubrInit[];
ptr ← longzone.NEW[seq[nwords]];
};

FreeWords: PUBLIC PROC[ptr: LONG POINTER] = {
IF longzone = NIL THEN ERROR;
IF ptr = NIL THEN RETURN;
longzone.FREE[@ptr];
};

CheckVitalSigns: PROC = {
IF ncharsallocated ~= 0 THEN
 CWF.WF1["Schmidt's debugging: Some memory not freed (%ld bytes).\n"L,
   @ncharsallocated];
ncharsallocated ← 0;
};

-- like Storage.CopyString
CopyString: PUBLIC PROC[sold: LONG STRING, zone: UNCOUNTED ZONE]
 RETURNS[snew: LONG STRING] = {
nchars: CARDINAL;
IF sold = NIL THEN ERROR;
nchars ← sold.length;
IF zone = NIL THEN {
 IF longzone = NIL THEN ERROR;
 zone ← longzone;
 };
IF zone = longzone THEN ncharsallocated ← ncharsallocated + nchars;
snew ← zone.NEW[StringBody[nchars]
 ← StringBody[length: nchars, maxlength: nchars, text:]];
Inline.LongCOPY[from: sold+2, nwords: (nchars+1)/2, to: snew+2];
};


strcpy: PUBLIC PROC[sto, sfrom: LONG STRING] = {
i : CARDINAL;
i ← MIN[sfrom.length, sto.maxlength];
Inline.LongCOPY[from: sfrom+2, nwords: (i+1)/2, to: sto+2];
sto.length ← i;
};

-- can also be used if sto and sfrom point to the same StringBody
SubStrCopy: PUBLIC PROC[sto, sfrom: LONG STRING, sfinx: CARDINAL] ={
i: CARDINAL ← 0;
WHILE sfinx < sfrom.length AND i < sto.maxlength DO
 sto[i] ← sfrom[sfinx];
 i ← i + 1;
 sfinx ← sfinx + 1;
 ENDLOOP;
sto.length ← i;
};

-- from CharIO.GetID
GetID: PUBLIC PROC [in: Stream.Handle, s: LONG STRING] = {
c: CHAR ← ' ;
DO
c ← Stream.GetChar[in ! ANY => EXIT];
IF c # ' THEN EXIT;
ENDLOOP;
DO
IF c = ' OR c = '\n THEN EXIT;
LongString.AppendChar[s, c];
c ← GetChar[in ! ANY => EXIT];
ENDLOOP;
};

StripLeadingBlanks: PUBLIC PROC[str: LONG STRING] = {
i: CARDINAL ← 0;
WHILE i < str.length AND (str[i] = ' OR str[i] = '\t) DO
 i ← i + 1;
 ENDLOOP;
SubStrCopy[str,str,i];
};


Any: PUBLIC PROC[str: LONG STRING, ch: CHAR] RETURNS[BOOL] = {
FOR i: CARDINAL IN [0..str.length) DO
 IF str[i] = ch THEN RETURN[TRUE];
 ENDLOOP;
RETURN[FALSE];
};

EndsIn: PUBLIC PROC[str: LONG STRING, suf: LONG STRING] RETURNS[BOOL] = {
FOR i: CARDINAL IN [0 .. str.length) DO {
 IF LowerCase[str[i]] = LowerCase[suf[0]] THEN {
  FOR j: CARDINAL IN [0 ..suf.length) DO
   IF i+j >= str.length
   OR LowerCase[str[i+j]] ~= LowerCase[suf[j]] THEN
    GOTO outer;
   ENDLOOP;
  IF i+suf.length < str.length THEN GOTO outer;
  RETURN[TRUE];
  };
 EXITS
 outer => NULL;
 };
 ENDLOOP;
RETURN[FALSE];
};

ControlChars: PUBLIC PROC[str: LONG STRING] RETURNS[BOOL] = {
j: CARDINAL;
FOR i: CARDINAL IN [0..str.length) DO
 j ← LOOPHOLE[str[i], CARDINAL];
 IF j IN [0..32) OR j >= 177B THEN RETURN[TRUE];
 ENDLOOP;
RETURN[FALSE];
};


Prefix: PUBLIC PROC[str,pref: LONG STRING] RETURNS[BOOL] = {
i: CARDINAL ← 0;
WHILE i < str.length AND i <pref.length
AND LowerCase[str[i]] = LowerCase[pref[i]] DO
 i ← i + 1;
 ENDLOOP;
RETURN[i = pref.length];
};

-- from [Indigo]<APilot>ComSoft>Private>StringsImplB.Mesa
-- only difference: INLINE

LowerCase: PROC [c: CHAR] RETURNS [CHAR] = INLINE
BEGIN IF c IN ['A..'Z] THEN c ← c + ('a - 'A); RETURN[c] END;

PrintGreeting: PUBLIC PROC[str: LONG STRING] = {
date: Subr.PackedTime ← Runtime.GetBcdTime[];
CWF.WF2["%s, Version Of %lt.\n"L, str, @date];
};

FindMappedSpace: PUBLIC PROC [space: Space.Handle] RETURNS [Space.Handle] =
BEGIN
mapped: BOOL;
parent: Space.Handle;
DO
[mapped: mapped, parent: parent] ← Space.GetAttributes[space];
IF mapped THEN RETURN[space];
space ← parent;
ENDLOOP;
END;

-- does not put a trailing CR into string "line"
-- if line ends with \ then omit \ and the following CR
-- append next line to last line
-- returns TRUE if NOT end-of-file, FALSE if eof has occured
GetLine: PUBLIC PROC[sh: Stream.Handle, line: LONG STRING]
 RETURNS[noteof: BOOL] = {
i: CARDINAL ← 0;
ch: CHAR;
DO
 IF i >= line.maxlength THEN EXIT;
 ch ← GetChar[sh];
 line[i] ← ch;
 IF ch = 0C OR ch = '\n THEN EXIT;
 i ← i + 1;
 ENDLOOP;
line.length ← i;
IF line.length >= line.maxlength THEN {
 line.length ← line.maxlength;
 CWF.WF1["GetLine-- line '%s' is too long.\n"L, line];
 };
RETURN[NOT (ch = 0C AND line.length = 0)];
};

-- return next char in input, return 0C if EOF
GetChar: PUBLIC PROC[sh: Stream.Handle] RETURNS[ch: CHAR] = {
{
ch ← Stream.GetChar[sh
 ! Stream.EndOfStream => {
  ch ← 0C;
  GOTO out
  }
 ];
IF ch = Ascii.ControlZ THEN DO  -- strip bravo trailer
 ch ← Stream.GetChar[sh
  ! Stream.EndOfStream => {
   ch ← 0C;
   GOTO out
   }
  ];
 IF ch = '\n OR ch = 0C THEN EXIT;
 ENDLOOP;
EXITS
out => NULL;
};
RETURN[ch];
};

-- parses line, beginning at line[inx], into sub
-- considers a string to be a sequence of characters
-- begun by anything except blank, :, =, tab, and [
-- and terminated by blank, :, =, tab, and [
-- leading and trailing blanks are ignored
-- TAB is not considered a blank
GetString: PUBLIC PROC[line: LONG STRING, sub: LONG STRING, inx: CARDINAL]
 RETURNS[CARDINAL] = {
i: CARDINAL;
sub.length ← 0;
WHILE inx < line.length AND line[inx] = ' DO
 inx ← inx + 1;
 ENDLOOP;
IF inx >= line.length THEN RETURN[inx];
i ← 0;
DO
 sub[i] ← line[inx];
 inx ← inx + 1;
 i ← i + 1;
 IF sub[i-1] = '=
 OR sub[i-1] = ': THEN
  EXIT; -- tests for termination chars
 IF inx < line.length AND i < sub.maxlength
 AND line[inx] ~= 0C
 AND line[inx] ~= '
 AND line[inx] ~= '\t
 AND line[inx] ~= ':
 AND line[inx] ~= '=
 AND line[inx] ~= '[ THEN
  LOOP; -- tests for begin chars
 EXIT;
 ENDLOOP;
sub.length ← i;
IF sub.length >= sub.maxlength THEN
 CWF.WF1["Substring %s not long enough\n"L, sub];
RETURN[inx];
};

-- heap management

INITHEAP: CARDINAL = 40; -- # pages initially allocated to the heap
DEFPAGES: CARDINAL = 256; -- size of long heap default, in pages

SubrInit: PUBLIC PROC[npages: CARDINAL ← INITHEAP] = {
-- space: Space.Handle;
IF longzone ~= NIL THEN {
 CWF.WF0["Schmidt's debugging: SubrInit called twice.\n"L];
 RETURN;
 };
errorflg ← FALSE;
numberofleaders ← 0;
ncharsallocated ← 0;
-- space ← Space.Create[size: npages, parent: Space.virtualMemory
 -- ! Space.InsufficientSpace => {
  -- CWF.WF1["ERROR Space.InsufficientSpace[%u].\n"L, @available];
  -- CWF.WF1["This program asked Pilot for %u pages, but the largest\n"L, @npages];
  -- CWF.WF1["space available was %u pages. You should rollback or boot\n"L, @available];
  -- CWF.WF0["and try again.\n"L];
  -- SIGNAL AbortMyself;
  -- }];
-- longzone ← Heap.Create[initial: INITHEAP, parent: space, increment: 20];
longzone ← UnsafeStorage.NewUZone[initialSize: INITHEAP*Environment.wordsPerPage,
     sr: prefixed];
};

SubrStop: PUBLIC PROC = {
deleteAgain: BOOL ← FALSE;
IF hugezone ~= NIL THEN hugezone ← FreeHugeZone[hugezone];
IF longzone = NIL THEN RETURN;
-- [parent: space] ← Heap.GetAttributes[longzone ! Heap.Error => CONTINUE];
CheckVitalSigns[];
-- Heap.Delete[z: longzone, checkEmpty: TRUE
  -- ! Heap.Error => {
   -- IF type = invalidHeap THEN {
   -- deleteAgain ← TRUE;
   -- CWF.WF0["Schmidt's debugging: Heap not empty.\n"L];
   -- };
--   CONTINUE
--   }
--  ];
-- IF deleteAgain THEN
--  Heap.Delete[z: longzone, checkEmpty: FALSE
--   ! Heap.Error => CONTINUE];
-- Space.Delete[space: space ! Space.Error => CONTINUE];
UnsafeStorage.FreeUZone[longzone];
longzone ← NIL;
};

LongZone: PUBLIC PROC RETURNS[UNCOUNTED ZONE] = {
IF longzone = NIL THEN SubrInit[DEFPAGES];
RETURN[longzone]
};


-- first the TYPEs
UZHandle: TYPE = LONG POINTER TO UZObject;

UZObject: TYPE = MACHINE DEPENDENT RECORD [
 procs: LONG POINTER TO UZProcs,
 data: LONG POINTER
 ];

UZProcs: TYPE = MACHINE DEPENDENT RECORD [
 alloc: PROC[zone: UZHandle, size: CARDINAL] RETURNS[LONG POINTER],
 dealloc: PROC[zone: UZHandle, object: LONG POINTER]
 ];

-- the HugeZone stuff

HZHeader: TYPE = LONG POINTER TO HZHeaderRecord;
HZHeaderRecord: TYPE = RECORD[
 next: HZHeader ← NIL, -- next in list
 space: Space.Handle ← Space.nullHandle, -- this space
 current: LONG POINTER ← NIL, -- next free spot in this segment
 ending: LONG POINTER ← NIL, -- last valid address in this segment + 1
 npages: CARDINAL ← 0  -- number of pages in this segment
 ];
 
-- now the procedures
HZAlloc: PROC[zone: UZHandle, size: CARDINAL] RETURNS[lp: LONG POINTER] =
 {
 RETURN[WordsFromHugeZone[LOOPHOLE[zone], size]];
 };

HZDeAlloc: PROC[zone: UZHandle, object: LONG POINTER] =
 {
 -- currently do nothing
 };

pagesPerChunk: CARDINAL = 32;

WordsFromHugeZone: PUBLIC PROC[zone: UNCOUNTED ZONE, nwords: LONG CARDINAL]
 RETURNS[lp: LONG POINTER] =
 {
 hzheader: HZHeader ← LOOPHOLE[zone, UZHandle].data;
 IF LOOPHOLE[hzheader.current, LONG CARDINAL] + nwords >
  LOOPHOLE[hzheader.ending, LONG CARDINAL] THEN {
   oldheader: HZHeader ← hzheader;
   Space.ForceOut[oldheader.space]; -- avoids running out of Pilot Swap Buffers
   hzheader ← AllocHeader[MAX[pagesPerChunk,
    Inline.LowHalf[(nwords + SIZE[HZHeaderRecord])/Environment.wordsPerPage + 1]]];
   hzheader.next ← oldheader;
   LOOPHOLE[zone, UZHandle].data ← hzheader;
   };
 lp ← hzheader.current;
 hzheader.current ← hzheader.current + nwords;
 RETURN[lp];
 };

PagesUsedInHugeZone: PUBLIC PROC[zone: UNCOUNTED ZONE] RETURNS[npages: CARDINAL] =
 {
 header: HZHeader ← LOOPHOLE[zone, UZHandle].data;
 npages ← 0;
 WHILE header ~= NIL DO
  npages ← npages + header.npages;
  header ← header.next;
  ENDLOOP;
 };

-- now the procedure that will give you one of these
HugeZone: PUBLIC PROC RETURNS[UNCOUNTED ZONE] =
 {
 hzprocs: LONG POINTER TO UZProcs;
 hzheader: HZHeader;
 hugezonehandle: UZHandle;
 IF hugezone ~= NIL THEN RETURN[hugezone];
 hzheader ← AllocHeader[1];
 hzprocs ← Heap.systemZone.NEW[UZProcs ← [alloc: HZAlloc, dealloc: HZDeAlloc]];
 hugezonehandle ← Heap.systemZone.NEW[UZObject ← [procs: hzprocs, data: hzheader]];
 hugezone ← LOOPHOLE[hugezonehandle];
 RETURN[hugezone];
 };

AllocHeader: PROC[npages: CARDINAL] RETURNS[header: HZHeader] =
{
space: Space.Handle;
nwords: LONG CARDINAL ← LONG[npages] * Environment.wordsPerPage;
-- CWF.WF1["Allocating %u huge pages.\n"L, @npages];
space ← Space.Create[size: npages, parent: Space.virtualMemory];
Space.Map[space];
header ← Space.LongPointer[space];
IF npages > 32 THEN
 Space.CreateUniformSwapUnits[8, space];
header^ ← [next: NIL, space: space, current: header + SIZE[HZHeaderRecord],
 ending: header + nwords, npages: npages];
};

-- to free the huge zone
-- always returns nil
FreeHugeZone: PUBLIC PROC[zone: UNCOUNTED ZONE] RETURNS[UNCOUNTED ZONE]=
 {
 space: Space.Handle;
 uzhandle: UZHandle ← LOOPHOLE[zone];
 header: HZHeader ← uzhandle.data;
 uzhandle.data ← NIL;
 WHILE header ~= NIL DO
  space ← header.space;
  header ← header.next;
  Space.Delete[space: space
   ! Space.Error => {
    CWF.WF0["Schmidt's Debugging: Error freeing hugespace.\n"L];
    CONTINUE;
    }];
   ENDLOOP;
 Heap.systemZone.FREE[@uzhandle.procs];
 Heap.systemZone.FREE[@uzhandle];
 -- kludge until multiple hugezones exist
 hugezone ← NIL;
 RETURN[NIL];
 };

pairsPerLine: CARDINAL = 40;

-- debugging procedure
DebugPrintZone: PUBLIC PROC[h: Subr.TTYProcs] =
{
i, j, n1, n2, nwords: CARDINAL;
addr, lp: LONG POINTER TO CARDINAL;
header: HZHeader ← LOOPHOLE[hugezone, UZHandle].data;
 WHILE header ~= NIL DO
  lp ← LOOPHOLE[header + SIZE[HZHeaderRecord]];
 nwords ← (header.npages * Environment.wordsPerPage) - SIZE[HZHeaderRecord];
  i ← 0;
  WHILE i < nwords DO
   addr ← lp + i;
   CWF.WF1["%06u "L, @addr];
  FOR j IN [0 .. MIN[pairsPerLine, nwords - i]) DO
   [n1, n2] ← LOOPHOLE[(addr + j)^, Inline.BytePair];
   CWF.WFC[IF n1 < 040B OR n1 >= 0177B THEN ' ELSE LOOPHOLE[n1, CHAR]];
   CWF.WFC[IF n2 < 040B OR n2 >= 0177B THEN ' ELSE LOOPHOLE[n2, CHAR]];
   ENDLOOP;
  CWF.WFCR[];
  i ← i + pairsPerLine;
  IF h.in.UserAbort[] THEN SIGNAL AbortMyself;
  ENDLOOP;
 header ← header.next;
  ENDLOOP;
 };

-- Space Zone stuff

-- now the procedures
SZAlloc: PROC[zone: UZHandle, size: CARDINAL] RETURNS[lp: LONG POINTER] = {
space: Space.Handle;
npages: CARDINAL ← (size/Environment.wordsPerPage) + 1;
space ← Space.Create[npages, Space.virtualMemory];
Space.Map[space];
lp ← Space.LongPointer[space];
IF npages > 20 THEN Space.CreateUniformSwapUnits[10, space];
};

SZDeAlloc: PROC[zone: UZHandle, object: LONG POINTER] = {
Space.Delete[FindMappedSpace[Space.GetHandle[
 Space.PageFromLongPointer[object]]]];
};

-- now the procedure that will give you one of these
SpaceZone: PUBLIC PROC RETURNS[UNCOUNTED ZONE] = {
RETURN[LOOPHOLE[spacezonehandle]];
};

-- end of heap stuff

-- if nt = login, sets Profile.userName and userPassword
-- if nt = connect, sets name2, password2

GetNameandPassword: PUBLIC PROC[nt: Subr.NameType, name2, password2: LONG STRING,
 h: Subr.TTYProcs] = {
n: LONG STRING ← AllocateString[50];
p: LONG STRING ← AllocateString[50];
{ENABLE UNWIND => {FreeString[n]; FreeString[p]};
IF nt = login THEN
 UserCredentialsUnsafe.GetUserCredentials[name: n, password: NIL]
ELSE IF nt = connect THEN
 strcpy[n, name2];
--
CWF.WF0["Name: "L];
GetIDProc[h: h, s: n, echo: TRUE];
--
CWF.WF0[" Password: "L];
p.length ← 0;
GetIDProc[h: h, s: p, echo: FALSE];
--
IF nt = login THEN
 UserCredentialsUnsafe.SetUserCredentials[name: n, password: p]
ELSE {
 strcpy[name2, n];
 strcpy[password2, p];
 };
}; -- of ENABLE UNWIND
FreeString[n]; FreeString[p];
};

useIOGetSequence: BOOL ← FALSE;
GetIDProc: PROC[h: Subr.TTYProcs, s: LONG STRING, echo: BOOL] = {
 input: IO.Handle ← h.in;
 r: Rope.ROPE;
 f: Rope.Text;
 IF NOT echo THEN
  input ← h.in.backingStream;
 IF input = NIL THEN -- in case it was not an edited stream
  input ← IO.CreateEditedStream[in: h.in, echoTo: h.out];
 IF useIOGetSequence
  THEN r ← input.GetSequence[]
  ELSE r ← SpecialGetLine[input];
 IF r ~= NIL THEN {
  f ← RopeInline.InlineFlatten[r];
  strcpy[s, LOOPHOLE[f]];
  };
 };
 
SpecialGetLine: PROC[in: IO.Handle] RETURNS[r: Rope.ROPE] = {
 ch: CHAR;
 DO
  ch ← in.GetChar[! IO.Signal => TRUSTED{EXIT}];
  IF ch = '\n THEN EXIT;
  r ← r.Concat[Rope.FromChar[ch]];
  ENDLOOP;
 };

-- here because I wanted to remove reliance on PilotSSImpl and DummyFileCache
FileError: PUBLIC ERROR[error: Subr.FileErrorType] = CODE;

-- npages should not include the leader page; I'll add +1
NewFile: PUBLIC PROC [name: LONG STRING, access: File.Permissions,
 npages: CARDINAL] RETURNS [cap: File.Capability] = {
old: BOOL ← FALSE;
IF access ~= Subr.Read THEN
 cap ← Directory.CreateFile[name, DCSFileTypes.tLeaderPage, npages + 1
  ! Directory.Error => {
   IF type = fileAlreadyExists THEN old ← TRUE
   ELSE ERROR FileError[notFound];
   CONTINUE
  }]
ELSE old ← TRUE;
IF old THEN
 cap ← Directory.Lookup[fileName: name, permissions: Directory.ignore
  ! Directory.Error => ERROR FileError[notFound]];
cap ← Directory.UpdateDates[cap, access];
IF old AND npages > 0 AND (access = Subr.Write OR access = Subr.ReadWrite) THEN
 File.SetSize[cap, npages + 1];
};

NewStream: PUBLIC PROC [name: LONG STRING, access: File.Permissions]
 RETURNS [Stream.Handle] = {
RETURN[FileStream.Create[NewFile[name, access, 0]]];
};

EnumerateDirectory: PUBLIC PROC [proc: PROC [File.Capability, LONG STRING]
 RETURNS [BOOL]] =
BEGIN
next: LONG STRING ← AllocateString[100];
name: LONG STRING ← AllocateString[100];
cap: File.Capability;
{ENABLE UNWIND => {FreeString[next]; FreeString[name]};
DO
cap ← Directory.GetNext[pathName: "WorkDir>*"L, currentName: next,
  nextName: next];
StripPathName[name, next];
IF name.length = 0 THEN EXIT;
IF proc[cap, name] THEN EXIT;
ENDLOOP;
}; -- of ENABLE UNWIND
FreeString[next]; FreeString[name]
END;

StripPathName: PROC [noPath, withPath: LONG STRING] = {
pos, len: CARDINAL ← withPath.length;
WHILE pos > 0 AND withPath[pos-1] # '> DO pos ← pos - 1; ENDLOOP;
len ← len - pos;
FOR i: CARDINAL IN [0..len) DO noPath[i] ← withPath[pos+i] ENDLOOP;
noPath.length ← len;
};

-- by convention, the remote name is where the file was retrieved FROM or stored ONTO
RemoteNameProperty: Directory.PropertyType = LOOPHOLE[213B];

-- the maxlength of remotename MUST be 125
SetRemoteFilenameProp: PUBLIC PROC[cap: File.Capability, remotename: LONG STRING] = {
-- remotename should be of the form [ivy]<directory>name!vers
IF remotename.maxlength ~= 125 THEN ERROR;
Directory.PutProperty[cap, RemoteNameProperty,
 DESCRIPTOR[remotename, SIZE[StringBody[remotename.maxlength]]], TRUE];
};

-- the maxlength of remotename MUST be 125
GetRemoteFilenameProp: PUBLIC PROC[cap: File.Capability, remotename: LONG STRING] = {
mlen: CARDINAL ← remotename.maxlength;
-- this is erroneous, because reading the property will set the maxlength
IF mlen ~= 125 THEN ERROR;
Directory.GetProperty[cap, RemoteNameProperty,
 DESCRIPTOR[remotename, SIZE[StringBody[mlen]]]
 ! Directory.Error => IF type = invalidProperty THEN GOTO leave];
LOOPHOLE[remotename+1, LONG POINTER TO CARDINAL]^ ← mlen; -- reset the maxlength!!!
EXITS
leave => remotename.length ← 0;
};


-- if window is NIL then gets the window that Exec.w is in
CursorInWindow: PUBLIC PROC[h: Subr.TTYProcs] RETURNS[BOOL] = {RETURN[FALSE]};

-- if window is NIL, will use Exec.w
CheckForModify: PUBLIC PROC[file: LONG STRING, h: Subr.TTYProcs]
 RETURNS[oktomodify: BOOL] = {
-- short: STRING ← [100];
-- strcpy[short, file];
-- IF NOT Segments.ModifyFile[short] THEN {
 -- CWF.WF1["%s cannot be modified.\n"L, file];
 -- CWF.WF0["Shall I go ahead and modify it"L];
 -- IF Confirm['n, h] = 'y THEN {
  -- CWF.WF0["Yes.\n"L];
  -- RETURN[TRUE];
  -- }
 -- ELSE {
  -- CWF.WF0["No.\n"L];
  -- RETURN[FALSE];
  -- };
 -- };
RETURN[TRUE];
};

GetCreateDate: PUBLIC PROC[cap: File.Capability]
 RETURNS[create: LONG CARDINAL] = {
[create: create] ← FileStream.GetLeaderPropertiesForCapability[cap];
numberofleaders ← numberofleaders + 1;
};

-- leader page
-- (copied straight from [Idun]<APilot60>ComSoft>Private>FileStreamImpl.Mesa)
maxLeaderNameCharacters: CARDINAL = 40;

LeaderPage: TYPE = MACHINE DEPENDENT RECORD [
versionID: CARDINAL,
dataType: FileStream.Subtype,
create, write, read: System.GreenwichMeanTime,
length: LONG CARDINAL,
nameLength: CARDINAL,
name: PACKED ARRAY [0..maxLeaderNameCharacters) OF CHAR
];

-- experiments with SModel Nov 81, Rubicon:
-- using CopyIn is 2-5% faster than using Map
-- using Map is 2-5% faster than using FileStream
-- (these times include other things like parsing the DF file,
-- writing the DF file, etc.)

-- space is a 1-page space, and must BE MAPPED (anonymously)
GetCreateDateWithSpace: PUBLIC PROC[cap: File.Capability, space: Space.Handle]
 RETURNS[create: LONG CARDINAL] = {
leader: LONG POINTER TO LeaderPage;
Space.CopyIn[space, [cap, 0]];
leader ← Space.LongPointer[space];
create ← leader.create;
numberofleaders ← numberofleaders + 1;
Space.Kill[space];
RETURN[create];
};
 
-- space is a 1-page space, and must NOT BE MAPPED
OldGetCreateDateWithSpace: PUBLIC PROC[cap: File.Capability, space: Space.Handle]
 RETURNS[create: LONG CARDINAL] = {
leader: LONG POINTER TO LeaderPage;
Space.Map[space, [cap, 0]];
leader ← Space.LongPointer[space];
create ← leader.create;
numberofleaders ← numberofleaders + 1;
Space.Unmap[space];
RETURN[create];
};
 
}.


Confirm: PUBLIC PROC[dch: CHAR, h: Subr.TTYProcs] RETURNS[CHAR] = {
ch: CHAR;
DO
 {
 ENABLE h.rubOut => LOOP;
 CWF.FWF0[h.putChar, "? "L];
 ch ← h.getChar[];
 IF ch = '\n THEN ch ← dch;
 ch ← LowerCase[ch];
 RETURN[ch];
 };
 ENDLOOP;
};