<<>> <> <> <> <> <> DIRECTORY Basics, CirioMemory, CirioNubAccess, IntHashTable, IO, LoadStateAccess, PBasics, Rope, SymTab; CirioMemoryImpl: CEDAR PROGRAM IMPORTS CirioMemory, CirioNubAccess, IntHashTable, IO, PBasics, 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] within _ FALSE; main.size=unspecdBA => within _ TRUE; BaCompare[inner.start, zeroBA] 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 _ PBasics.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 _ PBasics.BITAND[ans, lmask]; IF afterLastBit>32 THEN { ans2: CARD ~ CirioNubAccess.Read32BitsAsCard[[um.nub, readStart.aus+4, 0, readStart.aus+4=0, TRUE]]; ans _ PBasics.BITOR[ PBasics.BITLSHIFT[ans, afterLastBit-32], PBasics.BITRSHIFT[ans2, 64-afterLastBit] ]; RETURN[ans]}; IF afterLastBit<32 THEN ans _ PBasics.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 ~ PBasics.BITRSHIFT[CARD.LAST, writeStart.bits]; rMaskNew: CARD ~ PBasics.BITLSHIFT[CARD.LAST, 64-afterLastBit]; lInsNew: CARD ~ PBasics.BITRSHIFT[bits, afterLastBit-32]; rInsNew: CARD ~ PBasics.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 ~ PBasics.BITOR[PBasics.BITAND[lInsNew, lMaskNew], PBasics.BITAND[lOld, PBasics.BITNOT[lMaskNew]]]; rNew: CARD ~ PBasics.BITOR[PBasics.BITAND[rInsNew, rMaskNew], PBasics.BITAND[rOld, PBasics.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 ~ PBasics.BITLSHIFT[hmn+(hmn-1), 32-afterLastBit]; insNew: CARD ~ PBasics.BITLSHIFT[bits, 32-afterLastBit]; old: CARD ~ CirioNubAccess.Read32BitsAsCard[[um.nub, writeStart.aus, 0, writeStart.aus=0, TRUE]]; new: CARD ~ PBasics.BITOR[PBasics.BITAND[insNew, maskNew], PBasics.BITAND[old, PBasics.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.