DIRECTORY AMBridge USING[ GetWorld, nilRemotePointer, RemotePointer, SetTVFromLC, TVForReferent, TVToLC, WordSequence], AMTypes USING [ Class, Coerce, Error, IndexToTV, NComponents, New, Tag, TV, TVEqual, TVSize, TVType, TypeClass, TypedVariable, UnderType, VariableType], PrincOpsUtils USING[LongCOPY], RCMap USING[nullIndex], RTTypesBasicPrivate USING[AssignComposite, AssignCompositeNew, MapRefs, MapTiRcmx], RTTypesPrivate USING[GetValueAddress, TypedVariableRec, ValueAddress], RTTypesRemotePrivate USING[GetRemoteWords, RemoteStoreWords], SafeStorage USING[EquivalentTypes, fhType, gfhType, nullType, Type], SafeStoragePrivate USING[ValidateRef]; AMVariablesImpl: PROGRAM IMPORTS AMBridge, AMTypes, PrincOpsUtils, SafeStoragePrivate, SafeStorage, RTTypesBasicPrivate, RTTypesPrivate, RTTypesRemotePrivate EXPORTS AMTypes = BEGIN OPEN AMTypes; TypedVariableRec: TYPE = RTTypesPrivate.TypedVariableRec; Type: TYPE = SafeStorage.Type; nullType: Type = SafeStorage.nullType; 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]; rhsSize: INT _ TVSize[rhs]; lhsSize: INT _ TVSize[lhs]; lhsRemPtr: AMBridge.RemotePointer _ AMBridge.nilRemotePointer; rhsPtr: LONG POINTER _ NIL; unCountedAssignment: BOOL; isRC: BOOL _ IsRC[lhsType]; lhsa: RTTypesPrivate.ValueAddress _ RTTypesPrivate.GetValueAddress[tv: lhs, mutableOnly: TRUE]; ws: AMBridge.WordSequence _ NIL; IF lhsType = SafeStorage.fhType OR lhsType = SafeStorage.gfhType THEN ERROR Error[reason: typeFault, type: lhsType]; IF rhsType = SafeStorage.fhType OR rhsType = SafeStorage.gfhType THEN ERROR Error[reason: typeFault, type: rhsType]; {--be real careful not to use the size field of lhsa if new rhsa: RTTypesPrivate.ValueAddress _ RTTypesPrivate.GetValueAddress[rhs]; lhsa _ RTTypesPrivate.GetValueAddress[tv: lhs, mutableOnly: TRUE]; IF NOT AsGoodAs[rhsType: rhsType, lhsType: lhsType] THEN { ENABLE AMTypes.Error => IF reason = typeFault THEN GO TO incompatible; rhs _ AMTypes.Coerce[rhs, lhsType]; rhsType _ AMTypes.TVType[rhs]; rhsSize _ AMTypes.TVSize[rhs]; }; IF AMTypes.TVEqual[lhs, rhs] THEN RETURN; 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; SELECT TRUE FROM 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) ) => { IF rhsSize <= 2 AND AMBridge.TVToLC[rhs] = 0 THEN { rhsPtr _ @ws; -- the address of a NIL double-word GO TO copy; }; ERROR Error[reason: notImplemented, msg: "remote reference-counted assignment"]; }; rhsType = nullType => { rhsPtr _ @ws; -- the address of a NIL double-word SELECT TypeClass[UnderType[lhsType]] FROM list, ref, atom, rope, countedZone => { IF unCountedAssignment OR new THEN GO TO copy; LOOPHOLE[ NARROW[lhsa, pointer RTTypesPrivate.ValueAddress].ptr, REF REF ANY]^ _ NIL; RETURN; }; pointer, longPointer, procedure, signal, error => GO TO copy; basePointer, relativePointer, uncountedZone => GO TO copy; ENDCASE => GO TO incompatible; }; ENDCASE; IF NOT new AND rhsSize > lhsSize THEN GO TO incompatible; IF rhsSize = 0 THEN RETURN; IF NOT isRC AND rhsSize <= 2 THEN GO TO smallAssign; WITH t: rhsa SELECT FROM constant => { rhsPtr _ @t.value[0]; IF unCountedAssignment THEN GO TO copy ELSE GO TO rcAssign; }; pointer => { WITH fd: t.fd SELECT FROM large => { rhsPtr _ t.ptr; WITH rhs SELECT FROM tr: REF TypedVariableRec => WITH tr.head SELECT FROM fh => { procLeaf: PROC[r: REF ANY] = {SafeStoragePrivate.ValidateRef[r]}; RTTypesBasicPrivate.MapRefs[ ptr: t.ptr, rcmx: RTTypesBasicPrivate.MapTiRcmx[rhsType], procLeaf: procLeaf]; }; ENDCASE; ENDCASE; SELECT TRUE FROM unCountedAssignment => WITH fd: t.fd SELECT FROM large => {rhsPtr _ t.ptr; GO TO copy}; small => GO TO smallAssign; ENDCASE => ERROR; ENDCASE => GO TO rcAssign }; small => GO TO smallAssign; ENDCASE => ERROR}; remotePointer => { WITH fd: t.fd SELECT FROM large => { ws _ RTTypesRemotePrivate.GetRemoteWords[t.ptr, rhsSize]; rhsPtr _ @ws[0]; GO TO copy; }; small => GO TO smallAssign; ENDCASE => ERROR}; copiedRemoteObject => { WITH fd: t.fd SELECT FROM large => {rhsPtr _ t.ptr; GO TO copy}; small => GO TO smallAssign; ENDCASE => ERROR; }; ENDCASE => ERROR; EXITS copy => { lhsPtr: LONG POINTER _ NIL; WITH lh: lhsa SELECT FROM remotePointer => RTTypesRemotePrivate.RemoteStoreWords[from: rhsPtr, to: lh.ptr, nWords: rhsSize]; pointer => PrincOpsUtils.LongCOPY[from: rhsPtr, to: lh.ptr, nwords: rhsSize]; copiedRemoteObject => PrincOpsUtils.LongCOPY[from: rhsPtr, to: lh.ptr, nwords: rhsSize]; ENDCASE => ERROR; }; rcAssign => { lhsPtr: LONG POINTER _ NARROW[lhsa, pointer RTTypesPrivate.ValueAddress].ptr; IF new THEN RTTypesBasicPrivate.AssignCompositeNew[ rhs: rhsPtr, lhs: lhsPtr, type: rhsType, nwords: rhsSize] ELSE RTTypesBasicPrivate.AssignComposite[ rhs: rhsPtr, lhs: lhsPtr, type: rhsType, nwords: rhsSize]; }; smallAssign => AMBridge.SetTVFromLC[lhs, AMBridge.TVToLC[rhs]]; 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: AMBridge.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[SafeStorage.EquivalentTypes[rhsType,lhsType]]}; END. ®AMVariablesImpl.Mesa Copyright c 1984 by Xerox Corporation. All rights reserved. Russ Atkinson, July 16, 1984 7:56:25 pm PDT Richard Koo, July 2, 1984 8:35:25 pm PDT T Y P E S PROCs raises typeFault, notImplemented, incompatibleTypes, notMutable Try to coerce the right hand to the lhs type If the value we are assigning is already the same as the value that is present, then we do not need to move the bits at all. We may be trying to perform remote reference counting, so we really can't do this assignment, UNLESS the source = NIL. Source = NIL, so force uncounted assignment. This may leave the current destination RC too high, but at least we will be able to complete the assignment. We cannot do this assignment and keep things safe, so we raise an error (sigh). this bunch is RC, so we can't use the copy outlet may be an uninitialized union or seq validate rhs NOTE remote RC not allowed (except for NIL) rhsa.tag = remotePointer rhsa.tag = copiedRemoteObject must not be RC (except for NIL) must be RC must not be RC we just can't assign these guys COPIED in RTTypedVariablesImpl copied in RTTypesBridgeImpl copied in RTTypedVariablesImpl NOTE freely conforms = Equivalent for now Ê À˜šœ™Jšœ Ïmœ1™Jšœžœžœžœ˜Jšœžœ˜Jšœžœ˜JšœYžœ˜_Jšœžœ˜ J˜šžœžœ˜@Jšžœžœ)˜3—šžœžœ˜@Jšžœžœ)˜3J˜—šœÏc:˜;JšœH˜HJšœ<žœ˜BJ˜šžœžœ.žœ˜:Jšœ,™,Jš žœžœžœžœžœ˜FJšœ#˜#Jšœ˜Jšœ˜J˜J˜—šžœžœžœ˜)Jšœ|™|—J˜šžœžœž˜šœžœ˜šžœ žœž˜Jšœžœ˜