<> <> <> <> <> DIRECTORY AMBridge, AMBridgeExtras USING[], -- EXPORTS only, to be merged with next release of AMBridge AMTypes, AtomsPrivate USING[GetAtom], Environment USING[bitsPerWord], Inline USING[BITSHIFT, LongCOPY, LongNumber, LowHalf, HighHalf], RCMap USING[nullIndex], Rope USING[ROPE], RTCommon USING [FetchField, FetchFieldLong, StoreFieldLong, ShortenLongCardinal, ShortenLongInteger, Field], RTStorageOps USING[ValidateRef], RTTypesBasic USING[GetReferentType, Type, nullType, anyType], RTTypesBasicPrivate USING[MapTiRcmx], RTTypesPrivate, RTTypesRemotePrivate USING [GetRemoteGFHeader, GetRemoteWords, RemoteStoreWord, RemoteStoreDoubleWord, RemoteStoreFieldLong, GetRemoteWord, GetRemoteLC], WorldVM USING[CurrentIncarnation, Long, LocalWorld, World, Write, CopyWrite]; RTTypesBridgeImpl: PROGRAM IMPORTS AMBridge, AtomsPrivate, RTCommon, RTStorageOps, RTTypesBasic, AMTypes, RTTypesPrivate, RTTypesBasicPrivate, RTTypesRemotePrivate, WorldVM EXPORTS AMTypes, AMBridge, AMBridgeExtras, RTTypesPrivate = BEGIN OPEN AMBridge, AMTypes, Environment, Rope, tp: RTTypesPrivate, RTCommon, RTTypesBasic, RTStorageOps, RTTypesRemotePrivate, WorldVM; <> TypedVariableRec: TYPE = tp.TypedVariableRec; Pointer: TYPE = LONG POINTER --TO UNSPECIFIED--; <> tvZone: ZONE; tvPrefixedZone: ZONE; <> 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; ValidateRef[ref]; 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 _ tvZone.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 _ tvZone.NEW[TypedVariableRec _ [ referentType: [type], head: [reference[ref: ref]], status: status, field: entire[]]]}; TVForReadOnlyReferent: PUBLIC PROC [ref: REF READONLY ANY] RETURNS[TypedVariable] = { <> ValidateRef[LOOPHOLE[ref]]; 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]; 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 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 [AtomsPrivate.GetAtom[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 _ tvZone.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 _ tvZone.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 _ LOOPHOLE[LONG[head.gfh]]; fh => p _ LOOPHOLE[LONG[head.fh]]; ENDCASE => ERROR Error[reason: typeFault, type: nullType]; }; IF tv = NIL THEN RETURN[NIL]; WITH tv SELECT FROM tr: REF TypedVariableRec => { IF 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 CARDINAL] ^ _ 0; 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 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 _ LOOPHOLE[LONG[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 _ LOOPHOLE[LONG[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 _ LOOPHOLE[ptr.ptr, LONG CARDINAL] + 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 _ LOOPHOLE[ptr.ptr, LONG CARDINAL] + 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 _ LOOPHOLE[@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 _ LOOPHOLE[ptr.ptr, LONG CARDINAL] + 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 _ LOOPHOLE[ptr.ptr, LONG CARDINAL] + 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 { world1: WorldVM.World _ AMBridge.GetWorld[tv1]; world2: WorldVM.World _ AMBridge.GetWorld[tv2]; class1: Class _ AMTypes.UnderClass[AMTypes.TVType[tv1]]; class2: Class _ AMTypes.UnderClass[AMTypes.TVType[tv2]]; size1,size2: INT; IF world1 # world2 THEN RETURN [FALSE]; 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[tv1, i] THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE]; }; 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[IF t.value.size > 2 THEN ERROR Error[reason: typeFault, type: TVType[tv]] ELSE LOOPHOLE[@t.value[0], LONG POINTER TO LONG CARDINAL]^ + tp.GetOrigin[TVType[tv]]]; pointer => {ptr _ t.ptr; fd _ t.fd}; remotePointer => { WITH f: t.fd SELECT FROM large => { SELECT f.size FROM 1 => lc _ GetRemoteWord[remotePointer: t.ptr]; 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 _ 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[LOOPHOLE[lc,Inline.LongNumber].lowbits, INTEGER]]] <> ELSE RETURN[LOOPHOLE[lc, LONG INTEGER]]}; TVToRef: PUBLIC PROC[tv: TV] RETURNS[REF ANY] = { 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 atom, rope, list, ref => RETURN[LOOPHOLE[TVToLC[tv], REF ANY]]; 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 _ tvPrefixedZone.NEW[WordSequenceRecord[words]]; 1 => { s _ tvPrefixedZone.NEW[WordSequenceRecord[words]]; LOOPHOLE[@s[0], LONG POINTER TO CARDINAL]^ _ ShortenLongCardinal[TVToLC[tv]]; RETURN}; 2 => { s _ tvPrefixedZone.NEW[WordSequenceRecord[words]]; 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 _ tvPrefixedZone.NEW[WordSequenceRecord[words]]; Inline.LongCOPY[from: ptr, nwords: words, to: @s[0]]; }; }; SetTVFromWordSequence: PUBLIC PROC[tv: AMTypes.TV, ws: WordSequence] = { type: Type = AMTypes.TVType[tv]; a: RTTypesPrivate.ValueAddress = RTTypesPrivate.GetValueAddress[tv: tv, mutableOnly: TRUE]; WITH t: a SELECT FROM remotePointer => { IF IsRC[type] THEN ERROR AMTypes.Error[reason: typeFault, type: type]; WITH fd: t.fd SELECT FROM large => SELECT fd.size FROM 0 => {}; 1 => { lc: LONG CARDINAL _ LOOPHOLE[ (LONG[LOOPHOLE[ws[0], INTEGER]] - RTTypesPrivate.GetOrigin[type]), LONG CARDINAL]; WorldVM.Write[ world: AMBridge.GetWorld[tv], addr: t.ptr.ptr, value: RTCommon.ShortenLongCardinal[lc]]}; 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]] - RTTypesPrivate.GetOrigin[type]), LONG CARDINAL]; IF Inline.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]] - RTTypesPrivate.GetOrigin[type]), LONG CARDINAL]; LOOPHOLE[t.ptr, LONG POINTER TO CARDINAL]^ _ RTCommon.ShortenLongCardinal[lc]}; ENDCASE => Inline.LongCOPY[from: @ws[0], nwords: ws.size, to: t.ptr]; small => { lc: LONG CARDINAL _ LOOPHOLE[ (LONG[LOOPHOLE[ws[0], INTEGER]] - RTTypesPrivate.GetOrigin[type]), LONG CARDINAL]; IF Inline.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]] - RTTypesPrivate.GetOrigin[type]), LONG CARDINAL]; LOOPHOLE[t.ptr, LONG POINTER TO CARDINAL]^ _ RTCommon.ShortenLongCardinal[lc]}; ENDCASE => Inline.LongCOPY[from: @ws[0], nwords: ws.size, to: t.ptr]; small => { lc: LONG CARDINAL _ LOOPHOLE[ (LONG[LOOPHOLE[ws[0], INTEGER]] - RTTypesPrivate.GetOrigin[type]), LONG CARDINAL]; IF Inline.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 Inline.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 Inline.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 Inline.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 Inline.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 Inline.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 Inline.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]}; <> [qz: tvZone, pz: tvPrefixedZone] _ tp.GetTVZones[]; END.