-- RTTypedVariablesImpl.Mesa -- last modified on December 21, 1982 8:53 am by Paul Rovner -- try to avoid acquisition of already acquired symbol tables -- status stuff is wrong. DIRECTORY AMBridge USING[WordSequence, WordSequenceRecord, TVForReferent, SetTVFromLC, TVToLC, TVToCardinal, TVToProc, TVToSignal, GFHFromTV, TVToLI, TVForPointerReferent, SetTVFromLI, TVToWordSequence, IsRemote, TVToRemoteProc, TVToRemoteSignal, RemoteGFHFromTV, TVForRemoteReferent, RemotePointer, TVForRemotePointerReferent, RemoteRef, GetWorld, GetWorldIncarnation], AMTypes USING[Error, Status, Class, VariableType, TVType, IsComputed, Size, NComponents, IsOverlaid, TypeClass, UnderType, NameToIndex, TVStatus, First, IndexToName, Domain, Range, Last, GroundStar, ReferentStatus, IsAtom, IsRope, IndexToType], AtomsPrivate USING[AtomRec], CedarLinkerOps USING[NullLink], Environment USING[bitsPerWord], Inline USING[BITSHIFT, LongCOPY, LongNumber, LowHalf, HighHalf], List USING[AList], PrincOps USING[ProcDesc, SignalDesc], RCMap USING[nullIndex], RemoteRope USING[RemoteFetch, RemoteLength, RopeFromTV], Rope USING[ROPE, RopeRep, Fetch, Length], RTBasic USING[TV, TypedVariable, Index], RTCommon USING[FetchField, ShortenLongCardinal, ShortenLongInteger], RTStorageOps USING[NewObject, AssignComposite, AssignCompositeNew, ValidateRef], RTSymbols USING[AcquireType, GetTypeSymbols, AcquireSequenceType, SymbolTableBase, ReleaseSTB, SymbolIndex, SymbolConstructorIndex, SymbolIdIndex, SymbolRecordIndex], RTTypesBasic USING[EquivalentTypes, Type, unspecType, anyType, nullType, GetCanonicalType, fhType, gfhType, GetReferentType], RTTypesBasicPrivate USING[MapTiRcmx, MapRefs], RTTypesPrivate, RTTypesRemotePrivate USING[GetRemoteWords, RemoteStoreWords, RemoteGFHToName, RemoteSEDToName, RemotePDToName, ValidateRemoteRef, RemoteTypeToLocal, GetRemoteWord, GetRemoteReferentType], SafeStorage USING[NewZone], WorldVM USING[CurrentIncarnation, Long, World, LocalWorld, Address]; RTTypedVariablesImpl: PROGRAM IMPORTS AMBridge, AMTypes, CedarLinkerOps, Inline, RemoteRope, Rope, RTCommon, RTStorageOps, RTTypesBasic, RTTypesBasicPrivate, RTSymbols, RTTypesPrivate, RTTypesRemotePrivate, SafeStorage, WorldVM EXPORTS AMTypes, AMBridge, RTTypesPrivate SHARES Rope = BEGIN OPEN AMBridge, AMTypes, Environment, Rope, RTBasic, tp: RTTypesPrivate, RTCommon, RTStorageOps, RTSymbols, RTTypesBasic, RTTypesRemotePrivate, WorldVM; -- T Y P E S TypedVariableRec: TYPE = tp.TypedVariableRec; Pointer: TYPE = LONG POINTER --TO UNSPECIFIED--; -- V A L U E S -- ZONEs tvZone: ZONE = SafeStorage.NewZone[quantized]; tvPrefixedZone: ZONE = SafeStorage.NewZone[]; -- PROCs exported to RTTypesPrivate GetTVZones: PUBLIC PROC RETURNS[qz, pz: ZONE] = {RETURN[tvZone, tvPrefixedZone]}; -- PROCs exported to AMTypes -- raises typeFault New: PUBLIC SAFE PROC[type: Type, status: Status _ mutable, world: WorldVM.World _ WorldVM.LocalWorld[], tag: TV _ NIL] RETURNS[newTV: TypedVariable] = TRUSTED { variantClass: Class; length: CARDINAL _ 0; IF type = nullType THEN RETURN[NIL]; IF type = fhType OR type = gfhType THEN ERROR Error[reason: typeFault, type: type]; variantClass _ VariableType[type].c; -- variantClass = nil if type not a record or structure, or if non-variant (i.e. does -- not contain a union or sequence) IF tag # NIL AND variantClass = sequence THEN length _ ShortenLongCardinal [LOOPHOLE[TVToLI[tag] - TVToLI[First[TVType[tag]]], LONG CARDINAL]]; IF world # WorldVM.LocalWorld[] THEN -- make a new remote TV {IF tag # NIL AND (variantClass = union OR variantClass = sequence) THEN { ws: WordSequence _ tvPrefixedZone.NEW [WordSequenceRecord[Size[type, length]]]; newTV: TV _ tvZone.NEW[TypedVariableRec _ [referentType: [type, IF IsComputed[type] OR (variantClass = union AND IsOverlaid[type]) THEN tag ELSE NIL], head: [copiedRemoteObject [world: world, worldIncarnation: CurrentIncarnation[world], copy: ws]], status: status, field: entire[]]]; newTag: TV; IF IsComputed[type] OR (variantClass = union AND IsOverlaid[type]) THEN RETURN[newTV]; -- here to initialize the tag of the new variant or sequence record newTag _ Tag[IndexToTV[newTV, NComponents[type]]]; -- assume sharing NARROW[newTag, REF TypedVariableRec].status _ mutable; Assign[lhs: newTag, rhs: tag]; NARROW[newTag, REF TypedVariableRec].status _ readOnly; RETURN[newTV]; } ELSE RETURN [tvZone.NEW [TypedVariableRec _ [referentType: [type], head: [copiedRemoteObject [world: world, worldIncarnation: CurrentIncarnation[world], copy: tvPrefixedZone.NEW[WordSequenceRecord[Size[type]]]]], status: status, field: entire[]]]]} -- end make a new remote TV ELSE -- make a new local TV {newTV _ TVForReferent[NewObject[type: type, size: Size[type, length]]]; -- cleared -- if a new variant or sequence record, initialize the tag IF tag # NIL AND (variantClass = union OR variantClass = sequence) THEN {IF IsComputed[type] OR (variantClass = union AND IsOverlaid[type]) THEN NARROW[newTV, REF TypedVariableRec].referentType.tag _ tag ELSE {newTag: TV _ Tag[IndexToTV[newTV, NComponents[type]]]; NARROW[newTag, REF TypedVariableRec].status _ mutable; Assign[lhs: newTag, rhs: tag]; NARROW[newTag, REF TypedVariableRec].status _ readOnly}; }; RETURN[newTV]}; }; -- end New -- raises IncompatibleTypes, NotMutable Assign: PUBLIC SAFE PROC[lhs: TypedVariable, rhs: TypedVariable] = TRUSTED {DoAssign[lhs, rhs]}; -- raises typeFault, notImplemented, incompatibleTypes DoAssign: PROC[lhs: TypedVariable, rhs: TypedVariable, new: BOOLEAN _ FALSE] = {lhsType: Type = TVType[lhs]; rhsType: Type = TVType[rhs]; size: CARDINAL = TVSize[rhs]; lhsPtrHead: BOOLEAN _ FALSE; IF lhsType = fhType OR lhsType = gfhType THEN ERROR Error[reason: typeFault, type: lhsType]; IF rhsType = fhType OR rhsType = gfhType THEN ERROR Error[reason: typeFault, type: rhsType]; {lhsa: tp.ValueAddress _ tp.GetValueAddress[tv: lhs, mutableOnly: TRUE]; rhsa: tp.ValueAddress _ tp.GetValueAddress[rhs]; IF IsRC[lhsType] AND ((lhsa.tag = remotePointer) OR (lhsa.tag = pointer AND rhsa.tag = remotePointer) OR (lhsa.tag = pointer AND rhsa.tag = copiedRemoteObject) OR (lhsa.tag = copiedRemoteObject AND rhsa.tag = pointer) ) THEN ERROR Error[reason: notImplemented, msg: "remote reference-counted assignment"]; WITH lhs SELECT FROM tr: REF TypedVariableRec => WITH tr.head SELECT FROM constant, remoteConstant => ERROR Error[reason: notMutable]; reference, gfh => NULL; pointer, fh, remoteReference, copiedRemoteObject, remotePointer, remoteGFH, remoteFH => lhsPtrHead _ TRUE; ENDCASE => ERROR; ENDCASE => ERROR; IF rhsType = nullType THEN {SELECT TypeClass[UnderType[lhsType]] FROM list, ref, atom, rope => IF lhsPtrHead OR new THEN SetTVFromLC[lhs, 0] ELSE LOOPHOLE[NARROW[lhsa, pointer tp.ValueAddress].ptr, REF REF ANY]^ _ NIL; pointer, longPointer, procedure, signal, error, basePointer, relativePointer => SetTVFromLC[lhs, 0]; ENDCASE => ERROR Error[reason: typeFault, type: rhsType]; RETURN}; IF size > TVSize[lhs] THEN ERROR Error[reason: incompatibleTypes, type: lhsType, otherType: rhsType]; IF NOT AsGoodAs[rhsType: rhsType, lhsType: lhsType] THEN {DoAssign[lhs: lhs, rhs: Coerce[rhs, lhsType]]; RETURN}; WITH t: rhsa SELECT FROM constant => {IF t.value.size <= 2 THEN SetTVFromLC[lhs, TVToLC[rhs]] -- NOTE non-RC, <= 2 words ELSE {IF lhsPtrHead -- NOTE remote RC not allowed THEN {IF lhsa.tag = remotePointer THEN RemoteStoreWords [from: @t.value[0], to: NARROW[lhsa, remotePointer tp.ValueAddress].ptr, nWords: t.value.size] ELSE Inline.LongCOPY [from: @t.value[0], to: IF lhsa.tag = pointer THEN NARROW[lhsa, pointer tp.ValueAddress].ptr ELSE NARROW [lhsa, copiedRemoteObject tp.ValueAddress].ptr, nwords: t.value.size]} ELSE IF new THEN AssignCompositeNew [rhs: @t.value[0], lhs: NARROW[lhsa, pointer tp.ValueAddress].ptr, type: rhsType, nwords: t.value.size] ELSE AssignComposite[rhs: @t.value[0], lhs: NARROW[lhsa, pointer tp.ValueAddress].ptr, type: rhsType, nwords: t.value.size]} }; pointer => {WITH fd: t.fd SELECT FROM large => {SELECT fd.size FROM 1 => SetTVFromLC[lhs, TVToLC[rhs]]; ENDCASE => {WITH rhs SELECT FROM tr: REF TypedVariableRec => WITH tr.head SELECT FROM fh => { -- validate rhs OPEN RTTypesBasicPrivate; procLeaf: PROC[r: REF ANY] = {ValidateRef[r]}; -- start here MapRefs[ptr: t.ptr, rcmx: MapTiRcmx[rhsType], procLeaf: procLeaf]}; ENDCASE; ENDCASE; IF lhsPtrHead -- NOTE remote RC not allowed THEN {IF lhsa.tag = remotePointer THEN RemoteStoreWords [from: t.ptr, to: NARROW[lhsa, remotePointer tp.ValueAddress].ptr, nWords: size] ELSE Inline.LongCOPY [from: t.ptr, to: IF lhsa.tag = pointer THEN NARROW [lhsa, pointer tp.ValueAddress].ptr ELSE NARROW [lhsa, copiedRemoteObject tp.ValueAddress].ptr, nwords: size]} ELSE IF new THEN AssignCompositeNew [rhs: t.ptr, lhs: NARROW[lhsa, pointer tp.ValueAddress].ptr, type: rhsType, nwords: size] ELSE AssignComposite [rhs: t.ptr, lhs: NARROW[lhsa, pointer tp.ValueAddress].ptr, type: rhsType, nwords: size]}}; small => SetTVFromLC[lhs, TVToLC[rhs]]; ENDCASE => ERROR}; remotePointer => -- rhsa.tag = remotePointer {WITH fd: t.fd SELECT FROM large => {SELECT fd.size FROM 1, 2 => SetTVFromLC[lhs, TVToLC[rhs]]; ENDCASE => {ws: WordSequence = GetRemoteWords[t.ptr, size]; WITH rhs SELECT FROM tr: REF TypedVariableRec => WITH tr.head SELECT FROM remoteFH => { -- validate rhs OPEN RTTypesBasicPrivate; procLeaf: PROC[r: REF ANY] = {ValidateRemoteRef [[world: remoteFrameHandle.world, worldIncarnation: CurrentIncarnation[remoteFrameHandle.world], ref: LOOPHOLE[r, WorldVM.Address]]]}; -- start here MapRefs[ptr: @ws[0], rcmx: MapTiRcmx[rhsType], procLeaf: procLeaf]}; ENDCASE; ENDCASE; IF lhsa.tag = remotePointer THEN RemoteStoreWords [from: @ws[0], to: NARROW[lhsa, remotePointer tp.ValueAddress].ptr, nWords: size] ELSE Inline.LongCOPY [from: @ws[0], to: IF lhsa.tag = pointer THEN NARROW [lhsa, pointer tp.ValueAddress].ptr ELSE NARROW [lhsa, copiedRemoteObject tp.ValueAddress].ptr, nwords: size]}}; small => SetTVFromLC[lhs, TVToLC[rhs]]; ENDCASE => ERROR}; copiedRemoteObject => -- rhsa.tag = copiedRemoteObject {WITH fd: t.fd SELECT FROM large => {SELECT fd.size FROM 1,2 => SetTVFromLC[lhs, TVToLC[rhs]]; ENDCASE => {IF lhsa.tag = remotePointer THEN RemoteStoreWords [from: t.ptr, to: NARROW[lhsa, remotePointer tp.ValueAddress].ptr, nWords: size] ELSE Inline.LongCOPY [from: t.ptr, to: IF lhsa.tag = pointer THEN NARROW [lhsa, pointer tp.ValueAddress].ptr ELSE NARROW [lhsa, copiedRemoteObject tp.ValueAddress].ptr, nwords: size]}}; small => SetTVFromLC[lhs, TVToLC[rhs]]; ENDCASE => ERROR}; ENDCASE => ERROR}}; -- end DoAssign Copy: PUBLIC SAFE PROC[tv: TypedVariable] RETURNS[newTV: TypedVariable] = TRUSTED { type: Type; tag: TV _ NIL; IF tv = NIL THEN RETURN[NIL]; tag _ TVTag[tv]; type _ TVType[tv]; IF tag = NIL THEN {variantClass: Class = VariableType[type].c; IF variantClass = union OR variantClass = sequence THEN tag _ Tag[IndexToTV[tv, NComponents[type]]]; }; newTV _ New[world: GetWorld[tv], type: type, tag: tag]; DoAssign[lhs: newTV, rhs: tv, new: TRUE]}; TVTag: PROC[tv: TypedVariable] RETURNS[TV] = {RETURN[NARROW[tv, REF TypedVariableRec].referentType.tag]}; -- Could overflow TVSize: PUBLIC SAFE PROC[tv: TypedVariable] RETURNS[INT--words--] = TRUSTED { type: Type = UnderType[TVType[tv]]; vClass: Class _ VariableType[type].c; vTv: TV; IF (IsOverlaid[type] OR IsComputed[type]) AND TVTag[tv] = NIL THEN RETURN[Size[type: type]]; vTv _ SELECT vClass FROM union, sequence => IndexToTV[tv, NComponents[type]], ENDCASE => NIL; RETURN[IF vClass=union THEN TVSize[Variant[vTv]] ELSE Size[type: type, length: IF vClass=sequence THEN ShortenLongCardinal[LOOPHOLE[Length[vTv], LONG CARDINAL]] ELSE 0]]}; -- MOVE Tag: PUBLIC SAFE PROC[tv: TypedVariable--union, sequence--] RETURNS[ans: TypedVariable] = TRUSTED {type: Type = TVType[tv]; stb: SymbolTableBase; sei: SymbolIndex; IF TVTag[tv] # NIL THEN RETURN[TVTag[tv]]; IF IsComputed[type] OR IsOverlaid[type] THEN RETURN[NIL]; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex = stb.UnderType[sei]; tagSei: SymbolIdIndex; WITH ser: stb.seb[csei] SELECT FROM union => {IF IsOverlaid[type] THEN ERROR Error[reason: typeFault, type: type]; tagSei _ ser.tagSei}; sequence => tagSei _ ser.tagSei; ENDCASE => ERROR Error[reason: typeFault, type: type]; IF stb.seb[tagSei].constant THEN ERROR; ans _ tvZone.NEW [TypedVariableRec _ [ referentType: [Domain[type]], head: (WITH tv SELECT FROM tr: REF TypedVariableRec => tr.head, ENDCASE => ERROR), status: readOnly, field: embedded[fd: BuildRecordFieldDescriptor [parentTV: tv, fieldBitOffset: LOOPHOLE[stb.seb[tagSei].idValue, CARDINAL], fieldBits: LOOPHOLE[stb.seb[tagSei].idInfo, CARDINAL], bitsForType: stb.BitsForType [stb.UnderType [stb.seb[tagSei].idType]] ] ] ] ]; }; ReleaseSTB[stb]}; -- end Tag -- break up and MOVE Variant: PUBLIC SAFE PROC[tv: TypedVariable--union--] RETURNS[ans: TypedVariable _ NIL--record--] = TRUSTED { type: Type = TVType[tv]; p: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = { cType: Type _ AcquireType[stb, stb.UnderType[isei]]; -- NOTE chaining for multiple names size: CARDINAL _ Size[cType]; IF size = 0 THEN RETURN; ans _ tvZone.NEW [TypedVariableRec _ [ referentType: [cType], head: (WITH tv SELECT FROM tr: REF TypedVariableRec => tr.head, ENDCASE => [reference[ref: tv]]), status: TVStatus[tv], field: embedded[fd: [wordOffset: (WITH tv SELECT FROM tr: REF TypedVariableRec => WITH t: tr SELECT FROM embedded => t.fd.wordOffset, ENDCASE => 0, ENDCASE => 0), extent: large[size: size]]]]]}; -- end p -- Begin Here IF TypeClass[UnderType[type]] # union THEN Error[reason: typeFault, type: type]; tp.ComponentISEI[type, NameToIndex[type, TVToName[Tag[tv]]], p]}; -- break up and MOVE -- [1..NComponents[TVType[tv]]] IndexToTV: PUBLIC SAFE PROC[tv: TypedVariable--record, structure--, index: Index] RETURNS[TypedVariable] = TRUSTED {cType: Type; type: Type _ UnderType[TVType[tv]]; et: REF TypedVariableRec; argRec: BOOLEAN; interfaceRec: BOOLEAN; bitsForTV: LONG CARDINAL; BuildEmbeddedTV: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = {sei: SymbolIndex = stb.seb[isei].idType; csei: SymbolConstructorIndex _ stb.UnderType[sei]; bitsForType: CARDINAL _ stb.BitsForType[csei]; -- bits for the value in the field fieldBits: CARDINAL _ stb.seb[isei].idInfo; -- bits for the field fieldBitOffset: CARDINAL _ IF argRec THEN stb.FnField[isei].offset.wd*bitsPerWord ELSE IF interfaceRec THEN stb.seb[isei].idValue*bitsPerWord ELSE stb.seb[isei].idValue; -- bit offset of the field within the record isSequence: BOOLEAN _ FALSE; WITH cse: stb.seb[csei] SELECT FROM relative => bitsForType _ stb.BitsForType[cse.offsetType]; -- NOTE SymbolPack bug workaround ENDCASE; IF (NOT Embedded[tv]) AND bitsForTV < bitsPerWord -- if the entire tv is smaller than a word and in an allocated object THEN fieldBitOffset _ fieldBitOffset + bitsPerWord - ShortenLongCardinal[bitsForTV]; WITH cse: stb.seb[csei] SELECT FROM sequence => {recstb: SymbolTableBase; recsei: SymbolIndex; [recstb, recsei] _ GetTypeSymbols[type]; cType _ AcquireSequenceType[stb, sei, recstb, LOOPHOLE[recsei, SymbolRecordIndex] ! UNWIND => ReleaseSTB[recstb]]; isSequence _ TRUE; ReleaseSTB[recstb]}; ENDCASE => cType _ AcquireType[stb, sei]; IF stb.seb[isei].constant THEN {ENABLE Error => IF reason = notImplemented THEN GOTO nimp; et _ tvZone.NEW[TypedVariableRec _ [ referentType: [cType, TVTag[tv]], head: [constant[]], status: const, field: constant[value: tp.GetIdConstantValue[tv, stb, isei]] ] ]; EXITS nimp => et _ NIL} ELSE IF interfaceRec AND NOT IsInterfaceElementType[cType] -- an interface variable THEN { -- XXX old: the (16-bit) value in the indicated field of the IR instance is... -- a (loadstate config index (identifies a BCD), -- index in linksary of EXPRecord for this interface in that BCD) fD: tp.FieldDescriptor; headP: Pointer; IF IsRemote[tv] THEN ERROR Error[reason: notImplemented, msg: "Interface variables for remote interface records"]; fD _ BuildRecordFieldDescriptor[tv, fieldBitOffset, 16, 16]; IF TRUE THEN {hP: Pointer = -- NOTE XXX Remote WITH head: NARROW[tv, REF TypedVariableRec].head SELECT FROM reference => LOOPHOLE[head.ref, Pointer], ENDCASE => ERROR Error[reason: internalTV]; ptr: POINTER _ LOOPHOLE[hP + fD.wordOffset, LONG POINTER TO POINTER]^; IF CedarLinkerOps.NullLink[ptr] -- maybe not bound THEN et _ NIL ELSE et _ NARROW[AMBridge.TVForPointerReferent [ptr: LONG[ptr], type: cType, status: readOnly]]; RETURN}; WITH tv SELECT FROM tr: REF TypedVariableRec => WITH head: tr.head SELECT FROM reference => headP _ LOOPHOLE[head.ref, Pointer]; ENDCASE => ERROR Error[reason: internalTV]; ENDCASE => ERROR; -- headP _ LOOPHOLE[tv]; -- et _ AMMiniModelPrivate.TVForExportedVariable -- [stb.stHandle.version, -- LOOPHOLE[headP + fD.wordOffset, -- LONG POINTER TO UNSPECIFIED]^]; WITH e: stb.seb[csei] SELECT FROM ref => IF e.var THEN {IF e.readOnly THEN NARROW[et, REF TypedVariableRec].status _ readOnly} ELSE IF stb.seb[isei].immutable THEN NARROW[et, REF TypedVariableRec].status _ readOnly; -- old symbol table ENDCASE => IF stb.seb[isei].immutable THEN NARROW[et, REF TypedVariableRec].status _ readOnly; -- old symbol table } ELSE IF Constant[tv] THEN WITH tv SELECT FROM tr: REF constant TypedVariableRec => {ws: WordSequence; IF fieldBits >= bitsPerWord THEN {ws _ NEW[WordSequenceRecord[fieldBits/bitsPerWord]]; FOR i: NAT IN [0..fieldBits/bitsPerWord) DO ws[i] _ tr.value[i]; ENDLOOP; } ELSE {ws _ NEW[WordSequenceRecord[1]]; ws[0] _ FetchField[@tr.value[0], [bitFirst: fieldBitOffset, bitCount: fieldBits]]}; et _ tvZone.NEW[TypedVariableRec _ [ referentType: [cType, TVTag[tv]], head: [constant[]], status: const, field: constant[value: ws]] ]} ENDCASE => ERROR ELSE {et _ tvZone.NEW[TypedVariableRec _ [ referentType: [cType, TVTag[tv]], head: (WITH tv SELECT FROM tr: REF TypedVariableRec => tr.head, ENDCASE => ERROR), -- [reference[ref: tv]]), status: (IF NOT interfaceRec AND stb.seb[isei].immutable THEN readOnly ELSE TVStatus[tv]), field: embedded[fd: (SELECT TypeClass[UnderType[cType]] FROM union, sequence => [wordOffset: (IF Embedded[tv] THEN LOOPHOLE [tv, REF embedded TypedVariableRec] .fd.wordOffset ELSE 0), extent: large[size: Size[type, 0--fix length later if sequence--]]], ENDCASE => BuildRecordFieldDescriptor [tv, fieldBitOffset, fieldBits, bitsForType])]]]; IF isSequence THEN WITH x: et SELECT FROM embedded => x.fd.extent _ large [size: Size[type, ShortenLongCardinal[TVToLC[Tag[et]] - TVToLC[First[Domain[cType]]]]]]; ENDCASE => ERROR}}; -- END BuildEmbeddedTV -- Begin IndexToTV Here [bitsForTV, argRec, interfaceRec] _ tp.BitsForType[type]; tp.RecordComponentISEI[type, index, BuildEmbeddedTV]; RETURN[et]}; -- end IndexToTV IsInterfaceElementType: PROC[type: Type] RETURNS[BOOLEAN] = { class: Class = TypeClass[UnderType[type]]; RETURN[SELECT class FROM program, procedure, signal, error => TRUE, ENDCASE => FALSE]}; -- raises typeFault TVToType: PUBLIC SAFE PROC[tv: TypedVariable--type--] RETURNS[Type] = TRUSTED {type: Type = UnderType[TVType[tv]]; RETURN[SELECT TypeClass[type] FROM type => IF IsRemote[tv] THEN RemoteTypeToLocal[world: GetWorld[tv], remoteType: TVToCardinal[tv]] ELSE LOOPHOLE[TVToCardinal[tv], Type], ENDCASE => ERROR Error[reason: typeFault, type: type]]}; -- raises typeFault PropertyList: PUBLIC SAFE PROC[tv: TypedVariable--atom--] RETURNS[TV--list--] = TRUSTED {type: Type = UnderType[TVType[tv]]; RETURN[SELECT TypeClass[type] FROM -- NOTE assumption of remote AtomRec identity atom => Loophole[IndexToTV[Loophole[tv, CODE[REF AtomsPrivate.AtomRec]], NameToIndex[CODE[AtomsPrivate.AtomRec], "propList"]], CODE[List.AList]], ENDCASE => ERROR Error[reason: typeFault, type: type]]}; TVToName: PUBLIC SAFE PROC[tv: TypedVariable --transfer, program, globalFrame, enumerated, atom, rope-- ] RETURNS[ans: ROPE] = TRUSTED {type: Type = UnderType[TVType[tv]]; world: World = GetWorld[tv]; RETURN [SELECT TypeClass[type] FROM ref => IF IsAtom[tv] THEN TVToName[Coerce[tv, CODE[ATOM]]] ELSE IF IsRope[tv] THEN TVToName[Coerce[tv, CODE[ROPE]]] ELSE ERROR Error[reason: typeFault, type: type], atom => IF IsRemote[tv] THEN RemoteRope.RopeFromTV [Loophole[IndexToTV [Loophole[tv, CODE[REF AtomsPrivate.AtomRec]], 1], CODE[ROPE]]] -- NOTE beware ELSE LOOPHOLE[TVToLC[tv], REF AtomsPrivate.AtomRec].pName, rope => IF IsRemote[tv] THEN RemoteRope.RopeFromTV[tv] ELSE LOOPHOLE[TVToLC[tv], ROPE], enumerated => IF TVToLC[tv] + 1 > LAST[CARDINAL] THEN ERROR Error[reason: notImplemented, msg: "Gigunda MACHINE DEPENDENT enumerations", type: type] ELSE IndexToName[type, TVToLC[tv] + 1], program, procedure => IF IsRemote[tv] THEN RemotePDToName[TVToRemoteProc[tv]] ELSE tp.PDToName[LOOPHOLE[TVToProc[tv], PrincOps.ProcDesc]], signal, error => IF IsRemote[tv] THEN RemoteSEDToName[TVToRemoteSignal[tv]] ELSE tp.SEDToName[LOOPHOLE[TVToSignal[tv], PrincOps.SignalDesc]], globalFrame => IF IsRemote[tv] THEN RemoteGFHToName[RemoteGFHFromTV[tv]] ELSE tp.GFHToName[GFHFromTV[tv]], ENDCASE => NIL]}; -- break up and MOVE Apply: PUBLIC SAFE PROC[mapper: TV--array, sequence, descriptor, longDescriptor--, arg: TV] RETURNS[embeddedTV: TV] = TRUSTED { type: Type _ UnderType[TVType[mapper]]; stb: SymbolTableBase; sei: SymbolIndex; class: Class = TypeClass[type]; IF mapper = NIL THEN ERROR Error[reason: typeFault, type: type]; IF class = descriptor OR class = longDescriptor THEN {ws: WordSequence = TVToWordSequence[mapper]; length: CARDINAL = IF class = descriptor THEN LENGTH[LOOPHOLE [@ws[0], LONG POINTER TO DESCRIPTOR FOR ARRAY OF WORD]^] ELSE LENGTH[LOOPHOLE [@ws[0], LONG POINTER TO LONG DESCRIPTOR FOR ARRAY OF WORD]^]; type _ Range[type]; IF TVToCardinal[arg] >= length THEN ERROR Error[reason: rangeFault]; IF IsRemote[mapper] THEN mapper _ TVForRemotePointerReferent [remotePointer: [world: GetWorld[mapper], worldIncarnation: GetWorldIncarnation[mapper], ptr: IF class = descriptor THEN LOOPHOLE [LONG[BASE[LOOPHOLE [@ws[0], LONG POINTER TO DESCRIPTOR FOR ARRAY OF WORD]^]], WorldVM.Address] ELSE LOOPHOLE [BASE [LOOPHOLE [@ws[0], LONG POINTER TO LONG DESCRIPTOR FOR ARRAY OF WORD]^ ], WorldVM.Address] ], type: type, status: ReferentStatus[TVType[mapper]]] ELSE mapper _ TVForPointerReferent [ptr: IF class = descriptor THEN BASE[LOOPHOLE [@ws[0], LONG POINTER TO DESCRIPTOR FOR ARRAY OF WORD]^] ELSE BASE [LOOPHOLE [@ws[0], LONG POINTER TO LONG DESCRIPTOR FOR ARRAY OF WORD]^], type: type, status: ReferentStatus[TVType[mapper]]]}; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; eltTypeEi: SymbolIndex; domainType: Type = Domain[type]; upperLimit: INT _ TVToLI[Last[domainType]]; lowerLimit: INT _ TVToLI[First[domainType]]; argValue: INT = TVToLI[arg]; bitOffset: INT; bitsPerElement: CARDINAL; tagEndOffset: INTEGER _ 0; isPacked: BOOLEAN _ FALSE; isSequence: BOOLEAN _ FALSE; fd: tp.FieldDescriptor; WITH ser: stb.seb[stb.UnderType[sei]] SELECT FROM array => {isPacked _ ser.packed; eltTypeEi _ ser.componentType}; sequence => {tag: TV _ Tag[mapper]; isPacked _ ser.packed; isSequence _ TRUE; upperLimit _ TVToLI[tag] - 1; eltTypeEi _ ser.componentType; -- Sequence begins in the word beyond the tag! tagEndOffset _ IF IsComputed[type] THEN 0 ELSE (stb.seb[ser.tagSei].idInfo + stb.seb[ser.tagSei].idValue)}; ENDCASE => ERROR Error[reason: typeFault, type: TVType[mapper]]; IF ~InRange[domainType, arg] OR argValue > upperLimit THEN ERROR Error[reason: rangeFault]; -- extra check for sequences! bitsPerElement _ stb.BitsPerElement[type: eltTypeEi, packed: isPacked]; bitOffset _ tagEndOffset + (argValue - lowerLimit) * bitsPerElement; -- now adjust bitOffset if the entire mapper is smaller than a word and in an allocated object IF (class # descriptor) AND (class # longDescriptor) AND (NOT isSequence) AND (NOT Embedded[mapper]) THEN {bitsForTV: LONG CARDINAL _ 0; [bitsForTV,,] _ tp.BitsForType[type]; IF bitsForTV < bitsPerWord THEN bitOffset _ bitOffset + bitsPerWord - ShortenLongCardinal[bitsForTV]}; fd _ BuildRecordFieldDescriptor[mapper, bitOffset, bitsPerElement, stb.BitsForType[eltTypeEi]]; embeddedTV _ tvZone.NEW[TypedVariableRec _ [referentType: [Range[type]], head: NARROW[mapper, REF TypedVariableRec].head, status: NARROW[mapper, REF TypedVariableRec].status, field: embedded[fd: fd]]]; ReleaseSTB[stb]}}; -- end Apply Fetch: PUBLIC SAFE PROC[tv: TypedVariable--rope--, index: INT] RETURNS[CHAR] = TRUSTED {type: Type = UnderType[TVType[tv]]; RETURN[SELECT TypeClass[type] FROM rope => IF IsRemote[tv] THEN RemoteRope.RemoteFetch[tv, index] ELSE Rope.Fetch[TVToName[tv], index], ENDCASE => ERROR Error[reason: typeFault, type: type]]}; OctalRead: PUBLIC SAFE PROC[tv: TypedVariable, offset: INT] RETURNS[ans: CARDINAL] = TRUSTED {addr: tp.ValueAddress = tp.GetValueAddress[tv]; WITH t: addr SELECT FROM constant => RETURN[t.value[offset]]; pointer => RETURN[LOOPHOLE[t.ptr + offset, LONG POINTER TO CARDINAL]^]; remotePointer => RETURN [RTTypesRemotePrivate.GetRemoteWord [[world: GetWorld[tv], worldIncarnation: GetWorldIncarnation[tv], ptr: t.ptr.ptr + offset]]]; copiedRemoteObject => RETURN[LOOPHOLE[t.ptr + offset, LONG POINTER TO CARDINAL]^]; ENDCASE => ERROR; }; Length: PUBLIC SAFE PROC[tv: TV --sequence, rope, descriptor, longDescriptor--] RETURNS[INT] = TRUSTED {type: Type = UnderType[TVType[tv]]; SELECT TypeClass[type] FROM sequence => RETURN[TVToLI[Tag[tv]]-TVToLI[First[Domain[type]]]]; rope => IF IsRemote[tv] THEN RETURN[RemoteRope.RemoteLength[tv]] ELSE RETURN[Rope.Length[TVToName[tv]]]; descriptor => {ws: WordSequence = TVToWordSequence[tv]; RETURN[LENGTH[LOOPHOLE[@ws[0], LONG POINTER TO DESCRIPTOR FOR ARRAY OF WORD]^]]}; longDescriptor => {ws: WordSequence = TVToWordSequence[tv]; RETURN[LENGTH[LOOPHOLE[@ws[0], LONG POINTER TO LONG DESCRIPTOR FOR ARRAY OF WORD]^]]}; ENDCASE => ERROR Error[reason: typeFault, type: type]}; -- raises typeFault, badTV -- NOTE no size check. You're on your own. Loophole: PUBLIC PROC[tv: TypedVariable, type: Type, tag: TypedVariable _ NIL] RETURNS[TypedVariable] = {variantClass: Class = VariableType[type].c; IF tag # NIL AND variantClass # union AND variantClass # sequence THEN ERROR Error[reason: typeFault, type: type, msg: "non-NIL tag makes no sense"]; WITH tv SELECT FROM tvr: REF TypedVariableRec => WITH tvr: tvr SELECT FROM entire => RETURN[tvZone.NEW[TypedVariableRec _ [ referentType: [type, tag], head: tvr.head, status: tvr.status, field: entire[]]]]; embedded => RETURN[tvZone.NEW[TypedVariableRec _ [ referentType: [type, tag], head: tvr.head, status: tvr.status, field: embedded[fd: tvr.fd]]]]; constant => RETURN[tvZone.NEW[TypedVariableRec _ [ referentType: [type, tag], head: tvr.head, status: tvr.status, field: constant[value: tvr.value]]]]; ENDCASE => ERROR; ENDCASE => ERROR; }; ConcreteRef: PUBLIC SAFE PROC[tv: TypedVariable--ref any--] RETURNS[ans: TypedVariable _ NIL] = TRUSTED {type: Type _ UnderType[TVType[tv]]; class: Class _ TypeClass[type]; IF class = nil OR TVToLC[tv] = 0 THEN RETURN[NIL]; IF class = atom OR class = rope OR class = list THEN RETURN[tv]; IF class # ref THEN ERROR Error[reason: typeFault, type: type]; IF TypeClass[Range[type]] # any THEN RETURN[tv]; IF IsAtom[tv] THEN RETURN[Coerce[tv, CODE[ATOM]]] ELSE IF IsRope[tv] THEN RETURN[Coerce[tv, CODE[ROPE]]] ELSE { realSourceRangeType: Type; IF IsRemote[tv] THEN {r: RemoteRef = [world: GetWorld[tv], worldIncarnation: GetWorldIncarnation[tv], ref: TVToLC[tv]]; realSourceRangeType _ RTTypesRemotePrivate.GetRemoteReferentType[r]} ELSE realSourceRangeType _ RTTypesBasic.GetReferentType[LOOPHOLE[TVToLC[tv], REF ANY]]; IF TypeClass[UnderType[realSourceRangeType]] = structure AND NComponents[UnderType[realSourceRangeType]] = 2 AND TypeClass[UnderType[IndexToType[realSourceRangeType, 2]]] = list THEN ans _ Coerce[tv, IndexToType[realSourceRangeType, 2] ! Error => CONTINUE]; }; IF ans = NIL THEN ERROR Error[reason: notImplemented, msg: "ConcreteRef for other than ATOM, ROPE or LIST targets"]; }; -- break up and MOVE Referent: PUBLIC SAFE PROC [tv: TypedVariable, --ref, list, pointer, longPointer, relativePointer base: TypedVariable _ NIL] --base non-nil only if ref is a relativePointer. UNSAFE in this case. RETURNS[TypedVariable] = TRUSTED { type: Type _ TVType[tv]; referentType: Type _ Range[type]; -- raises Error[typeFault] status: Status _ mutable; ptr: Pointer; stb: SymbolTableBase; sei: SymbolIndex; [stb, sei] _ GetTypeSymbols[type]; { ENABLE UNWIND => ReleaseSTB[stb]; csei: SymbolConstructorIndex = stb.UnderType[sei]; WITH ser: stb.seb[csei] SELECT FROM long => WITH ser1: stb.seb[stb.UnderType[ser.rangeType]] SELECT FROM ref => IF ser1.readOnly THEN status _ readOnly; ENDCASE => ERROR Error[reason: typeFault, type: type]; ref => IF ser.readOnly THEN status _ readOnly; relative => NULL; ENDCASE => ERROR Error[reason: typeFault, type: type]}; ReleaseSTB[stb]; IF referentType = unspecType THEN ERROR Error[reason: typeFault, type: referentType]; IF IsRemote[tv] THEN SELECT TypeClass[UnderType[type]] FROM relativePointer => { world: World = GetWorld[tv]; ptr: RemotePointer = [world: world, worldIncarnation: CurrentIncarnation[world], ptr: TVToLC[base] + TVToCardinal[tv]]; -- NOTE assumption that MDS is in the same place IF NOT TypeClass[UnderType[TVType[base]]] = basePointer THEN ERROR Error[reason: typeFault, type: TVType[base]]; RETURN[TVForRemotePointerReferent [remotePointer: ptr, type: referentType, status: status]]}; ref, list => {world: World = GetWorld[tv]; ref: RemoteRef = [world: world, worldIncarnation: CurrentIncarnation[world], ref: TVToLC[tv]]; ValidateRemoteRef[ref]; RETURN[TVForRemoteReferent[remoteRef: ref, status: status]]}; pointer => {world: World = GetWorld[tv]; ptr: RemotePointer = [world: world, worldIncarnation: CurrentIncarnation[world], ptr: Long[world: world, addr: TVToCardinal[tv]]]; -- NOTE assumption that MDS is in the same place IF TypeClass[UnderType[referentType]] = opaque THEN ERROR Error[reason: typeFault, type: referentType]; RETURN[TVForRemotePointerReferent [remotePointer: ptr, type: referentType, status: status]]}; longPointer => {world: World = GetWorld[tv]; IF TypeClass[UnderType[referentType]] = opaque THEN ERROR Error[reason: typeFault, type: referentType]; RETURN[TVForRemotePointerReferent [remotePointer: [world: world, worldIncarnation: CurrentIncarnation[world], ptr: TVToLC[tv]], type: referentType, status: status]]}; ENDCASE => ERROR -- end IsRemote[tv] ELSE -- local tv SELECT TypeClass[UnderType[type]] FROM relativePointer => { IF NOT TypeClass[UnderType[TVType[base]]] = basePointer THEN ERROR Error[reason: typeFault, type: TVType[base]]; ptr _ LOOPHOLE[TVToLC[base] + TVToCardinal[tv], Pointer]; RETURN[TVForPointerReferent[ptr: ptr, type: referentType, status: status]]}; ref, list => {ref: REF ANY = LOOPHOLE[TVToLC[tv], REF ANY]; ValidateRef[ref]; RETURN[TVForReferent[ref: ref, status: status]]}; pointer => {ptr _ LONG[LOOPHOLE[TVToCardinal[tv], POINTER]]; IF TypeClass[UnderType[referentType]] = opaque THEN ERROR Error[reason: typeFault, type: referentType]; RETURN[TVForPointerReferent[ptr: ptr, type: referentType, status: status]]}; longPointer => {ptr _ LOOPHOLE[TVToLC[tv], Pointer]; IF TypeClass[UnderType[referentType]] = opaque THEN ERROR Error[reason: typeFault, type: referentType]; RETURN[TVForPointerReferent[ptr: ptr, type: referentType, status: status]]}; ENDCASE => ERROR; }; -- end Referent tInteger: Type _ nullType; tCardinal: Type _ nullType; tLongInteger: Type _ nullType; tLongCardinal: Type _ nullType; -- Raises typeFault, rangeFault. COPIES unless types are equivalent. Coerce: PUBLIC SAFE PROC[tv: TypedVariable, targetType: Type] RETURNS[newTV: TypedVariable] = TRUSTED {type: Type = TVType[tv]; tvr: REF TypedVariableRec; -- utility targetClass, sourceClass: Class; IF type = targetType THEN RETURN[tv]; IF EquivalentTypes[type, targetType] THEN RETURN[Loophole[tv, targetType]]; targetClass _ TypeClass[UnderType[targetType]]; sourceClass _ TypeClass[UnderType[type]]; IF sourceClass = ref AND TypeClass[UnderType[Range[type]]] = opaque THEN RETURN[Coerce[Loophole[tv, CODE[REF ANY]], targetType]]; SELECT targetClass FROM procedure => --the target type class {SELECT sourceClass FROM -- look at the source type procedure => { IF TypeClass[UnderType[Domain[targetType]]] = any AND TypeClass[UnderType[Range[targetType]]] = any THEN -- assignment of a proc to a PROC ANY ANY; copy it {IF IsRemote[tv] THEN newTV _ tvZone.NEW[TypedVariableRec _ [referentType: [targetType], head: [copiedRemoteObject [world: GetWorld[tv], worldIncarnation: GetWorldIncarnation[tv], copy: tvZone.NEW[WordSequenceRecord[1]]]], status: mutable, field: entire[]]] ELSE newTV _ New[type: targetType]; Assign[lhs: newTV, rhs: Loophole[tv, targetType]]; } ELSE ERROR Error[reason: typeFault, type: type, otherType: targetType]; }; nil => RETURN[NIL]; -- NIL conforms to any PROC type ENDCASE => ERROR Error[reason: typeFault, type: type, otherType: targetType]; }; ref, list, atom, rope => --the target type class {targetRangeType: Type _ nullType; sourceRangeType: Type _ nullType; realSourceRangeType: Type _ nullType; narrowToAtomOrRope: BOOL _ FALSE; widenFromAtomOrRope: BOOL _ FALSE; SELECT sourceClass FROM -- look at the source type ref, list, atom, rope => NULL; nil => RETURN[NIL]; -- NIL conforms to any REF type ENDCASE => ERROR Error[reason: typeFault, type: type]; IF targetClass = ref OR targetClass = list THEN targetRangeType _ Range[targetType]; IF sourceClass = ref OR sourceClass = list THEN {sourceRangeType _ Range[UnderType[type]]; IF IsRemote[tv] THEN {r: RemoteRef = [world: GetWorld[tv], worldIncarnation: GetWorldIncarnation[tv], ref: TVToLC[tv]]; realSourceRangeType _ RTTypesRemotePrivate.GetRemoteReferentType[r]} ELSE realSourceRangeType _ RTTypesBasic.GetReferentType[LOOPHOLE[TVToLC[tv], REF ANY]]}; IF targetClass = atom OR targetClass = rope THEN {narrowToAtomOrRope _ sourceClass = ref AND sourceRangeType = anyType AND (IF targetClass = atom THEN EquivalentTypes[realSourceRangeType, CODE[AtomsPrivate.AtomRec]] ELSE EquivalentTypes[realSourceRangeType, CODE[Rope.RopeRep]]); --check that a REF ANY tv represents an atom or rope, respectively IF NOT narrowToAtomOrRope THEN ERROR Error[reason: rangeFault]}; IF sourceClass = atom OR sourceClass = rope THEN {widenFromAtomOrRope _ targetClass = ref AND (targetRangeType = unspecType OR targetRangeType = anyType); IF NOT widenFromAtomOrRope THEN ERROR Error[reason: rangeFault]}; IF narrowToAtomOrRope OR widenFromAtomOrRope OR targetRangeType = unspecType --widen-- OR targetRangeType = anyType --widen-- OR sourceRangeType = nullType --NIL conforms to any ref target type-- OR AsGoodAs[lhsType: targetRangeType, rhsType: sourceRangeType] --narrow-- THEN -- create a new TV of the specified targetType with the specified value {IF IsRemote[tv] THEN {world: World = GetWorld[tv]; ws: WordSequence = NEW[WordSequenceRecord[2]]; LOOPHOLE[@ws[0], LONG POINTER TO LONG UNSPECIFIED]^ _ TVToLC[tv]; newTV _ tvZone.NEW[TypedVariableRec _ [referentType: [targetType], head: [copiedRemoteObject [world: world, worldIncarnation: CurrentIncarnation[world], copy: ws]], status: readOnly, field: entire[]]]; } ELSE {result: REF ANY = LOOPHOLE[TVToLC[tv], REF ANY]; -- logically, the value of tv (a REF, LIST, ATOM, or ROPE) newTV _ New[type: targetType, status: readOnly]; tvr _ NARROW[newTV, REF TypedVariableRec]; WITH hd: tvr.head SELECT FROM reference => LOOPHOLE[hd.ref, REF REF ANY]^ _ result; ENDCASE => ERROR}} ELSE ERROR Error[reason: rangeFault]}; subrange, character, enumerated, integer, cardinal, longInteger, longCardinal => {g1: Type = GetCanonicalType[GroundStar[type]]; g2: Type = GetCanonicalType[GroundStar[targetType]]; li: LONG INTEGER = TVToLI[tv]; IF g1 = g2 THEN NULL ELSE { IF tInteger = nullType THEN { tInteger _ GetCanonicalType[CODE[INTEGER]]; tCardinal _ GetCanonicalType[CODE[CARDINAL]]; tLongInteger _ GetCanonicalType[CODE[LONG INTEGER]]; tLongCardinal _ GetCanonicalType[CODE[LONG CARDINAL]]}; IF (g1 = tCardinal OR g1 = tInteger OR g1 = tLongCardinal OR g1 = tLongInteger) AND (g2 = tCardinal OR g2 = tInteger OR g2 = tLongCardinal OR g2 = tLongInteger) THEN NULL ELSE ERROR Error[reason: typeFault, type: type]}; IF li < TVToLI[First[targetType]] OR TVToLI[Last[targetType]] < li THEN ERROR Error[reason: rangeFault]; newTV _ New[type: targetType, status: readOnly]; tvr _ NARROW[newTV, REF TypedVariableRec]; tvr.status _ mutable; SetTVFromLI[newTV, li]; tvr.status _ readOnly}; ENDCASE => ERROR Error[reason: typeFault, type: targetType]}; -- end Coerce InRange: PUBLIC SAFE PROC[type: Type--subrange--, groundTV: TypedVariable] RETURNS[val: BOOLEAN] = TRUSTED { [] _ Coerce[groundTV, type ! Error => IF reason = rangeFault THEN GOTO nope]; RETURN[TRUE]; EXITS nope => RETURN[FALSE]}; Next: PUBLIC SAFE PROC[tv: TypedVariable--enumerated, subrange, basic--] RETURNS[TypedVariable] = TRUSTED { val: LONG INTEGER = TVToLI[tv]; type: Type = TVType[tv]; newTV: TypedVariable; IF val = TVToLI[Last[type]] THEN RETURN[NIL]; newTV _ New[type]; SetTVFromLC[newTV, LOOPHOLE[val + 1, LONG CARDINAL]]; -- NOTE mach dep enum? RETURN[newTV]}; -- Procedures private to this module Constant: PROC[tv: TypedVariable] RETURNS[BOOLEAN] = {WITH tv SELECT FROM rtr: REF TypedVariableRec => WITH etr: rtr SELECT FROM constant => RETURN[TRUE]; ENDCASE; ENDCASE; RETURN[FALSE]}; Embedded: PROC[tv: TypedVariable] RETURNS[ans: BOOLEAN _ FALSE] = {WITH tv SELECT FROM rtr: REF TypedVariableRec => WITH etr: rtr SELECT FROM embedded => ans _ TRUE; ENDCASE; ENDCASE => ERROR}; -- BuildRecordFieldDescriptor is used to build FieldDescriptors for components of TVs. -- fieldBitOffset and fieldBits specify the component's container location and size relative -- to the container holding parentTV's value. -- If the component is smaller than a word, bitsForType specifies its size, which may be -- smaller than the size of the component's container (if bitsForType >= bitsPerWord, the -- component size is the same as the container size). -- The result of BuildRecordFieldDescriptor describes an embedded field WRT parentTV's -- head wherein the bits of the component reside. -- Generally, an embedded field of a TV describes where WRT its head the bits -- of its value reside. BuildRecordFieldDescriptor: PUBLIC PROC[parentTV: TypedVariable, fieldBitOffset, fieldBits, bitsForType: INT] RETURNS[fD: tp.FieldDescriptor] = {fD _ IF bitsForType < bitsPerWord THEN BuildSmallFieldDescriptor[fieldBitOffset + fieldBits - bitsForType, bitsForType] ELSE BuildLargeFieldDescriptor[fieldBitOffset / bitsPerWord, fieldBits / bitsPerWord]; IF parentTV = NIL THEN RETURN; -- adjust offsets relative to parent. WITH parentTV SELECT FROM parentTr: REF TypedVariableRec => WITH parentT: parentTr SELECT FROM embedded=> { fD.wordOffset _ fD.wordOffset + parentT.fd.wordOffset; WITH parentF: parentT.fd SELECT FROM small=> WITH f: fD SELECT FROM small=> f.field.bitFirst _ f.field.bitFirst + parentF.field.bitFirst; ENDCASE => ERROR; ENDCASE}; ENDCASE; ENDCASE => ERROR}; BuildSmallFieldDescriptor: PROC[bitOffset, bitCount: INT] RETURNS[small tp.FieldDescriptor] = INLINE {RETURN[tp.FieldDescriptor[wordOffset: ShortenLongInteger[bitOffset / bitsPerWord], extent: small[field: [bitFirst: ShortenLongInteger [bitOffset MOD bitsPerWord], bitCount: ShortenLongInteger[bitCount]]]]]}; BuildLargeFieldDescriptor: PROC[wordOffset, nWords: INT] RETURNS[large tp.FieldDescriptor] = INLINE {RETURN[tp.FieldDescriptor[wordOffset: ShortenLongInteger[wordOffset], extent: large[size: ShortenLongInteger[nWords]]]]}; --copied in RTTypesBridgeImpl IsRC: PROC[type: Type] RETURNS[ans: BOOL] = {RETURN[RTTypesBasicPrivate.MapTiRcmx[type] # RCMap.nullIndex]}; IsTypedVariableRec: PROC[tv: TypedVariable] RETURNS[BOOLEAN] = { RETURN[WITH tv SELECT FROM tr: REF TypedVariableRec => TRUE, ENDCASE => ERROR]}; AsGoodAs: PROC[rhsType,lhsType: Type] RETURNS[BOOLEAN] = {RETURN[EquivalentTypes[rhsType,lhsType]]};-- NOTE freely conforms = Equivalent for now END. ��y�"Mesa" style�Iproc��cZ��>��k ��5��"��2��'��&��H��M��C��O��&�� !�� 3��$��n �� %��X�V��$��>��K��#��$��%�� ]��h��Z��L��(��7�D�G�� j�� 9��%��{��Q��<��#��&��=��C�� p�� D��(��,��7��.��J��,��n��9��)��'��,�� %��O�� '��8��|��:��+��Q��6�� I��1��1�� 7��K��[��U�� V��1��E�� <��;��[��-��,�� +��O��W��8�� Y��^��1��E�� B��;��[��-��,��E��R��@��@�� !� �� X��E��R��@��@��5��<��(��(�� \�� S��&��6��8��U��*�� R�� 3��k��,��d��7��6�� #��t�$� �� +��C��?��T��@��[� ��$��p�� ;�� #��(��I��.��C�� -��Q�"�� F��V��@��>��6��'�� !��&��O��1��E�a��"��1��7��9��L��[��,��0��.��,��Y��"��1��A��<��J��;��J��U��/��J��;��4��m��&��>��!��;��,��f��}��N�� 3��v�� 7��6�� +��*��)��*��+��.�7��W��*��*�:��M��;��%��Q�� 2��$��1�� 3��]��%��;�� Y��%��>��[��%��=��)�� /�� +��E��;��?� ��+��~��?�� 9��,��#��C��<��D� ��8��9��~��?�� M��C��G� ��3��9��?�� f��-��,��#��"��g��D��Y�/��-��C��6��_�� H��(�� M�� {� �� +��)��>��0��*� ��9�� &��.��,��=��.��r��B��?� ��w��B��?�� )�F��5��C��M�� "��P�� +�� ,��4��i��A��;��K��A��&�3�'��F��E��T��-��%��6��(�� B��3��1� ��A��<��1��E��E��J��J��)��A��B��9��m�� -��F��E��E��2��J��J�� E��,��"��(�� #��~��/�� =��;��3��~��Y��!��c�� !�� .��-��D��4��e��Y��5��6��d��:��c��C��$��Z��A��-��$�� '� ��>� ��H� ��L��'�� .�� ;�Q��!�� *��.��1��2�� .��(��&��_��p��/��!��+�� J��1�� %�� W��]��.��Y��Z��6��W��2��N��r��#��$��&�� f��$�� w�� ;�� $�-��/