-- RTTypedVariablesImpl.Mesa
-- last modified on December 21, 1982 3:09 pm by Paul Rovner
-- try to avoid acquisition of already acquired symbol tables
-- status stuff is wrong.

DIRECTORY
AMBridge USING[WordSequence, WordSequenceRecord, TVForReferent, SetTVFromLC,
TVToLC, TVToCardinal, TVToProc, TVToSignal, GFHFromTV,
TVToLI, TVForPointerReferent, SetTVFromLI,
TVToWordSequence, IsRemote, TVToRemoteProc, TVToRemoteSignal,
RemoteGFHFromTV, TVForRemoteReferent, RemotePointer,
TVForRemotePointerReferent, RemoteRef, GetWorld,
GetWorldIncarnation],
AMTypes USING[Error, Status, Class, VariableType, TVType, IsComputed, Size,
NComponents, IsOverlaid, TypeClass, UnderType, NameToIndex,
TVStatus, First, IndexToName, Domain, Range, Last, GroundStar,
ReferentStatus, IsAtom, IsRope, IndexToType],
AtomsPrivate USING[AtomRec],
CedarLinkerOps USING[NullLink],
Environment USING[bitsPerWord],
Inline USING[BITSHIFT, LongCOPY, LongNumber, LowHalf, HighHalf],
List USING[AList],
PrincOps USING[ProcDesc, SignalDesc],
RCMap USING[nullIndex],
RemoteRope USING[RemoteFetch, RemoteLength, RopeFromTV],
Rope USING[ROPE, RopeRep, Fetch, Length],
RTBasic USING[TV, TypedVariable, Index],
RTCommon USING[FetchField, ShortenLongCardinal, ShortenLongInteger],
RTStorageOps USING[NewObject, AssignComposite, AssignCompositeNew, ValidateRef],
RTSymbolDefs USING[SymbolTableBase, SymbolIndex, SymbolConstructorIndex,
SymbolIdIndex, SymbolRecordIndex],
RTSymbolOps USING[AcquireType, AcquireSequenceType],
RTSymbols USING[GetTypeSymbols, ReleaseSTB],
RTTypesBasic USING[EquivalentTypes, Type, unspecType, anyType, nullType,
GetCanonicalType, fhType, gfhType, GetReferentType],
RTTypesBasicPrivate USING[MapTiRcmx, MapRefs],
RTTypesPrivate,
RTTypesRemotePrivate USING[GetRemoteWords, RemoteStoreWords, RemoteGFHToName,
RemoteSEDToName, RemotePDToName, ValidateRemoteRef,
RemoteTypeToLocal, GetRemoteWord, GetRemoteReferentType],
SafeStorage USING[NewZone],
WorldVM USING[CurrentIncarnation, Long, World, LocalWorld, Address];

RTTypedVariablesImpl: PROGRAM
IMPORTS AMBridge, AMTypes, CedarLinkerOps, Inline, RemoteRope, Rope, RTCommon,
RTStorageOps, RTTypesBasic, RTTypesBasicPrivate, RTSymbolOps, RTSymbols,
RTTypesPrivate, RTTypesRemotePrivate, SafeStorage, WorldVM
EXPORTS AMTypes, AMBridge, RTTypesPrivate
SHARES Rope

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

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

-- V A L U E S
-- ZONEs
tvZone: ZONE = SafeStorage.NewZone[quantized];
tvPrefixedZone: ZONE = SafeStorage.NewZone[];


-- PROCs exported to RTTypesPrivate

GetTVZones: PUBLIC PROC RETURNS[qz, pz: ZONE] = {RETURN[tvZone, tvPrefixedZone]};

-- PROCs exported to AMTypes

-- raises typeFault
New: PUBLIC SAFE PROC[type: Type,
status: Status ← mutable,
world: WorldVM.World ← WorldVM.LocalWorld[],
tag: TV ← NIL]
RETURNS[newTV: TypedVariable] = TRUSTED
{ variantClass: Class;
length: CARDINAL ← 0;

IF type = nullType THEN RETURN[NIL];
IF type = fhType OR type = gfhType THEN ERROR Error[reason: typeFault, type: type];

variantClass ← VariableType[type].c;
-- variantClass = nil if type not a record or structure, or if non-variant (i.e. does
-- not contain a union or sequence)

IF tag # NIL AND variantClass = sequence
THEN length ← ShortenLongCardinal
[LOOPHOLE[TVToLI[tag] - TVToLI[First[TVType[tag]]],
LONG CARDINAL]];
IF world # WorldVM.LocalWorld[]
THEN -- make a new remote TV
{IF tag # NIL AND (variantClass = union OR variantClass = sequence)
THEN { ws: WordSequence ← tvPrefixedZone.NEW
[WordSequenceRecord[Size[type, length]]];
newTV: TV ← tvZone.NEW[TypedVariableRec
← [referentType: [type,
IF IsComputed[type]
OR (variantClass = union
AND IsOverlaid[type])
THEN tag
ELSE NIL],
head: [copiedRemoteObject
[world: world,
worldIncarnation:
CurrentIncarnation[world],
copy: ws]],
status: status,
field: entire[]]];
newTag: TV;

IF IsComputed[type] OR (variantClass = union AND IsOverlaid[type])
THEN RETURN[newTV];

-- here to initialize the tag of the new variant or sequence record
newTag ← Tag[IndexToTV[newTV, NComponents[type]]]; -- assume sharing
NARROW[newTag, REF TypedVariableRec].status ← mutable;
Assign[lhs: newTag, rhs: tag];
NARROW[newTag, REF TypedVariableRec].status ← readOnly;
RETURN[newTV];
}
ELSE RETURN
[tvZone.NEW
[TypedVariableRec
← [referentType: [type],
head: [copiedRemoteObject
[world: world,
worldIncarnation: CurrentIncarnation[world],
copy: tvPrefixedZone.NEW[WordSequenceRecord[Size[type]]]]],
status: status,
field: entire[]]]]} -- end make a new remote TV
ELSE -- make a new local TV
{newTV ← TVForReferent[NewObject[type: type, size: Size[type, length]]]; -- cleared

-- if a new variant or sequence record, initialize the tag
IF tag # NIL AND (variantClass = union OR variantClass = sequence)
THEN {IF IsComputed[type] OR (variantClass = union AND IsOverlaid[type])
THEN NARROW[newTV, REF TypedVariableRec].referentType.tag ← tag
ELSE
{newTag: TV ← Tag[IndexToTV[newTV, NComponents[type]]];
NARROW[newTag, REF TypedVariableRec].status ← mutable;
Assign[lhs: newTag, rhs: tag];
NARROW[newTag, REF TypedVariableRec].status ← readOnly};
};

RETURN[newTV]};
}; -- end New

-- raises IncompatibleTypes, NotMutable
Assign: PUBLIC SAFE PROC[lhs: TypedVariable, rhs: TypedVariable] =
TRUSTED {DoAssign[lhs, rhs]};

-- raises typeFault, notImplemented, incompatibleTypes
DoAssign: PROC[lhs: TypedVariable, rhs: TypedVariable, new: BOOLEAN ← FALSE] =
{lhsType: Type = TVType[lhs];
rhsType: Type = TVType[rhs];
size: CARDINAL = TVSize[rhs];
lhsPtrHead: BOOLEAN ← FALSE;

IF lhsType = fhType OR lhsType = gfhType
THEN ERROR Error[reason: typeFault, type: lhsType];
IF rhsType = fhType OR rhsType = gfhType
THEN ERROR Error[reason: typeFault, type: rhsType];

{lhsa: tp.ValueAddress ← tp.GetValueAddress[tv: lhs, mutableOnly: TRUE];
rhsa: tp.ValueAddress ← tp.GetValueAddress[rhs];

IF IsRC[lhsType]
AND ((lhsa.tag = remotePointer)
OR (lhsa.tag = pointer AND rhsa.tag = remotePointer)
OR (lhsa.tag = pointer AND rhsa.tag = copiedRemoteObject)
OR (lhsa.tag = copiedRemoteObject AND rhsa.tag = pointer)
)
THEN ERROR Error[reason: notImplemented, msg: "remote reference-counted assignment"];

WITH lhs SELECT FROM
tr: REF TypedVariableRec =>
WITH tr.head SELECT FROM
constant, remoteConstant => ERROR Error[reason: notMutable];
reference, gfh => NULL;
pointer, fh, remoteReference, copiedRemoteObject,
remotePointer, remoteGFH, remoteFH => lhsPtrHead ← TRUE;
ENDCASE => ERROR;
ENDCASE => ERROR;

IF rhsType = nullType
THEN {SELECT TypeClass[UnderType[lhsType]] FROM
list, ref, atom, rope
=> IF lhsPtrHead OR new
THEN SetTVFromLC[lhs, 0]
ELSE LOOPHOLE[NARROW[lhsa, pointer tp.ValueAddress].ptr,
REF REF ANY]^ ← NIL;
pointer, longPointer, procedure, signal, error, basePointer, relativePointer
=> SetTVFromLC[lhs, 0];
ENDCASE => ERROR Error[reason: typeFault, type: rhsType];
RETURN};

IF size > TVSize[lhs]
THEN ERROR Error[reason: incompatibleTypes, type: lhsType, otherType: rhsType];

IF NOT AsGoodAs[rhsType: rhsType, lhsType: lhsType]
THEN {DoAssign[lhs: lhs, rhs: Coerce[rhs, lhsType]]; RETURN};

WITH t: rhsa SELECT FROM
constant =>
{IF t.value.size <= 2
THEN SetTVFromLC[lhs, TVToLC[rhs]] -- NOTE non-RC, <= 2 words
ELSE {IF lhsPtrHead -- NOTE remote RC not allowed
THEN {IF lhsa.tag = remotePointer
THEN RemoteStoreWords
[from: @t.value[0],
to: NARROW[lhsa, remotePointer tp.ValueAddress].ptr,
nWords: t.value.size]
ELSE Inline.LongCOPY
[from: @t.value[0],
to: IF lhsa.tag = pointer
THEN NARROW[lhsa, pointer tp.ValueAddress].ptr
ELSE NARROW
[lhsa,
copiedRemoteObject tp.ValueAddress].ptr,
nwords: t.value.size]}
ELSE IF new THEN AssignCompositeNew
[rhs: @t.value[0],
lhs: NARROW[lhsa, pointer tp.ValueAddress].ptr,
type: rhsType,
nwords: t.value.size]
ELSE AssignComposite[rhs: @t.value[0],
lhs: NARROW[lhsa, pointer tp.ValueAddress].ptr,
type: rhsType,
nwords: t.value.size]}
};
pointer =>
{WITH fd: t.fd SELECT FROM
large => {SELECT fd.size FROM
1 => SetTVFromLC[lhs, TVToLC[rhs]];
ENDCASE => {WITH rhs SELECT FROM
tr: REF TypedVariableRec =>
WITH tr.head SELECT FROM
fh => { -- validate rhs
OPEN RTTypesBasicPrivate;
procLeaf: PROC[r: REF ANY] =
{ValidateRef[r]};

-- start here
MapRefs[ptr: t.ptr,
rcmx: MapTiRcmx[rhsType],
procLeaf: procLeaf]};
ENDCASE;
ENDCASE;
IF lhsPtrHead -- NOTE remote RC not allowed
THEN {IF lhsa.tag = remotePointer
THEN
RemoteStoreWords
[from: t.ptr,
to: NARROW[lhsa, remotePointer tp.ValueAddress].ptr,
nWords: size]
ELSE Inline.LongCOPY
[from: t.ptr,
to: IF lhsa.tag = pointer
THEN NARROW
[lhsa, pointer tp.ValueAddress].ptr
ELSE NARROW
[lhsa,
copiedRemoteObject tp.ValueAddress].ptr,
nwords: size]}
ELSE IF new
THEN AssignCompositeNew
[rhs: t.ptr,
lhs: NARROW[lhsa, pointer tp.ValueAddress].ptr,
type: rhsType,
nwords: size]
ELSE AssignComposite
[rhs: t.ptr,
lhs: NARROW[lhsa, pointer tp.ValueAddress].ptr,
type: rhsType,
nwords: size]}};
small => SetTVFromLC[lhs, TVToLC[rhs]];
ENDCASE => ERROR};
remotePointer => -- rhsa.tag = remotePointer
{WITH fd: t.fd SELECT FROM
large => {SELECT fd.size FROM
1, 2 => SetTVFromLC[lhs, TVToLC[rhs]];
ENDCASE => {ws: WordSequence = GetRemoteWords[t.ptr, size];
WITH rhs SELECT FROM
tr: REF TypedVariableRec =>
WITH tr.head SELECT FROM
remoteFH => { -- validate rhs
OPEN RTTypesBasicPrivate;
procLeaf: PROC[r: REF ANY] =
{ValidateRemoteRef
[[world: remoteFrameHandle.world,
worldIncarnation: CurrentIncarnation[remoteFrameHandle.world],
ref: LOOPHOLE[r, WorldVM.Address]]]};

-- start here
MapRefs[ptr: @ws[0],
rcmx: MapTiRcmx[rhsType],
procLeaf: procLeaf]};
ENDCASE;
ENDCASE;
IF lhsa.tag = remotePointer
THEN RemoteStoreWords
[from: @ws[0],
to: NARROW[lhsa, remotePointer tp.ValueAddress].ptr,
nWords: size]
ELSE Inline.LongCOPY
[from: @ws[0],
to: IF lhsa.tag = pointer
THEN
NARROW
[lhsa, pointer tp.ValueAddress].ptr
ELSE
NARROW
[lhsa,
copiedRemoteObject tp.ValueAddress].ptr,
nwords: size]}};
small => SetTVFromLC[lhs, TVToLC[rhs]];
ENDCASE => ERROR};
copiedRemoteObject => -- rhsa.tag = copiedRemoteObject
{WITH fd: t.fd SELECT FROM
large => {SELECT fd.size FROM
1,2 => SetTVFromLC[lhs, TVToLC[rhs]];
ENDCASE => {IF lhsa.tag = remotePointer
THEN RemoteStoreWords
[from: t.ptr,
to: NARROW[lhsa, remotePointer tp.ValueAddress].ptr,
nWords: size]
ELSE Inline.LongCOPY
[from: t.ptr,
to: IF lhsa.tag = pointer
THEN
NARROW
[lhsa, pointer tp.ValueAddress].ptr
ELSE
NARROW
[lhsa,
copiedRemoteObject tp.ValueAddress].ptr,
nwords: size]}};
small => SetTVFromLC[lhs, TVToLC[rhs]];
ENDCASE => ERROR};
ENDCASE => ERROR}}; -- end DoAssign

Copy: PUBLIC SAFE PROC[tv: TypedVariable] RETURNS[newTV: TypedVariable] = TRUSTED
{ type: Type;
tag: TV ← NIL;
IF tv = NIL THEN RETURN[NIL];

tag ← TVTag[tv];
type ← TVType[tv];

IF tag = NIL
THEN {variantClass: Class = VariableType[type].c;
IF variantClass = union OR variantClass = sequence
THEN tag ← Tag[IndexToTV[tv, NComponents[type]]];
};

newTV ← New[world: GetWorld[tv], type: type, tag: tag];

DoAssign[lhs: newTV, rhs: tv, new: TRUE]};

TVTag: PROC[tv: TypedVariable] RETURNS[TV] =
{RETURN[NARROW[tv, REF TypedVariableRec].referentType.tag]};

-- Could overflow
TVSize: PUBLIC SAFE PROC[tv: TypedVariable] RETURNS[INT--words--] = TRUSTED
{ type: Type = UnderType[TVType[tv]];
vClass: Class ← VariableType[type].c;
vTv: TV;
IF (IsOverlaid[type] OR IsComputed[type]) AND TVTag[tv] = NIL
THEN RETURN[Size[type: type]];
vTv ← SELECT vClass FROM
union, sequence => IndexToTV[tv, NComponents[type]],
ENDCASE => NIL;
RETURN[IF vClass=union
THEN TVSize[Variant[vTv]]
ELSE Size[type: type,
length: IF vClass=sequence
THEN ShortenLongCardinal[LOOPHOLE[Length[vTv],
LONG CARDINAL]]
ELSE 0]]};

-- MOVE
Tag: PUBLIC SAFE PROC[tv: TypedVariable--union, sequence--]
RETURNS[ans: TypedVariable] = TRUSTED
{type: Type = TVType[tv];
stb: SymbolTableBase;
sei: SymbolIndex;

IF TVTag[tv] # NIL THEN RETURN[TVTag[tv]];
IF IsComputed[type] OR IsOverlaid[type]
THEN RETURN[NIL];

[stb, sei] ← GetTypeSymbols[type];
{ ENABLE UNWIND => ReleaseSTB[stb];
csei: SymbolConstructorIndex = stb.UnderType[sei];
tagSei: SymbolIdIndex;
WITH ser: stb.seb[csei] SELECT FROM
union => {IF IsOverlaid[type] THEN ERROR Error[reason: typeFault, type: type];
tagSei ← ser.tagSei};
sequence => tagSei ← ser.tagSei;
ENDCASE => ERROR Error[reason: typeFault, type: type];

IF stb.seb[tagSei].constant THEN ERROR;
ans ← tvZone.NEW
[TypedVariableRec ←
[ referentType: [Domain[type]],
head: (WITH tv SELECT FROM
tr: REF TypedVariableRec => tr.head,
ENDCASE => ERROR),
status: readOnly,
field: embedded[fd: BuildRecordFieldDescriptor
[parentTV: tv,
fieldBitOffset: LOOPHOLE[stb.seb[tagSei].idValue, CARDINAL],
fieldBits: LOOPHOLE[stb.seb[tagSei].idInfo, CARDINAL],
bitsForType: stb.BitsForType
[stb.UnderType
[stb.seb[tagSei].idType]]
]
]
]
];
};
ReleaseSTB[stb]}; -- end Tag

-- break up and MOVE
Variant: PUBLIC SAFE PROC[tv: TypedVariable--union--]
RETURNS[ans: TypedVariable ← NIL--record--] =
TRUSTED { type: Type = TVType[tv];
p: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] =
{ cType: Type ← AcquireType[stb, stb.UnderType[isei]];
-- NOTE chaining for multiple names
size: CARDINAL ← Size[cType];
IF size = 0 THEN RETURN;
ans ← tvZone.NEW
[TypedVariableRec ←
[ referentType: [cType],
head: (WITH tv SELECT FROM
tr: REF TypedVariableRec => tr.head,
ENDCASE => [reference[ref: tv]]),
status: TVStatus[tv],
field: embedded[fd: [wordOffset:
(WITH tv SELECT FROM
tr: REF TypedVariableRec =>
WITH t: tr SELECT FROM
embedded =>
t.fd.wordOffset,
ENDCASE => 0,
ENDCASE => 0),
extent: large[size: size]]]]]}; -- end p

-- Begin Here
IF TypeClass[UnderType[type]] # union THEN Error[reason: typeFault, type: type];
tp.ComponentISEI[type, NameToIndex[type, TVToName[Tag[tv]]], p]};


-- break up and MOVE
-- [1..NComponents[TVType[tv]]]
IndexToTV: PUBLIC SAFE PROC[tv: TypedVariable--record, structure--, index: Index]
RETURNS[TypedVariable] =
TRUSTED {cType: Type;
type: Type ← UnderType[TVType[tv]];
et: REF TypedVariableRec;
argRec: BOOLEAN;
interfaceRec: BOOLEAN;
bitsForTV: LONG CARDINAL;

BuildEmbeddedTV: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] =
{sei: SymbolIndex = stb.seb[isei].idType;
csei: SymbolConstructorIndex ← stb.UnderType[sei];
bitsForType: CARDINAL ← stb.BitsForType[csei];
-- bits for the value in the field
fieldBits: CARDINAL ← stb.seb[isei].idInfo;
-- bits for the field
fieldBitOffset: CARDINAL ← IF argRec
THEN stb.FnField[isei].offset.wd*bitsPerWord
ELSE IF interfaceRec
THEN stb.seb[isei].idValue*bitsPerWord
ELSE stb.seb[isei].idValue;
-- bit offset of the field within the record

isSequence: BOOLEAN ← FALSE;

WITH cse: stb.seb[csei] SELECT FROM
relative => bitsForType ← stb.BitsForType[cse.offsetType];
-- NOTE SymbolPack bug workaround
ENDCASE;

IF (NOT Embedded[tv]) AND bitsForTV < bitsPerWord
-- if the entire tv is smaller than a word and in an allocated object
THEN fieldBitOffset ← fieldBitOffset + bitsPerWord - ShortenLongCardinal[bitsForTV];

WITH cse: stb.seb[csei] SELECT FROM
sequence => {recstb: SymbolTableBase;
recsei: SymbolIndex;
[recstb, recsei] ← GetTypeSymbols[type];
cType ← AcquireSequenceType[stb,
sei,
recstb,
LOOPHOLE[recsei, SymbolRecordIndex]
! UNWIND => ReleaseSTB[recstb]];
isSequence ← TRUE;
ReleaseSTB[recstb]};
ENDCASE => cType ← AcquireType[stb, sei];
IF stb.seb[isei].constant
THEN {ENABLE Error => IF reason = notImplemented THEN GOTO nimp;
et ← tvZone.NEW[TypedVariableRec ←
[ referentType: [cType, TVTag[tv]],
head: [constant[]],
status: const,
field: constant[value: tp.GetIdConstantValue[tv, stb, isei]]
]
];
EXITS nimp => et ← NIL}
ELSE IF interfaceRec AND NOT IsInterfaceElementType[cType]
-- an interface variable
THEN { -- XXX old: the (16-bit) value in the indicated field of the IR instance is...
-- a (loadstate config index (identifies a BCD),
-- index in linksary of EXPRecord for this interface in that BCD)
fD: tp.FieldDescriptor;
headP: Pointer;

IF IsRemote[tv] THEN
ERROR Error[reason: notImplemented,
msg: "Interface variables for remote interface records"];

fD ← BuildRecordFieldDescriptor[tv, fieldBitOffset, 16, 16];

IF TRUE
THEN {hP: Pointer = -- NOTE XXX Remote
WITH head: NARROW[tv, REF TypedVariableRec].head SELECT FROM
reference => LOOPHOLE[head.ref, Pointer],
ENDCASE => ERROR Error[reason: internalTV];
ptr: POINTER ← LOOPHOLE[hP + fD.wordOffset,
LONG POINTER TO POINTER]^;

IF CedarLinkerOps.NullLink[ptr] -- maybe not bound
THEN et ← NIL
ELSE et ← NARROW[AMBridge.TVForPointerReferent
[ptr: LONG[ptr],
type: cType,
status: readOnly]];
RETURN};

WITH tv SELECT FROM
tr: REF TypedVariableRec =>
WITH head: tr.head SELECT FROM
reference => headP ← LOOPHOLE[head.ref, Pointer];
ENDCASE => ERROR Error[reason: internalTV];
ENDCASE => ERROR; -- headP ← LOOPHOLE[tv];
-- et ← AMMiniModelPrivate.TVForExportedVariable
-- [stb.stHandle.version,
-- LOOPHOLE[headP + fD.wordOffset,
-- LONG POINTER TO UNSPECIFIED]^];
WITH e: stb.seb[csei] SELECT FROM
ref => IF e.var
THEN {IF e.readOnly
THEN NARROW[et, REF TypedVariableRec].status ← readOnly}
ELSE IF stb.seb[isei].immutable
THEN NARROW[et, REF TypedVariableRec].status ← readOnly;
-- old symbol table
ENDCASE => IF stb.seb[isei].immutable
THEN NARROW[et, REF TypedVariableRec].status ← readOnly;
-- old symbol table
}
ELSE IF Constant[tv]
THEN WITH tv SELECT FROM
tr: REF constant TypedVariableRec =>
{ws: WordSequence;
IF fieldBits >= bitsPerWord
THEN {ws ← NEW[WordSequenceRecord[fieldBits/bitsPerWord]];
FOR i: NAT IN [0..fieldBits/bitsPerWord)
DO ws[i] ← tr.value[i]; ENDLOOP;
}
ELSE {ws ← NEW[WordSequenceRecord[1]];
ws[0] ← FetchField[@tr.value[0], [bitFirst: fieldBitOffset,
bitCount: fieldBits]]};
et ← tvZone.NEW[TypedVariableRec ←
[ referentType: [cType, TVTag[tv]],
head: [constant[]],
status: const,
field: constant[value: ws]]
]}
ENDCASE => ERROR
ELSE {et ← tvZone.NEW[TypedVariableRec ←
[ referentType: [cType, TVTag[tv]],
head: (WITH tv SELECT FROM
tr: REF TypedVariableRec => tr.head,
ENDCASE => ERROR), -- [reference[ref: tv]]),
status: (IF NOT interfaceRec AND stb.seb[isei].immutable
THEN readOnly
ELSE TVStatus[tv]),
field: embedded[fd:
(SELECT TypeClass[UnderType[cType]] FROM
union, sequence =>
[wordOffset: (IF Embedded[tv]
THEN LOOPHOLE
[tv,
REF embedded TypedVariableRec]
.fd.wordOffset
ELSE 0),
extent: large[size: Size[type,
0--fix length later if sequence--]]],
ENDCASE => BuildRecordFieldDescriptor
[tv, fieldBitOffset, fieldBits, bitsForType])]]];
IF isSequence
THEN WITH x: et SELECT FROM
embedded =>
x.fd.extent
← large
[size:
Size[type,
ShortenLongCardinal[TVToLC[Tag[et]]
- TVToLC[First[Domain[cType]]]]]];
ENDCASE => ERROR}}; -- END BuildEmbeddedTV

-- Begin IndexToTV Here
[bitsForTV, argRec, interfaceRec] ← tp.BitsForType[type];
tp.RecordComponentISEI[type, index, BuildEmbeddedTV];
RETURN[et]}; -- end IndexToTV


IsInterfaceElementType: PROC[type: Type] RETURNS[BOOLEAN] =
{ class: Class = TypeClass[UnderType[type]];
RETURN[SELECT class FROM
program, procedure, signal, error => TRUE,
ENDCASE => FALSE]};

-- raises typeFault
TVToType: PUBLIC SAFE PROC[tv: TypedVariable--type--] RETURNS[Type] = TRUSTED
{type: Type = UnderType[TVType[tv]];
RETURN[SELECT TypeClass[type] FROM
type => IF IsRemote[tv]
THEN RemoteTypeToLocal[world: GetWorld[tv],
remoteType: TVToCardinal[tv]]
ELSE LOOPHOLE[TVToCardinal[tv], Type],
ENDCASE => ERROR Error[reason: typeFault, type: type]]};

-- raises typeFault
PropertyList: PUBLIC SAFE PROC[tv: TypedVariable--atom--] RETURNS[TV--list--] = TRUSTED
{type: Type = UnderType[TVType[tv]];
RETURN[SELECT TypeClass[type] FROM -- NOTE assumption of remote AtomRec identity
atom => Loophole[IndexToTV[Loophole[tv, CODE[REF AtomsPrivate.AtomRec]],
NameToIndex[CODE[AtomsPrivate.AtomRec],
"propList"]],
CODE[List.AList]],
ENDCASE => ERROR Error[reason: typeFault, type: type]]};

TVToName: PUBLIC SAFE PROC[tv: TypedVariable
--transfer, program, globalFrame, enumerated, atom, rope--
]
RETURNS[ans: ROPE] = TRUSTED
{type: Type = UnderType[TVType[tv]];
world: World = GetWorld[tv];
RETURN
[SELECT TypeClass[type] FROM
ref => IF IsAtom[tv] THEN TVToName[Coerce[tv, CODE[ATOM]]]
ELSE IF IsRope[tv] THEN TVToName[Coerce[tv, CODE[ROPE]]]
ELSE ERROR Error[reason: typeFault, type: type],
atom => IF IsRemote[tv]
THEN RemoteRope.RopeFromTV
[Loophole[IndexToTV
[Loophole[tv, CODE[REF AtomsPrivate.AtomRec]],
1], CODE[ROPE]]] -- NOTE beware
ELSE LOOPHOLE[TVToLC[tv], REF AtomsPrivate.AtomRec].pName,
rope => IF IsRemote[tv]
THEN RemoteRope.RopeFromTV[tv]
ELSE LOOPHOLE[TVToLC[tv], ROPE],
enumerated =>
IF TVToLC[tv] + 1 > LAST[CARDINAL]
THEN ERROR Error[reason: notImplemented,
msg: "Gigunda MACHINE DEPENDENT enumerations",
type: type]
ELSE IndexToName[type, TVToLC[tv] + 1],
program, procedure =>
IF IsRemote[tv]
THEN RemotePDToName[TVToRemoteProc[tv]]
ELSE tp.PDToName[LOOPHOLE[TVToProc[tv], PrincOps.ProcDesc]],
signal, error =>
IF IsRemote[tv]
THEN RemoteSEDToName[TVToRemoteSignal[tv]]
ELSE tp.SEDToName[LOOPHOLE[TVToSignal[tv], PrincOps.SignalDesc]],
globalFrame =>
IF IsRemote[tv]
THEN RemoteGFHToName[RemoteGFHFromTV[tv]]
ELSE tp.GFHToName[GFHFromTV[tv]],
ENDCASE => NIL]};

-- break up and MOVE
Apply: PUBLIC SAFE PROC[mapper: TV--array, sequence, descriptor, longDescriptor--, arg: TV]
RETURNS[embeddedTV: TV] = TRUSTED
{ type: Type ← UnderType[TVType[mapper]];
stb: SymbolTableBase;
sei: SymbolIndex;
class: Class = TypeClass[type];
IF mapper = NIL THEN ERROR Error[reason: typeFault, type: type];
IF class = descriptor OR class = longDescriptor
THEN {ws: WordSequence = TVToWordSequence[mapper];
length: CARDINAL = IF class = descriptor
THEN LENGTH[LOOPHOLE
[@ws[0],
LONG POINTER TO
DESCRIPTOR FOR ARRAY OF WORD]^]
ELSE LENGTH[LOOPHOLE
[@ws[0],
LONG POINTER TO
LONG DESCRIPTOR FOR ARRAY OF WORD]^];
type ← Range[type];
IF TVToCardinal[arg] >= length THEN ERROR Error[reason: rangeFault];
IF IsRemote[mapper]
THEN mapper ← TVForRemotePointerReferent
[remotePointer:
[world: GetWorld[mapper],
worldIncarnation: GetWorldIncarnation[mapper],
ptr: IF class = descriptor
THEN LOOPHOLE
[LONG[BASE[LOOPHOLE
[@ws[0],
LONG POINTER TO
DESCRIPTOR FOR ARRAY OF WORD]^]],
WorldVM.Address]
ELSE LOOPHOLE
[BASE
[LOOPHOLE
[@ws[0],
LONG POINTER TO
LONG DESCRIPTOR FOR ARRAY OF WORD]^
], WorldVM.Address]
],
type: type,
status: ReferentStatus[TVType[mapper]]]
ELSE mapper ← TVForPointerReferent
[ptr: IF class = descriptor
THEN BASE[LOOPHOLE
[@ws[0],
LONG POINTER TO
DESCRIPTOR FOR ARRAY OF WORD]^]
ELSE BASE
[LOOPHOLE
[@ws[0],
LONG POINTER TO
LONG DESCRIPTOR FOR ARRAY OF WORD]^],
type: type,
status: ReferentStatus[TVType[mapper]]]};
[stb, sei] ← GetTypeSymbols[type];
{ ENABLE UNWIND => ReleaseSTB[stb];
eltTypeEi: SymbolIndex;
domainType: Type = Domain[type];
upperLimit: INT ← TVToLI[Last[domainType]];
lowerLimit: INT ← TVToLI[First[domainType]];
argValue: INT = TVToLI[arg];
bitOffset: INT;
bitsPerElement: CARDINAL;
tagEndOffset: INTEGER ← 0;
isPacked: BOOLEAN ← FALSE;
isSequence: BOOLEAN ← FALSE;
fd: tp.FieldDescriptor;

WITH ser: stb.seb[stb.UnderType[sei]] SELECT FROM
array => {isPacked ← ser.packed; eltTypeEi ← ser.componentType};
sequence =>
{tag: TV ← Tag[mapper];
isPacked ← ser.packed;
isSequence ← TRUE;
upperLimit ← TVToLI[tag] - 1;
eltTypeEi ← ser.componentType;
-- Sequence begins in the word beyond the tag!
tagEndOffset ← IF IsComputed[type]
THEN 0
ELSE (stb.seb[ser.tagSei].idInfo + stb.seb[ser.tagSei].idValue)};
ENDCASE => ERROR Error[reason: typeFault, type: TVType[mapper]];

IF ~InRange[domainType, arg] OR argValue > upperLimit
THEN ERROR Error[reason: rangeFault]; -- extra check for sequences!

bitsPerElement ← stb.BitsPerElement[type: eltTypeEi, packed: isPacked];
bitOffset ← tagEndOffset + (argValue - lowerLimit) * bitsPerElement;

-- now adjust bitOffset if the entire mapper is smaller than a word and in an allocated object
IF (class # descriptor)
AND (class # longDescriptor)
AND (NOT isSequence)
AND (NOT Embedded[mapper])
THEN {bitsForTV: LONG CARDINAL ← 0;
[bitsForTV,,] ← tp.BitsForType[type];
IF bitsForTV < bitsPerWord
THEN bitOffset ← bitOffset + bitsPerWord - ShortenLongCardinal[bitsForTV]};

fd ← BuildRecordFieldDescriptor[mapper, bitOffset, bitsPerElement, stb.BitsForType[eltTypeEi]];
embeddedTV ← tvZone.NEW[TypedVariableRec ←
[referentType: [Range[type]],
head: NARROW[mapper, REF TypedVariableRec].head,
status: NARROW[mapper, REF TypedVariableRec].status,
field: embedded[fd: fd]]];
ReleaseSTB[stb]}}; -- end Apply

Fetch: PUBLIC SAFE PROC[tv: TypedVariable--rope--, index: INT] RETURNS[CHAR] = TRUSTED
{type: Type = UnderType[TVType[tv]];
RETURN[SELECT TypeClass[type] FROM
rope => IF IsRemote[tv]
THEN RemoteRope.RemoteFetch[tv, index]
ELSE Rope.Fetch[TVToName[tv], index],
ENDCASE => ERROR Error[reason: typeFault, type: type]]};

OctalRead: PUBLIC SAFE PROC[tv: TypedVariable, offset: INT] RETURNS[ans: CARDINAL] = TRUSTED
{addr: tp.ValueAddress = tp.GetValueAddress[tv];
WITH t: addr SELECT FROM
constant => RETURN[t.value[offset]];
pointer => RETURN[LOOPHOLE[t.ptr + offset, LONG POINTER TO CARDINAL]^];
remotePointer => RETURN
[RTTypesRemotePrivate.GetRemoteWord
[[world: GetWorld[tv],
worldIncarnation: GetWorldIncarnation[tv],
ptr: t.ptr.ptr + offset]]];
copiedRemoteObject => RETURN[LOOPHOLE[t.ptr + offset, LONG POINTER TO CARDINAL]^];
ENDCASE => ERROR;
};

Length: PUBLIC SAFE PROC[tv: TV --sequence, rope, descriptor, longDescriptor--]
RETURNS[INT] = TRUSTED
{type: Type = UnderType[TVType[tv]];
SELECT TypeClass[type] FROM
sequence => RETURN[TVToLI[Tag[tv]]-TVToLI[First[Domain[type]]]];
rope => IF IsRemote[tv]
THEN RETURN[RemoteRope.RemoteLength[tv]]
ELSE RETURN[Rope.Length[TVToName[tv]]];
descriptor => {ws: WordSequence = TVToWordSequence[tv];
RETURN[LENGTH[LOOPHOLE[@ws[0],
LONG POINTER TO
DESCRIPTOR FOR ARRAY OF WORD]^]]};
longDescriptor =>
{ws: WordSequence = TVToWordSequence[tv];
RETURN[LENGTH[LOOPHOLE[@ws[0],
LONG POINTER TO
LONG DESCRIPTOR FOR ARRAY OF WORD]^]]};
ENDCASE => ERROR Error[reason: typeFault, type: type]};

-- raises typeFault, badTV
-- NOTE no size check. You're on your own.
Loophole: PUBLIC PROC[tv: TypedVariable, type: Type, tag: TypedVariable ← NIL]
RETURNS[TypedVariable] =
{variantClass: Class = VariableType[type].c;
IF tag # NIL AND variantClass # union AND variantClass # sequence
THEN ERROR Error[reason: typeFault, type: type, msg: "non-NIL tag makes no sense"];
WITH tv SELECT FROM
tvr: REF TypedVariableRec =>
WITH tvr: tvr SELECT FROM
entire =>
RETURN[tvZone.NEW[TypedVariableRec ←
[ referentType: [type, tag],
head: tvr.head,
status: tvr.status,
field: entire[]]]];
embedded =>
RETURN[tvZone.NEW[TypedVariableRec ←
[ referentType: [type, tag],
head: tvr.head,
status: tvr.status,
field: embedded[fd: tvr.fd]]]];
constant =>
RETURN[tvZone.NEW[TypedVariableRec ←
[ referentType: [type, tag],
head: tvr.head,
status: tvr.status,
field: constant[value: tvr.value]]]];
ENDCASE => ERROR;
ENDCASE => ERROR;
};

ConcreteRef: PUBLIC SAFE PROC[tv: TypedVariable--ref any--]
RETURNS[ans: TypedVariable ← NIL] = TRUSTED
{type: Type ← UnderType[TVType[tv]];
class: Class ← TypeClass[type];
IF class = nil OR TVToLC[tv] = 0 THEN RETURN[NIL];
IF class = atom OR class = rope OR class = list THEN RETURN[tv];
IF class # ref THEN ERROR Error[reason: typeFault, type: type];
IF TypeClass[Range[type]] # any THEN RETURN[tv];
IF IsAtom[tv] THEN RETURN[Coerce[tv, CODE[ATOM]]]
ELSE IF IsRope[tv] THEN RETURN[Coerce[tv, CODE[ROPE]]]
ELSE
{ realSourceRangeType: Type;
IF IsRemote[tv]
THEN {r: RemoteRef
= [world: GetWorld[tv],
worldIncarnation: GetWorldIncarnation[tv],
ref: TVToLC[tv]];
realSourceRangeType ← RTTypesRemotePrivate.GetRemoteReferentType[r]}
ELSE realSourceRangeType ← RTTypesBasic.GetReferentType[LOOPHOLE[TVToLC[tv],
REF ANY]];
IF TypeClass[UnderType[realSourceRangeType]] = structure
AND NComponents[UnderType[realSourceRangeType]] = 2
AND TypeClass[UnderType[IndexToType[realSourceRangeType, 2]]] = list
THEN ans ← Coerce[tv, IndexToType[realSourceRangeType, 2] ! Error => CONTINUE];
};

IF ans = NIL
THEN ERROR Error[reason: notImplemented,
msg: "ConcreteRef for other than ATOM, ROPE or LIST targets"];
};

-- break up and MOVE
Referent: PUBLIC SAFE PROC
[tv: TypedVariable, --ref, list, pointer, longPointer, relativePointer
base: TypedVariable ← NIL]
--base non-nil only if ref is a relativePointer. UNSAFE in this case.
RETURNS[TypedVariable] = TRUSTED
{ type: Type ← TVType[tv];
referentType: Type ← Range[type]; -- raises Error[typeFault]
status: Status ← mutable;
ptr: Pointer;

stb: SymbolTableBase;
sei: SymbolIndex;

[stb, sei] ← GetTypeSymbols[type];
{ ENABLE UNWIND => ReleaseSTB[stb];
csei: SymbolConstructorIndex = stb.UnderType[sei];
WITH ser: stb.seb[csei] SELECT FROM
long => WITH ser1: stb.seb[stb.UnderType[ser.rangeType]] SELECT FROM
ref => IF ser1.readOnly THEN status ← readOnly;
ENDCASE => ERROR Error[reason: typeFault, type: type];
ref => IF ser.readOnly THEN status ← readOnly;
relative => NULL;
ENDCASE => ERROR Error[reason: typeFault, type: type]};
ReleaseSTB[stb];

IF referentType = unspecType THEN ERROR Error[reason: typeFault, type: referentType];
IF IsRemote[tv]
THEN
SELECT TypeClass[UnderType[type]] FROM
relativePointer =>
{ world: World = GetWorld[tv];
ptr: RemotePointer =
[world: world,
worldIncarnation: CurrentIncarnation[world],
ptr: TVToLC[base] + TVToCardinal[tv]];
-- NOTE assumption that MDS is in the same place
IF NOT TypeClass[UnderType[TVType[base]]] = basePointer
THEN ERROR Error[reason: typeFault, type: TVType[base]];
RETURN[TVForRemotePointerReferent
[remotePointer: ptr, type: referentType, status: status]]};
ref, list =>
{world: World = GetWorld[tv];
ref: RemoteRef = [world: world,
worldIncarnation: CurrentIncarnation[world],
ref: TVToLC[tv]];
ValidateRemoteRef[ref];
RETURN[TVForRemoteReferent[remoteRef: ref, status: status]]};
pointer => {world: World = GetWorld[tv];
ptr: RemotePointer =
[world: world,
worldIncarnation: CurrentIncarnation[world],
ptr: Long[world: world, addr: TVToCardinal[tv]]];
-- NOTE assumption that MDS is in the same place
IF TypeClass[UnderType[referentType]] = opaque
THEN ERROR Error[reason: typeFault, type: referentType];
RETURN[TVForRemotePointerReferent
[remotePointer: ptr, type: referentType, status: status]]};
longPointer => {world: World = GetWorld[tv];
IF TypeClass[UnderType[referentType]] = opaque
THEN ERROR Error[reason: typeFault, type: referentType];
RETURN[TVForRemotePointerReferent
[remotePointer: [world: world,
worldIncarnation:
CurrentIncarnation[world],
ptr: TVToLC[tv]],
type: referentType,
status: status]]};
ENDCASE => ERROR -- end IsRemote[tv]
ELSE -- local tv
SELECT TypeClass[UnderType[type]] FROM
relativePointer =>
{ IF NOT TypeClass[UnderType[TVType[base]]] = basePointer
THEN ERROR Error[reason: typeFault, type: TVType[base]];
ptr ← LOOPHOLE[TVToLC[base] + TVToCardinal[tv], Pointer];
RETURN[TVForPointerReferent[ptr: ptr, type: referentType, status: status]]};
ref, list =>
{ref: REF ANY = LOOPHOLE[TVToLC[tv], REF ANY];
ValidateRef[ref];
RETURN[TVForReferent[ref: ref, status: status]]};
pointer => {ptr ← LONG[LOOPHOLE[TVToCardinal[tv], POINTER]];
IF TypeClass[UnderType[referentType]] = opaque
THEN ERROR Error[reason: typeFault, type: referentType];
RETURN[TVForPointerReferent[ptr: ptr,
type: referentType,
status: status]]};
longPointer => {ptr ← LOOPHOLE[TVToLC[tv], Pointer];
IF TypeClass[UnderType[referentType]] = opaque
THEN ERROR Error[reason: typeFault, type: referentType];
RETURN[TVForPointerReferent[ptr: ptr,
type: referentType,
status: status]]};
ENDCASE => ERROR;
}; -- end Referent

tInteger: Type ← nullType;
tCardinal: Type ← nullType;
tLongInteger: Type ← nullType;
tLongCardinal: Type ← nullType;

-- Raises typeFault, rangeFault. COPIES unless types are equivalent.
Coerce: PUBLIC SAFE PROC[tv: TypedVariable, targetType: Type]
RETURNS[newTV: TypedVariable] = TRUSTED
{type: Type = TVType[tv];
tvr: REF TypedVariableRec; -- utility
targetClass, sourceClass: Class;

IF type = targetType THEN RETURN[tv];

IF EquivalentTypes[type, targetType] THEN RETURN[Loophole[tv, targetType]];

targetClass ← TypeClass[UnderType[targetType]];
sourceClass ← TypeClass[UnderType[type]];

IF sourceClass = ref AND TypeClass[UnderType[Range[type]]] = opaque
THEN RETURN[Coerce[Loophole[tv, CODE[REF ANY]], targetType]];

SELECT targetClass FROM
procedure => --the target type class
{SELECT sourceClass FROM -- look at the source type
procedure =>
{ IF TypeClass[UnderType[Domain[targetType]]] = any
AND TypeClass[UnderType[Range[targetType]]] = any
THEN -- assignment of a proc to a PROC ANY ANY; copy it
{IF IsRemote[tv]
THEN newTV ← tvZone.NEW[TypedVariableRec ←
[referentType: [targetType],
head: [copiedRemoteObject
[world: GetWorld[tv],
worldIncarnation:
GetWorldIncarnation[tv],
copy:
tvZone.NEW[WordSequenceRecord[1]]]],
status: mutable,
field: entire[]]]
ELSE newTV ← New[type: targetType];
Assign[lhs: newTV, rhs: Loophole[tv, targetType]];
}
ELSE ERROR Error[reason: typeFault, type: type, otherType: targetType];
};
nil => RETURN[NIL]; -- NIL conforms to any PROC type
ENDCASE => ERROR Error[reason: typeFault, type: type, otherType: targetType];
};
ref, list, atom, rope => --the target type class
{targetRangeType: Type ← nullType;
sourceRangeType: Type ← nullType;
realSourceRangeType: Type ← nullType;
narrowToAtomOrRope: BOOL ← FALSE;
widenFromAtomOrRope: BOOL ← FALSE;

SELECT sourceClass FROM -- look at the source type
ref, list, atom, rope => NULL;
nil => RETURN[NIL]; -- NIL conforms to any REF type
ENDCASE => ERROR Error[reason: typeFault, type: type];

IF targetClass = ref OR targetClass = list
THEN targetRangeType ← Range[targetType];

IF sourceClass = ref OR sourceClass = list
THEN {sourceRangeType ← Range[UnderType[type]];

IF IsRemote[tv]
THEN {r: RemoteRef = [world: GetWorld[tv],
worldIncarnation: GetWorldIncarnation[tv],
ref: TVToLC[tv]];
realSourceRangeType ← RTTypesRemotePrivate.GetRemoteReferentType[r]}
ELSE realSourceRangeType ← RTTypesBasic.GetReferentType[LOOPHOLE[TVToLC[tv],
REF ANY]]};
IF targetClass = atom OR targetClass = rope
THEN {narrowToAtomOrRope
← sourceClass = ref
AND sourceRangeType = anyType
AND (IF targetClass = atom
THEN EquivalentTypes[realSourceRangeType,
CODE[AtomsPrivate.AtomRec]]
ELSE EquivalentTypes[realSourceRangeType,
CODE[Rope.RopeRep]]);
--check that a REF ANY tv represents an atom or rope, respectively
IF NOT narrowToAtomOrRope THEN ERROR Error[reason: rangeFault]};

IF sourceClass = atom OR sourceClass = rope
THEN {widenFromAtomOrRope
← targetClass = ref
AND (targetRangeType = unspecType
OR targetRangeType = anyType);
IF NOT widenFromAtomOrRope THEN ERROR Error[reason: rangeFault]};

IF narrowToAtomOrRope OR widenFromAtomOrRope
OR targetRangeType = unspecType --widen--
OR targetRangeType = anyType --widen--
OR sourceRangeType = nullType --NIL conforms to any ref target type--
OR AsGoodAs[lhsType: targetRangeType, rhsType: sourceRangeType] --narrow--
THEN -- create a new TV of the specified targetType with the specified value
{IF IsRemote[tv]
THEN
{world: World = GetWorld[tv];
ws: WordSequence = NEW[WordSequenceRecord[2]];
LOOPHOLE[@ws[0], LONG POINTER TO LONG UNSPECIFIED]^ ← TVToLC[tv];
newTV ← tvZone.NEW[TypedVariableRec ←
[referentType: [targetType],
head: [copiedRemoteObject
[world: world,
worldIncarnation: CurrentIncarnation[world],
copy: ws]],
status: readOnly,
field: entire[]]];
}
ELSE
{result: REF ANY = LOOPHOLE[TVToLC[tv], REF ANY];
-- logically, the value of tv (a REF, LIST, ATOM, or ROPE)
newTV ← New[type: targetType, status: readOnly];
tvr ← NARROW[newTV, REF TypedVariableRec];
WITH hd: tvr.head SELECT FROM
reference => LOOPHOLE[hd.ref, REF REF ANY]^ ← result;
ENDCASE => ERROR}}
ELSE ERROR Error[reason: rangeFault]};

subrange, character, enumerated, integer, cardinal, longInteger, longCardinal =>
{g1: Type = GetCanonicalType[GroundStar[type]];
g2: Type = GetCanonicalType[GroundStar[targetType]];
li: LONG INTEGER = TVToLI[tv];

IF g1 = g2
THEN NULL
ELSE
{ IF tInteger = nullType THEN
{ tInteger ← GetCanonicalType[CODE[INTEGER]];
tCardinal ← GetCanonicalType[CODE[CARDINAL]];
tLongInteger ← GetCanonicalType[CODE[LONG INTEGER]];
tLongCardinal ← GetCanonicalType[CODE[LONG CARDINAL]]};
IF (g1 = tCardinal OR g1 = tInteger OR g1 = tLongCardinal OR g1 = tLongInteger)
AND (g2 = tCardinal OR g2 = tInteger OR g2 = tLongCardinal OR g2 = tLongInteger)
THEN NULL
ELSE ERROR Error[reason: typeFault, type: type]};
IF li < TVToLI[First[targetType]]
OR TVToLI[Last[targetType]] < li
THEN ERROR Error[reason: rangeFault];
newTV ← New[type: targetType, status: readOnly];
tvr ← NARROW[newTV, REF TypedVariableRec];
tvr.status ← mutable;
SetTVFromLI[newTV, li];
tvr.status ← readOnly};

ENDCASE => ERROR Error[reason: typeFault, type: targetType]}; -- end Coerce

InRange: PUBLIC SAFE PROC[type: Type--subrange--, groundTV: TypedVariable]
RETURNS[val: BOOLEAN] = TRUSTED
{ [] ← Coerce[groundTV, type ! Error => IF reason = rangeFault THEN GOTO nope];
RETURN[TRUE];
EXITS nope => RETURN[FALSE]};

Next: PUBLIC SAFE PROC[tv: TypedVariable--enumerated, subrange, basic--]
RETURNS[TypedVariable] = TRUSTED
{ val: LONG INTEGER = TVToLI[tv];
type: Type = TVType[tv];
newTV: TypedVariable;
IF val = TVToLI[Last[type]] THEN RETURN[NIL];
newTV ← New[type];
SetTVFromLC[newTV, LOOPHOLE[val + 1, LONG CARDINAL]]; -- NOTE mach dep enum?
RETURN[newTV]};


-- Procedures private to this module

Constant: PROC[tv: TypedVariable] RETURNS[BOOLEAN] =
{WITH tv SELECT FROM
rtr: REF TypedVariableRec =>
WITH etr: rtr SELECT FROM
constant => RETURN[TRUE];
ENDCASE;
ENDCASE;
RETURN[FALSE]};

Embedded: PROC[tv: TypedVariable] RETURNS[ans: BOOLEAN ← FALSE] =
{WITH tv SELECT FROM
rtr: REF TypedVariableRec =>
WITH etr: rtr SELECT FROM
embedded => ans ← TRUE;
ENDCASE;
ENDCASE => ERROR};

-- BuildRecordFieldDescriptor is used to build FieldDescriptors for components of TVs.
-- fieldBitOffset and fieldBits specify the component's container location and size relative
-- to the container holding parentTV's value.
-- If the component is smaller than a word, bitsForType specifies its size, which may be
-- smaller than the size of the component's container (if bitsForType >= bitsPerWord, the
-- component size is the same as the container size).
-- The result of BuildRecordFieldDescriptor describes an embedded field WRT parentTV's
-- head wherein the bits of the component reside.
-- Generally, an embedded field of a TV describes where WRT its head the bits
-- of its value reside.
BuildRecordFieldDescriptor: PUBLIC PROC[parentTV: TypedVariable,
fieldBitOffset, fieldBits, bitsForType: INT]
RETURNS[fD: tp.FieldDescriptor] =

{fD ← IF bitsForType < bitsPerWord
THEN BuildSmallFieldDescriptor[fieldBitOffset + fieldBits - bitsForType,
bitsForType]
ELSE BuildLargeFieldDescriptor[fieldBitOffset / bitsPerWord,
fieldBits / bitsPerWord];

IF parentTV = NIL THEN RETURN;

-- adjust offsets relative to parent.
WITH parentTV SELECT FROM
parentTr: REF TypedVariableRec =>
WITH parentT: parentTr SELECT FROM
embedded=> { fD.wordOffset ← fD.wordOffset + parentT.fd.wordOffset;
WITH parentF: parentT.fd SELECT FROM
small=> WITH f: fD SELECT FROM
small=> f.field.bitFirst ← f.field.bitFirst + parentF.field.bitFirst;
ENDCASE => ERROR;
ENDCASE};
ENDCASE;
ENDCASE => ERROR};

BuildSmallFieldDescriptor: PROC[bitOffset, bitCount: INT]
RETURNS[small tp.FieldDescriptor] =
INLINE
{RETURN[tp.FieldDescriptor[wordOffset: ShortenLongInteger[bitOffset / bitsPerWord],
extent: small[field: [bitFirst: ShortenLongInteger
[bitOffset MOD bitsPerWord],
bitCount: ShortenLongInteger[bitCount]]]]]};

BuildLargeFieldDescriptor: PROC[wordOffset, nWords: INT]
RETURNS[large tp.FieldDescriptor] =
INLINE
{RETURN[tp.FieldDescriptor[wordOffset: ShortenLongInteger[wordOffset],
extent: large[size: ShortenLongInteger[nWords]]]]};

--copied in RTTypesBridgeImpl
IsRC: PROC[type: Type] RETURNS[ans: BOOL] =
{RETURN[RTTypesBasicPrivate.MapTiRcmx[type] # RCMap.nullIndex]};

IsTypedVariableRec: PROC[tv: TypedVariable] RETURNS[BOOLEAN] =
{ RETURN[WITH tv SELECT FROM
tr: REF TypedVariableRec => TRUE,
ENDCASE => ERROR]};

AsGoodAs: PROC[rhsType,lhsType: Type] RETURNS[BOOLEAN] =
{RETURN[EquivalentTypes[rhsType,lhsType]]};-- NOTE freely conforms = Equivalent for now


END.