REFBitImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Last edited by Curry, May 27, 1986 7:22:20 am PDT
This package provides bit level access to the values behind Cedar REFs. `Error' will be raised if you try to twiddle refs or pointers in this way. This may change.
DIRECTORY
AMBridge,
AMTypes,
Basics USING [BITAND, BITNOT, BITOR, BITSHIFT, bitsPerWord, CARD],
Commander USING [CommandProc, Register],
CommandTool USING [ParseToList],
Convert USING [RopeFromInt],
HashTable USING [Create, Fetch, Store, Table],
Interpreter USING [Evaluate],
IO,
PrincOpsUtils,
REFBit,
Rope USING [Cat, Equal, Fetch, Length],
RTTypesPrivate;
REFBitImpl:
CEDAR
PROGRAM
IMPORTS AMTypes, AMBridge, Basics, Commander, CommandTool, Convert, HashTable, Interpreter, IO, PrincOpsUtils, Rope, RTTypesPrivate
EXPORTS REFBit =
BEGIN OPEN REFBit;
Error: PUBLIC ERROR [msg: ROPE] = CODE;
Size: PUBLIC PROC[ref: REF] RETURNS [index: INT] = {RETURN[Desc[ref].bitForm.size]};
Get:
PUBLIC
PROC[ref:
REF, index:
INT]
RETURNS [val:
BOOL] = {
wdSz: CARDINAL = Basics.bitsPerWord;
desc: REFBitDesc ← Desc[ref];
idx: CARDINAL ← desc.bitForm[index].firstBit;
TVToDescWds[desc];
val ← Basics.BITAND[desc.wds[idx/wdSz], Basics.BITSHIFT[1, wdSz - (idx MOD wdSz)-1]]#0};
Set:
PUBLIC
PROC[ref:
REF, index:
INT, val:
BOOL] = {
word: WORD;
wdSz: CARDINAL = Basics.bitsPerWord;
desc: REFBitDesc ← Desc[ref];
idx: CARDINAL ← desc.bitForm[index].firstBit;
TVToDescWds[desc];
idx ← idx MOD wdSz;
word ← desc.wds[idx/wdSz];
desc.wds[idx/wdSz] ←
IF val
THEN Basics.BITOR [word, Basics.BITSHIFT[1, wdSz-idx-1]]
ELSE Basics.BITAND [word, Basics.BITNOT[ Basics.BITSHIFT[1, wdSz-idx-1]]];
DescWdsToTV[desc]};
Procs handy for format access, names, printing, speed etc.
refDescCache: HashTable.Table ← HashTable.Create[];
ResetCache: PUBLIC PROC = {refDescCache ← HashTable.Create[]};
Desc:
PUBLIC
PROC[ref:
REF]
RETURNS [desc: REFBitDesc] = {
found: BOOL;
value: REF;
IF ISTYPE[ref, ROPE] THEN ref ← NEWFromName[NARROW[ref]];
[found, value] ← HashTable.Fetch[refDescCache, ref];
IF found
THEN desc ← NARROW[value]
ELSE
TRUSTED {
desc ← NEW[REFBitDescRec ← [ ] ];
desc.tv ← AMBridge.TVForReferent[ref];
desc.wds ← AMBridge.TVToWordSequence[desc.tv];
desc.typeName ← AMTypes.TVToName[desc.tv];
desc.fieldForm ← FieldFormatFromTV[desc.tv, NIL];
desc.bitForm ← FlattenFormat[desc.fieldForm]};
[] ← HashTable.Store[refDescCache, ref, desc]};
BitNameList:
PUBLIC
PROC[ref:
REF, both:
BOOL]
RETURNS[list:
LIST
OF
ROPE] = {
desc: REFBitDesc ← Desc[ref];
FOR i:
CARDINAL
DECREASING
IN [0..desc.bitForm.size)
DO
IF both
THEN list ←
CONS[(
IF desc.bitForm[i].nameInv#
NIL
THEN desc.bitForm[i].nameInv
ELSE Rope.Cat["not.", desc.bitForm[i].name]), list];
list ←
CONS[(
IF desc.bitForm[i].name#
NIL
THEN desc.bitForm[i].name
ELSE Rope.Cat["not.", desc.bitForm[i].nameInv]), list] ENDLOOP };
FormatListing:
PUBLIC
PROC[record:
REF, bitLevel:
BOOL←
FALSE]
RETURNS[listing:
ROPE] = {
rope: IO.STREAM ← IO.ROS[];
current: CARDINAL ← 0;
total: CARDINAL ← 0;
form: Format;
desc: REFBitDesc ← Desc[record];
form ← IF bitLevel THEN desc.bitForm ELSE desc.fieldForm;
IF form=NIL THEN RETURN[NIL];
rope.PutF["\nBit Format: %g", IO.rope[desc.typeName]];
rope.PutRope["\n Index First Size Name"];
FOR i:
CARDINAL
IN [0..form.size)
DO
name: ROPE ← NIL;
IF form[i].name#
NIL
THEN name ← Rope.Cat[name, " ", form[i].name];
IF form[i].nameInv#
NIL
THEN name ← Rope.Cat[name, " not.", form[i].nameInv];
IF current # form[i].firstBit THEN {current ← form[i].firstBit; rope.PutRope["\n"]};
rope.PutRope["\n"];
rope.PutF["%4g %4g %4g%g",
IO.card[i],
IO.card[form[i].firstBit],
IO.card[form[i].bitSize],
IO.rope[name]];
total ← total + form[i].bitSize;
current ← current + form[i].bitSize;
ENDLOOP;
rope.PutF["\n ---\n BitTotal: %4g\n", IO.card[total]];
listing ← IO.RopeFromROS[rope] };
NEWFromName:
PUBLIC
PROC[record:
ROPE]
RETURNS[ref:
REF] = {
tv: TV;
errorRope: ROPE;
noResult: BOOL;
type: AMTypes.Type;
[tv, errorRope, noResult] ← Interpreter.Evaluate[record];
IF noResult OR errorRope#NIL THEN ERROR Error[errorRope];
type ← AMTypes.TVType[tv];
WHILE AMTypes.TypeClass[type]=type
DO
type ← AMTypes.UnderType[AMTypes.TVToType[tv]];
tv ← AMTypes.New[type] ENDLOOP;
TRUSTED {ref← AMBridge.SomeRefFromTV[tv]};
Desc[ref].typeName ← record };
DescWdsToTV:
PUBLIC
PROC[desc: REFBitDesc] =
TRUSTED {AMBridge.SetTVFromWordSequence[desc.tv, desc.wds]};
TVToDescWds: PUBLIC PROC[desc: REFBitDesc] =
TRUSTED {desc.wds ← AMBridge.TVToWordSequence[desc.tv]};
TVToDescWds:
PUBLIC
PROC[desc: REFBitDesc] =
TRUSTED {
CardPointer: TYPE = LONG POINTER TO Basics.CARD;
ValueAddress: TYPE = RTTypesPrivate.ValueAddress;
Pointer: TYPE = LONG POINTER;
ptr: Pointer;
words: CARDINAL = TVSize[tv];
words: CARDINAL ← desc.wds.size;
SELECT words
FROM
0 => { RETURN};
1 => {desc.wds[0] ← AMBridge.TVToLC[desc.tv]; RETURN};
2 => {LOOPHOLE[@desc.wds[0], CardPointer]^𡤊MBridge.TVToLC[desc.tv]; RETURN};
ENDCASE => {
a: ValueAddress ← RTTypesPrivate.GetValueAddress[desc.tv];
WITH t: a
SELECT
FROM
constant => {--desc.wds ← t.value;-- RETURN};
pointer => ptr ← t.ptr;
remotePointer => {
desc.wds ← RTTypesRemotePrivate.GetRemoteWords
[remotePointer: t.ptr, nWords: words];
RETURN};
copiedRemoteObject => ptr ← t.ptr;
ENDCASE => ERROR;
PrincOpsUtils.LongCopy[from: ptr, nwords: words, to: @desc.wds[0]] } };
Private
FieldFormatFromTV:
PROC[toptv:
TV, topName:
ROPE]
RETURNS[format: Format] = {
FieldFormatRecList:
PROC[list: FormatList, tv:
TV, name:
ROPE]
RETURNS [FormatList] = {
type: AMTypes.Type ← AMTypes.TVType[tv];
utype: AMTypes.Type ← AMTypes.UnderType[type];
uClass: AMTypes.Class ← AMTypes.TypeClass[ utype];
SELECT uClass
FROM
record, structure => {
nofFlds: NAT ← AMTypes.NComponents[utype];
IF name#NIL AND name.Length[]>0 THEN name ← name.Cat["."];
FOR fldIndex:
CARDINAL
DECREASING
IN [0..nofFlds)
DO
fldTV: TV ← AMTypes.IndexToTV[tv, fldIndex+1];
fldName: ROPE ← AMTypes.IndexToName[utype, fldIndex+1];
list ← FieldFormatRecList[list, fldTV, name.Cat[fldName]];
ENDLOOP};
cardinal, longCardinal, integer, longInteger, real, character,
enumerated,
subrange => {
firstBit, bitSize: INT;
[firstBit, bitSize] ← FieldBitsFromTV[tv];
list ←
CONS[[
type: utype,
name: name,
nameInv: NIL,
firstBit: firstBit,
bitSize: bitSize
], list] };
ENDCASE => ERROR Error["I can't deal with this TYPE"];
RETURN[list]};
formlist: FormatList ← FieldFormatRecList[NIL, toptv, topName];
index: INT ← 0;
FOR lst: FormatList ← formlist, lst.rest WHILE lst#NIL DO index ← index+1 ENDLOOP;
format ← NEW[FormatSeq[index]];
index ← 0;
FOR lst: FormatList ← formlist, lst.rest
WHILE lst#
NIL
DO format[index] ← lst.first; index ← index+1 ENDLOOP};
array, sequence => {
ispacked: BOOL ← AMTypes.IsPacked [utype];
dType: AMTypes.Type ← AMTypes.UnderType [AMTypes.Domain [utype]];
rType: AMTypes.Type ← AMTypes.UnderType [ AMTypes.Range [utype]];
length: INT ← AMTypes.Length [tv];
rtv: TV ← AMTypes.New [rType];
bitsUsed: INT ← 1;
bitsForType: INT;
TRUSTED {bitsForType ← RTTypesPrivate.BitsForType[rType].bft};
[ ] ← FieldBitsFromTV [rtv];
IF length <=0 THEN ERROR;
IF ispacked AND bitsForType > 16
THEN WHILE bitsForType > bitsUsed DO bitsUsed ← bitsUsed*2 ENDLOOP
ELSE bitsUsed ← 16*((bitsForType-1)/16 +1);
format ← NEW[FormatSeq[length]];
FOR i: INT IN [0..length) DO
format[i].format ← NIL;
format[i].name ← IO.PutFR["seq.%g", IO.int[i]];
format[i].firstBit ← i*bitsUsed;
format[i].bitSize ← bitsForType;
ENDLOOP;
ERROR Error["I can't deal with this TYPE"]}; -- Yet
FieldBitsFromTV:
PROC[fieldTV:
TV]
RETURNS[firstBit, bitSize:
CARDINAL] =
TRUSTED {
tvRef: REF RTTypesPrivate.TypedVariableRec ← NARROW[fieldTV];
WITH tv: tvRef
SELECT
FROM
entire => ERROR; -- was RETURN[0,0];
embedded => {
WITH fld: tv.fd
SELECT
FROM
small => RETURN[16*fld.wordOffset+fld.field.bitFirst, fld.field.bitCount];
large => RETURN[16*fld.wordOffset, fld.size*16];
ENDCASE => ERROR };
constant => RETURN[0, tv.value.size*16];
ENDCASE => ERROR };
FlattenFormat:
PROC[format: Format]
RETURNS[new: Format] = {
bitIdx, bitFrmIdx, fldFrmIdx, bitsum: CARDINAL ← 0;
FOR fldFrmIdx IN [0..format.size) DO bitsum ← bitsum + format[fldFrmIdx].bitSize ENDLOOP;
new ← NEW[ FormatSeq[bitsum]];
FOR fldFrmIdx
IN [0..format.size)
DO
decoded: BOOL;
names: LIST OF ROPE ← NIL;
[decoded, names] ←
DecodedEnumTypeCheck[format[fldFrmIdx].type, format[fldFrmIdx].bitSize];
FOR bitIdx
IN [0..format[fldFrmIdx].bitSize)
DO
name, nameInv: IO.ROPE;
IF decoded
THEN {
name ← format[fldFrmIdx].name.Cat[".", names.first];
IF (bitIdx+1) = format[fldFrmIdx].bitSize
THEN {
name ← IF names.first=NIL THEN NIL ELSE name;
nameInv ← format[fldFrmIdx].name.Cat[".", names.rest.first] };
names ← names.rest}
ELSE name ←
IF format[fldFrmIdx].bitSize > 1
THEN format[fldFrmIdx].name.Cat[".", Convert.RopeFromInt[bitIdx]]
ELSE format[fldFrmIdx].name;
new[bitFrmIdx] ← [
type: CODE[BOOL],
name: name,
nameInv: nameInv,
firstBit: format[fldFrmIdx].firstBit + bitIdx,
bitSize: 1 ];
bitFrmIdx ← bitFrmIdx+1;
ENDLOOP ENDLOOP};
DecodedEnumTypeCheck:
PROC[type: Type, size:
CARDINAL]
RETURNS[isDET: BOOL, names: LIST OF ROPE] = {
A decoded enumerated type can be used to directly generate multiplex controls.
The type can be coded as {0, 1} or {0, 1, 2, 4, 8 ...} or {0, 3, 5, 9, 17 ...}.
The first and last cases have the advantage that zero can be used a default multiplex control (lsb = 0 => no other bit is true).
In all cases it's possible to name the bits and/or their inverses using the enumerated type element names.
zeroHot, oneHot: BOOL ← FALSE;
biPwr: CARDINAL ← 2;
tv: TV;
index: CARDINAL;
bitName: ROPE;
NextEnum:
PROC = {
bitName ← NIL;
FOR tv ← tv, AMTypes.Next[tv]
WHILE tv#
NIL
DO
TRUSTED {index ← AMBridge.TVToCardinal[tv]};
bitName ← AMTypes.TVToName[tv ! AMTypes.Error => CONTINUE];
IF bitName # NIL THEN EXIT ENDLOOP };
IF AMTypes.TypeClass[type] # enumerated THEN RETURN[FALSE, NIL];
tv ← AMTypes.First[type]; NextEnum[];
IF bitName = NIL OR Rope.Equal[bitName,"FALSE"] THEN RETURN[FALSE, NIL];
IF index # 0
THEN names ←
CONS[
NIL, names]
ELSE
{zeroHot ← TRUE; names ← CONS[bitName, names]; tv ← AMTypes.Next[tv]; NextEnum[]};
IF index # 1
THEN names ←
CONS[
NIL, names]
ELSE
{oneHot ← TRUE; names ← CONS[bitName, names]; tv ← AMTypes.Next[tv]; NextEnum[]};
THROUGH [1..size)
DO
check: INT ← IF oneHot THEN biPwr ELSE biPwr+1;
IF bitName = NIL OR index # check THEN RETURN[FALSE, NIL];
names ← CONS[bitName, names];
tv ← AMTypes.Next[tv]; NextEnum[];
biPwr ← biPwr*2;
ENDLOOP;
IF bitName #
NIL
THEN RETURN[FALSE, NIL] -- leftovers
ELSE RETURN[TRUE, names]};
FlattenFormatOld:
PROC[format: Format]
RETURNS[new: Format] = {
bitIdx, bitFrmIdx, fldFrmIdx, bitsum: CARDINAL ← 0;
FOR fldFrmIdx IN [0..format.size) DO bitsum ← bitsum + format[fldFrmIdx].bitSize ENDLOOP;
new ← NEW[ FormatSeq[bitsum]];
FOR fldFrmIdx
IN [0..format.size)
DO
FOR bitIdx
IN [0..format[fldFrmIdx].bitSize)
DO
name:
IO.
ROPE ←
IF format[fldFrmIdx].bitSize > 1
THEN format[fldFrmIdx].name.Cat[".", Convert.RopeFromInt[bitIdx]]
ELSE format[fldFrmIdx].name;
new[bitFrmIdx] ← [
type: CODE[BOOL],
name: name,
nameInv: NIL,
firstBit: format[fldFrmIdx].firstBit + bitIdx,
bitSize: 1 ];
bitFrmIdx ← bitFrmIdx+1;
ENDLOOP ENDLOOP };
BitFormat: Commander.CommandProc = {
bitLevel: BOOL ← FALSE;
list: LIST OF ROPE;
length: NAT;
[list, length] ← CommandTool.ParseToList[cmd];
FOR list ← list, list.rest
WHILE list#
NIL
DO
IF list.first.Fetch[0]='-
THEN
SELECT list.first.Fetch[1]
FROM
'b,'B => bitLevel ← TRUE;
ENDCASE
ELSE cmd.out.PutRope[FormatListing[list.first, bitLevel]];
ENDLOOP };
MyType: TYPE = INT[0..125];
MySeq: TYPE = REF MySeqRec;
MySeqRec: TYPE = RECORD[SEQUENCE size: CARDINAL OF MyType];
MyPSeq: TYPE = REF MyPSeqRec;
MyPSeqRec: TYPE = RECORD[PACKED SEQUENCE size: CARDINAL OF MyType];
MyArray: TYPE = ARRAY [-2..7) OF MyType;
MyPArray: TYPE = PACKED ARRAY [-1..9) OF MyType;
Test: Commander.CommandProc = {
aref: REF ← NEW[MyArray];
apref: REF ← NEW[MyPArray];
ref: MySeq ← NEW[MySeqRec[7]];
packed: MyPSeq ← NEW[MyPSeqRec[9]];
[] ← Size[aref];
[] ← Size[apref];
[] ← Size[ref];
[] ← Size[packed] };
bitFormatDoc: ROPE = "[nameOfSomeType] -b => bit level";
Commander.Register[key:"REFBitFormat", proc: BitFormat, doc: bitFormatDoc];
Commander.Register[key:"Test", proc: Test, doc: bitFormatDoc];
END.