RoseBasicSequenceImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, September 5, 1985 6:37:22 pm PDT
Spreitzer, November 18, 1985 10:21:25 pm PST
DIRECTORY Basics, BitTwiddling, Convert, ImagerFont, IO, PrincOpsUtils, Real, Rope, RoseBehavior, RoseControl, RoseWireClasses, RoseWireFormats, RoseWireTypes, RoseWireTypeUse, RoseWiring, VFonts;
RoseBasicSequenceImpl:
CEDAR
PROGRAM
IMPORTS BitTwiddling, IO, PrincOpsUtils, Rope, RoseControl, RoseWireFormats, RoseWireTypes, RoseWiring
EXPORTS RoseWireClasses =
BEGIN OPEN RoseWireTypes;
SwitchVal: TYPE = RoseBehavior.SwitchVal;
Level: TYPE = RoseBehavior.Level;
BasicSeqClass: TYPE = REF BasicSeqClassPrivate;
BasicSeqClassPrivate:
TYPE =
RECORD [
rwc: RoseWireClass,
name: ROPE,
repAux: Mesa ← [],
ewc: RoseWireClass,
length: NAT,
leftPad, wordLength: NAT
];
BasicSeqType: TYPE = REF BasicSeqTypePrivate;
BasicSeqTypePrivate:
TYPE =
RECORD [
rwt: RoseWireType,
ewt: RoseWireType
];
GetBasicSequence:
PUBLIC
PROC [prototype: Wire]
RETURNS [rwc: RoseWireClass] = {
name: ROPE = RoseWiring.WireName[prototype];
flavor: WireFlavor = simple;
length: NAT = prototype.elements.size;
cedarTypeName: ROPE = name.Cat[WireFlavorName[flavor]];
ewc: RoseWireClass = RoseWiring.GetWiring[prototype.elements[0], flavor];
eltsPerWord: NAT = Basics.bitsPerWord;
wordLength: NAT = (length + eltsPerWord-1)/eltsPerWord;
bsc: BasicSeqClass ←
NEW [BasicSeqClassPrivate ← [
rwc: NIL,
name: cedarTypeName,
ewc: ewc,
length: length,
leftPad: wordLength*Basics.bitsPerWord - length,
wordLength: wordLength
]];
IF StructureOfWire[prototype] # sequence THEN ERROR;
IF ewc # RoseControl.boolType.class THEN ERROR;
bsc.repAux ← [mesa: NIL];
bsc.rwc ← rwc ←
NEW [RoseWireClassRec ← [
structure: sequence,
dereference: FALSE,
addressContaining: ewc.dereference OR ewc.addressContaining,
classData: bsc,
super: basicSeqSuperClass]];
};
basicSeqSuperClass: RoseWireSuperClass ←
NEW[RoseWireSuperClassRec ← [
GetType: BasicSeqGetType,
ListFormats: BasicSeqListFormats,
GetFormat: BasicSeqGetFormat,
SelectorOffset: BasicSeqSelectorOffset,
SubType: BasicSeqSubType,
SubClass: BasicSeqSubClass,
Bits: BasicSeqBits,
MesaRepresentation: BasicSeqMesaRepresentation,
MesaRepAux: BasicSeqMesaRepAux,
flavor: simple,
Initialize: BasicSeqInitialize,
Transduce: BasicSeqTransduce
]];
BasicSeqGetType:
PROC [rwc: RoseWireClass, wire: Wire]
RETURNS [rwt: RoseWireType] = {
bsc: BasicSeqClass = NARROW[rwc.classData];
bst: BasicSeqType =
NEW [BasicSeqTypePrivate ← [
rwt: rwt ←
NEW [RoseWireTypeRec ← [
class: rwc,
typeData: NIL,
length: bsc.length
]],
ewt: bsc.ewc.super.GetType[bsc.ewc, wire.elements[0]]
]];
rwt.typeData ← bst;
};
BasicSeqListFormats:
PROC [rwt: RoseWireType]
RETURNS [lor:
LOR] = {
lor ← LIST["2", "4", "8", "16", "idiosyncratic"];
};
BasicSeqGetFormat:
PROC [rwt: RoseWireType, formatName:
ROPE]
RETURNS [format: Format] = {
basic: BOOL = rwt.class.super.SubClass[rwt.class, [subscript[0]]].structure = atom;
switch: BOOL = rwt.class.super.flavor = switch;
Do:
PROC [lgBase:
NAT]
RETURNS [format: Format] = {
format ←
(
IF NOT basic THEN RoseWireFormats.constructNumericSequence
ELSE IF switch THEN RoseWireFormats.numericBasicSwitchSequence
ELSE RoseWireFormats.numericBasicSimpleSequence)
[lgBase];
};
format ←
SELECT
TRUE
FROM
formatName.Equal["idiosyncratic"] => RoseWireFormats.constructIdiosyncraticSequence,
formatName.Equal["2"] => Do[1],
formatName.Equal["2"] => Do[2],
formatName.Equal["8"] => Do[3],
formatName.Equal["16"], formatName=NIL => Do[4],
ENDCASE => ERROR;
};
BasicSeqSelectorOffset:
PROC [rwt: RoseWireType, sel: Selector]
RETURNS [dBits:
NAT] = {
bsc: BasicSeqClass = NARROW[rwt.class.classData];
WITH sel
SELECT
FROM
whole => RETURN [0];
field => ERROR;
subscript => RETURN [SuboffI[bsc, index]];
ENDCASE => ERROR;
};
Suboff:
PROC [bsc: BasicSeqClass, i:
NAT]
RETURNS [dBits:
NAT] =
{dBits ← SuboffI[bsc, i]};
SuboffI:
PROC [bsc: BasicSeqClass, i:
NAT]
RETURNS [dBits:
NAT] =
INLINE {
dBits ← bsc.leftPad + i;
};
WordSP: TYPE = LONG POINTER TO WordSeq;
WordSeq: TYPE = RECORD [elts: SEQUENCE length: NAT OF WORD];
BasicSeqSubType:
PROC [rwt: RoseWireType, sel: Selector]
RETURNS [RoseWireType] = {
bst: BasicSeqType = NARROW[rwt.typeData];
WITH sel
SELECT
FROM
whole => RETURN [rwt];
field => ERROR;
subscript => RETURN [bst.ewt];
ENDCASE => ERROR;
};
BasicSeqSubClass:
PROC [rwc: RoseWireClass, sel: Selector]
RETURNS [RoseWireClass] = {
bsc: BasicSeqClass = NARROW[rwc.classData];
WITH sel
SELECT
FROM
whole => RETURN [rwc];
field => ERROR;
subscript => RETURN [bsc.ewc];
ENDCASE => ERROR;
};
BasicSeqBits:
PROC [rwc: RoseWireClass]
RETURNS [n:
INT] = {
bsc: BasicSeqClass = NARROW[rwc.classData];
n ← Basics.bitsPerWord * bsc.wordLength;
};
BasicSeqMesaRepresentation:
PROC [rwc: RoseWireClass]
RETURNS [mesa: Mesa] = {
bsc: BasicSeqClass = NARROW[rwc.classData];
mesa ←
SELECT bsc.wordLength
FROM
=1 => [mesa: "BitOps.BitWord", directory: LIST["BitOps"]],
=2 => [mesa: "BitOps.BitDWord", directory: LIST["BitOps"]],
>2 => [
mesa:
IO.PutFR[
"ARRAY [0 .. %g) OF CARDINAL",
[integer[bsc.wordLength]]
]
],
ENDCASE => ERROR;
};
BasicSeqMesaRepAux:
PROC [rwc: RoseWireClass]
RETURNS [mesa: Mesa] = {
bsc: BasicSeqClass = NARROW[rwc.classData];
mesa ← bsc.repAux;
};
BasicSeqInitialize:
PROC [rwt: RoseWireType, p: Ptr, steady:
BOOL] =
TRUSTED {
bsc: BasicSeqClass = NARROW[rwt.class.classData];
ap: ArrPtr = ToArrPtr[p];
PrincOpsUtils.LongZero[LOOPHOLE[ap], bsc.wordLength];
steady ← steady;
};
ArrPtr: TYPE = LONG POINTER TO ARRAY NAT OF CARDINAL;
ToArrPtr:
PROC [p: Ptr]
RETURNS [ap: ArrPtr] =
TRUSTED {
ap ← p.word;
IF p.bit # 0 THEN ERROR;
};
BasicSeqTransduce:
PROC [fromS: Strength, fromT, toT: RoseWireType, fromP, toP: Ptr] = {
bsc: BasicSeqClass = NARROW[fromT.class.classData];
IF fromT.class.structure # sequence THEN ERROR;
IF toT.class.structure # sequence THEN ERROR;
IF fromT.length # toT.length THEN ERROR;
IF toT.class.super.flavor # switch THEN ERROR;
IF toT.class.dereference THEN toP ← BitTwiddling.DeReferencePtr[toP];
FOR i:
NAT
IN [0 .. bsc.length)
DO
subFrom: Ptr = BitTwiddling.OffsetPtr[fromP, SuboffI[bsc, i]];
sel: Selector = [subscript[i]];
subTo: Ptr = BitTwiddling.OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]];
RoseControl.WriteSwitch[
subTo,
SELECT RoseControl.ReadBool[subFrom]
FROM
FALSE => [s: [q: fromS, u: none, d: fromS], val: L],
TRUE => [s: [q: fromS, u: fromS, d: none], val: H],
ENDCASE => ERROR
];
ENDLOOP;
toT ← toT;
};
END.