<> <> <> <> <> DIRECTORY AMBridge USING [TVHeadType, GetWorld, OctalRead, Loophole, WordSequence, RemotePointer, WordSequenceRecord], AMTypes, Atom USING [MakeAtom], Basics USING [BITSHIFT, bitsPerWord, CARD, LongNumber, LowHalf], PrincOpsUtils USING [LongCopy], RCMap USING [nullIndex], Rope USING [ROPE], RTCommon USING [FetchField, FetchFieldLong, StoreFieldLong, 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, 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, RTTypesPrivate, RTCommon, SafeStorage, RTTypesRemotePrivate, WorldVM; <> Pointer: TYPE = LONG POINTER; CardPointer: TYPE = LONG POINTER TO CARD; SmallCardPointer: TYPE = LONG POINTER TO CARDINAL; IntPointer: TYPE = LONG POINTER TO INT; SmallIntPointer: TYPE = LONG POINTER TO INTEGER; TypedVariableRec: TYPE = RTTypesPrivate.TypedVariableRec; ValueAddress: TYPE = RTTypesPrivate.ValueAddress; checkMutable: BOOL _ TRUE; <> IsAtom: PUBLIC SAFE PROC [tv: TV--ref any--] RETURNS [ans: BOOL _ TRUE] = TRUSTED { [] _ Coerce[tv, CODE[ATOM] ! Error => {ans _ FALSE; CONTINUE}]; }; IsRope: PUBLIC SAFE PROC [tv: TV--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: TV] RETURNS [AMBridge.TVHeadType] = { WITH tv SELECT FROM tvr: REF TypedVariableRec => RETURN[tvr.head.tag]; ENDCASE => RETURN[notTVRecord]; }; TVType: PUBLIC SAFE PROC [tv: TV] RETURNS [type: Type] = TRUSTED { WITH tv SELECT FROM tr: REF TypedVariableRec => RETURN[tr.referentType.type]; ENDCASE => IF tv = NIL THEN RETURN[nullType] ELSE ERROR; }; TVStatus: PUBLIC SAFE PROC [tv: TV] RETURNS [status: Status] = TRUSTED { WITH tv SELECT FROM tr: REF TypedVariableRec => { IF (status _ tr.status) = mutable THEN { <> WITH h: tr.head SELECT FROM gfh => IF h.gfh.code.out THEN status _ readOnly; remoteGFH => IF GetRemoteGFHeader[h.remoteGlobalFrameHandle].code.out THEN status _ readOnly; ENDCASE; }; }; ENDCASE => IF tv = NIL THEN status _ readOnly ELSE ERROR; }; TVForReferent: PUBLIC PROC [ref: REF, status: Status _ mutable] RETURNS [tv: TV] = { <> type: Type; bitsForType: CARD; 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 _ RTTypesPrivate.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 [TV] = { <> RETURN[TVForReferent[ref: LOOPHOLE[ref], status: readOnly]]; }; RefFromTV: PUBLIC PROC [tv: TV] 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: TV --, 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: TV] 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 [TV--atom--] = { RETURN[TVForReadOnlyReferent[NEW[ATOM _ atom]]]; }; TVToATOM: PUBLIC PROC [tv: TV--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 [TV--rope--] = { <> RETURN[TVForReadOnlyReferent[NEW[ROPE _ rope]]]; }; TVForPointerReferent: PUBLIC PROC [ptr: Pointer, type: Type, status: Status _ mutable] RETURNS [tv: TV] = { <> bitsForType: CARD _ bitsPerWord--not smaller than a word--; IF ptr = NIL THEN RETURN[NIL]; bitsForType _ RTTypesPrivate.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: bitsForType]]]]]] ELSE tv _ NEW[TypedVariableRec _ [ referentType: [type], head: [pointer[ptr: ptr]], status: status, field: entire[]]]; }; PointerFromTV: PUBLIC PROC [tv: TV] RETURNS [p: Pointer _ NIL] = { <> <> <> IF tv # NIL THEN WITH tv SELECT FROM tr: REF TypedVariableRec => { WITH head: tr.head SELECT FROM pointer => p _ head.ptr; reference => GO TO badType; gfh => p _ head.gfh; fh => p _ head.fh; ENDCASE => GO TO badType; 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[p + fd.wordOffset]; small => IF fd.field.bitFirst = 0 THEN RETURN[p + fd.wordOffset] ELSE ERROR Error[reason: internalTV]; ENDCASE => ERROR; entire => RETURN[p]; --may have been narrowed-- ENDCASE => ERROR} ENDCASE => GO TO badType; EXITS badType => ERROR Error[reason: typeFault, type: nullType]; }; nilValueAddress: ValueAddress = MakeNilValueAddress[]; MakeNilValueAddress: PROC RETURNS [ValueAddress] = { ws: WordSequence = NEW[WordSequenceRecord[SIZE[Pointer]]]; LOOPHOLE[@ws[0], LONG POINTER TO Pointer] ^ _ NIL; RETURN[[constant[value: ws]]]; }; GetValueAddress: PUBLIC PROC [tv: TV, mutableOnly: BOOL _ FALSE] RETURNS [ValueAddress] = { <> tr: REF TypedVariableRec _ NIL; words: CARDINAL = AMTypes.TVSize[tv]; IF mutableOnly AND TVStatus[tv] # mutable THEN GO TO cantChange; WITH tv SELECT FROM temp: REF TypedVariableRec => { tr _ temp; WITH etr: tr SELECT FROM constant => RETURN [[constant[etr.value]]]; ENDCASE; }; ENDCASE => RETURN [nilValueAddress]; 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: words]]]]]; ENDCASE => ERROR}; 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: words]]]]]; ENDCASE => ERROR}; 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: words]]]]]; ENDCASE => ERROR}; 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: words]]]]]; 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: words]]]]]; ENDCASE => ERROR}; 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: words]]]]]; ENDCASE => ERROR}; 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: words]]]]]; ENDCASE => ERROR}; 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: words]]]]]; ENDCASE => ERROR}; 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: words]]]]]; ENDCASE => ERROR}; ENDCASE => GO TO cantChange; EXITS cantChange => ERROR Error[reason: notMutable]; }; TVEq: PUBLIC SAFE PROC [tv1, tv2: TV] RETURNS [BOOL] = TRUSTED { <> <> <> RETURN[EQValueAddress[GetValueAddress[tv1], GetValueAddress[tv2]]]; }; EQValueAddress: PROC [a1, a2: ValueAddress] RETURNS [BOOL] = { fd1, fd2: RTTypesPrivate.FieldDescriptor; WITH t: a1 SELECT FROM constant => { ws: WordSequence = NARROW[a2, constant ValueAddress].value; IF a2.tag # constant OR t.value.size # ws.size THEN RETURN[FALSE]; FOR i: NAT IN [0..t.value.size) DO IF t.value[i] # ws[i] THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE]}; pointer => { IF a2.tag # pointer THEN RETURN[FALSE]; IF t.ptr # NARROW[a2, pointer ValueAddress].ptr THEN RETURN[FALSE]; fd1 _ t.fd; fd2 _ NARROW[a2, pointer ValueAddress].fd; }; remotePointer => { IF a2.tag # remotePointer THEN RETURN[FALSE]; IF t.ptr # NARROW[a2, remotePointer ValueAddress].ptr THEN RETURN[FALSE]; fd1 _ t.fd; fd2 _ NARROW[a2, remotePointer ValueAddress].fd; }; copiedRemoteObject => { IF a2.tag # copiedRemoteObject THEN RETURN[FALSE]; IF t.ptr # NARROW[a2, copiedRemoteObject ValueAddress].ptr THEN RETURN[FALSE]; fd1 _ t.fd; fd2 _ NARROW[a2, copiedRemoteObject ValueAddress].fd; }; ENDCASE; WITH f1: fd1 SELECT FROM small => WITH f2: fd2 SELECT FROM small => IF f1.field = f2.field THEN RETURN[TRUE]; ENDCASE; large => WITH f2: fd2 SELECT FROM large => IF f1.size = f2.size THEN RETURN[TRUE]; ENDCASE; ENDCASE; RETURN[FALSE]; }; TVEqual: PUBLIC SAFE PROC [tv1, tv2: TV] RETURNS [BOOL] = 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: TV] RETURNS [lc: CARD] = { <> <> a: ValueAddress = GetValueAddress[tv]; ut: Type = AMTypes.UnderType[AMTypes.TVType[tv]]; size: CARDINAL = AMTypes.TVSize[tv]; org: INTEGER = RTTypesPrivate.GetOrigin[ut]; ptr: Pointer; fd: RTTypesPrivate.FieldDescriptor; WITH t: a SELECT FROM constant => RETURN[ SELECT t.value.size FROM 1 => LONG[LOOPHOLE[t.value[0], CARDINAL]] + org, 2 => LOOPHOLE[@t.value[0], CardPointer]^ + org, ENDCASE => ERROR Error[reason: typeFault, type: ut] ]; pointer => {ptr _ t.ptr; fd _ t.fd}; remotePointer => { WITH f: t.fd SELECT FROM large => { words: CARDINAL = MIN[f.size, size]; SELECT words FROM 1 => lc _ LONG[LOOPHOLE[GetRemoteWord[remotePointer: t.ptr], CARDINAL]]; 2 => lc _ GetRemoteLC[remotePointer: t.ptr]; ENDCASE => ERROR Error[reason: typeFault, type: ut]; lc _ LOOPHOLE[LOOPHOLE[lc, INT] + org, CARD]; RETURN}; small => { word: WORD _ GetRemoteWord[remotePointer: t.ptr]; RETURN[FetchFieldLong[@word, f.field] + org]}; ENDCASE => ERROR}; copiedRemoteObject => {ptr _ t.ptr; fd _ t.fd}; ENDCASE => ERROR; WITH f: fd SELECT FROM large => { words: CARDINAL = MIN[f.size, size]; SELECT words FROM 1 => lc _ LONG[LOOPHOLE[ptr, SmallCardPointer]^]; 2 => lc _ LOOPHOLE[ptr, CardPointer]^; ENDCASE => ERROR Error[reason: typeFault, type: ut]; lc _ LOOPHOLE[LOOPHOLE[lc, INT] + org, CARD]; RETURN}; small => lc _ FetchFieldLong[ptr, f.field] + org; ENDCASE => ERROR; }; TVToInteger: PUBLIC PROC [tv: TV] RETURNS [INTEGER] = { RETURN[TVToLI[tv]] }; TVToLI: PUBLIC PROC [tv: TV] RETURNS [INT] = { lc: CARD _ TVToLC[tv]; IF TVSize[tv] = 1 AND TypeClass[GroundStar[TVType[tv]]] = integer THEN RETURN[LONG[LOOPHOLE[Basics.LowHalf[lc], INTEGER]]] <> ELSE RETURN[LOOPHOLE[lc, INT]]}; 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: TV] RETURNS [REAL] = { type: Type = AMTypes.TVType[tv]; ground: Type = AMTypes.GroundStar[type]; SELECT AMTypes.TypeClass[ground] FROM real => RETURN[LOOPHOLE[TVToLC[tv], REAL]]; integer => RETURN [TVToInteger[tv]]; longInteger => RETURN [TVToLI[tv]]; cardinal => RETURN [TVToCardinal[tv]]; longCardinal, unspecified => RETURN [TVToLC[tv]]; ENDCASE => ERROR AMTypes.Error[reason: typeFault, type: type]; }; TVToCardinal: PUBLIC PROC [tv: TV] RETURNS [CARDINAL] = { RETURN[TVToLC[tv]]; }; TVToCharacter: PUBLIC PROC [tv: TV] RETURNS [CHAR] = { <> ans: INTEGER = TVToInteger[tv]; IF ans IN [(FIRST[CHAR] - 0C)..(LAST[CHAR] - 0C)] THEN RETURN[LOOPHOLE[ans, CHAR]] ELSE ERROR Error[reason: rangeFault]; }; TVToWordSequence: PUBLIC PROC [tv: TV] RETURNS [s: WordSequence] = { ptr: Pointer; words: CARDINAL = TVSize[tv]; SELECT words FROM 0 => s _ NEW[WordSequenceRecord[0]]; 1 => { s _ NEW[WordSequenceRecord[1]]; s[0] _ TVToLC[tv]; RETURN; }; 2 => { s _ NEW[WordSequenceRecord[2]]; LOOPHOLE[@s[0], CardPointer]^ _ TVToLC[tv]; RETURN; }; ENDCASE => { a: 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: ValueAddress = RTTypesPrivate.GetValueAddress[tv: tv, mutableOnly: TRUE]; org: INTEGER = RTTypesPrivate.GetOrigin[type]; words: CARDINAL _ AMTypes.TVSize[tv]; IF ws.size < words THEN words _ ws.size; IF words # 0 THEN { lc: CARD = LOOPHOLE[(LONG[LOOPHOLE[ws[0], INTEGER]] - org), CARD]; <> src: Pointer _ @ws[0]; WITH t: a SELECT FROM remotePointer => { IF IsRC[type] THEN GO TO nonRC; WITH fd: t.fd SELECT FROM large => { world: WorldVM.World = AMBridge.GetWorld[tv]; IF (words _ MIN[words, fd.size]) # 0 THEN WorldVM.CopyWrite[world: world, from: src, nwords: words, to: t.ptr.ptr]; }; small => { IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN GO TO fault; RTTypesRemotePrivate.RemoteStoreFieldLong[ptr: t.ptr, field: fd.field, value: lc]}; ENDCASE}; copiedRemoteObject => WITH fd: t.fd SELECT FROM large => IF (words _ MIN[words, fd.size]) # 0 THEN PrincOpsUtils.LongCopy[from: src, nwords: words, to: t.ptr]; small => { IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN GO TO fault; RTCommon.StoreFieldLong[t.ptr, fd.field, lc]}; ENDCASE; pointer => { IF IsRC[type] THEN GO TO nonRC; WITH fd: t.fd SELECT FROM large => IF (words _ MIN[words, fd.size]) # 0 THEN PrincOpsUtils.LongCopy[from: src, nwords: words, to: t.ptr]; small => { IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN GO TO fault; RTCommon.StoreFieldLong[t.ptr, fd.field, lc]}; ENDCASE}; ENDCASE => ERROR; EXITS fault => ERROR AMTypes.Error[reason: rangeFault]; nonRC => ERROR AMTypes.Error[reason: typeFault, type: type]; }; }; SetTVFromLC: PUBLIC PROC [tv: TV, lc: CARD] = { <> <> a: ValueAddress _ RTTypesPrivate.GetValueAddress[tv, TRUE]; type: Type = AMTypes.TVType[tv]; ut: Type = AMTypes.UnderType[type]; words: CARDINAL _ AMTypes.TVSize[tv]; lc _ LOOPHOLE[(LOOPHOLE[lc, INT] - RTTypesPrivate.GetOrigin[ut])]; IF words > 0 THEN { WITH t: a SELECT FROM pointer => { IF IsRC[type] THEN GO TO badType; WITH fd: t.fd SELECT FROM large => { SELECT (words _ MIN[fd.size, words]) FROM 0 => {}; 1 => LOOPHOLE[t.ptr, SmallCardPointer]^ _ lc; 2 => LOOPHOLE[t.ptr, CardPointer]^ _ lc; ENDCASE => GO TO badType; }; small => { IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN GO TO badRange; StoreFieldLong[t.ptr, fd.field, lc]}; ENDCASE => ERROR}; remotePointer => { IF IsRC[type] THEN GO TO badType; WITH fd: t.fd SELECT FROM large => { SELECT (words _ MIN[fd.size, words]) FROM 0 => {}; 1 => RemoteStoreWord[t.ptr, lc]; 2 => RemoteStoreDoubleWord[t.ptr, lc]; ENDCASE => GO TO badType; }; small => { IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN GO TO badRange; RemoteStoreFieldLong[ptr: t.ptr, field: fd.field, value: lc]}; ENDCASE => ERROR}; copiedRemoteObject => { WITH fd: t.fd SELECT FROM large => { SELECT (words _ MIN[fd.size, words]) FROM 0 => {}; 1 => LOOPHOLE[t.ptr, SmallCardPointer]^ _ lc; 2 => LOOPHOLE[t.ptr, CardPointer]^ _ lc; ENDCASE => GO TO badType; }; small => { IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN GO TO badRange; StoreFieldLong[t.ptr, fd.field, lc]}; ENDCASE => ERROR; }; ENDCASE => ERROR; EXITS badRange => ERROR AMTypes.Error[reason: rangeFault]; badType => ERROR AMTypes.Error[reason: typeFault, type: type]; }; }; SetTVFromLI: PUBLIC PROC [tv: TV, li: INT] = { <> a: ValueAddress _ GetValueAddress[tv, TRUE]; type: Type = TVType[tv]; ut: Type = AMTypes.UnderType[type]; class: Class _ AMTypes.TypeClass[ut]; words: CARDINAL _ AMTypes.TVSize[tv]; lc: CARD; lp: Pointer; li _ li - RTTypesPrivate.GetOrigin[type]; lc _ LOOPHOLE[li]; IF words > 0 THEN { WITH t: a SELECT FROM pointer => { IF IsRC[type] THEN GO TO badType; WITH fd: t.fd SELECT FROM large => { lp _ t.ptr; SELECT (words _ MIN[fd.size, words]) FROM 0 => {}; 1 => GO TO short; 2 => GO TO long; ENDCASE => GO TO badType}; small => { IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN GO TO badRange; StoreFieldLong[t.ptr, fd.field, lc]}; ENDCASE => ERROR}; remotePointer => { IF IsRC[type] THEN GO TO badType; WITH fd: t.fd SELECT FROM large => { SELECT (words _ MIN[fd.size, words]) FROM 0 => {}; 1 => { <> c: CARDINAL; IF class = integer THEN {i: INTEGER _ li; c _ LOOPHOLE[i]} ELSE c _ li; RemoteStoreWord[t.ptr, c]; }; 2 => RemoteStoreDoubleWord[t.ptr, lc]; ENDCASE => GO TO badType}; small => { IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN GO TO badRange; RemoteStoreFieldLong[ptr: t.ptr, field: fd.field, value: lc]}; ENDCASE => ERROR}; copiedRemoteObject => WITH fd: t.fd SELECT FROM large => { lp _ t.ptr; SELECT (words _ MIN[fd.size, words]) FROM 0 => {}; 1 => GO TO short; 2 => GO TO long; ENDCASE => GO TO badType}; small => { IF Basics.BITSHIFT[1, fd.field.bitCount] <= lc THEN GO TO badRange; StoreFieldLong[t.ptr, fd.field, lc]}; ENDCASE => ERROR; ENDCASE => ERROR; EXITS short => { <> IF class = integer THEN LOOPHOLE[lp, LONG POINTER TO INTEGER]^ _ li ELSE LOOPHOLE[lp, SmallCardPointer]^ _ lc; }; long => LOOPHOLE[lp, LONG POINTER TO INT]^ _ li; badRange => ERROR AMTypes.Error[reason: rangeFault]; badType => ERROR AMTypes.Error[reason: typeFault, type: type]; }; }; IsRC: PROC [type: Type] RETURNS [ans: BOOL] = { RETURN[RTTypesBasicPrivate.MapTiRcmx[type] # RCMap.nullIndex]; }; END.