-- RTTypesBridgeImpl.Mesa
-- last modified on December 17, 1982 8:56 am by Paul Rovner

DIRECTORY
AMBridge USING[GetWorld, TVHeadType, WordSequence, WordSequenceRecord, RemotePointer],
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];

RTTypesBridgeImpl: PROGRAM
IMPORTS AMBridge, AtomsPrivate, RTCommon, RTStorageOps, RTTypesBasic,
AMTypes, RTTypesPrivate, RTTypesBasicPrivate, RTTypesRemotePrivate, WorldVM
EXPORTS AMTypes, AMBridge, RTTypesPrivate

= BEGIN OPEN AMBridge, AMTypes, Environment, Rope, tp: RTTypesPrivate, RTCommon,
RTTypesBasic, RTStorageOps, RTTypesRemotePrivate,
WorldVM;

-- T Y P E S
TypedVariableRec: TYPE = tp.TypedVariableRec;
Pointer: TYPE = LONG POINTER --TO UNSPECIFIED--;

-- VARIABLES
tvZone: ZONE;
tvPrefixedZone: ZONE;

-- PROCs exported to AMTypes

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]};

-- raises badTV
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};


-- These procedures make a TypedVariable accessible as a REF ANY and vice versa.
TVForReferent: PUBLIC PROC[ref: REF ANY, status: Status ← mutable] RETURNS[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;

RETURN[
IF bitsForType < bitsPerWord
THEN
tvZone.NEW
[TypedVariableRec ←
[referentType: [type],
head: [reference[ref: ref]],
status: status,
field: embedded
[fd: [wordOffset: 0,
extent: small[field: [bitFirst: bitsPerWord-bitsForType,
bitCount: ShortenLongCardinal[bitsForType]]]]]]]
ELSE 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]]};

-- Raises internalTV if value is not a collectible object, notMutable if
-- TVStatus[tv] # mutable. NOTE the result may carry a wider (narrower?) type!
RefFromTV: PUBLIC PROC[tv: TypedVariable] RETURNS[REF ANY] =
{WITH tv SELECT FROM
tr: REF TypedVariableRec =>
{IF tr.tag # entire
THEN ERROR Error[reason: internalTV]
ELSE IF tr.status # mutable
THEN ERROR Error[reason: notMutable]
ELSE WITH head: tr.head SELECT FROM
reference => RETURN[head.ref];
ENDCASE => ERROR Error[reason: internalTV]};
ENDCASE => ERROR};

-- raises internalTV
-- Like RefFromTV, but accepts only readOnly TVs, returns REF READONLY.
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};

-- One has a mutable TypedVariable that is not embedded.
-- One wants a tv for a REF to the cell described by the TypedVariable.
-- This may raise NotMutable or InternalTV, or return NIL if the referer type is not available.
-- to be parsed TVFor(RefToTV)
--TVForRefToTV: PUBLIC PROC[tv: TypedVariable] RETURNS[rtv: TypedVariable] =
-- {t: Type ← RefType[TVType[tv]];
-- IF t = nullType THEN RETURN[NIL];
-- rtv ← New[t];
-- LOOPHOLE[rtv, REF REF ANY]^ ← RefFromTV[tv]};

-- Like RefFromTV, but copies instead of raising an 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 RETURN[RefFromTV[Copy[tv]]]
ELSE RETURN[RefFromTV[tv]]};
ENDCASE => ERROR};

TVForATOM: PUBLIC PROC[atom: ATOM] RETURNS[TypedVariable--atom--] =
{RETURN[TVForReadOnlyReferent[NEW[ATOM ← atom]]]};

-- raises typeFault
TVToATOM: PUBLIC PROC[tv: TypedVariable--atom--] RETURNS[ATOM] =
{ type: Type = UnderType[TVType[tv]];
RETURN
[SELECT TypeClass[type] FROM
ref => IF Range[type] = anyType
THEN TVToATOM[Coerce[tv, CODE[ATOM]]]
ELSE ERROR Error[reason: typeFault, type: type],
atom => AtomsPrivate.GetAtom[TVToName[tv]],
ENDCASE => ERROR Error[reason: typeFault, type: type]];
};

-- use TVToName to get the ROPE back
TVForROPE: PUBLIC PROC[rope: ROPE] RETURNS[TypedVariable--rope--] =
{RETURN[TVForReadOnlyReferent[NEW[ROPE ← rope]]]};

-- These procedures map Pointers, proc descs and frames to TypedVariables and vice versa.
TVForPointerReferent: PUBLIC PROC[ptr: Pointer, type: Type, status: Status ← mutable]
RETURNS[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;
RETURN[
IF bitsForType < bitsPerWord
THEN
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 tvZone.NEW[TypedVariableRec ← [referentType: [type],
head: [pointer[ptr: ptr]],
status: status,
field: entire[]]]]};

-- raises typeFault
-- Raises internalTV if tv is embedded and not word aligned
-- Raises notMutable if TVStatus[tv] # mutable.
PointerFromTV: PUBLIC PROC[tv: TypedVariable] RETURNS[Pointer] =
{
GetHeadPointer: PROC[tr: REF TypedVariableRec] RETURNS[Pointer] = INLINE
{RETURN[(WITH head: tr.head SELECT FROM
pointer => head.ptr,
reference => ERROR Error[reason: typeFault, type: nullType],
gfh => LOOPHOLE[LONG[head.gfh]],
fh => 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]};

-- Raises notMutable
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


 -- 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.
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 {ws1: WordSequence;
ws2: WordSequence;
ws1 ← TVToWordSequence[tv1];
ws2 ← TVToWordSequence[tv2];
IF ws1.size <= 2 AND ws2.size <= 2 THEN RETURN[TVToLC[tv1] = TVToLC[tv2]];

IF ws1.size # ws2.size THEN RETURN[FALSE];
FOR i: NAT IN [0..ws1.size)
DO IF ws1[i] # ws2[i] THEN RETURN[FALSE]; ENDLOOP;
RETURN[TRUE]};


-- 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.
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: UNSPECIFIED ← 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 => RETURN[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]]]
-- sign extend.
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]]]};

-- raises rangeFault
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];

IF words = 2
THEN {s ← tvPrefixedZone.NEW[WordSequenceRecord[words]];
LOOPHOLE[@s[0], LONG POINTER TO LONG CARDINAL]^ ← TVToLC[tv];
RETURN};
IF words = 1
THEN {s ← tvPrefixedZone.NEW[WordSequenceRecord[words]];
LOOPHOLE[@s[0], LONG POINTER TO CARDINAL]^
← ShortenLongCardinal[TVToLC[tv]];
RETURN};

{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]]}};

-- 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
SetTVFromLC: PUBLIC PROC[tv: TypedVariable, lc: LONG CARDINAL] = {
type: Type = TVType[tv];

{a: tp.ValueAddress ← GetValueAddress[tv, TRUE];
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;
}};


-- raises typeFault, rangeFault
SetTVFromLI: PUBLIC PROC[tv: TypedVariable, li: LONG INTEGER] = {
type: Type = TVType[tv];

{a: tp.ValueAddress ← GetValueAddress[tv, TRUE];
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]};

-- START HERE
[qz: tvZone, pz: tvPrefixedZone] ← tp.GetTVZones[];

END.