DIRECTORY AMBridge USING [GetWorld, nilRemotePointer, RemotePointer, SetTVFromLC, TVToLC, WordSequence, WordSequenceRecord], AMTypes USING [Class, Coerce, Error, IndexToTV, NComponents, New, nullType, Tag, TV, TVEqual, TVSize, TVType, Type, UnderClass, 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, 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; emptyTV: TV _ NIL; GetEmptyTV: PUBLIC SAFE PROC RETURNS [TV] = TRUSTED { IF emptyTV = NIL THEN { ws: AMBridge.WordSequence _ NEW[AMBridge.WordSequenceRecord[0]]; emptyTV _ NEW[TypedVariableRec _ [ referentType: [SafeStorage.nullType, NIL], head: [constant[]], status: const, field: constant[ws] ]]; }; RETURN[emptyTV]; }; Assign: PUBLIC SAFE PROC [lhs: TV, rhs: TV] = TRUSTED { DoAssign[lhs, rhs]; }; AssignNew: PUBLIC SAFE PROC [lhs: TV, rhs: TV] = TRUSTED{ DoAssign[lhs, rhs, TRUE]; }; DoAssign: PROC [lhs: TV, rhs: TV, 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; SELECT UnderClass[lhsType] FROM any, globalFrame, localFrame => Error[reason: typeFault, type: lhsType]; ENDCASE; SELECT UnderClass[rhsType] FROM any, globalFrame, localFrame => Error[reason: typeFault, type: rhsType]; ENDCASE; { 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 UnderClass[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]; }; }; TVTag: PROC [tv: TV] RETURNS [TV] = { RETURN[NARROW[tv, REF TypedVariableRec].referentType.tag]; }; Copy: PUBLIC SAFE PROC [tv: TV] RETURNS [newTV: TV _ NIL] = TRUSTED { IF tv # NIL THEN { tag: TV _ TVTag[tv]; type: 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, 1985 by Xerox Corporation. All rights reserved. Russ Atkinson, February 20, 1985 8:18:05 pm PST Richard Koo, July 2, 1984 8:35:25 pm PDT T Y P E S PROCs Sigh, have to construct this one on the fly raises typeFault, notImplemented, incompatibleTypes, notMutable be real careful not to use the size field of lhsa if new 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 private version, assumes tv # NIL (copied in RTTypesBridgeImpl) private version, assumes tv # NIL (copied in RTTypesBridgeImpl) private version, assumes tv # NIL (copied in RTTypesBridgeImpl) NOTE freely conforms = Equivalent for now Κ ˜codešœ™Kšœ Οmœ7™BK™/K™(K˜—šΟk ˜ Kšœ žœc˜rKšœžœCžœ9˜ŽKšœžœ ˜Kšœžœ ˜Kšœžœ:˜TKšœžœ2˜GKšœžœ#˜>Kšœ žœ"˜4Kšœžœ˜'K˜—šœž˜Kšžœ~˜…Kšžœ ˜Kšœžœžœ ˜K˜—šœ ™ Kšœžœ#˜9K˜—šœ™K˜—Kšœ žœžœ˜K˜šΟn œžœžœžœžœžœžœ˜5šžœ žœžœ˜Kšœ+™+Kšœžœ!˜@šœ žœ˜"Kšœ%žœ˜*Kšœ˜Kšœ˜Kšœ˜—K˜—Kšžœ ˜Kšœ˜K˜—šŸœžœžœžœžœžœžœ˜7Kšœ˜Kšœ˜K˜—šŸ œžœžœžœžœžœžœ˜9Kšœžœ˜Kšœ˜K˜—š Ÿœžœžœžœžœžœ˜8Kšœ?™?Kšœ˜K˜Kšœ žœ˜Kšœ žœ˜Kšœ,žœ˜>Kšœžœžœžœ˜Kšœžœ˜Kšœžœ˜KšœYžœ˜_Kšœžœ˜ K˜šžœž˜KšœH˜HKšžœ˜—šžœž˜KšœH˜HKšžœ˜—K˜šœ˜Kšœ8™8KšœH˜HKšœ<žœ˜BK˜šžœžœ.žœ˜:Kšœ,™,Kš žœžœžœžœžœ˜FKšœ#˜#Kšœ˜Kšœ˜K˜K˜—šžœžœžœ˜)Kšœ|™|—K˜šžœžœž˜šœžœ˜šžœ žœž˜Kšœžœ˜Kšœ˜K˜—šŸœžœžœžœ˜9Kšœžœž™?Kš )™)Kšžœ/˜5Kšœ˜K˜—Kšžœ˜K˜K˜K˜—…—J(ή