<> <> <> <> <> DIRECTORY AMBridge USING[TVHeadType, GetWorld, OctalRead, Loophole, WordSequence, RemotePointer, WordSequenceRecord], AMTypes, Atom USING[MakeAtom], Basics USING[BITSHIFT, bitsPerWord, LongNumber, LowHalf], PrincOpsUtils USING[LongCOPY], RCMap USING[nullIndex], Rope USING[ROPE], RTCommon USING [FetchField, FetchFieldLong, StoreFieldLong, ShortenLongCardinal, ShortenLongInteger, Field], RTSymbolDefs USING[SymbolTableBase, symbolIndexForTYPE], RTSymbolOps USING[AcquireType], RTSymbols USING[GetTypeSymbols, ReleaseSTB], RTTypesBasicPrivate USING[MapTiRcmx], RTTypesPrivate USING[TypedVariableRec, BitsForType, ValueAddress, FieldDescriptor, GetOrigin, GetValueAddress], RTTypesRemotePrivate USING [GetRemoteGFHeader, GetRemoteWords, RemoteStoreWord, RemoteStoreDoubleWord, RemoteStoreFieldLong, GetRemoteWord, GetRemoteLC], SafeStorage USING[GetReferentType, Type, nullType, anyType], SafeStoragePrivate USING[ValidateRef], WorldVM USING[CurrentIncarnation, Long, LocalWorld, World, Write, CopyWrite]; RTTypesBridgeImpl: PROGRAM IMPORTS AMBridge, AMTypes, Atom, Basics, PrincOpsUtils, RTCommon, RTSymbolOps, RTSymbols, RTTypesBasicPrivate, RTTypesPrivate, RTTypesRemotePrivate, SafeStorage, SafeStoragePrivate, WorldVM EXPORTS AMTypes, AMBridge, RTTypesPrivate = BEGIN OPEN AMBridge, AMTypes, Basics, Rope, tp: RTTypesPrivate, RTCommon, SafeStorage, RTTypesRemotePrivate, WorldVM; <> TypedVariableRec: TYPE = tp.TypedVariableRec; Pointer: TYPE = LONG POINTER --TO UNSPECIFIED--; checkMutable: BOOL _ TRUE; <> IsAtom: PUBLIC SAFE PROC [tv: TypedVariable--ref any--] RETURNS[ans: BOOL _ TRUE] = TRUSTED { [] _ Coerce[tv, CODE[ATOM] ! Error => {ans _ FALSE; CONTINUE}]}; IsRope: PUBLIC SAFE PROC [tv: TypedVariable--ref any--] RETURNS[ans: BOOL _ TRUE] = TRUSTED { [] _ Coerce[tv, CODE[ROPE] ! Error => {ans _ FALSE; CONTINUE}]; }; IsRefAny: PUBLIC SAFE PROC[type: Type--ref--] RETURNS[ans: BOOL _ TRUE] = TRUSTED { type _ UnderType[type]; RETURN[TypeClass[type] = ref AND Range[type] = anyType]; }; TVHead: PUBLIC PROC[tv: TypedVariable] RETURNS[AMBridge.TVHeadType] = { IF tv = NIL THEN RETURN[notTVRecord]; WITH tv SELECT FROM tvr: REF TypedVariableRec => RETURN[tvr.head.tag]; ENDCASE => RETURN[notTVRecord]; }; TVType: PUBLIC SAFE PROC[tv: TypedVariable] RETURNS[type: Type] = TRUSTED { <> IF tv = NIL THEN RETURN[nullType]; WITH tv SELECT FROM tr: REF TypedVariableRec => RETURN[tr.referentType.type]; ENDCASE => ERROR; }; TVStatus: PUBLIC SAFE PROC[tv: TypedVariable] RETURNS[Status] = TRUSTED { IF tv = NIL THEN RETURN[readOnly]; WITH tv SELECT FROM tr: REF TypedVariableRec => RETURN[tr.status]; ENDCASE => ERROR }; TVForReferent: PUBLIC PROC [ref: REF, status: Status _ mutable] RETURNS[tv: TypedVariable] = { <> type: Type; bitsForType: LONG CARDINAL; WITH ref SELECT FROM a: ATOM => ERROR Error[reason: typeFault, type: CODE[ATOM]]; r: ROPE => ERROR Error[reason: typeFault, type: CODE[ROPE]]; ENDCASE; type _ GetReferentType[ref]; IF type = nullType THEN RETURN[NIL]; bitsForType _ tp.BitsForType[type].bft; IF bitsForType IN [1..bitsPerWord) THEN tv _ NEW[TypedVariableRec _ [ referentType: [type], head: [reference[ref: ref]], status: status, field: embedded [fd: [ wordOffset: 0, extent: small[ field: [bitFirst: bitsPerWord-bitsForType, bitCount: bitsForType]]]]]] ELSE tv _ NEW[TypedVariableRec _ [ referentType: [type], head: [reference[ref: ref]], status: status, field: entire[]]]}; TVForReadOnlyReferent: PUBLIC PROC [ref: REF READONLY ANY] RETURNS[TypedVariable] = { <> RETURN[TVForReferent[ref: LOOPHOLE[ref], status: readOnly]]}; RefFromTV: PUBLIC PROC[tv: TypedVariable] RETURNS[REF ANY] = { <> WITH tv SELECT FROM tr: REF TypedVariableRec => SELECT TRUE FROM tr.tag # entire => ERROR Error[reason: internalTV]; checkMutable AND tr.status # mutable => ERROR Error[reason: notMutable]; ENDCASE => WITH head: tr.head SELECT FROM reference => RETURN[head.ref]; ENDCASE => ERROR Error[reason: internalTV]; ENDCASE => ERROR; }; ReadOnlyRefFromTV: PUBLIC PROC[tv: TypedVariable --, status: readOnly--] RETURNS[REF READONLY ANY] = { <> WITH tv SELECT FROM tr: REF TypedVariableRec => { IF tr.tag # entire THEN ERROR Error[reason: internalTV] ELSE WITH head: tr.head SELECT FROM reference => RETURN[LOOPHOLE[head.ref]]; ENDCASE => ERROR Error[reason: internalTV]}; ENDCASE => ERROR}; SomeRefFromTV: PUBLIC PROC[tv: TypedVariable] RETURNS[REF ANY] = { <> WITH tv SELECT FROM tr: REF TypedVariableRec => IF tr.tag # entire OR (checkMutable AND tr.status # mutable) OR tr.head.tag # reference THEN WITH Copy[tv] SELECT FROM tr: REF TypedVariableRec => WITH head: tr.head SELECT FROM reference => RETURN[head.ref]; ENDCASE => ERROR Error[reason: internalTV, msg: "not a REF head"]; ENDCASE => ERROR ELSE RETURN[RefFromTV[tv]]; ENDCASE => ERROR}; TVForATOM: PUBLIC PROC[atom: ATOM] RETURNS[TypedVariable--atom--] = { RETURN[TVForReadOnlyReferent[NEW[ATOM _ atom]]]}; TVToATOM: PUBLIC PROC[tv: TypedVariable--atom--] RETURNS[ATOM] = { <> type: Type = UnderType[TVType[tv]]; SELECT TypeClass[type] FROM ref => IF Range[type] = anyType THEN RETURN [TVToATOM[Coerce[tv, CODE[ATOM]]]]; atom => RETURN [Atom.MakeAtom[TVToName[tv]]]; ENDCASE; ERROR Error[reason: typeFault, type: type]; }; TVForROPE: PUBLIC PROC[rope: ROPE] RETURNS[TypedVariable--rope--] = { <> RETURN[TVForReadOnlyReferent[NEW[ROPE _ rope]]]}; TVForPointerReferent: PUBLIC PROC[ptr: Pointer, type: Type, status: Status _ mutable] RETURNS[tv: TypedVariable] = { <> bitsForType: LONG CARDINAL _ bitsPerWord--not smaller than a word--; IF ptr = NIL THEN RETURN[NIL]; bitsForType _ tp.BitsForType[ type ! Error => IF reason = typeFault THEN CONTINUE; -- not smaller than a word ].bft; IF bitsForType IN [1..bitsPerWord) THEN tv _ NEW[TypedVariableRec _ [ referentType: [type], head: [pointer[ptr: ptr]], status: status, field: embedded[fd: [ wordOffset: 0, extent: small[field: [bitFirst: bitsPerWord-bitsForType, bitCount: ShortenLongCardinal[bitsForType]]]]]]] ELSE tv _ NEW[TypedVariableRec _ [ referentType: [type], head: [pointer[ptr: ptr]], status: status, field: entire[]]]}; PointerFromTV: PUBLIC PROC[tv: TypedVariable] RETURNS[Pointer] = { <> <> <> GetHeadPointer: PROC[tr: REF TypedVariableRec] RETURNS[p: Pointer] = INLINE { WITH head: tr.head SELECT FROM pointer => p _ head.ptr; reference => ERROR Error[reason: typeFault, type: nullType]; gfh => p _ head.gfh; fh => p _ head.fh; ENDCASE => ERROR Error[reason: typeFault, type: nullType]; }; IF tv = NIL THEN RETURN[NIL]; WITH tv SELECT FROM tr: REF TypedVariableRec => { IF checkMutable AND tr.status # mutable THEN ERROR Error[reason: notMutable]; WITH etr: tr SELECT FROM embedded => WITH fd: etr.fd SELECT FROM large => RETURN[GetHeadPointer[tr] + fd.wordOffset]; small => IF fd.field.bitFirst = 0 THEN RETURN[GetHeadPointer[tr] + fd.wordOffset] ELSE ERROR Error[reason: internalTV]; ENDCASE => ERROR; entire => RETURN[GetHeadPointer[tr]]; --may have been narrowed-- ENDCASE => ERROR} ENDCASE => ERROR Error[reason: typeFault, type: nullType]}; GetValueAddress: PUBLIC PROC [tv: TypedVariable, mutableOnly: BOOLEAN _ FALSE] RETURNS[tp.ValueAddress] = { <> IF tv = NIL THEN IF mutableOnly THEN ERROR Error[reason: notMutable] ELSE { ws: WordSequence = NEW[WordSequenceRecord[2]]; LOOPHOLE[@ws[0], LONG POINTER TO LONG POINTER] ^ _ NIL; RETURN[[constant[value: ws]]]}; IF mutableOnly THEN WITH tv SELECT FROM tr: REF TypedVariableRec => WITH h: tr.head SELECT FROM gfh => IF NOT h.gfh.started THEN ERROR Error[reason: notMutable]; remoteGFH => IF NOT GetRemoteGFHeader[h.remoteGlobalFrameHandle].started THEN ERROR Error[reason: notMutable]; ENDCASE; ENDCASE => ERROR; WITH tv SELECT FROM tr: REF TypedVariableRec => { IF mutableOnly AND checkMutable AND tr.status # mutable THEN ERROR Error[reason: notMutable]; WITH head: tr.head SELECT FROM pointer => { ptr: Pointer _ head.ptr; WITH etr: tr SELECT FROM embedded => RETURN[[pointer[ptr: ptr + etr.fd.wordOffset, fd: etr.fd]]]; entire => RETURN[[pointer[ptr: ptr, fd: [wordOffset: 0, extent: large[size: TVSize[tv]]]]]]; ENDCASE => ERROR Error[reason: notMutable]}; reference => { ptr: Pointer _ LOOPHOLE[head.ref]; WITH etr: tr SELECT FROM embedded => RETURN[[pointer[ptr: ptr + etr.fd.wordOffset, fd: etr.fd]]]; entire => RETURN[[pointer[ptr: ptr, fd: [wordOffset: 0, extent: large[size: TVSize[tv]]]]]]; ENDCASE => ERROR Error[reason: notMutable]}; gfh => { ptr: Pointer _ head.gfh; WITH etr: tr SELECT FROM embedded => RETURN[[pointer[ptr: ptr + etr.fd.wordOffset, fd: etr.fd]]]; entire => RETURN[[pointer[ptr: ptr, fd: [wordOffset: 0, extent: large[size: TVSize[tv]]]]]]; ENDCASE => ERROR Error[reason: notMutable]}; fh => { ptr: Pointer _ head.fh; WITH etr: tr SELECT FROM embedded => RETURN[[pointer[ptr: ptr + etr.fd.wordOffset, fd: etr.fd]]]; entire => RETURN[[pointer[ptr: ptr, fd: [wordOffset: 0, extent: large[size: TVSize[tv]]]]]]; ENDCASE => ERROR Error[reason: notMutable]}; constant => WITH etr: tr SELECT FROM constant => RETURN[[constant[value: etr.value]]]; ENDCASE => ERROR; remotePointer => { ptr: RemotePointer _ head.remotePointer; WITH etr: tr SELECT FROM embedded => {ptr.ptr _ ptr.ptr + etr.fd.wordOffset; RETURN[[remotePointer[ptr: ptr, fd: etr.fd]]]}; entire => RETURN[[remotePointer[ptr: ptr, fd: [wordOffset: 0, extent: large[size: TVSize[tv]]]]]]; ENDCASE => ERROR Error[reason: notMutable]}; remoteReference => { ptr: RemotePointer _ [world: head.remoteRef.world, worldIncarnation: CurrentIncarnation[head.remoteRef.world], ptr: head.remoteRef.ref]; WITH etr: tr SELECT FROM embedded => {ptr.ptr _ ptr.ptr + etr.fd.wordOffset; RETURN[[remotePointer[ptr: ptr, fd: etr.fd]]]}; entire => RETURN[[remotePointer[ptr: ptr, fd: [wordOffset: 0, extent: large[size: TVSize[tv]]]]]]; ENDCASE => ERROR Error[reason: notMutable]}; copiedRemoteObject => { ptr: Pointer _ @head.copy[0]; WITH etr: tr SELECT FROM embedded => RETURN[[copiedRemoteObject[ptr: ptr + etr.fd.wordOffset, fd: etr.fd]]]; entire => RETURN[[copiedRemoteObject [ptr: ptr, fd: [wordOffset: 0, extent: large[size: TVSize[tv]]]]]]; ENDCASE => ERROR Error[reason: notMutable]}; remoteGFH => { ptr: RemotePointer _ [world: head.remoteGlobalFrameHandle.world, worldIncarnation: CurrentIncarnation[head.remoteGlobalFrameHandle.world], ptr: Long[world: head.remoteGlobalFrameHandle.world, addr: head.remoteGlobalFrameHandle.gfh]]; WITH etr: tr SELECT FROM embedded => { ptr.ptr _ ptr.ptr + etr.fd.wordOffset; RETURN[[remotePointer[ptr: ptr, fd: etr.fd]]]; }; entire => RETURN[[remotePointer[ptr: ptr, fd: [wordOffset: 0, extent: large[size: TVSize[tv]]]]]]; ENDCASE => ERROR Error[reason: notMutable]}; remoteFH => { ptr: RemotePointer _ [world: head.remoteFrameHandle.world, worldIncarnation: CurrentIncarnation[head.remoteFrameHandle.world], ptr: Long[world: head.remoteFrameHandle.world, addr: head.remoteFrameHandle.fh]]; WITH etr: tr SELECT FROM embedded => { ptr.ptr _ ptr.ptr + etr.fd.wordOffset; RETURN[[remotePointer[ptr: ptr, fd: etr.fd]]]; }; entire => RETURN[[remotePointer[ptr: ptr, fd: [wordOffset: 0, extent: large[size: TVSize[tv]]]]]]; ENDCASE => ERROR Error[reason: notMutable]}; remoteConstant => WITH etr: tr SELECT FROM constant => RETURN[[constant[value: etr.value]]]; ENDCASE => ERROR; ENDCASE => ERROR Error[reason: notMutable]}; ENDCASE => ERROR; }; -- end GetValueAddress TVEq: PUBLIC SAFE PROC[tv1, tv2: TypedVariable] RETURNS [BOOLEAN] = TRUSTED { <> <> <> RETURN[EQValueAddress[GetValueAddress[tv1], GetValueAddress[tv2]]]}; EQValueAddress: PROC[a1, a2: tp.ValueAddress] RETURNS[BOOLEAN] = { fd1, fd2: tp.FieldDescriptor; WITH t: a1 SELECT FROM constant => { IF a2.tag # constant OR t.value.size # NARROW[a2, constant tp.ValueAddress].value.size THEN RETURN[FALSE]; FOR i: NAT IN [0..t.value.size) DO IF t.value[i] # NARROW[a2, constant tp.ValueAddress].value[i] THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE]}; pointer => { IF a2.tag # pointer THEN RETURN[FALSE]; IF t.ptr # NARROW[a2, pointer tp.ValueAddress].ptr THEN RETURN[FALSE]; fd1 _ t.fd; fd2 _ NARROW[a2, pointer tp.ValueAddress].fd; }; remotePointer => { IF a2.tag # remotePointer THEN RETURN[FALSE]; IF t.ptr # NARROW[a2, remotePointer tp.ValueAddress].ptr THEN RETURN[FALSE]; fd1 _ t.fd; fd2 _ NARROW[a2, remotePointer tp.ValueAddress].fd; }; copiedRemoteObject => { IF a2.tag # copiedRemoteObject THEN RETURN[FALSE]; IF t.ptr # NARROW[a2, copiedRemoteObject tp.ValueAddress].ptr THEN RETURN[FALSE]; fd1 _ t.fd; fd2 _ NARROW[a2, copiedRemoteObject tp.ValueAddress].fd; }; ENDCASE; WITH f1: fd1 SELECT FROM small => WITH f2: fd2 SELECT FROM small => IF f1.field # f2.field THEN RETURN[FALSE]; ENDCASE => RETURN[FALSE]; large => WITH f2: fd2 SELECT FROM large => IF f1.size # f2.size THEN RETURN[FALSE]; ENDCASE => RETURN[FALSE]; ENDCASE; RETURN[TRUE]}; TVEqual: PUBLIC SAFE PROC[tv1, tv2: TypedVariable] RETURNS [BOOLEAN] = TRUSTED { class1: Class _ AMTypes.UnderClass[AMTypes.TVType[tv1]]; class2: Class _ AMTypes.UnderClass[AMTypes.TVType[tv2]]; size1,size2: INT; IF TVEq[tv1, tv2] THEN RETURN [TRUE]; SELECT class1 FROM localFrame, globalFrame => RETURN [FALSE]; ENDCASE; SELECT class2 FROM localFrame, globalFrame => RETURN [FALSE]; ENDCASE; size1 _ AMTypes.TVSize[tv1]; size2 _ AMTypes.TVSize[tv2]; IF size1 # size2 THEN RETURN [FALSE]; IF size1 <= 2 THEN RETURN[TVToLC[tv1] = TVToLC[tv2]]; FOR i: INT IN [0..size1) DO IF AMBridge.OctalRead[tv1, i] # AMBridge.OctalRead[tv2, i] THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE]; }; TVForType: PUBLIC PROC [type: Type] RETURNS [ntv: TV _ NIL] = { stb: RTSymbolDefs.SymbolTableBase = RTSymbols.GetTypeSymbols[type].stb; { ENABLE UNWIND => RTSymbols.ReleaseSTB[stb]; ntv _ AMBridge.Loophole[ tv: TVForReferent[NEW[CARDINAL _ type]], type: RTSymbolOps.AcquireType[stb, LOOPHOLE[RTSymbolDefs.symbolIndexForTYPE]]]; }; RTSymbols.ReleaseSTB[stb]; }; TVToLC: PUBLIC PROC[tv: TypedVariable] RETURNS[lc: LONG CARDINAL] = { <> <> a: tp.ValueAddress = GetValueAddress[tv]; ptr: Pointer; fd: tp.FieldDescriptor; WITH t: a SELECT FROM constant => RETURN[ SELECT t.value.size FROM 1 => LONG[LOOPHOLE[t.value[0], CARDINAL]] + tp.GetOrigin[TVType[tv]], 2 => LOOPHOLE[@t.value[0], LONG POINTER TO LONG CARDINAL]^ + tp.GetOrigin[TVType[tv]], ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]] ]; pointer => {ptr _ t.ptr; fd _ t.fd}; remotePointer => { WITH f: t.fd SELECT FROM large => { SELECT f.size FROM 1 => lc _ LONG[LOOPHOLE[GetRemoteWord[remotePointer: t.ptr], CARDINAL]]; 2 => lc _ GetRemoteLC[remotePointer: t.ptr]; ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]; lc _ LOOPHOLE[LOOPHOLE[lc, LONG INTEGER] + tp.GetOrigin[TVType[tv]], LONG CARDINAL]; RETURN}; small => { word: WORD _ GetRemoteWord[remotePointer: t.ptr]; RETURN[FetchFieldLong[@word, f.field] + tp.GetOrigin[TVType[tv]]]}; ENDCASE => ERROR}; copiedRemoteObject => {ptr _ t.ptr; fd _ t.fd}; ENDCASE; WITH f: fd SELECT FROM large => { SELECT f.size FROM 1 => lc _ LONG[LOOPHOLE[ptr, LONG POINTER TO CARDINAL]^]; 2 => lc _ LOOPHOLE[ptr, LONG POINTER TO LONG CARDINAL]^; ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]; lc _ LOOPHOLE[LOOPHOLE[lc, LONG INTEGER] + tp.GetOrigin[TVType[tv]], LONG CARDINAL]; RETURN}; small => lc _ FetchFieldLong[ptr, f.field] + tp.GetOrigin[TVType[tv]]; ENDCASE => ERROR; }; TVToInteger: PUBLIC PROC[tv: TypedVariable] RETURNS[INTEGER] = { RETURN[ShortenLongInteger[TVToLI[tv]]] }; TVToLI: PUBLIC PROC[tv: TypedVariable] RETURNS[LONG INTEGER] = { lc: LONG CARDINAL _ TVToLC[tv]; IF TVSize[tv] = 1 AND TypeClass[GroundStar[TVType[tv]]] = integer THEN RETURN[LONG[LOOPHOLE[Basics.LowHalf[lc], INTEGER]]] <> ELSE RETURN[LOOPHOLE[lc, LONG INTEGER]]}; TVToRef: PUBLIC PROC[tv: TV] RETURNS[ref: REF] = { IF GetWorld[tv] # LocalWorld[] THEN ERROR Error[reason: typeFault, msg: "Can't get a local REF for a remote object"]; SELECT TypeClass[UnderType[TVType[tv]]] FROM nil => ref _ NIL; atom, rope, list, ref => { ref _ LOOPHOLE[TVToLC[tv], REF ANY]; IF TVHead[tv] = fh THEN SafeStoragePrivate.ValidateRef[ref]; }; ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]; }; TVToReal: PUBLIC PROC[tv: TypedVariable] RETURNS[REAL] = { RETURN[LOOPHOLE[TVToLC[tv], REAL]]}; TVToCardinal: PUBLIC PROC[tv: TypedVariable] RETURNS[CARDINAL] = { RETURN[ShortenLongCardinal[TVToLC[tv]]]}; TVToCharacter: PUBLIC PROC[tv: TypedVariable] RETURNS[CHARACTER] = { <> ans: INTEGER = TVToInteger[tv]; IF ans IN [(FIRST[CHARACTER] - 0C)..(LAST[CHARACTER] - 0C)] THEN RETURN[LOOPHOLE[ans, CHARACTER]] ELSE ERROR Error[reason: rangeFault]}; TVToWordSequence: PUBLIC PROC[tv: TypedVariable] RETURNS [s: WordSequence] = { ptr: Pointer; words: CARDINAL = TVSize[tv]; SELECT words FROM 0 => s _ NEW[WordSequenceRecord[0]]; 1 => { s _ NEW[WordSequenceRecord[1]]; s[0] _ ShortenLongCardinal[TVToLC[tv]]; RETURN; }; 2 => { s _ NEW[WordSequenceRecord[2]]; LOOPHOLE[@s[0], LONG POINTER TO LONG CARDINAL]^ _ TVToLC[tv]; RETURN; }; ENDCASE => { a: tp.ValueAddress _ GetValueAddress[tv]; WITH t: a SELECT FROM constant => RETURN[t.value]; pointer => ptr _ t.ptr; remotePointer => RETURN[GetRemoteWords[remotePointer: t.ptr, nWords: words]]; copiedRemoteObject => ptr _ t.ptr; ENDCASE => ERROR; s _ NEW[WordSequenceRecord[words]]; PrincOpsUtils.LongCOPY[from: ptr, nwords: words, to: @s[0]]; }; }; SetTVFromWordSequence: PUBLIC PROC[tv: AMTypes.TV, ws: WordSequence] = { type: Type = AMTypes.TVType[tv]; a: tp.ValueAddress = tp.GetValueAddress[tv: tv, mutableOnly: TRUE]; WITH t: a SELECT FROM remotePointer => { IF IsRC[type] THEN ERROR AMTypes.Error [reason: typeFault, msg: "can't do remote RC assignment", type: type]; WITH fd: t.fd SELECT FROM large => SELECT fd.size FROM 0 => {}; 1 => { -- target size origin: INTEGER = tp.GetOrigin[type]; c: CARDINAL _ ws[0]; IF ws.size # 1 THEN ERROR; IF origin # 0 THEN c _ LONG[LOOPHOLE[c, INTEGER] - origin]; WorldVM.Write[ world: AMBridge.GetWorld[tv], addr: t.ptr.ptr, value: c ]; }; ENDCASE => WorldVM.CopyWrite[ world: AMBridge.GetWorld[tv], from: @ws[0], nwords: ws.size, to: t.ptr.ptr ]; small => { lc: LONG CARDINAL _ LOOPHOLE[ (LONG[LOOPHOLE[ws[0], INTEGER]] - tp.GetOrigin[type]), LONG CARDINAL]; IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN ERROR Error[reason: rangeFault]; RTTypesRemotePrivate.RemoteStoreFieldLong[ptr: t.ptr, field: fd.field, value: lc]}; ENDCASE => ERROR}; copiedRemoteObject => WITH fd: t.fd SELECT FROM large => SELECT fd.size FROM 0 => {}; 1 => { lc: LONG CARDINAL _ LOOPHOLE[ (LONG[LOOPHOLE[ws[0], INTEGER]] - tp.GetOrigin[type]), LONG CARDINAL]; LOOPHOLE[t.ptr, LONG POINTER TO CARDINAL]^ _ RTCommon.ShortenLongCardinal[lc]}; ENDCASE => PrincOpsUtils.LongCOPY[from: @ws[0], nwords: ws.size, to: t.ptr]; small => { lc: LONG CARDINAL _ LOOPHOLE[ (LONG[LOOPHOLE[ws[0], INTEGER]] - tp.GetOrigin[type]), LONG CARDINAL]; IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN ERROR Error[reason: rangeFault]; RTCommon.StoreFieldLong[t.ptr, fd.field, lc]}; ENDCASE => ERROR; pointer => { IF IsRC[type] THEN ERROR AMTypes.Error[reason: typeFault, type: type]; WITH fd: t.fd SELECT FROM large => SELECT fd.size FROM 1 => { lc: LONG CARDINAL _ LOOPHOLE[(LONG[LOOPHOLE[ws[0], INTEGER]] - tp.GetOrigin[type]), LONG CARDINAL]; LOOPHOLE[t.ptr, LONG POINTER TO CARDINAL]^ _ RTCommon.ShortenLongCardinal[lc]}; ENDCASE => PrincOpsUtils.LongCOPY[from: @ws[0], nwords: ws.size, to: t.ptr]; small => { lc: LONG CARDINAL _ LOOPHOLE[ (LONG[LOOPHOLE[ws[0], INTEGER]] - tp.GetOrigin[type]), LONG CARDINAL]; IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN ERROR AMTypes.Error[reason: rangeFault]; RTCommon.StoreFieldLong[t.ptr, fd.field, lc]}; ENDCASE => ERROR}; ENDCASE => ERROR; }; SetTVFromLC: PUBLIC PROC[tv: TypedVariable, lc: LONG CARDINAL] = { <> <> a: tp.ValueAddress _ GetValueAddress[tv, TRUE]; type: Type = TVType[tv]; lc _ LOOPHOLE[(LOOPHOLE[lc, LONG INTEGER] - tp.GetOrigin[type]), LONG CARDINAL]; WITH t: a SELECT FROM pointer => { IF IsRC[type] THEN ERROR Error[reason: typeFault, type: type]; WITH fd: t.fd SELECT FROM large => SELECT fd.size FROM 1 => LOOPHOLE[t.ptr, LONG POINTER TO CARDINAL]^ _ ShortenLongCardinal[lc]; 2 => LOOPHOLE[t.ptr, LONG POINTER TO LONG CARDINAL]^ _ lc; ENDCASE => ERROR Error[reason: typeFault, type: type]; small => { IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN ERROR Error[reason: rangeFault]; StoreFieldLong[t.ptr, fd.field, lc]}; ENDCASE => ERROR}; remotePointer => { IF IsRC[type] THEN ERROR Error[reason: typeFault, type: type]; WITH fd: t.fd SELECT FROM large => SELECT fd.size FROM 1 => RemoteStoreWord[t.ptr, ShortenLongCardinal[lc]]; 2 => RemoteStoreDoubleWord[t.ptr, lc]; ENDCASE => ERROR Error[reason: typeFault, type: type]; small => { IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN ERROR Error[reason: rangeFault]; RemoteStoreFieldLong[ptr: t.ptr, field: fd.field, value: lc]}; ENDCASE => ERROR}; copiedRemoteObject => WITH fd: t.fd SELECT FROM large => SELECT fd.size FROM 1 => LOOPHOLE[t.ptr, LONG POINTER TO CARDINAL]^ _ ShortenLongCardinal[lc]; 2 => LOOPHOLE[t.ptr, LONG POINTER TO LONG CARDINAL]^ _ lc; ENDCASE => ERROR Error[reason: typeFault, type: type]; small => { IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN ERROR Error[reason: rangeFault]; StoreFieldLong[t.ptr, fd.field, lc]}; ENDCASE => ERROR; ENDCASE => ERROR; }; SetTVFromLI: PUBLIC PROC[tv: TypedVariable, li: LONG INTEGER] = { <> a: tp.ValueAddress _ GetValueAddress[tv, TRUE]; type: Type = TVType[tv]; li _ li - tp.GetOrigin[type]; WITH t: a SELECT FROM pointer => { IF IsRC[type] THEN ERROR Error[reason: typeFault, type: type]; WITH fd: t.fd SELECT FROM large => SELECT fd.size FROM 1 => LOOPHOLE[t.ptr, LONG POINTER TO INTEGER]^ _ ShortenLongInteger[li]; 2 => LOOPHOLE[t.ptr, LONG POINTER TO LONG INTEGER]^ _ li; ENDCASE => ERROR Error[reason: typeFault, type: type]; small => {lc: LONG CARDINAL = LOOPHOLE[li]; IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN ERROR Error[reason: rangeFault]; StoreFieldLong[t.ptr, fd.field, lc]}; ENDCASE => ERROR}; remotePointer => { IF IsRC[type] THEN ERROR Error[reason: typeFault, type: type]; WITH fd: t.fd SELECT FROM large => SELECT fd.size FROM 1 => RemoteStoreWord[t.ptr, ShortenLongInteger[li]]; 2 => RemoteStoreDoubleWord[t.ptr, li]; ENDCASE => ERROR Error[reason: typeFault, type: type]; small => {lc: LONG CARDINAL = LOOPHOLE[li]; IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN ERROR Error[reason: rangeFault]; RemoteStoreFieldLong[ptr: t.ptr, field: fd.field, value: lc]}; ENDCASE => ERROR}; copiedRemoteObject => WITH fd: t.fd SELECT FROM large => SELECT fd.size FROM 1 => LOOPHOLE[t.ptr, LONG POINTER TO INTEGER]^ _ ShortenLongInteger[li]; 2 => LOOPHOLE[t.ptr, LONG POINTER TO LONG INTEGER]^ _ li; ENDCASE => ERROR Error[reason: typeFault, type: type]; small => { lc: LONG CARDINAL = LOOPHOLE[li]; IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN ERROR Error[reason: rangeFault]; StoreFieldLong[t.ptr, fd.field, lc]}; ENDCASE => ERROR; ENDCASE => ERROR; }; IsRC: PROC[type: Type] RETURNS[ans: BOOL] = { RETURN[RTTypesBasicPrivate.MapTiRcmx[type] # RCMap.nullIndex]}; END.