-- 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.