[Indigo]<Cedar>AMTypes>RTTypesBridgeImpl.mesa!4

RTTypesBridgeImpl.Mesa

last modified on March 10, 1983 9:08 am by Paul Rovner

Russ Atkinson, April 25, 1983 4:04 pm

RRA: fixed TVEq & TVEqual for frames

RRA: reformated; also fixed TVForPointerReferent to handle 0-width referents

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;

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

};

TVType: PUBLIC SAFE PROC[tv: TypedVariable] RETURNS[type: Type] = TRUSTED {

raises badTV

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] = {

makes a REF ANY accessible as a 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] = {

makes a TypedVariable accessible as a REF ANY.

ValidateRef[LOOPHOLE[ref]];

RETURN[TVForReferent[ref: LOOPHOLE[ref], status: readOnly]]};

RefFromTV: PUBLIC PROC[tv: TypedVariable] RETURNS[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!

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] = {

raises internalTV Like RefFromTV, but accepts only readOnly TVs, returns REF READONLY.

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] = {

Like RefFromTV, but copies instead of raising an error.

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] = {

raises typeFault

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--] = {

use TVToName to get the ROPE back

RETURN[TVForReadOnlyReferent[NEW[ROPE ← rope]]]};

TVForPointerReferent: PUBLIC PROC[ptr: Pointer, type: Type, status: Status ← mutable]

RETURNS[tv: TypedVariable] = {

These procedures map Pointers, proc descs and frames to TypedVariables and vice versa.

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] = {

raises typeFault

Raises internalTV if tv is embedded and not word aligned

Raises notMutable if TVStatus[tv] # mutable.

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] = {

Raises notMutable

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 {

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.

RETURN[EQValueAddress[GetValueAddress[tv1], GetValueAddress[tv2]]]};

EQValueAddress: PROC[a1, a2: tp.ValueAddress] RETURNS[BOOLEAN] = {

fd1, fd2: tp.FieldDescriptor;

WITH t: a1 SELECT FROM

constant => {

IF a2.tag # constant

OR t.value.size # NARROW[a2, constant tp.ValueAddress].value.size

THEN RETURN[FALSE];

FOR i: NAT IN [0..t.value.size)

DO IF t.value[i] # NARROW[a2, constant tp.ValueAddress].value[i]

THEN RETURN[FALSE];

ENDLOOP;

RETURN[TRUE]};

pointer => {

IF a2.tag # pointer THEN RETURN[FALSE];

IF t.ptr # NARROW[a2, pointer tp.ValueAddress].ptr

THEN RETURN[FALSE];

fd1 ← t.fd;

fd2 ← NARROW[a2, pointer tp.ValueAddress].fd;

};

remotePointer => {

IF a2.tag # remotePointer THEN RETURN[FALSE];

IF t.ptr # NARROW[a2, remotePointer tp.ValueAddress].ptr

THEN RETURN[FALSE];

fd1 ← t.fd;

fd2 ← NARROW[a2, remotePointer tp.ValueAddress].fd;

};

copiedRemoteObject => {

IF a2.tag # copiedRemoteObject THEN RETURN[FALSE];

IF t.ptr # NARROW[a2, copiedRemoteObject tp.ValueAddress].ptr

THEN RETURN[FALSE];

fd1 ← t.fd;

fd2 ← NARROW[a2, copiedRemoteObject tp.ValueAddress].fd;

};

ENDCASE;

WITH f1: fd1 SELECT FROM

small => WITH f2: fd2 SELECT FROM

small => IF f1.field # f2.field THEN RETURN[FALSE];

ENDCASE => RETURN[FALSE];

large => WITH f2: fd2 SELECT FROM

large => IF f1.size # f2.size THEN RETURN[FALSE];

ENDCASE => RETURN[FALSE];

ENDCASE;

RETURN[TRUE]};

TVEqual: PUBLIC SAFE PROC[tv1, tv2: TypedVariable] RETURNS [BOOLEAN] = TRUSTED {

world1: WorldVM.World ← AMBridge.GetWorld[tv1];

world2: WorldVM.World ← AMBridge.GetWorld[tv2];

class1: Class ← AMTypes.UnderClass[AMTypes.TVType[tv1]];

class2: Class ← AMTypes.UnderClass[AMTypes.TVType[tv2]];

size1,size2: INT;

IF world1 # world2 THEN RETURN [FALSE];

IF TVEq[tv1, tv2] THEN RETURN [TRUE];

SELECT class1 FROM

localFrame, globalFrame => RETURN [FALSE];

ENDCASE;

SELECT class2 FROM

localFrame, globalFrame => RETURN [FALSE];

ENDCASE;

size1 ← AMTypes.TVSize[tv1];

size2 ← AMTypes.TVSize[tv2];

IF size1 # size2 THEN RETURN [FALSE];

IF size1 <= 2 THEN RETURN[TVToLC[tv1] = TVToLC[tv2]];

FOR i: INT IN [0..size1) DO

IF AMBridge.OctalRead[tv1, i] # AMBridge.OctalRead[tv1, i]

THEN RETURN[FALSE];

ENDLOOP;

RETURN[TRUE];

};

TVToLC: PUBLIC PROC[tv: TypedVariable] RETURNS[lc: LONG CARDINAL] = {

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.

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

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

TVToCharacter: PUBLIC PROC[tv: TypedVariable] RETURNS[CHARACTER] = {

raises rangeFault

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] = {

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?

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;

};

SetTVFromLI: PUBLIC PROC[tv: TypedVariable, li: LONG INTEGER] = {

raises typeFault, rangeFault

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;

};

IsRC: PROC[type: Type] RETURNS[ans: BOOL] = {

RETURN[RTTypesBasicPrivate.MapTiRcmx[type] # RCMap.nullIndex]};

START HERE

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

END.