-- StreamImpl.mesa (last edited by: Gobbel on: 20-Mar-81 14:28:24)

DIRECTORY
  BitBlt USING [AlignedBBTable, BITBLT, BBptr, BBTableSpace],
  ByteBlt USING [],
  Environment USING [bitsPerWord, bitsPerByte, Block, Byte, bytesPerWord],
  Inline USING [LongCOPY],
  MiscPrograms USING [],
  PrincOps USING [UnboundLink],
  Stream USING [Block, Byte, CompletionCode, defaultInputOptions, Object, Handle, InputOptions,
    SubSequenceType, Word],
  SystemInternal USING [Unimplemented];

StreamImpl: PROGRAM
  IMPORTS Inline, BitBlt, SystemInternal
  EXPORTS ByteBlt, MiscPrograms, Stream =
BEGIN OPEN Stream;

--MiscPrograms.--InitializeStream: PUBLIC PROCEDURE =
  BEGIN -- may be something here someday -- END;

EndOfStream: PUBLIC SIGNAL [nextIndex: CARDINAL] = CODE;
LongBlock: PUBLIC SIGNAL [nextIndex: CARDINAL] = CODE;
ShortBlock: PUBLIC ERROR = CODE;
SSTChange: PUBLIC SIGNAL [sst: SubSequenceType, nextIndex: CARDINAL] = CODE;
TimeOut: PUBLIC SIGNAL [nextIndex: CARDINAL] = CODE;

LeftAndRight: TYPE = MACHINE DEPENDENT RECORD [left, right: Environment.Byte];

--
-- Stream implementation (defaults)

defaultObject: PUBLIC Object _ [
  options: defaultInputOptions,
  getByte: DefaultGetByte,
  putByte: DefaultPutByte,
  getWord: DefaultGetWord,
  putWord: DefaultPutWord,
  get: DefaultGet,
  put: DefaultPut,
  setSST: LOOPHOLE[PrincOps.UnboundLink],
  sendAttention: LOOPHOLE[PrincOps.UnboundLink],
  waitAttention: LOOPHOLE[PrincOps.UnboundLink],
  delete: LOOPHOLE[PrincOps.UnboundLink]];

DefaultGetByte: PROCEDURE [sH: Handle] RETURNS [byte: Byte] =
  -- Get one byte, using GetBlock on a one-byte block
  BEGIN
  array: PACKED ARRAY [0..1] OF Byte;
  options: InputOptions = [FALSE, FALSE, FALSE, TRUE, TRUE];
  IF sH.get=DefaultGet THEN ERROR SystemInternal.Unimplemented;
  [] _ sH.get[sH, Block[@array, 1, 2], options];
  RETURN[array[1]] -- right-justify the byte
  END;

DefaultGetWord: PROCEDURE [sH: Handle] RETURNS [word: Word] =
  -- Get one word using GetBlock on a two-byte block
  BEGIN OPEN w: LOOPHOLE[word, LeftAndRight];
  options: InputOptions = [FALSE, FALSE, FALSE, TRUE, TRUE];
  SELECT TRUE FROM
   sH.getByte~=DefaultGetByte => BEGIN w.left _ sH.getByte[sH]; w.right _ sH.getByte[sH]; END;
   sH.get~=DefaultGet => [] _ sH.get[sH, Block[@word, 0, 2], options];
   ENDCASE => ERROR SystemInternal.Unimplemented;
  END;

DefaultGet: PROCEDURE [sH: Handle, block: Block, options: InputOptions] RETURNS [bytesTransferred: CARDINAL, why: CompletionCode, sst: SubSequenceType] =
  -- Get block, using GetByte repeatedly
  BEGIN
  i: CARDINAL;
  sstNew: SubSequenceType;
  IF sH.getByte=DefaultGetByte OR options.terminateOnEndPhysicalRecord OR options.signalLongBlock OR options.signalShortBlock THEN
     ERROR SystemInternal.Unimplemented;
  why _ normal;
  i _ block.startIndex;
  WHILE i<block.stopIndexPlusOne DO
   LOOPHOLE[block.blockPointer, LONG POINTER TO PACKED ARRAY [0..0) OF Byte][i] _ sH.getByte[sH !
     SSTChange =>
      IF ~options.signalSSTChange THEN BEGIN sstNew _ sst; GO TO PostSSTChange END
      ELSE BEGIN SIGNAL SSTChange[sst: sst, nextIndex: i]; RESUME END;
     EndOfStream =>
      IF ~options.signalEndOfStream THEN GO TO PostEndOfStream
      ELSE BEGIN SIGNAL EndOfStream[nextIndex: i]; RESUME -- why is this useful? -- END];
   i _ i+1;
   REPEAT
     PostSSTChange => why _ sstChange;
     PostEndOfStream => why _ endOfStream;
   ENDLOOP;
  bytesTransferred _ i-block.startIndex;
  sst _ sstNew
  END;

DefaultPutByte: PROCEDURE [sH: Handle, byte: Byte] =
  -- Put one byte, using PutBlock on a one-byte block
  BEGIN
  array: PACKED ARRAY [0..1] OF Byte _ [0, byte];
  IF sH.put=DefaultPut THEN ERROR SystemInternal.Unimplemented;
  sH.put[sH, Block[@array, 1, 2], FALSE];
  END;

DefaultPutWord: PROCEDURE [sH: Handle, word: Word] =
  -- Put one word, using PutBlock on a one-byte block
  BEGIN OPEN w: LOOPHOLE[word, LeftAndRight];
  SELECT TRUE FROM
   sH.putByte~=DefaultPutByte => BEGIN sH.putByte[sH, w.left]; sH.putByte[sH, w.right]; END;
   sH.put~=DefaultPut => sH.put[sH, Block[@word, 0, 2], FALSE];
   ENDCASE => ERROR SystemInternal.Unimplemented;
  END;

DefaultPut: PROCEDURE [sH: Handle, block: Block, endPhysicalRecord: BOOLEAN] =
  -- Put block, using PutByte repeatedly
  BEGIN
  i: CARDINAL;
  IF sH.putByte=DefaultPutByte OR endPhysicalRecord THEN ERROR SystemInternal.Unimplemented;
  FOR i IN [block.startIndex..block.stopIndexPlusOne) DO
   sH.putByte[sH, LOOPHOLE[block.blockPointer, LONG POINTER TO PACKED ARRAY [0..0) OF Byte][i]];
   ENDLOOP;
  END;

--
-- ByteBlt implementation

useBitBlt: BOOLEAN _ TRUE;

ByteBlt: PUBLIC PROCEDURE [to, from: Environment.Block] RETURNS [nBytes: CARDINAL] =
  -- Byte-boundary block transfer
  BEGIN
  -- NB: to&from are RECORDs, not POINTERs to RECORDs, so we can update them
  toBytes, fromBytes: LONG POINTER TO PACKED ARRAY [0..0) OF [0..377B);
  moved: CARDINAL _ 0;

  -- This check is necessary since subtracting CARDINALs gives big numbers
  IF to.startIndex>to.stopIndexPlusOne
   OR from.startIndex>from.stopIndexPlusOne THEN
   ERROR StartIndexGreaterThanStopIndexPlusOne;
  IF (nBytes _ MIN[to.stopIndexPlusOne-to.startIndex,from.stopIndexPlusOne-from.startIndex])=0 THEN RETURN;
  toBytes _ to.blockPointer; fromBytes _ from.blockPointer;

  -- Move the first odd byte (if any) to be sure that to is word aligned
  IF (to.startIndex MOD 2)#0 THEN
   BEGIN
   toBytes[to.startIndex] _ fromBytes[from.startIndex];
   moved _ 1;
   to.startIndex _ to.startIndex+1;
   from.startIndex _ from.startIndex+1;
   END;
  IF (from.startIndex MOD 2)=0 THEN
   -- Fast case: both are word aligned
   BEGIN
   words: CARDINAL = (nBytes-moved)/2;
   Inline.LongCOPY[to: toBytes+to.startIndex/2, from: fromBytes+from.startIndex/2, nwords: words];
   IF (moved+2*words)#nBytes THEN
     -- Move the one and only remaining byte
     toBytes[to.startIndex+2*words] _ fromBytes[from.startIndex+2*words];
   END
  -- Slow case: have to ripple things
  ELSE IF ~useBitBlt THEN
   BEGIN
   i: CARDINAL;
   count: CARDINAL = nBytes - moved;
   FOR i IN [0..count) DO
     toBytes[to.startIndex+i] _ fromBytes[from.startIndex+i];
     ENDLOOP;
   END
  ELSE
   -- BitBlt is not interruptable except at the end of each scan line, so we break things up into chunks in order to maintain reasonable interrupt latency for the IO devices.  It takes about 200microsec to move 50 bytes with the display off.
   BEGIN
   bba: BitBlt.BBTableSpace;
   bbt: BitBlt.BBptr = BitBlt.AlignedBBTable[@bba];
   lineWidth: CARDINAL = 16; -- words per scan line: controls interrupt latency
   bitsPerLine: CARDINAL = lineWidth*Environment.bitsPerWord;
   bytesPerLine: CARDINAL =lineWidth*Environment.bytesPerWord;
   lines: CARDINAL = (nBytes-moved)/bytesPerLine; -- bytes left to move with first BitBlt
   tail: CARDINAL = (nBytes-moved) MOD bytesPerLine; -- bytes left to move with second BitBlt

   bbt^ _ [
     dst: [word: toBytes+to.startIndex/2, bit: 0], dstBpl: bitsPerLine,
     src: [word: fromBytes+from.startIndex/2, bit: 8], srcDesc: [srcBpl[bitsPerLine]],
     width: bitsPerLine, height: lines,
     flags: [direction: forward, disjoint: TRUE, disjointItems: TRUE, gray: FALSE,
     srcFunc: null, dstFunc: null]];

   -- This BitBlt moves a rectangle that is lineWidth words wide by as many lines high as will fit.  NB: It cheats and actually reads a byte from beyond the edge of the rectangle.  This is not really legal, but works out OK for any reasonable inplementation of BitBlt.
   IF lines#0 THEN BitBlt.BITBLT[bbt];

   -- update the pointers to reflect the work done, and then move one line that is less than lineWidth words wide.
   bbt.dst.word _ bbt.dst.word + lines*lineWidth;
   bbt.src.word _ bbt.src.word + lines*lineWidth;
   bbt.width _ Environment.bitsPerByte*tail; bbt.height _ 1;
   IF tail#0 THEN BitBlt.BITBLT[bbt];
   END;
  END;

StartIndexGreaterThanStopIndexPlusOne: PUBLIC ERROR = CODE;

END.




LOG
Time: April 11, 1980  6:37 PM	By: Forrest	Action: Trimmed log to Amargosa; Converted ByteBlt to use PrincOps BitBlt
Time: April 14, 1980  8:39 AM	By: Knutsen	Action: Module STARTed by  InitializeStream.
Time: April 16, 1980  9:07 PM	By: Forrest	Action: Stopped using BitBlt until it is debugged.
Time: April 28, 1980  10:12 AM	By: Forrest	Action: ControlDefs => PrincOps.
ream.
Time: April 16, 1980  9:07 PM	By: Forrest	Action: Stopped using BitBlt until it is debugged.
Time: April 28, 1980  10:12 AM	By: Forrest	Action: ControlDefs => PrincOps.
Time:  9-Mar-81 18:22:25	By: Gobbel	Action: useBitBlt _ TRUE.