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[tv2, 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. ðRTTypesBridgeImpl.Mesa last modified on March 10, 1983 9:08 am by Paul Rovner Russ Atkinson, June 7, 1983 1:47 pm RRA: fixed TVEq & TVEqual for frames RRA: reformated; also fixed TVForPointerReferent to handle 0-width referents T Y P E S VARIABLES PROCs exported to AMTypes raises badTV makes a REF ANY accessible as a TypedVariable. makes a TypedVariable accessible as a REF ANY. Raises internalTV if value is not a collectible object, notMutable if TVStatus[tv] # mutable. NOTE the result may carry a wider (narrower?) type! raises internalTV Like RefFromTV, but accepts only readOnly TVs, returns REF READONLY. Like RefFromTV, but copies instead of raising an error. raises typeFault use TVToName to get the ROPE back These procedures map Pointers, proc descs and frames to TypedVariables and vice versa. raises typeFault Raises internalTV if tv is embedded and not word aligned Raises notMutable if TVStatus[tv] # mutable. Raises notMutable Two TypedVariables are Eq if they address the same bits. Two TypedVariables are Equal if their values have the same size and the same bits. NOTE there is no type checking in these comparisons. These procedures make 1 or 2 word values available as bit patterns, and vice versa. raises typeFault if the field is bigger than 2 words, else PUNs its value (right justified, zero filled) into a LONG CARDINAL. sign extend. raises rangeFault raises typeFault, rangeFault raises NotMutable if TVStatus[tv] # mutable; raises TypeFault if the tv type is RC or its value is bigger than 2 words, else PUNs lc into TVType[tv] and assigns it to the field specified by tv. NOTE this is a LOOPHOLE which may cause bounds checking to miss a bounds violation NOTE what about immutable variant records? raises typeFault, rangeFault START HERE Êt˜šœ™Jšœ6™6šœ#™#Jšœ$™$J™LJ˜——šÏk ˜ J˜ JšœœÏc;˜TJ˜Jšœ œ ˜Jšœ œ˜Jšœœœ+˜@Jšœœ ˜Jšœœœ˜šœ ˜Jšœ]˜]—Jšœ œ˜ Jšœ œ+˜=Jšœœ ˜%J˜šœ˜Jšœ~˜~—Jšœœ@˜MJ˜—šœ˜š˜Jšœ‰˜‰—š˜Jšœ1˜1—šœœ˜ Jšœ~˜~J˜——šœ ™ Jšœœ˜-Jš œ œœœžœ˜1—J˜šœ ™ Jšœœ˜ Jšœœ˜—J˜Jšœ™J˜šÏnœœœ˜Jš œž œœœœœ˜DJš œœœœœ˜@J˜—šŸœœœ˜Jš œž œœœœœ˜DJš œœœœœ˜?Jšœ˜J˜—šŸœœœœ žœœœœœ˜SJšœ˜Jšœœ˜8Jšœ˜J˜—šŸœœœœ˜GJšœœœœ˜%šœœ˜Jšœœœ˜2Jšœœ˜—šœ˜J˜——š Ÿœœœœœœ˜KJšœ ™ Jšœœœœ ˜"šœœ˜Jšœœœ˜9Jšœ˜—šœ˜J˜——š Ÿœœœœœ œ˜IJšœœœœ ˜"šœœ˜Jšœœœ ˜.Jšœ˜—šœ˜J˜J˜——šŸ œœ˜Jšœœœ˜CJšœ.™.Jšœ ˜ Jšœ œœ˜ J˜šœœ˜Jš œœœ œœ˜Jšœ‘™‘šœœ˜šœœ˜šœœ˜Jšœœ˜3Jšœœ˜7šœ˜ šœœ˜Jšœ œ ˜Jšœœ˜+————Jšœ˜—Jšœ˜J˜—šŸœœœžœ˜HJšœœœœ˜JšœV™Všœœ˜šœœ˜šœ˜Jšœœ˜$šœœœ˜#Jšœ œœ ˜(Jšœœ˜,———Jšœœ˜—J˜—š Ÿ œœœœœœ˜BJšœ8™8šœœ˜šœœ˜šœœœ˜Dšœœ œ˜šœœ˜šœœ˜Jšœ œ ˜Jšœœ2˜B——Jšœ˜—Jšœœ˜——Jšœœ˜—J˜—š Ÿ œœœœœžœ˜EJšœœœ ˜1J˜—š Ÿœœœžœœœ˜BJšœ™Jšœ#˜#šœ˜šœ˜Jš œœœœœ˜H—Jšœœ&˜4Jšœ˜ —Jšœ&˜+Jšœ˜J˜—š Ÿ œœœœœžœ˜EJšœ!™!Jšœœœ ˜1J˜—šŸœœœ4˜UJšœ˜JšœV™VJšœ œœžœ˜DJš œœœœœ˜˜J˜Jšœ œœœž˜KJ˜—šœ œ˜"š˜šœ œ˜$Jšœ˜J˜J˜˜J˜˜8J˜0————š˜šœ œ˜$Jšœ˜J˜J˜J˜J˜————šŸ œœœœ ˜Bšœ™Jšœ8™8Jšœ,™,—š Ÿœœœœœ˜Mšœœ˜J˜Jšœ œ*˜Jšœœ˜%——Jšœ˜——Jšœœ˜J˜——šœœ˜šœœ˜Jšœ œœœ˜Lšœœ˜˜ J˜šœ œ˜Jšœ œ6˜Hšœ œ˜#J˜8—Jšœœ˜,——šœ˜Jšœœ ˜"šœ œ˜Jšœ œ6˜Hšœ œ˜#J˜8—Jšœœ˜,——šœ˜Jšœœœ ˜(šœ œ˜Jšœ œ6˜Hšœ œ˜#J˜8—Jšœœ˜,——šœ˜Jšœœœ ˜'šœ œ˜Jšœ œ6˜Hšœ œ˜#J˜8—Jšœœ˜,——šœ œ œ˜$Jšœ œ˜1Jšœœ˜—˜J˜(šœ œ˜šœœ œœ˜LJšœ)˜/—šœ œ˜)˜J˜$——Jšœœ˜,——˜J˜2J˜;J˜šœ œ˜šœœ œœ˜LJšœ)˜/—šœ œ˜)˜J˜$——Jšœœ˜,——šœ˜Jšœœ˜'šœ œ˜šœ œ2˜DJ˜—šœ œ˜$˜ ˜J˜$———Jšœœ˜,——˜J˜@J˜I˜4J˜)—šœ œ˜šœœ œœ˜LJšœ)˜/—šœ œ˜)˜J˜$——Jšœœ˜,——˜ J˜:J˜CJ˜Qšœ œ˜šœœ œœ˜LJšœ)˜/—šœ œ˜ Jšœ ˜ J˜8—Jšœœ˜,——šœœ œ˜*Jšœ œ˜1Jšœœ˜—Jšœœ˜,——Jšœœ˜—Jšœž˜—J˜J˜šŸœœœœœœœ˜MJšœ8™8JšœR™RJšœ4™4Jšœ>˜DJ˜—šŸœœœœ˜BJ˜šœœ˜šœ ˜ šœ˜Jšœœ)˜AJšœœœ˜—šœœœ˜šœœœ'˜@Jšœœœ˜—Jšœ˜—Jšœœ˜—šœ ˜ Jšœœœœ˜'šœ œ!˜2Jšœœœ˜—J˜ Jšœœ!˜-J˜—šœ˜Jšœœœœ˜-šœ œ'˜8Jšœœœ˜—J˜ Jšœœ'˜3J˜—šœ˜Jšœœœœ˜2šœ œ,˜=Jšœœœ˜—J˜ Jšœœ,˜8J˜—Jšœ˜J˜—šœ œ˜šœ œ œ˜!Jš œ œœœœ˜3Jšœœœ˜—šœ œ œ˜!Jš œ œœœœ˜1Jšœœœ˜—Jšœ˜—Jšœœ˜J˜—šŸœœœœœœœ˜PJ˜/J˜/J˜8J˜8Jšœ œ˜Jšœœœœ˜'Jšœœœœ˜%šœ˜Jšœœœ˜*Jšœ˜—šœ˜Jšœœœ˜*Jšœ˜—J˜J˜Jšœœœœ˜%Jšœ œœ˜5šœœœ ˜šœ8˜:Jšœœœ˜—Jšœ˜—Jšœœ˜ J˜J˜—š Ÿœœœœœœ˜EJšœS™SJšœ~™~Jšœ)˜)J˜ J˜šœœ˜šœ œœ˜&Jšœœ+˜5šœœ ˜Jš œœœœœ˜J˜——J˜$šœ˜šœ œ˜šœ ˜ šœ˜J˜.J˜,Jšœœ,˜<—š œœœœœ˜DJšœœ˜—Jšœ˜—šœ ˜ Jšœœ'˜1Jšœ=˜C——Jšœœ˜—J˜/Jšœ˜J˜—šœœ˜šœ ˜ šœ˜Jš œ œœœœœ˜3Jš œ œœœœœœ˜8Jšœœ,˜<—šœœ˜Jšœœœ˜6Jšœœ˜—Jšœ˜—JšœF˜FJšœ˜—Jšœ˜J˜—š Ÿ œœœœœ˜@Jšœ ˜&Jšœ˜J˜—š Ÿœœœœœœ˜@Jšœœœ˜šœœ,˜Aš œœœœœ œ˜LJšœ ™ —Jš œœœœœ˜)J˜——šŸœœœœœœœ˜1šœ˜#JšœL˜Q—šœ"˜,Jš œœœ œœ˜?Jšœœ,˜<—J˜J˜—š Ÿœœœœœ˜:Jšœœ œ˜$J˜—š Ÿ œœœœœ˜BJšœ#˜)J˜—š Ÿ œœœœ œ˜DJšœ™Jšœœ˜š œœœ œ œ œ˜;Jšœœœ œ˜%Jšœœ˜&J˜——šŸœœœœ˜NJšœ ˜ Jšœœ˜šœ˜Jšœœ˜7šœ˜Jšœœ˜2Jš œœœœœ%˜MJšœ˜—šœ˜Jšœœ˜2Jš œœœœœœ˜=Jšœ˜—šœ˜ J˜)šœœ˜Jšœ œ ˜J˜Jšœœ6˜MJ˜"Jšœœ˜—Jšœœ˜2J˜5J˜——J˜J˜—šŸœœœ œ˜HJ˜ šœ ˜ Jšœ4œ˜:—šœœ˜šœ˜Jšœ œœ.˜Fšœ œ˜šœ œ ˜Jšœ˜šœ˜šœœœœ˜Jšœœœœ%˜BJšœœ˜—˜J˜J˜J˜*——šœ˜Jšœ˜J˜ J˜J˜——šœ ˜ šœœœœ˜Jšœœœœ%˜BJšœœ˜—šœœ˜.Jšœœ˜&—J˜S——Jšœœ˜—˜šœ œ˜šœ œ ˜Jšœ˜šœ˜šœœœœ˜Jšœœœœ%˜BJšœœ˜—š œœœœœ˜*J˜$——Jšœ>˜E—šœ ˜ šœœœœ˜Jšœœœœ%˜BJšœœ˜—šœœ˜.Jšœœ˜&—J˜.—Jšœœ˜——šœ ˜ Jšœ œœ.˜Fšœ œ˜šœ ˜ šœ ˜šœ˜šœœ˜š œœœœœ˜*J˜"Jšœœ˜——š œœœœœ˜*J˜$——Jšœ>˜E——šœ ˜ šœœ˜šœœ˜ Jšœœœœ%˜BJšœœ˜——šœœ˜.Jšœœ$˜.—J˜.——Jšœœ˜—Jšœœ˜—Jšœ˜J˜—š Ÿ œœœœœ˜BJšœ™Jšœ¿™¿Jšœ)œ˜/J˜Jš œœœœœœœ˜Pšœœ˜šœ ˜ Jšœ œœ&˜>šœ œ˜šœ œ ˜Jš œœœœœœ˜JJš œœœœœœœ˜:Jšœœ&˜6—šœ ˜ šœœ˜.Jšœœ˜&—J˜%——Jšœœ˜—šœ˜Jšœ œœ&˜>šœ œ˜šœ œ ˜J˜5J˜&Jšœœ&˜6—šœ ˜ šœœ˜.Jšœœ˜&—J˜>——Jšœœ˜—˜šœ œ˜šœ œ ˜Jš œœœœœœ˜JJš œœœœœœœ˜:Jšœœ&˜6—šœ ˜ Jšœœœœ˜UJ˜%—Jšœœ˜——Jšœœ˜—J˜—J˜š Ÿ œœœœœ˜AJšœ™Jšœ)œ˜/J˜J˜šœœ˜šœ ˜ Jšœ œœ&˜>šœ œ˜šœ œ ˜Jš œœœœœœ˜HJš œœœœœœœ˜9Jšœœ&˜6—šœœœœ˜+šœœ˜.Jšœœ˜&—J˜%——Jšœœ˜—šœ˜Jšœ œœ&˜>šœ œ˜šœ œ ˜J˜4J˜&Jšœœ&˜6—šœœœœ˜+šœœ˜.Jšœœ˜&—J˜>——Jšœœ˜—˜šœ œ˜šœ œ ˜Jš œœœœœœ˜HJš œœœœœœœ˜9Jšœœ&˜6—šœ ˜ Jšœœœœ˜!Jšœœœœ˜UJ˜%—Jšœœ˜——Jšœœ˜—J˜—J˜šŸœœ œœ˜-Jšœ9˜?J˜—Jšœ ™ J˜3J˜Jšœ˜J˜J˜—…—Xh~Ì