DIRECTORY Basics, CirioMemory, CirioNubAccess, IntHashTable, IO, LoadStateAccess, Rope, SymTab;

CirioMemoryImpl: CEDAR PROGRAM
IMPORTS Basics, CirioMemory, CirioNubAccess, IntHashTable, IO, Rope, SymTab
EXPORTS CirioMemory

= BEGIN OPEN CirioMemory, LSA:LoadStateAccess;

Error: PUBLIC ERROR [msg: ROPE] ~ CODE;

PtrRegName: ARRAY PtrReg OF ROPE
~ [fp: "fp", sp: "sp", fe: "fe"];

BaAsAbs: PUBLIC PROC [ba: BitAddr] RETURNS [BitAddr] ~ {
IF ba.bits<0 THEN {
ba.bits ¬ ba.bits + bitsPerAu;
ba.aus ¬ ba.aus - 1;
IF ba.bits<0 THEN Error["asked to absify a broken BitAddr"];
};
RETURN[ba]};

BaCompare: PUBLIC PROC [a, b: BitAddr] RETURNS [Basics.Comparison] ~ {
a ¬ BaAsAbs[a];
b ¬ BaAsAbs[b];
SELECT TRUE FROM
a.aus < b.aus => RETURN [less];
a.aus > b.aus => RETURN [greater];
a.bits < b.bits => RETURN [less];
a.bits > b.bits => RETURN [greater];
ENDCASE => RETURN [equal]};

BsCompose: PUBLIC PROC [main, inner: BitStretch] RETURNS [within: BOOL, compd: BitStretch] ~ {
compd ¬ [main.start.BaAdd[inner.start], IF inner.size=unspecdBA AND main.size#unspecdBA THEN main.size.BaSub[inner.start] ELSE inner.size];
SELECT TRUE FROM
BaCompare[inner.size, zeroBA]<equal => within ¬ FALSE;
main.size=unspecdBA => within ¬ TRUE;
BaCompare[inner.start, zeroBA]<equal => within ¬ FALSE;
inner.size=unspecdBA => within ¬ TRUE;
ENDCASE => within ¬ BaCompare[inner.start.BaAdd[inner.size], main.size]<=equal;
RETURN};

MemIndirect: PUBLIC PROC [mem: Mem, size: BitAddr ¬ unspecdBA, offset: BitAddr ¬ zeroBA] RETURNS [Mem] ~ {
base: CARD ~ mem.MemRead[bitsPerPtr, zeroBA];
RETURN mem.class.CreateSimple[mem.data, [start: PtrToBa[base].BaAdd[offset], size: size], FALSE]};

MemPtrRegIndirect: PUBLIC PROC [mem: Mem, ptrReg: PtrReg, size, offset: BitAddr, keepFrame: BOOL] RETURNS [Mem] ~ {
ptrVal: BitStretch ~ mem.MemReadPtrReg[ptrReg];
sub: BitStretch;
within: BOOL;
[within, sub] ¬ BsCompose[ptrVal, [start: offset, size: size]];
IF NOT within THEN Error["MemPtrRegIndirecting out of bounds"];
RETURN mem.class.CreateSimple[mem.data, sub, keepFrame]};

MemSelectSegment: PUBLIC PROC [mem: Mem, segName: ROPE, segNum: INT, keepFrame: BOOL] RETURNS [Mem] ~ {
seg: BitStretch ~ mem.MemReadSegReg[segName, segNum];
RETURN mem.class.CreateSimple[mem.data, seg, keepFrame]};

UMem: TYPE = REF UMemPrivate;
UMemPrivate: TYPE ~ RECORD [
nub: CirioNubAccess.Handle,
ptrs: ARRAY PtrReg OF BitStretch,
segTables: SymTab.Ref--segName -> IntHashTable.Table(segNum -> REF BitStretch)--,
rawStart, rawSize: BitAddr];

AintSimple: PROC [um: UMem] RETURNS [BOOL]
~ INLINE {RETURN[um.rawStart=unspecdBA]};

CreateSimpleMem: PUBLIC PROC[addr: CirioNubAccess.RemoteAddress, size: BitAddr ¬ unspecdBA] RETURNS[Mem] = {
um: UMem;
rawStart: BitAddr ¬ BaCons[addr.byteAddress, addr.bitOffset].BaAsAbs;
IF rawStart=unspecdBA OR addr.nil OR NOT addr.valid THEN Error["trying to construct bogus Simple Mem in RMTWFrames"];
um ¬ NEW [UMemPrivate ¬ [
nub: addr.h,
ptrs: ALL[[unspecdBA, unspecdBA]],
segTables: SymTab.Create[--case?--],
rawStart: rawStart,
rawSize: size.BaAsAbs]];
RETURN[[uMemClass, um]]};

MakeDualMem: PUBLIC PROC [nub: CirioNubAccess.Handle, fp, sp: CARD, text, data, bss, fep, simple: BitStretch] RETURNS [mem: Mem] ~ {
um: UMem ¬ NEW [UMemPrivate ¬ [
nub: nub,
ptrs: [
fp: [IF fp=invalidPtr THEN unspecdBA ELSE PtrToBa[fp], unspecdBA],
sp: [IF sp=invalidPtr THEN unspecdBA ELSE PtrToBa[sp], unspecdBA],
fe: fep],
segTables: SymTab.Create[--case?--],
rawStart: simple.start,
rawSize: simple.size ]];
mem ¬ [uMemClass, um];
IF text#unspecdBS THEN mem ¬ UAddSegReg[mem, "text", 0, text];
IF data#unspecdBS THEN mem ¬ UAddSegReg[mem, "data", 0, data];
IF bss#unspecdBS THEN mem ¬ UAddSegReg[mem, "bss", 0, bss];
RETURN};

UAddSegReg: PROC [mem: Mem, segName: ROPE, segNum: INT, val: BitStretch] RETURNS [--same--Mem] ~ {
um: UMem ~ NARROW[mem.data];
segTable: IntHashTable.Table ¬ NARROW[um.segTables.Fetch[segName].val];
IF segTable=NIL THEN IF NOT um.segTables.Insert[segName, segTable ¬ IntHashTable.Create[]] THEN ERROR;
IF NOT segTable.Insert[segNum, NEW[BitStretch ¬ val]] THEN Error["redefining segment register"];
RETURN[mem]};

uMemClass: MemClass ¬ NEW[MemClassPrivate ¬ [UCreateSimple, USubfield, UShift, UGetStretch, URead, UWrite, UReadPtrReg, UReadSegmentReg, USetPtrReg]];

UCreateSimple: PROC [data: REF ANY, stretch: BitStretch, keepFrame: BOOL] RETURNS [Mem] ~ {
oldUm: UMem ~ NARROW[data];
new: Mem ¬ CreateSimpleMem[[h: oldUm.nub, byteAddress: stretch.start.aus, bitOffset: stretch.start.bits, nil: FALSE, valid: TRUE], stretch.size];
newUm: UMem ¬ NARROW[new.data];
CopySegReg: PROC [segName: ROPE, segNum: INT, val: BitStretch] RETURNS [BOOL]
~ {[] ¬ UAddSegReg[new, segName, segNum, val]; RETURN[FALSE]};
IF keepFrame THEN {
newUm.ptrs ¬ oldUm.ptrs;
IF UScanSegmentRegs[oldUm, CopySegReg].found THEN ERROR};
RETURN[new]};

USubfield: PROC [data: REF ANY, rel: BitStretch] RETURNS [Mem] ~ {
oldUm: UMem ~ NARROW[data];
newUm: UMem ~ NEW [UMemPrivate ¬ oldUm­];
within: BOOL;
IF AintSimple[oldUm] THEN Error["subfield of non-Simple Mem"];
[within, [newUm.rawStart, newUm.rawSize]] ¬ BsCompose[[oldUm.rawStart, oldUm.rawSize], rel];
IF NOT within THEN Error["taking subfield that extends outside main"];
RETURN[[uMemClass, newUm]]};

UShift: PROC [data: REF ANY, offset: BitAddr] RETURNS [Mem] ~ {
oldUm: UMem ~ NARROW[data];
newUm: UMem ~ NEW [UMemPrivate ¬ oldUm­];
IF AintSimple[oldUm] THEN Error["shift of non-Simple Mem"];
newUm.rawStart ¬ newUm.rawStart.BaAdd[offset];
RETURN[[uMemClass, newUm]]};

UGetStretch: PROC [data: REF ANY] RETURNS [BitStretch] ~ {
um: UMem ~ NARROW[data];
IF AintSimple[um] THEN Error["GetStretch of non-Simple Mem"];
RETURN[[um.rawStart, um.rawSize]]};

URead: PROC [data: REF ANY, bitSize: CARD, offset: BitAddr] RETURNS [CARD] ~ {
um: UMem ~ NARROW[data];
readStart, readSize: BitAddr;
lmask, ans: CARD;
within: BOOL;
afterLastBit: CARD;
IF AintSimple[um] THEN Error["Read of non-Simple Mem"];
IF bitSize=0 THEN RETURN [0];
IF bitSize > 32 THEN Error["trying to read more than 32 bits at once"];
IF um.rawStart=zeroBA THEN Error["trying to read from NIL address"];
[within, [readStart, readSize]] ¬ BsCompose[[um.rawStart, um.rawSize], [offset, BitsToBa[bitSize]]];
readStart ¬ WordAlign[readStart];
IF NOT within THEN Error["trying to read outside of bounds"];
lmask ¬ Basics.BITRSHIFT[CARD.LAST, readStart.bits];
afterLastBit ¬ readStart.bits+bitSize;
ans ¬ CirioNubAccess.Read32BitsAsCard[[um.nub, readStart.aus, 0, readStart.aus=0, TRUE]]; --doesn't work right with non-0 bitOffset
ans ¬ Basics.BITAND[ans, lmask];
IF afterLastBit>32 THEN {
ans2: CARD ~ CirioNubAccess.Read32BitsAsCard[[um.nub, readStart.aus+4, 0, readStart.aus+4=0, TRUE]];
ans ¬ Basics.BITOR[
Basics.BITLSHIFT[ans, afterLastBit-32],
Basics.BITRSHIFT[ans2, 64-afterLastBit] ];
RETURN[ans]};
IF afterLastBit<32 THEN ans ¬ Basics.BITRSHIFT[ans, 32-afterLastBit];
RETURN[ans]};

UWrite: PROC [data: REF ANY, bits: CARD, bitSize: CARD, offset: BitAddr] ~ {
um: UMem ~ NARROW[data];
writeStart, writeSize: BitAddr;
afterLastBit: CARD;
within: BOOL;
IF AintSimple[um] THEN Error["Write of non-Simple Mem"];
IF bitSize=0 THEN RETURN;
IF bitSize > 32 THEN Error["trying to write more than 32 bits at once"];
IF um.rawStart=zeroBA THEN Error["trying to write to NIL address"];
[within, [writeStart, writeSize]] ¬ BsCompose[[um.rawStart, um.rawSize], [offset, BitsToBa[bitSize]]];
IF NOT within THEN Error["trying to write outside of bounds"];
writeStart ¬ WordAlign[writeStart];
IF (afterLastBit ¬ writeStart.bits+bitSize) > 32 THEN {--split across two words
lMaskNew: CARD ~ Basics.BITRSHIFT[CARD.LAST, writeStart.bits];
rMaskNew: CARD ~ Basics.BITLSHIFT[CARD.LAST, 64-afterLastBit];
lInsNew: CARD ~ Basics.BITRSHIFT[bits, afterLastBit-32];
rInsNew: CARD ~ Basics.BITLSHIFT[bits, 64-afterLastBit];
lOld: CARD ~ CirioNubAccess.Read32BitsAsCard[[um.nub, writeStart.aus, 0, writeStart.aus=0, TRUE]];
rOld: CARD ~ CirioNubAccess.Read32BitsAsCard[[um.nub, writeStart.aus+4, 0, writeStart.aus+4=0, TRUE]];
lNew: CARD ~ Basics.BITOR[Basics.BITAND[lInsNew, lMaskNew], Basics.BITAND[lOld, Basics.BITNOT[lMaskNew]]];
rNew: CARD ~ Basics.BITOR[Basics.BITAND[rInsNew, rMaskNew], Basics.BITAND[rOld, Basics.BITNOT[rMaskNew]]];
CirioNubAccess.WriteCardAs32Bits[[um.nub, writeStart.aus, 0, FALSE, TRUE], lNew];
CirioNubAccess.WriteCardAs32Bits[[um.nub, writeStart.aus+4, 0, FALSE, TRUE], rNew];
RETURN}
ELSE {
hmn: CARD ~ 2**(bitSize-1);
maskNew: CARD ~ Basics.BITLSHIFT[hmn+(hmn-1), 32-afterLastBit];
insNew: CARD ~ Basics.BITLSHIFT[bits, 32-afterLastBit];
old: CARD ~ CirioNubAccess.Read32BitsAsCard[[um.nub, writeStart.aus, 0, writeStart.aus=0, TRUE]];
new: CARD ~ Basics.BITOR[Basics.BITAND[insNew, maskNew], Basics.BITAND[old, Basics.BITNOT[maskNew]]];
CirioNubAccess.WriteCardAs32Bits[[um.nub, writeStart.aus, 0, FALSE, TRUE], new];
RETURN};
};

WordAlign: PROC [ba: BitAddr] RETURNS [BitAddr] ~ {
rem: CARD;
ba ¬ ba.BaAsAbs[];
rem ¬ ba.aus MOD 4;
ba.aus ¬ ba.aus - rem;
ba.bits ¬ ba.bits + rem*8;
RETURN[ba]};

UReadPtrReg: PROC [data: REF ANY, ptrReg: PtrReg] RETURNS [BitStretch] ~ {
um: UMem ~ NARROW[data];
bs: BitStretch ~ um.ptrs[ptrReg];
IF bs.start=unspecdBA THEN Error[Rope.Cat["reading undefined pointer register (", PtrRegName[ptrReg], ")"]];
IF bs.start.bits#0 THEN Error[Rope.Cat["found non-AU-aligned pointer! (", PtrRegName[ptrReg], ")"]];
RETURN[bs]};

UReadSegmentReg: PROC [data: REF ANY, segName: ROPE, segNum: INT] RETURNS [BitStretch] ~ {
um: UMem ~ NARROW[data];
segTable: IntHashTable.Table ~ NARROW[um.segTables.Fetch[segName].val];
rbs: REF BitStretch;
IF segTable=NIL THEN Error[IO.PutFR["trying to read non-existing segment register (for \"%q\" (#%g))", [rope[segName]], [integer[segNum]] ]];
rbs ¬ NARROW[segTable.Fetch[segNum].value];
IF rbs=NIL THEN Error[IO.PutFR["trying to read non-existing segment register (for #%g of \"%q\")", [integer[segNum]], [rope[segName]] ]];
RETURN[rbs­]};

USetPtrReg: PROC [data: REF ANY, ptrReg: PtrReg, val: BitStretch] ~ {
um: UMem ~ NARROW[data];
um.ptrs[ptrReg] ¬ val;
RETURN};

UScanSegmentRegs: PROC [data: REF ANY, Consume: PROC [segName: ROPE, segNum: INT, val: BitStretch] RETURNS [BOOL]] RETURNS [found: BOOL ¬ FALSE, itsName: ROPE ¬ NIL, itsNum: INT ¬ 0] ~ {
um: UMem ~ NARROW[data];
PerSegTable: PROC [key: ROPE, val: REF ANY] RETURNS [quit: BOOL ¬ FALSE] ~ {
segName: ROPE ~ key;
segTable: IntHashTable.Table ~ NARROW[val];
PerSeg: PROC [key: INT, value: REF ANY] RETURNS [quit: BOOL] ~ {
rbs: REF BitStretch ~ NARROW[value];
IF Consume[segName, key, rbs­] THEN {
found ¬ TRUE;
itsName ¬ segName;
itsNum ¬ key};
RETURN[found]};
[] ¬ segTable.Pairs[PerSeg];
RETURN[found]};
IF um.segTables#NIL THEN [] ¬ um.segTables.Pairs[PerSegTable];
RETURN};

END.
š
CirioMemoryImpl.mesa
Copyright Σ 1991, 1992 by Xerox Corporation.  All rights reserved.
Laurie Horton, September 20, 1991 8:36 am PDT
Last tweaked by Mike Spreitzer April 24, 1992 12:27 pm PDT
Philip James, February 24, 1992 9:59 am PST
Willie-s, May 14, 1992 2:22 pm PDT
Note: ABS[bits] < bitsPerAu.
Note: 0 <= bits < bitsPerAu.
MJS, May 23, 1991: As I write this for the first time, I am aware of no constraints on how I treat negatively-sized stretches, as I don't expect them to appear.
MJS, May 25, 1991: when main.size=unspecdBA, this is a base address from which negative offsets are valid (ie, may be within).
These cover both Simple and Frame Mems.
Κ–
(cedarcode) style•NewlineDelimiter

™
code™Kšœ
Οe
œ7™BK™-K™:K™+K™"—K˜KšΟk	œ4žœ ˜_K˜šΟnœžœ
ž˜Kšžœ4žœ˜KKšžœ˜—K˜Kšœžœ
žœžœ˜.K˜Kš
Ÿœžœ
žœžœžœ
˜'K˜šŸ
œžœžœ
ž˜ K˜!—K˜šŸœžœ
žœžœ˜8šžœžœ˜K˜K˜Kšžœžœ+˜<K˜—Kšžœ˜—K˜šŸ	œžœ
žœžœ˜FKšœžœ™K˜K˜Kš
œ™šžœ
žœ
ž˜Kšœžœ˜Kšœžœ˜"Kšœžœ˜!Kšœžœ˜$Kšžœžœ
˜——K˜š
Ÿ	œžœ
žœžœ
žœ˜^Kš	œ(žœžœžœžœ
˜‹
šžœ
žœ
ž˜Kšœ0žœ
˜6Kšœ žœ
˜%Kšœ1žœ
˜7Kšœ!žœ
˜&KšžœH˜OK™ 
Kš
œ~™~—Kšžœ˜—K˜šŸœžœ
žœAžœ
˜jKšœžœ#˜-KšžœTžœ˜b—K˜š
Ÿœžœ
žœ>žœžœ
˜sKš
œ/˜/K˜Kšœžœ
˜
K˜?Kšžœ
žœžœ-˜?Kšžœ3˜9—K˜šŸœžœ
žœžœ
žœ
žœžœ
˜gKš
œ5˜5Kšžœ3˜9—K˜Kšœžœžœ
˜šœ
žœžœ˜K˜Kšœžœžœ˜!KšœΟc;œ
˜QKš
œ˜K™'—K˜šŸ
œžœžœžœ
˜*Kšœžœžœ˜)—K˜šŸœžœ
žœ@žœ	˜lKš
œ	˜	K˜EKš
žœžœ
žœ
žœžœ=˜ušœžœ˜K˜Kšœžœ˜"Kšœ 	œ˜$Kš
œ˜Kš
œ˜—Kšžœ˜—K˜š
Ÿœžœ
žœ&žœ,žœ˜„
šœžœ˜K˜	˜Kšœžœžœžœ˜BKšœžœžœžœ˜BKš
œ	˜	—Kšœ 	œ˜$K˜K˜—K˜Kšžœžœ(˜>Kšžœžœ(˜>Kšžœžœ&˜;Kšžœ˜—K˜šŸ
œžœžœ
žœžœ œ˜bKšœžœ˜Kšœžœ"˜GKšžœ
žœ
žœ
žœ
žœ@žœ
žœ
˜fKšžœ
žœžœžœ&˜`Kšžœ˜
—K˜Kšœžœ}˜–
K˜šŸ
œžœžœ
žœ"žœžœ
˜[Kšœžœ˜Kšœnžœ	žœ˜‘
Kšœžœ˜šŸ
œžœžœ
žœžœžœ
˜MKšœ/žœ
žœ˜>—šžœžœ˜K˜Kšžœ+žœ
žœ˜9—Kšžœ˜
—K˜š
Ÿ	œžœžœ
žœžœ
˜BKšœžœ˜Kšœžœ˜)Kšœžœ
˜
Kšžœžœ%˜>K˜\Kšžœ
žœžœ4˜FKšžœ˜—K˜š
Ÿœžœžœ
žœžœ
˜?Kšœžœ˜Kšœžœ˜)Kšžœžœ"˜;K˜.Kšžœ˜—K˜š
Ÿœžœžœ
žœžœ˜:Kšœžœ˜Kšžœžœ'˜=Kšžœ˜#—K˜šŸœžœžœ
žœžœžœžœ˜NKšœžœ˜K˜Kšœžœ
˜Kšœžœ
˜
Kšœžœ
˜Kšžœžœ!˜7Kšžœžœ
žœ˜Kšžœžœ3˜GKšžœžœ*˜DK˜dK˜!Kšžœ
žœžœ+˜=Kšœž	œ
žœ
žœ˜4K˜&KšœRžœ )˜ƒ
Kšœ
žœ
˜ šžœžœ˜KšœžœSžœ˜dšœ
žœ
˜Kšœž	œ˜'Kšœž	œ˜*—Kšžœ˜
—Kšžœžœž	œ˜EKšžœ˜
—K˜šŸœžœžœ
žœžœžœ˜LKšœžœ˜K˜Kšœžœ
˜Kšœžœ
˜
Kšžœžœ"˜8Kšžœžœ
žœ
˜Kšžœžœ4˜HKšžœžœ)˜CK˜fKšžœ
žœžœ,˜>K˜#šžœ/žœ ˜OKš	œ
žœ
ž	œ
žœ
žœ˜>Kš	œ
žœ
ž	œ
žœ
žœ˜>Kšœ	žœ
ž	œ˜8Kšœ	žœ
ž	œ˜8KšœžœQžœ˜bKšœžœUžœ˜fKšœžœ
žœžœžœžœ
˜jKšœžœ
žœžœžœžœ
˜jKšœ=žœžœ	˜QKšœ?žœžœ	˜SKšžœ
˜—šžœ˜Kšœžœ˜Kšœ	žœ
ž	œ˜?Kšœžœ
ž	œ˜7KšœžœQžœ˜aKšœžœ
žœžœžœ
žœ˜eKšœ=žœžœ˜PKšžœ˜—Kš
œ˜—K˜šŸ	œžœžœ˜3Kšœžœ
˜
K˜Kšœ
žœ˜K˜K˜Kšžœ˜—K˜š
Ÿœžœžœ
žœžœ˜JKšœžœ˜K˜!KšžœžœR˜lKšžœžœM˜dKšžœ˜—K˜šŸœžœžœ
žœžœ
žœžœ˜ZKšœžœ˜Kšœžœ"˜GKšœžœ˜Kšžœ
žœ
žœžœp˜
Kšœžœ˜+Kšžœžœ
žœžœq˜‰
Kšžœ˜—K˜šŸ
œžœžœ
žœ&˜EKšœžœ˜K˜Kšžœ˜—K˜š Ÿœžœžœ
žœŸœžœžœ
žœžœžœžœ	žœžœžœžœ
žœ	˜Ί
Kšœžœ˜šŸœžœžœžœ
žœžœžœžœ˜LKšœ	žœ˜Kšœžœ˜+šŸœžœžœ	žœ
žœžœžœ˜@Kšœžœžœ˜$šžœžœ˜%Kšœžœ
˜
K˜K˜—Kšžœ	˜—K˜Kšžœ	˜—Kšžœžœ
žœ&˜>Kšžœ˜—K˜Kšžœ
˜—…—)ή8~