DIRECTORY AMBridge USING[WordSequence, SetTVFromLC, TVToLC, GetWorld, TVForReferent], AMTypes USING [ TVType, TVSize, Error, TypeClass, UnderType, Coerce, Tag, IndexToTV, NComponents, New, VariableType, Class, TypedVariable, TV], PrincOpsUtils USING[LongCOPY], RCMap USING[nullIndex], RTTypesBasicPrivate USING[MapTiRcmx, MapRefs, AssignCompositeNew, AssignComposite], RTTypesPrivate USING[ValueAddress, GetValueAddress, TypedVariableRec], RTTypesRemotePrivate USING[GetRemoteWords, RemoteStoreWords], SafeStorage USING[Type, nullType, fhType, gfhType, EquivalentTypes], SafeStoragePrivate USING[ValidateRef]; AMVariablesImpl: PROGRAM IMPORTS AMBridge, AMTypes, PrincOpsUtils, SafeStoragePrivate, SafeStorage, RTTypesBasicPrivate, RTTypesPrivate, RTTypesRemotePrivate EXPORTS AMTypes = BEGIN OPEN AMBridge, AMTypes, SafeStorage, SafeStoragePrivate, tp: RTTypesPrivate, RTTypesRemotePrivate; TypedVariableRec: TYPE = tp.TypedVariableRec; emptyTV: TypedVariable = AMBridge.TVForReferent[NEW[REF ANY _ $EmptyTVReferent]]; GetEmptyTV: PUBLIC SAFE PROC RETURNS[TypedVariable] = TRUSTED { RETURN[emptyTV]; }; Assign: PUBLIC SAFE PROC[lhs: TypedVariable, rhs: TypedVariable] = TRUSTED { DoAssign[lhs, rhs]}; AssignNew: PUBLIC SAFE PROC[lhs: TypedVariable, rhs: TypedVariable] = TRUSTED{ 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 PrincOpsUtils.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 => RTTypesBasicPrivate.AssignCompositeNew[ rhs: @t.value[0], lhs: NARROW[lhsa, pointer tp.ValueAddress].ptr, type: rhsType, nwords: t.value.size]; ENDCASE => RTTypesBasicPrivate.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 PrincOpsUtils.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 => RTTypesBasicPrivate.AssignCompositeNew[rhs: t.ptr, lhs: NARROW[lhsa, pointer tp.ValueAddress].ptr, type: rhsType, nwords: size] ENDCASE => RTTypesBasicPrivate.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]; IF lhsa.tag = remotePointer THEN RemoteStoreWords[ from: @ws[0], to: NARROW[lhsa, remotePointer tp.ValueAddress].ptr, nWords: size] ELSE PrincOpsUtils.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 PrincOpsUtils.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. <AMVariablesImpl.Mesa last modified on November 10, 1983 7:20 am 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 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šœ™šœ9™9Jšœ:™:Jšœ™—™&J™ J™}J˜—šÏk ˜ Jšœ œ=˜Kšœœ˜Jšœ{œ˜—Jšœœ ˜Jšœœ ˜Jšœœ:˜SJšœœ2˜FJšœœ#˜=Jšœ œ3˜DJšœœ˜&J˜—šœ˜š˜Jšœ}˜}—Jšœ ˜J˜šœœ˜ Jšœ]˜]—J˜—šœ ™ Jšœœ˜-J˜—šœ™J˜—Jšœ0œœœ˜QJ˜š Ïn œœœœœœ˜?Jšœ ˜Jšœ˜J˜—š žœœœœ*œ˜LJšœ˜J˜—š ž œœœœ+œ˜NJšœœ˜J˜—šžœœ.œœ˜MJšœ?™?Jšœ˜J˜Jšœœ˜Jšœœ˜Jšœœ˜J˜šœœ˜(Jšœœ)˜3—šœœ˜(Jšœœ)˜3J˜—šœÏc:˜;JšœAœ˜GJ˜0J˜šœ˜šœ˜Jšœœ˜4Jšœœ˜9Jšœ œ˜9J˜—JšœœK˜UJ˜—šœœ˜šœœ˜šœ œ˜Jšœœ˜