<<>> <> <> <> <> <> <> <> <> <> <<>> DIRECTORY Basics, Rope, RopeFile, Finalize, FinalizeOps, VM, UnixSysCallExtensions, Commander, IO; RopeFileImpl: CEDAR MONITOR IMPORTS Rope, Finalize, FinalizeOps, VM, UnixSysCallExtensions, Commander, IO EXPORTS RopeFile SHARES Rope ~ BEGIN ROPE: TYPE ~ Rope.ROPE; ByteSequenceObject: TYPE ~ RopeFile.ByteSequenceObject; DeactivateResult: TYPE ~ RopeFile.DeactivateResult; Error: PUBLIC ERROR [ec: ATOM, explanation: ROPE] ~ CODE; bufferSize: NAT ~ 8192; Buffer: TYPE ~ REF BufferRep; BufferRep: TYPE ~ RECORD [ byteSequenceObject: ByteSequenceObject, start: INT, end: INT, chars: POINTER TO Basics.RawBytes, interval: VM.Interval, rest: REF BufferRep ]; NewBuffer: PROC RETURNS [Buffer] ~ { interval: VM.Interval ~ VM.SimpleAllocate[VM.PagesForBytes[bufferSize]]; buffer: Buffer ~ NEW[BufferRep]; buffer.interval ¬ interval; buffer.chars ¬ LOOPHOLE[VM.AddressForPageNumber[interval.page]]; [] ¬ FinalizeOps.EnableFinalization[buffer, finalizationQueue]; RETURN [buffer] }; maxSmallBlock: NAT ¬ 2*bufferSize; <> <<>> maxTextSize: NAT ~ NAT15.LAST+1-BYTES[TEXT[0]]-8; flatTrigger1: NAT ¬ MIN[bufferSize*4, maxTextSize]; flatTrigger2: NAT ¬ flatTrigger1; filesMaxLimit: NAT = UnixSysCallExtensions.GetDTableSize1[std]; filesMax: NAT ¬ MAX[filesMaxLimit/4, 1]; bufferLimit: NAT ¬ filesMax; Flattery: PROC [byteSequenceObject: ByteSequenceObject, start: CARD, len: CARD] RETURNS [ROPE] = TRUSTED { SELECT len FROM <= flatTrigger1 => { <> text: Rope.Text ¬ Rope.NewText[len]; TRUSTED { [] ¬ byteSequenceObject.move[byteSequenceObject, [base: LOOPHOLE[text], startIndex: BYTES[TEXT[0]], count: len], start]; }; RETURN [text]; }; ENDCASE => { <> half: INT = (len - len MOD 16) / 2; ret: ROPE = Flattery[byteSequenceObject, start, half]; -- preferred evaluation order start ¬ start + half; len ¬ len - half; RETURN [Rope.Concat[ret, Flattery[byteSequenceObject, start, len]]]; }; }; CreateByteSequenceObject: PUBLIC PROC [ length: [0..LAST[INT]], data: REF ANY, equal: PROC [self: ByteSequenceObject, other: ByteSequenceObject] RETURNS [BOOL], deactivate: PROC [self: ByteSequenceObject, final: BOOL] RETURNS [DeactivateResult], describe: PROC [self: ByteSequenceObject] RETURNS [fileName: ROPE, created: ROPE, open: BOOL], move: UNSAFE PROC [self: ByteSequenceObject, block: Basics.UnsafeBlock, start: INT] RETURNS [charsMoved: INT ¬ 0]] RETURNS [ByteSequenceObject] ~ { byteSequenceObject: ByteSequenceObject ~ NEW[RopeFile.ByteSequenceObjectRep ¬ [length: length, data: data, equal: equal, deactivate: deactivate, describe: describe, move: move]]; [] ¬ FinalizeOps.EnableFinalization[byteSequenceObject, finalizationQueue]; RETURN [byteSequenceObject] }; FromByteSequenceObject: PUBLIC PROC [byteSequenceObject: ByteSequenceObject, flatten: BOOL ¬ FALSE] RETURNS [rope: ROPE] ~ { length: NAT ~ byteSequenceObject.length; IF flatten OR length <= flatTrigger2 THEN { rope ¬ Flattery[byteSequenceObject, 0, length]; [] ¬ byteSequenceObject.deactivate[byteSequenceObject, FALSE]; } ELSE { rope ¬ FindOld[byteSequenceObject]; IF rope = NIL THEN { rope ¬ Rope.MakeRope[byteSequenceObject, byteSequenceObject.length, RopeFileFetch, RopeFileMap, RopeFileMove]; Note[rope]; }; }; }; head: LIST OF Finalize.Handle ¬ LIST[NIL]; Note: ENTRY PROC [rope: ROPE] ~ { handle: Finalize.Handle ~ FinalizeOps.EnableFinalization[rope, finalizationQueue]; head.rest ¬ CONS[handle, head.rest]; }; Touch: ENTRY PROC [byteSequenceObject: ByteSequenceObject] ~ { <> prev: LIST OF Finalize.Handle ¬ head; FOR tail: LIST OF Finalize.Handle ¬ head.rest, tail.rest UNTIL tail = NIL DO WITH Finalize.HandleToObject[tail.first] SELECT FROM object: REF Rope.RopeRep.node.object => { IF object.base = byteSequenceObject THEN { prev.rest ¬ tail.rest; tail.rest ¬ head.rest; head.rest ¬ tail; RETURN }; }; ENDCASE; prev ¬ tail; ENDLOOP; }; Remove: ENTRY PROC [handle: Finalize.Handle] ~ { prev: LIST OF Finalize.Handle ¬ head; FOR tail: LIST OF Finalize.Handle ¬ head.rest, tail.rest UNTIL tail = NIL DO IF tail.first = handle THEN { prev.rest ¬ tail.rest; tail.rest ¬ NIL; RETURN }; prev ¬ tail; ENDLOOP; }; FindOld: ENTRY PROC [byteSequenceObject: ByteSequenceObject] RETURNS [ROPE ¬ NIL] ~ { <> FOR tail: LIST OF Finalize.Handle ¬ head.rest, tail.rest UNTIL tail = NIL DO WITH Finalize.HandleToObject[tail.first] SELECT FROM rope: REF Rope.RopeRep.node.object => { IF rope.size = byteSequenceObject.length THEN { WITH rope.base SELECT FROM other: ByteSequenceObject => { IF byteSequenceObject.equal = other.equal AND byteSequenceObject.equal[byteSequenceObject, other] THEN RETURN [rope] } ENDCASE } } ENDCASE ENDLOOP }; GetDeactivationTargets: ENTRY PROC [activeLimit: INT] RETURNS [list: LIST OF ByteSequenceObject ¬ NIL] ~ { FOR tail: LIST OF Finalize.Handle ¬ head.rest, tail.rest UNTIL tail = NIL DO WITH Finalize.HandleToObject[tail.first] SELECT FROM object: REF Rope.RopeRep.node.object => { WITH object.base SELECT FROM byteSequenceObject: ByteSequenceObject => { IF byteSequenceObject.describe[byteSequenceObject].open THEN { IF activeLimit > 0 THEN activeLimit ¬ activeLimit - 1 ELSE list ¬ CONS[byteSequenceObject, list]; }; }; ENDCASE; }; ENDCASE; ENDLOOP; }; GetObjectList: ENTRY PROC RETURNS [list: LIST OF ByteSequenceObject ¬ NIL] ~ { FOR tail: LIST OF Finalize.Handle ¬ head.rest, tail.rest UNTIL tail = NIL DO WITH Finalize.HandleToObject[tail.first] SELECT FROM object: REF Rope.RopeRep.node.object => { WITH object.base SELECT FROM byteSequenceObject: ByteSequenceObject => { list ¬ CONS[byteSequenceObject, list]; }; ENDCASE; }; ENDCASE; ENDLOOP; }; LimitActive: PUBLIC PROC [activeLimit: INT] ~ { next: LIST OF ByteSequenceObject ¬ NIL; FOR list: LIST OF ByteSequenceObject ¬ GetDeactivationTargets[activeLimit], next UNTIL list = NIL DO byteSequenceObject: ByteSequenceObject ~ list.first; list.first ¬ NIL; next ¬ list.rest; list.rest ¬ NIL; [] ¬ byteSequenceObject.deactivate[byteSequenceObject, FALSE]; ENDLOOP; }; RopeFileFetch: Rope.FetchType ~ { <> byteSequenceObject: ByteSequenceObject ~ NARROW[data]; buffer: Buffer ~ ObtainBuffer[byteSequenceObject, index]; char: CHAR; TRUSTED { char ¬ VAL[buffer.chars[index-buffer.start]] }; ReleaseBuffer[byteSequenceObject, buffer]; RETURN [char] }; RopeFileMap: Rope.MapType ~ { <> byteSequenceObject: ByteSequenceObject ~ NARROW[base]; buffer: Buffer ¬ ObtainBuffer[byteSequenceObject, start]; BEGIN ENABLE UNWIND => { ReleaseBuffer[byteSequenceObject, buffer] }; FOR i: INT IN [start..start+len) UNTIL quit DO IF i >= buffer.end THEN { ReleaseBuffer[byteSequenceObject, buffer]; buffer ¬ ObtainBuffer[byteSequenceObject, i]; }; TRUSTED { quit ¬ action[VAL[buffer.chars[i-buffer.start]]] }; ENDLOOP; END; ReleaseBuffer[byteSequenceObject, buffer]; }; RopeFileMove: Rope.MoveType ~ UNCHECKED { <> byteSequenceObject: ByteSequenceObject ~ NARROW[data]; MoveDataFromBuffer: UNSAFE PROC [buffer: Buffer] ~ INLINE { <> transfer: INT ~ MIN[INT[block.count], buffer.end-start]; Basics.MoveBytes[dstBase: block.base, dstStart: block.startIndex, srcBase: buffer.chars, srcStart: start-buffer.start, count: transfer]; block.startIndex ¬ block.startIndex + transfer; block.count ¬ block.count - transfer; start ¬ start + transfer; charsMoved ¬ charsMoved + transfer; ReleaseBuffer[byteSequenceObject, buffer]; }; IF block.count >= bufferSize THEN { <> wasAlreadyActive: BOOL ~ byteSequenceObject.describe[byteSequenceObject].open; buffer: Buffer ~ FindBuffer[byteSequenceObject, start, TRUE]; -- use buffered data if we happen to have it. IF buffer # NIL THEN { MoveDataFromBuffer[buffer] }; UNCHECKED { moved: INT ¬ byteSequenceObject.move[byteSequenceObject, [base: block.base, startIndex: block.startIndex, count: block.count], start]; block.startIndex ¬ block.startIndex + moved; block.count ¬ block.count - moved; start ¬ start + moved; charsMoved ¬ charsMoved + moved; }; Touch[byteSequenceObject]; IF NOT wasAlreadyActive THEN LimitActive[filesMax]; }; UNTIL block.count = 0 DO buffer: Buffer ~ ObtainBuffer[byteSequenceObject, start]; MoveDataFromBuffer[buffer]; ENDLOOP; }; ObtainBuffer: PROC [byteSequenceObject: ByteSequenceObject, index: INT] RETURNS [buffer: Buffer] ~ { <> buffer ¬ FindBuffer[byteSequenceObject, index]; IF buffer = NIL THEN buffer ¬ NewBuffer[]; IF NOT ((buffer.byteSequenceObject = byteSequenceObject) AND (index IN [buffer.start..buffer.end))) THEN { wasAlreadyActive: BOOL ~ byteSequenceObject.describe[byteSequenceObject].open; buffer.byteSequenceObject ¬ byteSequenceObject; buffer.start ¬ (CARD[index] / bufferSize) * bufferSize; buffer.end ¬ MIN[buffer.start + bufferSize, byteSequenceObject.length]; TRUSTED { moved: INT ¬ byteSequenceObject.move[byteSequenceObject, [base: buffer.chars, startIndex: 0, count: buffer.end-buffer.start], buffer.start]; IF buffer.start+moved # buffer.end THEN Error[$BadMove, "RopeFileImpl: Failed to get expected amount of data"]; }; Touch[byteSequenceObject]; IF NOT wasAlreadyActive THEN LimitActive[filesMax]; }; }; bufferHead: Buffer ~ NEW[BufferRep]; FindBuffer: ENTRY PROC [byteSequenceObject: ByteSequenceObject, index: INT, exact: BOOL ¬ FALSE] RETURNS [Buffer] ~ { <> nBuffers: INT ¬ 0; prev: Buffer ¬ bufferHead; prevPrev: Buffer ¬ NIL; preTarget: Buffer ¬ NIL; UNTIL prev.rest = NIL DO this: Buffer ~ prev.rest; IF this.byteSequenceObject = NIL THEN preTarget ¬ prev; IF (this.byteSequenceObject = byteSequenceObject AND index IN [this.start..this.end)) THEN { prev.rest ¬ prev.rest.rest; this.rest ¬ NIL; RETURN [this] }; nBuffers ¬ nBuffers + 1; prevPrev ¬ prev; prev ¬ prev.rest; ENDLOOP; IF exact THEN RETURN [NIL]; IF preTarget # NIL THEN { <> this: Buffer ~ preTarget.rest; preTarget.rest ¬ preTarget.rest.rest; this.rest ¬ NIL; RETURN [this] }; IF nBuffers < bufferLimit OR prevPrev = NIL THEN RETURN [NIL] ELSE { this: Buffer ~ prev; -- least-recently used buffer. prevPrev.rest ¬ NIL; RETURN [this] }; }; ReleaseBuffer: ENTRY PROC [byteSequenceObject: ByteSequenceObject, buffer: Buffer] ~ { IF buffer.rest # NIL OR buffer.byteSequenceObject # byteSequenceObject THEN ERROR; buffer.rest ¬ bufferHead.rest; bufferHead.rest ¬ buffer; }; finalizationQueue: FinalizeOps.CallQueue; -- no forking for now <> <<>> Finalizer: FinalizeOps.FinalizeProc ~ { WITH object SELECT FROM object: REF Rope.RopeRep.node.object => { Remove[handle]; WITH object.base SELECT FROM byteSequenceObject: ByteSequenceObject => { <> KillBuffers[byteSequenceObject]; [] ¬ byteSequenceObject.deactivate[byteSequenceObject, FALSE]; } ENDCASE }; buffer: Buffer => { <> buffer.chars ¬ NIL; TRUSTED { VM.Free[buffer.interval] }; buffer.interval ¬ VM.nullInterval; }; byteSequenceObject: ByteSequenceObject => { <> [] ¬ byteSequenceObject.deactivate[byteSequenceObject, TRUE]; }; ENDCASE; }; KillBuffers: ENTRY PROC [byteSequenceObject: ByteSequenceObject] ~ { <> FOR buffer: Buffer ¬ bufferHead.rest, buffer.rest UNTIL buffer = NIL DO IF buffer.byteSequenceObject = byteSequenceObject THEN buffer.byteSequenceObject ¬ NIL; ENDLOOP; }; Deactivate: PUBLIC PROC [rope: ROPE] ~ { WITH rope SELECT FROM x: REF Rope.RopeRep.node => TRUSTED { WITH x: x SELECT FROM substr => Deactivate[x.base]; concat => { Deactivate[x.base]; Deactivate[x.rest] }; replace => { Deactivate[x.base]; Deactivate[x.replace] }; object => IF x.fetch = RopeFileFetch THEN { WITH x.base SELECT FROM byteSequenceObject: ByteSequenceObject => { [] ¬ byteSequenceObject.deactivate[byteSequenceObject, FALSE]; }; ENDCASE }; ENDCASE }; ENDCASE; }; RopeFilesCommand: Commander.CommandProc ~ { FOR tail: LIST OF ByteSequenceObject ¬ GetObjectList[], tail.rest UNTIL tail = NIL DO byteSequenceObject: ByteSequenceObject ~ tail.first; P: PROC [fileName: ROPE, created: ROPE, open: BOOL] ~ { status: ROPE ~ IF open THEN "O" ELSE "X"; IO.PutFL[cmd.out, "%g\n %g %9d %g\n", LIST[[rope[fileName]], [rope[status]], [integer[byteSequenceObject.length]], [rope[created]]]]; }; [] ¬ APPLY [P, byteSequenceObject.describe[byteSequenceObject]]; ENDLOOP; }; Commander.Register["RopeFiles", RopeFilesCommand, "Lists the files currently in use as RopeFiles"]; END.