-- File PieceTableImpl.mesa
-- last modified by Sweet on 16-Apr-82 10:55:18
-- last modified by Satterthwaite, December 28, 1982 9:17 am

DIRECTORY
  Environment USING [Block, Byte, bytesPerPage, wordsPerPage],
  CIFS: TYPE USING [OpenFile, Close, GetFC, Open, create, replace, write],
  File: TYPE USING [Capability, ShowCapability],
  FileStream: TYPE USING [Create, GetCapability, SetIndex],
  Inline USING [LowHalf],
  Heap USING [Create--Uniform--, Delete],
  PieceTable,
  Space: TYPE USING [
    Handle, Create, Delete, LongPointer, Map, nullHandle, virtualMemory],
  Stream;

PieceTableImpl: PROGRAM 
    IMPORTS 
      CIFS, File, FileStream, Inline, Heap, Space, Stream
    EXPORTS PieceTable 
    SHARES File =
  BEGIN OPEN PieceTable;

  nullFile: CIFS.OpenFile = NIL;
    
-- ****************** global data ******************

  z: UNCOUNTED ZONE ← NIL;
    -- NB: all CIFS.OpenFile's are protected through REFs or global frames
  zVM: Space.Handle ← Space.nullHandle;
  
  vPosOfCurrentPiece, savedScratchPos: LONG CARDINAL;
  currentPieceByte: CARDINAL;

-- INVARIANTS:

--    0 < currentPieceByte <= current.length OR
--    0 = currentPieceByte AND currentPiece = pieceHead
--    (i.e., posn'd within piece, beginning ok only if 1st piece)

--    savedScratchPos used when lastScratchPiece = NullPiece to tell
--      where to do next put to scratch file

    
  pieceHead, lastScratchPiece: PieceIndex;
  current: PieceIndex;

  scratchAtEOF: BOOL;
--  means currentPiece = lastScratchPiece AND 
--    currentPieceByte = current.length

  scratch: PFS;
  active: Stream.Handle;
  pool: LONG POINTER TO PFS;

-- INVARIANTS:

-- IF active # NIL THEN 
-- active is a stream on current.file and
-- GetPosition[active] = current.position + currentPieceByte.


-- ****************** procedures ******************

  PTError: PUBLIC SIGNAL = CODE; -- something went wrong

  Append: PUBLIC PROC RETURNS [pos: LONG CARDINAL] =
    BEGIN
    UNTIL current.next = pieceHead DO
      vPosOfCurrentPiece ← vPosOfCurrentPiece + current.length;
      current ← current.next;
      ENDLOOP;
    currentPieceByte ← current.length;
    pos ← currentPieceByte + vPosOfCurrentPiece;
    END;
    
  AppendWord: PUBLIC PROC RETURNS [pos: LONG CARDINAL] =
    BEGIN
    pos ← Append[];
    IF CARDINAL[Inline.LowHalf[pos]] MOD 2 = 0 THEN RETURN;
    PutZeros[1];
    pos ← pos + 1;
    END;
    
  AppendQuadWord: PUBLIC PROC RETURNS [pos: LONG CARDINAL] =
    BEGIN
    slop: CARDINAL;
    pos ← Append[];
    slop ←  CARDINAL[Inline.LowHalf[pos]] MOD 8;
    IF slop = 0 THEN RETURN;
    PutZeros[8 - slop];
    pos ← pos + 8 - slop;
    END;
    
  AppendPage: PUBLIC PROC RETURNS [pos: LONG CARDINAL] =
    BEGIN
    slop: CARDINAL;
    pos ← Append[];
    slop ←  CARDINAL[Inline.LowHalf[pos]] MOD Environment.bytesPerPage;
    IF slop = 0 THEN RETURN;
    PutZeros[Environment.bytesPerPage - slop];
    pos ← pos + Environment.bytesPerPage - slop;
    END;
    
  BreakCurrentPiece: PROC =
    BEGIN
    newPos: LONG CARDINAL = current.position + currentPieceByte;
    newLength: CARDINAL;
    new: PieceIndex;
    
    IF currentPieceByte = current.length THEN RETURN;
    newLength ← current.length - currentPieceByte;
    new ← NewFilePiece[current.file, newPos, newLength];
    current.length ← currentPieceByte;
    LinkIn[new];
    IF current = lastScratchPiece THEN lastScratchPiece ← new;
    END;
    
  buffer: LONG POINTER ← NIL; -- allocated and freed by Store
  bufptr, bufmax: CARDINAL;

  CopyBytes: PROC [from, to: Stream.Handle, count: CARDINAL] =
    BEGIN OPEN Stream;
    fromBlock: Environment.Block;

    WHILE count # 0 DO
      tcount: CARDINAL ← MIN[count, bufmax];
      IF bufptr + tcount > bufmax THEN FlushBuffer[to];
      fromBlock ← [buffer, bufptr, bufptr+tcount];
      [bytesTransferred: tcount] ← GetBlock[from, fromBlock];
      bufptr ← bufptr + tcount; count ← count - tcount;
      ENDLOOP;
    END;


  CopyFromFile: PUBLIC PROC [
      file: CIFS.OpenFile, position: LONG CARDINAL, length: CARDINAL] =
    BEGIN
    new: PieceIndex;
    
    BreakCurrentPiece[];
    -- see if it is contiguous with current piece
    IF current # pieceHead AND SameFile[current.file, file] AND
      current.position + current.length = position THEN
      {currentPieceByte ← current.length ← current.length + length; RETURN};
    -- nope, make a new piece
    new ← NewFilePiece[file, position, length];
    LinkIn[new];
    vPosOfCurrentPiece ← vPosOfCurrentPiece + current.length;
    current ← new;
    currentPieceByte ← current.length;
    active ← NIL;
    END;
    
  CopyCurrentToScratch: PROC =
    BEGIN -- copy contents of currentPiece into scratch file
    scratchPos: LONG CARDINAL = NextScratchPos[];
    FileStream.SetIndex[scratch.stream, scratchPos];
    SetupStream[]; -- make current piece's stream active
    CopyBytes[
      from: active, to: scratch.stream, count: current.length];
    current.position ← scratchPos;
    current.file ← scratch.file;
    lastScratchPiece ← current;
    active ← NIL; -- since we screwed up whatever was setup
    END;
    
  Delete: PUBLIC PROC [count: INTEGER] =
    BEGIN -- delete "count" characters at current VPos (to left if negative)
    -- tries to avoid creating extra pieces as Cut would
    -- if there are fewer character to right or left, signals PTError
    
    -- There are characters in the current piece that stay, so  
    --  current, vPosOfCurrentPiece and currentPieceByte remain valid
    remaining: CARDINAL;
    p: PieceIndex;
    after: PieceIndex;
    cByte: CARDINAL;
    
    IF count < 0 THEN 
      BEGIN
      Move[count]; 
      count ← -count
      END;
    p ← current;
    cByte ← currentPieceByte;
    WHILE count # 0 DO
      remaining ← p.length - cByte;
      IF CARDINAL[count] < remaining THEN 
	BEGIN -- lies in the middle of this piece
	shrink: PieceIndex;
	IF cByte = 0 THEN shrink ← p
	ELSE 
	  BEGIN -- can happen only the first time through
	  BreakCurrentPiece[];
	  shrink ← current.next;
	  END;
	shrink.position ← shrink.position + count;
	shrink.length ← shrink.length - count;
	EXIT
	END;
      -- delete rest of this piece
      after ← p.next;
      IF cByte = 0 AND p # pieceHead THEN RemovePiece[p]
      ELSE p.length ← cByte;
      p ← after; cByte ← 0; count ← count - remaining; 
      IF p = pieceHead AND count # 0 THEN {SIGNAL PTError; RETURN};
      ENDLOOP;
    active ← NIL;
    END;
    
  Finalize: PUBLIC PROC =
    BEGIN
    p: PieceIndex;
    IF scratch.stream # NIL THEN { 
      scratch.stream.Delete[]; scratch.stream ← NIL};
    IF scratch.file # nullFile THEN {
      CIFS.Close[scratch.file]; scratch.file ← NIL};
    scratch.next ← NIL;
    active ← NIL;
    WHILE pool # NIL DO
      next: LONG POINTER TO PFS ← pool.next;
      pool.stream.Delete[];
      pool.stream ← NIL;  pool.file ← nullFile;
      z.FREE[@pool];
      pool ← next;
      ENDLOOP;
    IF pieceHead = NIL THEN RETURN;
    p ← pieceHead.next;
    WHILE p # pieceHead DO
      next: PieceIndex = p.next;
      z.FREE[@p];
      p ← next;
      ENDLOOP;
    z.FREE[@pieceHead];
    pieceHead ← current ← NullPiece;
    Heap.Delete[z];  z ← NIL;
    Space.Delete[zVM];  zVM ← Space.nullHandle;
    END;

  FlushBuffer: PROC [to: Stream.Handle] =
    BEGIN
    IF bufptr = 0 THEN RETURN;
    to.PutBlock[[buffer, 0, bufptr], FALSE];
    bufptr ← 0;
    END;
    
  GetByte: PUBLIC PROC RETURNS [byte: Environment.Byte] =
    BEGIN
    IF current = NullPiece THEN {SIGNAL PTError; RETURN[0]};
    IF currentPieceByte = current.length THEN
      BEGIN
      p: PieceIndex = current.next;
      IF p = pieceHead THEN {SIGNAL PTError; RETURN[0]};
      vPosOfCurrentPiece ← vPosOfCurrentPiece + current.length;
      current ← p;
      currentPieceByte ← 0;
      SetupStream[];
      -- currentPiece > 0 invariant will soon be true again
      END;
    IF current.file = nullFile THEN byte ← 0
    ELSE
      BEGIN
      IF active = NIL THEN SetupStream[];
      byte ← active.GetByte[];
      END;
    currentPieceByte ← currentPieceByte + 1;
    END;

  GetPlace: PUBLIC PROC RETURNS [Place] =
    BEGIN
    RETURN [[pi: current, pos: vPosOfCurrentPiece, filePos: current.position]];
    END;

  GetWord: PUBLIC PROC RETURNS [UNSPECIFIED] =
    BEGIN
    bytes: RECORD [left, right: Environment.Byte];
    bytes.left ← GetByte[];
    bytes.right ← GetByte[];
    RETURN [bytes];
    END;
    
  GetVPos: PUBLIC PROC RETURNS [pos: LONG CARDINAL] =
    BEGIN
    RETURN[vPosOfCurrentPiece + currentPieceByte];
    END;
    
  Initialize: PUBLIC PROC =
    BEGIN
    IF z # NIL THEN {
      Heap.Delete[z]; z ← NIL;
      IF zVM # Space.nullHandle THEN Space.Delete[zVM]};
    zVM ← Space.Create[size: 256, parent: Space.virtualMemory];
    z ← Heap.Create--Uniform--[parent: zVM,
      initial: 50, increment: 10, swapUnit--Size--: 10--, objectSize: SIZE[Piece]--];
    vPosOfCurrentPiece ← savedScratchPos ← 0;
    currentPieceByte ← 0;
    lastScratchPiece ← NullPiece;
    pieceHead ← current ← z.NEW [Piece ← [
      prev: NULL,
      length: 0,
      position: 0,
      next: NULL,
      file: nullFile]];
    pieceHead.next ← pieceHead.prev ← pieceHead;
    scratchAtEOF ← FALSE;
    scratch ← [NIL, nullFile, NIL];
    active ← NIL;
    pool ← NIL;
    END;
    
  Length: PUBLIC PROC RETURNS [l: LONG CARDINAL] =
    BEGIN
    p: PieceIndex ← current;
    l ← vPosOfCurrentPiece;
    DO
      IF p = pieceHead THEN EXIT;
      l ← l + p.length;
      p ← p.next;
      ENDLOOP;
    END;
    
  LinkIn: PROC [new: PieceIndex] =
    BEGIN
    right: PieceIndex;
    IF new = NullPiece THEN {SIGNAL PTError; RETURN};
    new.prev ← current;
    right ← current.next;
    current.next ← new;
    new.next ← right;
    right.prev ← new;
    END;
    
  Move: PUBLIC PROC [dist: LONG INTEGER] =
    BEGIN 
    cLength: CARDINAL;
    adist: LONG CARDINAL;
    IF dist = 0 THEN RETURN;
    active ← NIL;  -- no matter what we do
    IF dist > 0 THEN
      BEGIN -- move right
      -- adjust to move from beginning of current piece
      adist ← dist + currentPieceByte;
      currentPieceByte ← 0;
      DO
	IF (cLength ← current.length) >= adist THEN EXIT;
	adist ← adist - cLength;
	vPosOfCurrentPiece ← vPosOfCurrentPiece + cLength;
	current ← current.next;
	IF current = pieceHead THEN 
	  {SIGNAL PTError; RETURN};
	ENDLOOP;
      currentPieceByte ← Inline.LowHalf[adist];
      END
    ELSE
      BEGIN -- move left
      -- adjust to move from end of current piece
      cLength ← current.length;
      adist ← cLength - currentPieceByte - dist;
      currentPieceByte ← cLength;
      UNTIL adist < cLength DO
	adist ← adist - cLength; 
	IF current = pieceHead THEN EXIT;
	current ← current.prev;
	cLength ← current.length;
	vPosOfCurrentPiece ← vPosOfCurrentPiece - cLength;
	ENDLOOP;
      IF current = pieceHead THEN
	BEGIN
	currentPieceByte ← 0;
	IF adist # 0 THEN {SIGNAL PTError; RETURN};
	END
      ELSE currentPieceByte ← cLength - Inline.LowHalf[adist];
      END;
    END;
    
  NewFilePiece: PROC [
      file: CIFS.OpenFile, position: LONG CARDINAL, length: CARDINAL]
    RETURNS [new: PieceIndex] =
    BEGIN
    new ← z.NEW[Piece ← [
      next: NullPiece, length: length, position: position, prev: NullPiece,
      file: file]];
    END;
    
  NextScratchPos: PROC RETURNS [pos: LONG CARDINAL] =
    BEGIN -- returns position of end of scratch file
    IF scratch.file = nullFile THEN
      BEGIN
      scratch.file ← CIFS.Open[
        "/local/PTEdit.scratch$", CIFS.create+CIFS.replace+CIFS.write];
      scratch.stream ← FileStream.Create[scratch.file.GetFC];
      pos ← 0;
      END
    ELSE IF lastScratchPiece = NullPiece THEN pos ← savedScratchPos
    ELSE pos ← lastScratchPiece.position + lastScratchPiece.length;
    END;
    
  NewScratchPiece: PROC RETURNS [PieceIndex] =
    BEGIN -- returns zero length piece at end of scratch file
    RETURN[lastScratchPiece ←
      NewFilePiece[scratch.file, NextScratchPos[], 0]];
    END;
    
  PutByte: PUBLIC PROC [byte: Environment.Byte] =
    BEGIN
    new: PieceIndex;
    
    IF current = lastScratchPiece THEN
      {IF active = NIL THEN SetupStream[]}
    ELSE scratchAtEOF ← FALSE;
    IF scratchAtEOF THEN
      BEGIN
      scratch.stream.PutByte[byte];
      currentPieceByte ← currentPieceByte + 1;
      current.length ← current.length + 1;
      RETURN
      END;
    BreakCurrentPiece[];
    new ← NewScratchPiece[];
    LinkIn[new];
    vPosOfCurrentPiece ← vPosOfCurrentPiece + current.length;
    current ← new;
    currentPieceByte ← 0;
    -- the currentPieceByte > 0 invariant temporarily false
    SetupStream[]; -- will set scratchAtEOF = TRUE
    scratch.stream.PutByte[byte];
    currentPieceByte ← currentPieceByte + 1;
	-- not just currentPieceByte ← 1 to allow crossjump
    current.length ← current.length + 1;
    END;

  PutWord: PUBLIC PROC [word: UNSPECIFIED] =
    BEGIN
    bytes: RECORD [left, right: Environment.Byte] = word;
    PutByte[bytes.left];
    PutByte[bytes.right];
    END;

  PutZeros: PUBLIC PROC [count: CARDINAL] =
    BEGIN
    CopyFromFile[file: nullFile, position: 0, length: count];
    END;
    
  RemovePiece: PROC [p: PieceIndex] =
    BEGIN
    left, right: PieceIndex;
    IF p = pieceHead THEN {SIGNAL PTError; RETURN};
    left ← p.prev; right ← p.next;
    z.FREE [@p];
    left.next ← right;
    right.prev ← left;
    END;
    
  SameFile: PROC [f1, f2: CIFS.OpenFile] RETURNS [BOOL] =
    BEGIN
    IF f1 = nullFile THEN RETURN[f2 = nullFile];
    IF f2 = nullFile THEN RETURN[FALSE];
    RETURN [SameFC[f1.GetFC, f2.GetFC]]
    END;
    
  SameFC: PROC [f1, f2: File.Capability] RETURNS [BOOL] = INLINE
    BEGIN
    RETURN [f1.ShowCapability[].fID = f2.ShowCapability[].fID]
    END;
    

  SetupStream: PROC =
    -- called after currentPiece and currentPieceByte are changed
    BEGIN
    IF current.file = nullFile THEN scratchAtEOF ← FALSE
    ELSE
      BEGIN
      SetupFileStream[current.file, current.position + currentPieceByte];
      scratchAtEOF ← current = lastScratchPiece AND
	current.length = currentPieceByte;
      END;
    END;
    
  SetupFileStream: PROC [file: CIFS.OpenFile, pos: LONG CARDINAL] =
    BEGIN
    l, p: LONG POINTER TO PFS ← NIL;

    IF SameFile[file, scratch.file] THEN active ← scratch.stream
    ELSE 
      BEGIN
      FOR p ← pool, p.next UNTIL p = NIL DO
        IF SameFile[p.file, file] THEN
          BEGIN -- move to front of list
          IF l # NIL THEN {l.next ← p.next; p.next ← pool; pool ← p};
          -- otherwise, pool = p
          EXIT
          END;
        l ← p;
        REPEAT FINISHED =>
          BEGIN
          assert: BOOL[TRUE..TRUE] = (SIZE[PFS] <= SIZE[Piece]);
	  l ← z.NEW[PFS ← [
	    file: file, 
            stream: FileStream.Create[file.GetFC],
            next: pool]];
	  pool ← l;
          END;
        ENDLOOP;
      active ← pool.stream;
      END;
    FileStream.SetIndex[active, pos];
    END;
    
  SetVPos: PUBLIC PROC [pos: LONG CARDINAL, near: PlacePtr ← NIL] =
    BEGIN
    IF near # NIL THEN
      BEGIN
      current ← near.pi;
      vPosOfCurrentPiece ← near.pos + current.position - near.filePos;
      currentPieceByte ← current.length;
      active ← NIL;
      END;
    IF pos = 0 THEN
      BEGIN
      current ← pieceHead;
      currentPieceByte ← 0;
      vPosOfCurrentPiece ← 0;
      END
    ELSE Move[pos - (vPosOfCurrentPiece + currentPieceByte)];
    END;

  buffSize: CARDINAL = 6;
    
  Store: PUBLIC PROC [outStream: Stream.Handle] =
    BEGIN
    file: File.Capability;
    -- allocate buffer for copy
    scratch: Space.Handle ← Space.Create[size: buffSize, parent: Space.virtualMemory];
    scratch.Map[];  buffer ← scratch.LongPointer;
    bufptr ← 0;
    bufmax ← Environment.wordsPerPage*buffSize;

    file ← FileStream.GetCapability[outStream];
    -- first make sure destination is not part of source
    current ← pieceHead; vPosOfCurrentPiece ← 0; currentPieceByte ← 0;
    DO
      current ← current.next;
      IF current = pieceHead THEN EXIT;
      IF current.file # nullFile AND SameFC[current.file.GetFC, file] THEN
        CopyCurrentToScratch[];
      ENDLOOP;
    -- now copy a piece at a time
    -- current = pieceHead
    DO
      current ← current.next;
      IF current = pieceHead THEN EXIT;
      IF current.file = nullFile THEN 
        BEGIN
        IF bufptr # 0 THEN FlushBuffer[outStream];
	THROUGH [0..current.length) DO outStream.PutByte[0]; ENDLOOP;
	END
      ELSE
	BEGIN
        SetupStream[];
        CopyBytes[
	  from: active, 
	  to: outStream, 
	  count: current.length];
	  END;
      ENDLOOP;
    IF bufptr # 0 THEN FlushBuffer[outStream];
    Finalize[];
    buffer ← NIL;  Space.Delete[scratch];
    END;
    
  END.