DisplayControllersImpl:
CEDAR
PROGRAM
IMPORTS Basics, CharDisplays, IO, RefText, Rope
EXPORTS DisplayControllers
= {OPEN DisplayControllers;
neverMind: Action ¬ [proc: Naught, overrideable: TRUE];
print: Action ¬ [proc: Print, overrideable: TRUE];
displayDriverClass: ATOM = $TermEmDisplayController;
displayDriverProcs:
REF
IO.StreamProcs ¬
IO.CreateStreamProcs[
variety: output,
class: displayDriverClass,
flush: FlushDisplay,
putChar: ConsumeChar,
putBlock: ConsumeChars
];
Create:
PUBLIC
PROC [cd: CharDisplay, cp: ControlProgram]
RETURNS [dc: DisplayController] = {
dc ¬
NEW [DisplayControllerRep ¬ [
cd: cd,
cp: cp,
cps:
NEW [ControlProgramStateRep ¬ [
curVertex: cp.start,
chars: RefText.New[10]]],
toDisplay: NIL,
fromDisplay: cd.fromDisplay
]];
IF cp.Init # NIL THEN cp.Init[dc];
dc.toDisplay ¬ IO.CreateStream[streamProcs: displayDriverProcs, streamData: dc];
};
SetDriver:
PUBLIC
PROC [dc: DisplayController, driver:
IO.
STREAM] = {
dc.driver ¬ driver;
};
FlushDisplay:
PROC [self:
IO.
STREAM] = {
dc: DisplayController = NARROW[self.streamData];
IF dc.cd.class.Destroyed[dc.cd] THEN ERROR IO.Error[StreamClosed, self];
IF dc.cd.class.Flush # NIL THEN dc.cd.class.Flush[dc.cd];
};
ConsumeChar:
PROC [self:
IO.
STREAM, char:
CHAR] = {
dc: DisplayController ¬ NARROW[self.streamData];
consumed: BOOL ¬ FALSE;
IF dc.cd.class.Destroyed[dc.cd] THEN ERROR IO.Error[StreamClosed, self];
SELECT dc.cp.bits
FROM
7 => char ¬ VAL[Basics.BITAND[ORD[char], 127]];
8 => NULL;
ENDCASE => ERROR;
IF dc.cps.curVertex = dc.cp.start THEN dc.cps.chars.length ¬ 0;
WHILE dc.cps.chars.length >= dc.cps.chars.maxLength DO dc.cps.chars ¬ RefText.New[dc.cps.chars.maxLength*2] ENDLOOP;
dc.cps.chars ¬ RefText.InlineAppendChar[dc.cps.chars, char];
DO
ENABLE CharDisplays.DisplayDestroyed => ERROR IO.Error[StreamClosed, self];
Do:
PROC [t: Transition] =
INLINE {
t.action.proc[dc: dc, clientData: t.action.clientData];
dc.cps.curVertex ¬ t.newVertex};
v: Vertex ¬ dc.cps.curVertex;
SELECT v.repStyle
FROM
epsilon => Do[v.t];
list => {
el: EdgeList ¬ NIL;
IF consumed THEN EXIT;
consumed ¬ TRUE;
FOR el ¬ v.edgeList, el.rest
WHILE el #
NIL
DO
IF el.first.char = char THEN {Do[el.first.transition]; EXIT};
ENDLOOP;
IF el = NIL THEN Do[v.t];
};
array => {
IF consumed THEN EXIT;
consumed ¬ TRUE;
Do[v.edgeArray[char]];
};
ENDCASE => ERROR;
ENDLOOP;
Consider Flushing:
{driver: IO.STREAM = dc.driver;
flush: BOOL ¬ driver = NIL;
IF NOT flush THEN flush ¬ driver.CharsAvail[!IO.Error => {flush ¬ TRUE; CONTINUE}] = 0;
IF flush AND dc.cd.class.Flush # NIL THEN dc.cd.class.Flush[dc.cd];
};
};
ConsumeChars:
PROC [self:
IO.STREAM, block:
REF
READONLY
TEXT, startIndex:
NAT ¬ 0, count:
NAT ¬
NAT.LAST] = {
ENABLE CharDisplays.DisplayDestroyed => ERROR IO.Error[StreamClosed, self];
dc: DisplayController ¬ NARROW[self.streamData];
IF startIndex+count > block.maxLength THEN count ¬ block.length - startIndex;
FOR i:
INT
IN [startIndex..startIndex+count)
DO
char: CHAR ¬ block[i];
consumed: BOOL ¬ FALSE;
IF dc.cd.class.Destroyed[dc.cd] THEN ERROR IO.Error[StreamClosed, self];
SELECT dc.cp.bits
FROM
7 => char ¬ VAL[Basics.BITAND[ORD[char], 127]];
8 => NULL;
ENDCASE => ERROR;
IF dc.cps.curVertex = dc.cp.start THEN dc.cps.chars.length ¬ 0;
WHILE dc.cps.chars.length >= dc.cps.chars.maxLength DO dc.cps.chars ¬ RefText.New[dc.cps.chars.maxLength*2] ENDLOOP;
dc.cps.chars ¬ RefText.InlineAppendChar[dc.cps.chars, char];
DO
Do:
PROC [t: Transition] =
INLINE {
t.action.proc[dc: dc, clientData: t.action.clientData];
dc.cps.curVertex ¬ t.newVertex};
v: Vertex ¬ dc.cps.curVertex;
SELECT v.repStyle
FROM
epsilon => Do[v.t];
list => {
el: EdgeList ¬ NIL;
IF consumed THEN EXIT;
consumed ¬ TRUE;
FOR el ¬ v.edgeList, el.rest
WHILE el #
NIL
DO
IF el.first.char = char THEN {Do[el.first.transition]; EXIT};
ENDLOOP;
IF el = NIL THEN Do[v.t];
};
array => {
IF consumed THEN EXIT;
consumed ¬ TRUE;
Do[v.edgeArray[char]];
};
ENDCASE => ERROR;
ENDLOOP;
ENDLOOP;
-- Consider flushing
IF dc.cd.class.Flush #
NIL
THEN {
IF (dc.driver#NIL) AND (dc.driver.CharsAvail[!IO.Error=>CONTINUE] >0 ) THEN RETURN;
dc.cd.class.Flush[dc.cd]
}
};
NewControlProgram:
PUBLIC
PROC [
Init:
PROC [dc: DisplayController] ¬
NIL, clientData:
REF
ANY ¬
NIL, bits: [7 .. 8] ¬ 8]
RETURNS [cp: ControlProgram] = {
sv: Vertex ¬ NEW [VertexRep ¬ [repStyle: array]];
sv.edgeArray ¬ NEW [TransitionArrayRep ¬ ALL[[print, sv]]];
cp ¬
NEW [ControlProgramRep ¬ [
start: sv,
Init: Init,
clientData: clientData,
bits: bits]];
};
AddInstruction:
PUBLIC
PROC [cp: ControlProgram, steps: StepList, final: Action] = {
v: Vertex ¬ cp.start;
FOR steps ¬ steps, steps.rest
WHILE steps #
NIL
DO
lastStep: BOOL ¬ steps.rest = NIL;
WITH steps.first
SELECT
FROM
t:
REFTEXT => {
lastI: INT = t.length-1;
FOR i:
INT
IN [0 .. lastI]
DO
IF lastStep
AND i=lastI
THEN v ¬ Merge[cp: cp, char: t[i], v: v, last: TRUE, a: final]
ELSE v ¬ Merge[cp: cp, char: t[i], v: v, last: FALSE];
ENDLOOP;
IF lastStep THEN final ¬ neverMind;
};
r:
ROPE => {
lastI: INT = r.Length[]-1;
FOR i:
INT
IN [0 .. lastI]
DO
IF lastStep
AND i=lastI
THEN v ¬ Merge[cp: cp, char: r.Fetch[i], v: v, last: TRUE, a: final]
ELSE v ¬ Merge[cp: cp, char: r.Fetch[i], v: v, last: FALSE];
ENDLOOP;
IF lastStep THEN final ¬ neverMind;
};
d: Decode => {
IF d.len = 0
THEN {
dec0: Action ¬ DecodeAction[d, 0];
dec1: Action ¬ DecodeAction[d, 1];
IF lastStep THEN ERROR;
v ¬ MergeDigits[d: d, cp: cp, last: FALSE, a: dec0, v: v];
IF v # MergeDigits[d: d, cp: cp, last: FALSE, to: v, a: dec1, v: v] THEN ERROR;
}
ELSE {
FOR i:
INT
IN [0 .. d.len)
DO
dec: Action ¬ DecodeAction[d, i];
v ¬ MergeDigits[d: d, cp: cp, last: lastStep AND i=d.len-1 AND final=neverMind, a: dec, v: v];
ENDLOOP;
};
};
ENDCASE => ERROR;
IF (v = cp.start) # (lastStep AND final = neverMind) THEN ERROR;
ENDLOOP;
IF final # neverMind
THEN {
IF v = cp.start THEN ERROR;
v ¬ Append[cp: cp, a: final, from: v, to: cp.start]};
IF v # cp.start THEN ERROR;
};
Replaceable:
PROC [cp: ControlProgram, t: Transition, from: Vertex, a: Action]
RETURNS [boring:
BOOL] = {
boring ¬ t.action.overrideable OR ActionEqual[t.action, a]};
ActionEqual:
PROC [a1, a2: Action]
RETURNS [eq:
BOOL] = {
IF a1.proc # a2.proc THEN RETURN [FALSE];
IF a1.clientData = a1.clientData THEN RETURN [TRUE];
WITH a1.clientData
SELECT
FROM
dd1: DecodeData =>
WITH a2.clientData
SELECT
FROM
dd2: DecodeData => RETURN [dd1.i = dd2.i AND dd1.d = dd2.d];
ENDCASE => RETURN [FALSE];
ENDCASE => RETURN [FALSE];
};
AddEpsilon:
PROC [t: Transition, a: Action]
RETURNS [u: Transition] = {
u ¬ [
action: a,
newVertex: NEW [VertexRep ¬ [epsilon, t]]
]};
MergeDigits:
PROC
[
d: Decode,
cp: ControlProgram,
last: BOOL,
to: Vertex ¬ NIL,
a: Action,
v: Vertex]
RETURNS [newV: Vertex] = {
deltaMax: NAT ¬ MIN[(LAST[CHAR] - d.org), d.base-1];
newV ¬ to;
FOR c:
CHAR
IN [d.org .. d.org + deltaMax]
DO
xc: CHAR ¬ 0C + XOR[c-0C, d.xor];
ans: Vertex ¬ Merge[cp: cp, last: last, char: xc, to: newV, a: a, v: v];
IF newV = NIL THEN newV ¬ ans ELSE IF newV # ans THEN ERROR;
ENDLOOP;
};
Append:
PROC [cp: ControlProgram, a: Action, from, to: Vertex ¬
NIL]
RETURNS [newV: Vertex] = {
IF NOT (from.repStyle = list AND from.edgeList = NIL AND from.t = [print, cp.start]) THEN ERROR;
from.repStyle ¬ epsilon;
IF to #
NIL
THEN {
IF to # from.t.newVertex THEN ERROR;
from.t.action ¬ a;
newV ¬ from.t.newVertex;
}
ELSE {
newV ¬ NEW [VertexRep ¬ [repStyle: list, t: [print, cp.start]]];
from.t ¬ [a, newV];
};
};
Merge:
PROC
[
cp: ControlProgram,
last: BOOL,
char: CHAR,
to: Vertex ¬ NIL,
a: Action ¬ neverMind,
v: Vertex]
RETURNS [newV: Vertex]
= {
NextV:
PROC
RETURNS [v: Vertex] = {
v ¬
IF to #
NIL
THEN to
ELSE NEW [VertexRep ¬ [repStyle: list, t: DefaultEnd[cp]]];
};
Update:
PROC [oldT: Transition]
RETURNS [newT: Transition] = {
oldNext: Vertex ¬ oldT.newVertex;
rbl: BOOL ¬ Replaceable[cp, oldT, v, a];
IF oldNext # to
THEN {
IF to # NIL AND ((NOT rbl) OR oldNext # cp.start) THEN ERROR;
IF to = NIL AND (NOT rbl) AND (oldNext = cp.start OR NOT a.overrideable) THEN ERROR;
};
newT ¬ oldT;
IF rbl
THEN {
IF oldNext = cp.start OR to # NIL THEN newT ¬ [a, NextV[]] ELSE newT.action ¬ a;
}
ELSE IF to # NIL AND NOT a.overrideable THEN newT ¬ AddEpsilon[newT, a];
};
IF last
THEN {
IF to = NIL THEN to ¬ cp.start ELSE IF to # cp.start THEN ERROR;
IF a = neverMind THEN a ¬ print;
};
SELECT v.repStyle
FROM
epsilon => ERROR;
list => {
el: EdgeList ¬ NIL;
FOR el ¬ v.edgeList, el.rest
WHILE el #
NIL
DO
IF el.first.char = char THEN EXIT;
ENDLOOP;
IF el = NIL THEN v.edgeList ¬ el ¬ CONS[[char: char, transition: v.t], v.edgeList];
newV ¬ (el.first.transition ¬ Update[el.first.transition]).newVertex;
};
array => {
newV ¬ (v.edgeArray[char] ¬ Update[v.edgeArray[char]]).newVertex;
};
ENDCASE => ERROR;
DO
SELECT newV.repStyle
FROM
epsilon => newV ¬ newV.t.newVertex;
list, array => EXIT;
ENDCASE => ERROR;
ENDLOOP;
IF last AND newV # cp.start THEN ERROR;
};
DefaultEnd:
PROC [cp: ControlProgram]
RETURNS [t: Transition] =
{t ¬ [action: print, newVertex: cp.start]};
ClearRegAction:
PROC [d: Decode]
RETURNS [a: Action] =
{a ¬ [proc: ClearReg, clientData: d]};
ClearReg:
PROC [dc: DisplayController, clientData:
REF
ANY] = {
d: Decode ¬ NARROW[clientData];
dc.cps.regs[d.reg] ¬ d.offset};
DecodeData: TYPE = REF DecodeDataRep;
DecodeDataRep:
TYPE =
RECORD [
d: Decode,
i: NAT];
DecodeAction:
PROC [d: Decode, i:
NAT]
RETURNS [a: Action] =
{a ¬ [proc: DecodeReg, clientData: NEW [DecodeDataRep ¬ [d, i]]]};
DecodeReg:
PROC [dc: DisplayController, clientData:
REF
ANY] = {
dd: DecodeData ¬ NARROW[clientData];
c: CHAR ¬ dc.cps.chars[dc.cps.chars.length-1];
IF dd.i = 0 THEN dc.cps.regs[dd.d.reg] ¬ dd.d.offset;
dc.cps.regs[dd.d.reg] ¬
(dc.cps.regs[dd.d.reg] - dd.d.offset) * dd.d.base
+ (XOR[c-0C, dd.d.xor] - (dd.d.org - 0C))
+ dd.d.offset;
};
XOR:
PROC [i1, i2:
INTEGER]
RETURNS [i3:
INTEGER] =
TRUSTED {i3 ¬ Basics.BITXOR[i1, i2]};
Naught: PUBLIC PROC [dc: DisplayController, clientData: REF ANY] = {};
Print:
PUBLIC
PROC [dc: DisplayController, clientData:
REF
ANY] = {
Do: PROC [c: CHAR] = INLINE {dc.cd.class.TakeChar[dc.cd, c, dc.cps.modes[insert]]};
FOR i: INT IN [0 .. dc.cps.chars.length) DO Do[dc.cps.chars[i]] ENDLOOP;
};
}.