<> <> <> <> <> <<>> <> <<>> 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]}; <> 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: CARDINAL]; Rec2: TYPE = RECORD[i0, i1: CARDINAL]; Rec3: TYPE = RECORD[i0, i1, i2: CARDINAL]; Rec4: TYPE = RECORD[i0, i1, i2, i3: CARDINAL]; Rec5: TYPE = RECORD[i0, i1, i2, i3, i4: CARDINAL]; Rec6: TYPE = RECORD[i0, i1, i2, i3, i4, i5: CARDINAL]; Rec7: TYPE = RECORD[i0, i1, i2, i3, i4, i5, i6: CARDINAL]; Rec8: TYPE = RECORD[i0, i1, i2, i3, i4, i5, i6, i7: CARDINAL]; 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], 5 => NEW[Rec5], 6 => NEW[Rec6], 7 => NEW[Rec7], 8 => NEW[Rec8], 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 { CardPointer: TYPE = LONG POINTER TO CARD; ValueAddress: TYPE = RTTypesPrivate.ValueAddress; Pointer: TYPE = LONG POINTER; ptr: Pointer; <> 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]^_AMBridge.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: t.ptr, nWords: words];>> <> copiedRemoteObject => ptr _ t.ptr; ENDCASE => ERROR; PrincOpsUtils.LongCopy[from: ptr, nwords: words, to: @desc.wds[0]] } }; <<>> <> 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}; <<>> < {>> <> <> <> <> <> <> <> <> <<[ ] _ FieldBitsFromTV [rtv];>> <> < 16>> < bitsUsed DO bitsUsed _ bitsUsed*2 ENDLOOP>> <> <> <> <> <> <> <> <> <> 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] = { <> <> < no other bit is true).>> <> 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 }; <> <> <> <> <> <> <> <<>> <> <> <> <> <> <<[] _ 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]; <> END.