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