-- File PieceTableImpl.mesa
-- Last Modified by Sweet on  4-Mar-81 11:45:21
-- Last Modified by Lewis on October 10, 1980  11:56 AM

DIRECTORY
  Environment USING [Block, Byte, bytesPerPage, wordsPerPage],
  Heap USING [systemZone],
  Inline USING [LowHalf],
  PieceTable,
  Segments,
  Storage,
  Stream,
  Streams;

PieceTableImpl: PROGRAM 
    IMPORTS Heap, Inline, Segments, Storage, Stream, Streams
    EXPORTS PieceTable =
  BEGIN OPEN PieceTable;

-- ****************** imported stuff ********************
  z: UNCOUNTED ZONE = Heap.systemZone;

-- ****************** global data ******************

  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: BOOLEAN;
--  means currentPiece = lastScratchPiece AND 
--    currentPieceByte = current.length

  scratch: PFS;
  active: Streams.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 PROCEDURE 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 PROCEDURE 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 PROCEDURE 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 PROCEDURE 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: PRIVATE PROCEDURE =
    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: POINTER ← NIL; -- allocated and freed by Store
  bufptr, bufmax: CARDINAL;

  CopyBytes: PRIVATE PROCEDURE [from, to: Streams.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 PROCEDURE [
      file: Segments.FHandle, 
      position: LONG CARDINAL, 
      length: CARDINAL] =
    BEGIN
    new: PieceIndex;
    
    BreakCurrentPiece[];
    -- see if it is contiguous with current piece
    IF current # pieceHead AND 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: PRIVATE PROCEDURE =
    BEGIN -- copy contents of currentPiece into scratch file
    scratchPos: LONG CARDINAL = NextScratchPos[];
    Streams.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 PROCEDURE [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 PROCEDURE =
    BEGIN
    p: PieceIndex;
    IF scratch.stream # NIL THEN 
      {Streams.Destroy[scratch.stream]; scratch ← [NIL, NIL, NIL]};
    active ← NIL;
    WHILE pool # NIL DO
      next: LONG POINTER TO PFS ← pool.next;
      Streams.Destroy[pool.stream];
      z.FREE[@pool];
      pool ← next;
      ENDLOOP;
    p ← pieceHead.next;
    WHILE p # pieceHead DO
      next: PieceIndex = p.next;
      z.FREE[@p];
      p ← next;
      ENDLOOP;
    z.FREE[@pieceHead];
    pieceHead ← current ← NullPiece;
    END;

  FlushBuffer: PRIVATE PROC [to: Streams.Handle] =
    BEGIN
    block: Environment.Block ← [buffer, 0, bufptr];
    IF bufptr = 0 THEN RETURN;
    Stream.PutBlock[to, block, FALSE];
    bufptr ← 0;
    END;
    
  GetByte: PUBLIC PROCEDURE 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 = NIL THEN byte ← 0
    ELSE
      BEGIN
      IF active = NIL THEN SetupStream[];
      byte ← Streams.GetByte[active];
      END;
    currentPieceByte ← currentPieceByte + 1;
    END;

  GetPlace: PUBLIC PROCEDURE RETURNS [Place] =
    BEGIN
    RETURN [[current, vPosOfCurrentPiece]];
    END;

  GetWord: PUBLIC PROCEDURE RETURNS [UNSPECIFIED] =
    BEGIN
    bytes: RECORD [left, right: Environment.Byte];
    bytes.left ← GetByte[];
    bytes.right ← GetByte[];
    RETURN [bytes];
    END;
    
  GetVPos: PUBLIC PROCEDURE RETURNS [pos: LONG CARDINAL] =
    BEGIN
    RETURN[vPosOfCurrentPiece + currentPieceByte];
    END;
    
  Initialize: PUBLIC PROCEDURE =
    BEGIN
    vPosOfCurrentPiece ← savedScratchPos ← 0;
    currentPieceByte ← 0;
    lastScratchPiece ← NullPiece;
    pieceHead ← current ← z.NEW [Piece ← [
      prev: NULL,
      length: 0,
      position: 0,
      next: NULL,
      file: NIL]];
    pieceHead.next ← pieceHead.prev ← pieceHead;
    scratchAtEOF ← FALSE;
    scratch ← [NIL, NIL, NIL];
    active ← NIL;
    pool ← NIL;
    END;
    
  Length: PUBLIC PROCEDURE 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: PRIVATE PROCEDURE [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 PROCEDURE [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: PRIVATE PROCEDURE [
      file: Segments.FHandle,
      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: PRIVATE PROCEDURE RETURNS [pos: LONG CARDINAL] =
    BEGIN -- returns position of end of scratch file
    IF scratch.file = NIL THEN
      BEGIN OPEN Segments;
      scratch.file ← NewFile["PTEdit.scratch$"L, AllAccess];
      scratch.stream ← Streams.CreateStream[scratch.file, AllAccess];
      pos ← 0;
      END
    ELSE IF lastScratchPiece = NullPiece THEN pos ← savedScratchPos
    ELSE pos ← lastScratchPiece.position + lastScratchPiece.length;
    END;
    
  NewScratchPiece: PRIVATE PROCEDURE RETURNS [PieceIndex] =
    BEGIN -- returns zero length piece at end of scratch file
    RETURN[lastScratchPiece ←
      NewFilePiece[scratch.file, NextScratchPos[], 0]];
    END;
    
  PutByte: PUBLIC PROCEDURE [byte: Environment.Byte] =
    BEGIN
    new: PieceIndex;
    
    IF current = lastScratchPiece THEN
      {IF active = NIL THEN SetupStream[]}
    ELSE scratchAtEOF ← FALSE;
    IF scratchAtEOF THEN
      BEGIN
      Streams.PutByte[scratch.stream, 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
    Streams.PutByte[scratch.stream, byte];
    currentPieceByte ← currentPieceByte + 1;
	-- not just currentPieceByte ← 1 to allow crossjump
    current.length ← current.length + 1;
    END;

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

  PutZeros: PUBLIC PROCEDURE [count: CARDINAL] =
    BEGIN
    CopyFromFile[file: NIL, position: 0, length: count];
    END;
    
  RemovePiece: PRIVATE PROCEDURE [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;
    
  SetupStream: PRIVATE PROCEDURE =
    -- called after currentPiece and currentPieceByte are changed
    BEGIN
    IF current.file = NIL THEN scratchAtEOF ← FALSE
    ELSE
      BEGIN
      SetupFileStream[current.file, current.position + currentPieceByte];
      scratchAtEOF ← current = lastScratchPiece AND
	current.length = currentPieceByte;
      END;
    END;
    
  SetupFileStream: PRIVATE PROCEDURE [
      file: Segments.FHandle, pos: LONG CARDINAL] =
    BEGIN
    l, p: LONG POINTER TO PFS ← NIL;

    IF file = scratch.file THEN active ← scratch.stream
    ELSE 
      BEGIN
      FOR p ← pool, p.next UNTIL p = NIL DO
        IF 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 OPEN Streams;
          l ← z.NEW[PFS ← [
	    file: file, 
            stream: CreateStream[file, Read],
            next: pool]];
	  pool ← l;
          END;
        ENDLOOP;
      active ← pool.stream;
      END;
    Streams.SetIndex[active, pos];
    END;
    
  SetVPos: PUBLIC PROCEDURE [pos: LONG CARDINAL, near: PlacePtr ← NIL] =
    BEGIN
    IF near # NIL THEN
      BEGIN
      current ← near.pi;
      vPosOfCurrentPiece ← near.pos;
      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 PROCEDURE [outStream: Streams.Handle] =
    BEGIN OPEN Streams;
    file: Segments.FHandle;
    
    -- allocate buffer for copy
    buffer ← Storage.Pages[buffSize];
    bufptr ← 0;
    bufmax ← Environment.wordsPerPage*buffSize;

    file ← FileFromStream[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 = 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 = NIL THEN 
        BEGIN
        IF bufptr # 0 THEN FlushBuffer[outStream];
	THROUGH [0..current.length) DO PutByte[outStream, 0]; ENDLOOP;
	END
      ELSE
	BEGIN
        SetupStream[];
        CopyBytes[
	  from: active, 
	  to: outStream, 
	  count: current.length];
	  END;
      ENDLOOP;
    IF bufptr # 0 THEN FlushBuffer[outStream];
    Destroy[outStream];
    Finalize[];
    END;
    
  END.