DIRECTORY AMBridge USING[WordSequence, SetTVFromLC, TVToLC, GetWorld], AMBridgeExtras USING[], -- EXPORTS ONLY AMTypes USING [ TVType, TVSize, Error, TypeClass, UnderType, Coerce, Tag, IndexToTV, NComponents, New, VariableType, Class], Inline USING[LongCOPY], RCMap USING[nullIndex], RTBasic USING[TypedVariable, Type, nullType, TV], RTStorageOps USING[AssignCompositeNew, AssignComposite, ValidateRef], RTTypesBasic USING[fhType, gfhType, EquivalentTypes], RTTypesBasicPrivate USING[MapTiRcmx, MapRefs], RTTypesPrivate USING[ValueAddress, GetValueAddress, TypedVariableRec], RTTypesRemotePrivate USING[GetRemoteWords, RemoteStoreWords, ValidateRemoteRef], WorldVM USING[CurrentIncarnation, Address]; AMVariablesImpl: PROGRAM IMPORTS AMBridge, AMTypes, Inline, RTStorageOps, RTTypesBasic, RTTypesBasicPrivate, RTTypesPrivate, RTTypesRemotePrivate, WorldVM EXPORTS AMBridgeExtras, AMTypes = BEGIN OPEN AMBridge, AMTypes, RTBasic, RTStorageOps, RTTypesBasic, tp: RTTypesPrivate, RTTypesRemotePrivate, WorldVM; TypedVariableRec: TYPE = tp.TypedVariableRec; Assign: PUBLIC SAFE PROC[lhs: TypedVariable, rhs: TypedVariable] = TRUSTED { DoAssign[lhs, rhs]}; AssignNew: PUBLIC PROC[lhs: TypedVariable, rhs: TypedVariable] = { DoAssign[lhs, rhs, TRUE]}; DoAssign: PROC[lhs: TypedVariable, rhs: TypedVariable, new: BOOL _ FALSE] = { lhsType: Type = TVType[lhs]; rhsType: Type = TVType[rhs]; size: CARDINAL = TVSize[rhs]; unCountedAssignment: BOOL; isRC: BOOL = IsRC[lhsType]; 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]; {--be real careful not to use the size field of lhsa if new lhsa: tp.ValueAddress _ tp.GetValueAddress[tv: lhs, mutableOnly: TRUE]; rhsa: tp.ValueAddress _ tp.GetValueAddress[rhs]; IF isRC 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 => unCountedAssignment _ FALSE; pointer, fh, remoteReference, copiedRemoteObject, remotePointer, remoteGFH, remoteFH => unCountedAssignment _ TRUE; ENDCASE => ERROR; ENDCASE => ERROR; IF rhsType = nullType THEN { SELECT TypeClass[UnderType[lhsType]] FROM list, ref, atom, rope, countedZone => { IF unCountedAssignment OR new THEN LOOPHOLE[ NARROW[lhsa, pointer tp.ValueAddress].ptr, LONG POINTER TO LONG CARDINAL]^ _ 0 ELSE LOOPHOLE[ NARROW[lhsa, pointer tp.ValueAddress].ptr, REF REF ANY]^ _ NIL; RETURN; }; pointer, longPointer, procedure, signal, error, basePointer, relativePointer, uncountedZone => GO TO zeroAssign; ENDCASE => GO TO incompatible; }; IF NOT AsGoodAs[rhsType: rhsType, lhsType: lhsType] THEN { ENABLE AMTypes.Error => IF reason = typeFault THEN GO TO incompatible; DoAssign[lhs: lhs, rhs: AMTypes.Coerce[rhs, lhsType], new: new]; RETURN; }; IF NOT new AND size > TVSize[lhs] THEN GO TO incompatible; WITH t: rhsa SELECT FROM constant => { SELECT TRUE FROM NOT isRC AND t.value.size <= 2 => GO TO smallAssign; unCountedAssignment => 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]; new => AssignCompositeNew[ rhs: @t.value[0], lhs: NARROW[lhsa, pointer tp.ValueAddress].ptr, type: rhsType, nwords: t.value.size]; ENDCASE => 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 => { IF fd.size <= 2 AND NOT isRC THEN GO TO smallAssign; WITH rhs SELECT FROM tr: REF TypedVariableRec => WITH tr.head SELECT FROM fh => { OPEN RTTypesBasicPrivate; procLeaf: PROC[r: REF ANY] = {ValidateRef[r]}; MapRefs[ptr: t.ptr, rcmx: MapTiRcmx[rhsType], procLeaf: procLeaf]; }; ENDCASE; ENDCASE; SELECT TRUE FROM unCountedAssignment => { 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]}; new => AssignCompositeNew[rhs: t.ptr, lhs: NARROW[lhsa, pointer tp.ValueAddress].ptr, type: rhsType, nwords: size] ENDCASE => AssignComposite[rhs: t.ptr, lhs: NARROW[lhsa, pointer tp.ValueAddress].ptr, type: rhsType, nwords: size]}; small => GO TO smallAssign; ENDCASE => ERROR}; remotePointer => { WITH fd: t.fd SELECT FROM large => { SELECT fd.size FROM <= 2 => GO TO smallAssign; ENDCASE => { ws: WordSequence = GetRemoteWords[t.ptr, size]; WITH rhs SELECT FROM tr: REF TypedVariableRec => WITH tr.head SELECT FROM remoteFH => { OPEN RTTypesBasicPrivate; procLeaf: PROC[r: REF ANY] = { ValidateRemoteRef[[ world: remoteFrameHandle.world, worldIncarnation: CurrentIncarnation[remoteFrameHandle.world], ref: LOOPHOLE[r, WorldVM.Address]]]}; 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 => GO TO smallAssign; ENDCASE => ERROR}; copiedRemoteObject => { WITH fd: t.fd SELECT FROM large => { IF fd.size <= 2 THEN GO TO smallAssign; 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 => GO TO smallAssign; ENDCASE => ERROR; }; ENDCASE => ERROR; EXITS smallAssign => SetTVFromLC[lhs, TVToLC[rhs]]; zeroAssign => SetTVFromLC[lhs, 0]; incompatible => ERROR Error[reason: incompatibleTypes, type: lhsType, otherType: rhsType]; }; }; -- end DoAssign TVTag: PROC[tv: TypedVariable] RETURNS[TV] = { RETURN[NARROW[tv, REF TypedVariableRec].referentType.tag]; }; 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; SELECT variantClass FROM union, sequence => tag _ Tag[IndexToTV[tv, NComponents[type]]]; ENDCASE; }; newTV _ New[world: GetWorld[tv], type: type, tag: tag]; DoAssign[lhs: newTV, rhs: tv, new: TRUE]; }; IsRC: PROC[type: Type] RETURNS[ans: BOOL] = { RETURN[RTTypesBasicPrivate.MapTiRcmx[type] # RCMap.nullIndex]}; AsGoodAs: PROC[rhsType,lhsType: Type] RETURNS[BOOL] = { RETURN[EquivalentTypes[rhsType,lhsType]]};-- NOTE freely conforms = Equivalent for now END. PAMVariablesImpl.Mesa last modified on March 29, 1983 7:18 pm by Paul Rovner try to avoid acquisition of already acquired symbol tables status stuff is wrong. Russ Atkinson, April 27, 1983 10:42 pm reformatted try to get Coerce to occur earlier in DoAssign, since assignments of longInteger to subrange failed when they should not have T Y P E S PROCs raises typeFault, notImplemented, incompatibleTypes, notMutable this bunch is RC, so we can't use the zeroAssign outlet may be an uninitialized union or seq NOTE non-RC, <= 2 words NOTE remote RC not allowed validate rhs start here NOTE remote RC not allowed rhsa.tag = remotePointer validate rhs start here rhsa.tag = copiedRemoteObject must not be RC must not be RC we just can't assign these guys COPIED in RTTypedVariablesImpl copied in RTTypesBridgeImpl copied in RTTypedVariablesImpl Ê Ñ˜Jšœ™šœ6™6Jšœ:™:Jšœ™—™&J™ J™}J˜—šÏk ˜ Jšœ œ.˜