-- 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;
};


ÊÖ˜JšÓÏcÊ
œÏk	œ
žœ
žœžœžœ
žœžœžœ"žœ
žœžœ
žœžœ
žœžœ
žœ3žœ
žœ>žœ
žœžœ
žœ"žœžœ
žœUžœ
žœžœ
žœžœžœ
žœžœ
žœžœ
žœÅ
žœ
žœ)žœ
žœgžœ
žœ'žœ
žœ0žœ
žœ5žœ
žœ
žœ.žœ`žœœ
žœ
žœžœžœ
žœžœžœ
žœžœœ
ž	œ
žœžœœ
ž	œ
žœžœœfžœ*œ
œ
žœ
žœžœ*œ;œ
Ïnœžœ
žœ
žœžœ
žœŸœžœ
žœžœ
žœžœžœžœ
žœžœžœ
žœ9Ÿœžœ
žœ	žœž	œ
ž
œžœžœ
žœžœžœ
žœžœžœ
žœ#žœžœ7žœMŸ
œžœ
žœžœ
žœž	œ
ž
œžœžœ
žœ
žœžœžœ
žœžœžœ
žœ
žœžœžœ:žœŸ
œžœ
žœ	žœžœžœ
žœžœžœ	žœ
žœ
žœ
žœžœžœ
žœžœžœ
žœžœŸ	œžœ
žœžœ
žœžœžœ
žœ
žœžœžœ
žœ
žœžœŸœžœžœžœžœrŸ
œžœ
žœžœ
žœž	œ
žœžœžœ
žœžœžœžœ
žœ
žœžœžœ
žœžœžœ
žœ
žœžœžœ9žœ”
Ÿœžœ
žœ
žœ
žœ
žœžœoBŸ
œžœ
žœ
žœ
žœ	žœžœžœžœžœ:žœŸœžœ
žœžœ
žœ	žœžœ žœžœ
žœžœ
žœ	žœžœžœžœ	žœ
žœ>žœžœ
žœ
Ÿœžœ
žœžœ
žœ	žœžœžœžœžœžœŸœžœ
žœžœ
žœžœžœ
žœžœžœ
žœžœžœ
žœ
žœ
žœžœžœ
žœŸœžœ
žœžœ
žœžœ
žœžœ
žœžœžœ
žœžœžœ'žœžœžœ
žœžœžœžœ*žœžœžœžœžœ
žœ
žœ
žœ	žœžœžœžœ
žœŸœžœ
žœžœ
žœžœ
žœ	žœžœžœ
žœžœžœ	žœžœžœ
žœžœ
žœ
žœžœžœ
žœŸœžœ
žœžœ
žœžœ
žœ	žœžœžœžœ(žœžœžœUœŸ	œžœžœžœžœžœžœ
žœžœ
žœžœžœŸ
œžœ
žœžœ
žœ4žœ2Ÿœžœ
žœžœžœ
žœ žœLžœžœ
žœ%žœžœÇ
Ÿœžœ
žœžœ
žœžœ	žœ	žœ
žœžœžœžœ
žœ%žœ	žœ
žœ
žœžœžœžœ#žœ7žœ
žœ
žœ/Ÿœžœ
žœžœžœGžœ
žœžœ
žœœCžœžœ
žœ	žœ
žœžœžœžœžœ
“Ÿ	œžœ
žœžœ
žœžœ
žœžœžœ
žœ	žœžœžœžœžœžœžœ
žœžœ4žœžœžœžœœ
žœžœžœžœžœžœžœžœžœžœœ
žœžœžœžœžœ.žœœ
žœžœ+žœžœ'œ
Ÿœžœ
žœ	žœžœ
žœ
žœžœ9žœžœ,Bœ
"œAœRœYœ!œœSœ/žœ3Ÿœžœ
žœžœžœžœ
žœ
žœ$žœžœ
žœ
žœLœ-œœ œœ7œÂ
œ.žœŸœžœ
žœ
žœ
ž	œ
žœžœžœ
žœ
žœžœœ
žœžœ
žœ
žœžœžœ
ž	œ
žœžœ
žœ
žœžœ
žœžœžœ
ž	œ
žœžœžœžœ
žœ
žœ
žœžœ
žœœžœžœ
žœ
žœ!žœžœžœœ)œ
žœ
žœžœ"œ	žœ
žœžœ*œ	žœ#œŸœžœžœžœžœ
žœžœžœŸ	œžœžœ
žœœžœŸœžœ
žœž	œ
žœ
žœ
žœžœžœ
žœžœžœ
žœžœ
žœžœžœ
žœžœJ,œžœ-žœTžœpžœŸœžœ
žœž	œ
žœžœ	žœžœ%žœžœ
žœ>žœ5Ÿœžœ
žœ
žœ
ž	œ
žœžœ
žœ
žœ;žœ
žœ
žœ
žœCžœTžœ;žœžœŸœžœ	žœžœ=žœ
žœžœ(5œ‚
žœ
žœBžœ"žœG/Ÿœžœ
žœž	œ
žœžœ
ž	œ
žœ2žœ<žœžœžœ
žœgžœ>žœ
žœžœ$žœ)œžœžœ
žœžœŸœžœ
žœ4žœžœ
žœ
žœ
žœžœžœžœ
žœžœ
žœMžœžœžœžœžœžœžœžœžœ&žœ
žœ
žœžœ
žœžœ
žœžœ
žœ
žœ
žœžœ
žœžœ
žœžœ
žœžœ
žœ$žœžœ
žœžœžœ
œ
Ÿœžœžœžœžœ
žœ#žœŒ
žœ
žœ.Ÿ	œžœžœ
žœ_5Ÿ	œžœ
žœ
žœ
ž	œ
žœžœ
žœœ
cœ
Ÿœžœ
žœ&žœ
žœžœ
žœžœ
žœžœ
žœ#žœžœ>žœžœ
žœžœžœ-žœžœ@žœžœžœBžœ:žœ
žœ5žœžœŸ	œžœžœ
žœžœžœžœžœ
žœžœ!žœ	žœ
žœ
'œ
žœ/žœžœžœžœžœ
žœ2žœŸœžœžœ	žœ	žœžœžœžœžœ
žœžœ
žœ
žœ'žœNœžœ
žœžœ;Ÿœžœ
žœžœ
žœ%žœžœ!žœžœžœžœežœžœžœžœ
žœžœžœžœžœžœ_žœAžœžœžœžœžœ%Ÿ	œžœ
žœžœ
žœžœžœ3Ÿœžœ
žœžœžœžœžœžœžœ
žœžœ
žœ/žœ
žœ*žœ‹
žœžœ
žœžœžœ
žœžœžœ
ž
œ#žœŸ
œžœžœžœžœ	žœžœžœžœžœ
žœ
žœžœVœ-žœ	+Ÿœžœ
žœ#žœ
žœ>žœžœ
žœ2ž
œ
žœ%žœ+Ÿœžœ
žœ#žœ
žœžœJžœ
žœ
žœ2ž
œ
žœ*žœžœ
žœ	žœžœ
žœ
žœ
žœžœ';Ÿœžœ
žœžœ
žœžœ
žœ%Ÿœžœ
žœžœ
žœžœ
žœ^œ
/œ
/œ
!œœœœ

œœœœ
žœ
žœŸ
œžœ
žœžœ	žœ
žœv^œžœžœžœ
ž	œ
žœžœcžœ
žœžœžœ
žœžœ
žœ	ê
œ
=Ÿœžœ
žœ.žœ	žœ
žœžœ
žœ
žœ¡
žœ3Ÿœžœ
žœ.žœ	žœ
žœžœ
žœ
žœŸ
žœŸœžœ
žœžœžœ
žœ
žœžœžœ
žœžœ-žœ
žœ!žœžœ˜ç±
—…—XêhÆ