REFBitImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Last edited by Curry, October 13, 1986 11:38:20 am PDT
Don Curry April 30, 1987 9:55:35 pm PDT
Last Edited by: Don Curry July 18, 1987 10:58:18 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.
DIRECTORY
AMBridge, AMModel, AMTypes, Basics, Commander, CommandTool, Convert, RefTab, Interpreter, IO, PrincOpsUtils, REFBit, Rope, RopeList, RTTypesPrivate, WorldVM;
REFBitImpl:
CEDAR
PROGRAM
IMPORTS AMModel, AMTypes, AMBridge, Basics, Commander, CommandTool, Convert, RefTab, Interpreter, IO, PrincOpsUtils, Rope, RopeList, RTTypesPrivate, WorldVM
EXPORTS REFBit =
BEGIN OPEN REFBit;
Error: PUBLIC ERROR [msg: ROPE] = CODE;
Size: PUBLIC PROC[ref: REF] RETURNS [size: 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;
bit: CARDINAL ← idx MOD wdSz;
wd: CARDINAL ← idx/wdSz;
TVToDescWds[desc];
word ← desc.wds[wd];
desc.wds[wd] ←
IF val
THEN Basics.BITOR [word, Basics.BITSHIFT[1, wdSz-bit-1]]
ELSE Basics.BITAND [word, Basics.BITNOT[ Basics.BITSHIFT[1, wdSz-bit-1]]];
DescWdsToTV[desc]};
Procs handy for format access, names, printing, speed etc.
refDescCache: RefTab.Ref ← RefTab.Create[];
ResetCache: PUBLIC PROC = {refDescCache ← RefTab.Create[]};
Desc:
PUBLIC
PROC[ref:
REF]
RETURNS [desc: REFBitDesc] = {
found: BOOL;
value: REF;
IF ISTYPE[ref, ROPE] THEN ref ← NEWFromName[NARROW[ref]];
[found, value] ← RefTab.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]};
[] ← RefTab.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;
IF Rope.Find[record, "LIST"]#-1 THEN RETURN[ NewFromNameList[record] ];
[tv, errorRope, noResult] ← Interpreter.Evaluate[record, originalContext];
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 };
Rec1: TYPE = RECORD[i0: INT];
Rec2: TYPE = RECORD[i0, i1: INT];
Rec3: TYPE = RECORD[i0, i1, i2: INT];
Rec4: TYPE = RECORD[i0, i1, i2, i3: INT];
boolRef: REF BOOL ← NEW[BOOL ← TRUE];
NewFromNameList:
PROC[record:
ROPE]
RETURNS[ref:
REF] = {
names: LIST OF ROPE ← NIL;
inStm: IO.STREAM ← IO.RIS[record];
rope: IO.ROPE;
size: INT;
desc: REFBitDesc ← NEW[REFBitDescRec ← [ ] ];
boolType: AMTypes.Type;
DO
ENABLE IO.EndOfStream => EXIT;
rope ← IO.GetTokenRope[inStm].token;
SELECT
TRUE
FROM
Rope.Equal[rope, "LIST"] => LOOP;
Rope.Equal[rope, "["] => LOOP;
Rope.Equal[rope, "]"] => EXIT;
ENDCASE => names ← CONS[rope, names];
ENDLOOP;
names ← RopeList.Reverse[names];
size ← RopeList.Length[names];
ref ←
SELECT (size-1)/16 +1
FROM
1 => NEW[Rec1],
2 => NEW[Rec2],
3 => NEW[Rec3],
4 => NEW[Rec4],
ENDCASE => ERROR;
TRUSTED{
boolRef: REF BOOL ← NEW[BOOL ← TRUE];
boolType ← AMTypes.UnderType[AMTypes.TVType[AMBridge.TVForReferent[boolRef]]];
desc.tv ← AMBridge.TVForReferent[ref];
desc.wds ← AMBridge.TVToWordSequence[desc.tv];
desc.typeName ← record;
desc.fieldForm ← NEW[FormatSeq[size]];
desc.bitForm ← NEW[FormatSeq[size]]};
FOR i:
INT
IN [0..size)
DO
desc.fieldForm[i] ← desc.bitForm[i] ← [
type: boolType,
name: names.first,
nameInv: NIL,
firstBit: i,
bitSize: 1 ];
names ← names.rest ENDLOOP;
[] ← RefTab.Store[refDescCache, ref, desc]};
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 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 => RETURN[0, AMTypes.TVSize[fieldTV]*16];
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";
originalContext: AMModel.Context;
TRUSTED {originalContext ← AMModel.RootContext[WorldVM.LocalWorld[]]};
Commander.Register[key:"REFBitFormat", proc: BitFormat, doc: bitFormatDoc];
Commander.Register[key:"Test", proc: Test, doc: bitFormatDoc];
END.