DIRECTORY
PrincOpsUtils USING [LongCopy],
RCMap USING [Base, Index],
RCMapOps USING [GetBase],
Rope USING [ROPE],
RTCommon USING [FetchField],
RTTypesBasicPrivate USING [MapTiRcmx],
SafeStorage USING [GetReferentType, Type];
RCMapWalkerImpl:
PROGRAM
IMPORTS RCMapOps, RTCommon, SafeStorage, RTTypesBasicPrivate, PrincOpsUtils
EXPORTS RTTypesBasicPrivate
= BEGIN OPEN SafeStorage, RTTypesBasicPrivate, RTCommon;
NotImplemented: PUBLIC ERROR[msg: Rope.ROPE] = CODE;
checking: BOOLEAN = FALSE;
rcmb: RCMap.Base = RCMapOps.GetBase[].base;
AssignComposite:
PUBLIC
PROC [rhs, lhs:
LONG
POINTER, type: Type, nwords:
CARDINAL] = {
DoAssignComposite[rhs, lhs, type, nwords]};
DoAssignComposite:
PROC [rhs, lhs:
LONG
POINTER, type: Type, nwords:
CARDINAL] =
INLINE {
rcmx: RCMap.Index = MapTiRcmx[type];
IF checking
THEN
WITH rcmr: rcmb[rcmx]
SELECT
FROM
-- in case there are mutable variants
variant => {
v1:
CARDINAL =
FetchField[lhs + rcmr.fdTag.wordOffset,
[bitFirst: rcmr.fdTag.bitFirst,
bitCount: rcmr.fdTag.bitCount]];
v2:
CARDINAL =
FetchField[rhs + rcmr.fdTag.wordOffset,
[bitFirst: rcmr.fdTag.bitFirst,
bitCount: rcmr.fdTag.bitCount]];
IF v1 # v2 THEN ERROR NotImplemented["mutable variant records"]};
sequence => {
v1:
CARDINAL =
FetchField[lhs + rcmr.fdLength.wordOffset,
[bitFirst: rcmr.fdLength.bitFirst,
bitCount: rcmr.fdLength.bitCount]];
v2:
CARDINAL =
FetchField[rhs + rcmr.fdLength.wordOffset,
[bitFirst: rcmr.fdLength.bitFirst,
bitCount: rcmr.fdLength.bitCount]];
IF v1 # v2 THEN ERROR NotImplemented["mutable sequences"]};
ENDCASE;
ASSIGNify[rhs, rcmx, LOOPHOLE[lhs, LONG CARDINAL] - LOOPHOLE[rhs, LONG CARDINAL]];
PrincOpsUtils.LongCopy[from: rhs, to: lhs, nwords: nwords]};
AssignCompositeNew:
PUBLIC
PROC [rhs, lhs:
LONG
POINTER, type: Type, nwords:
CARDINAL] = {
d: LONG CARDINAL = LOOPHOLE[lhs, LONG CARDINAL] - LOOPHOLE[rhs, LONG CARDINAL];
ASSIGNNEWify[rhs, MapTiRcmx[type], d];
PrincOpsUtils.LongCopy[from: rhs, to: lhs, nwords: nwords]};
FreeCollectibleObject:
PUBLIC
PROC [refObj:
REF
ANY] = {
NILify[LOOPHOLE[refObj], MapTiRcmx[GetReferentType[refObj]]]};
MapRefs:
PUBLIC
PROC [ptr:
LONG
POINTER, rcmx: RCMap.Index, procLeaf:
PROC [p:
REF
ANY]] = {
MapComponents[ptr, rcmx, procLeaf]};
DoFREEify:
PUBLIC
PROC [ptr:
LONG
POINTER, rcmx: RCMap.Index, procLeaf:
PROC [p:
REF
ANY]] = {
INLDoMapComponents[ptr, rcmx, procLeaf]};
MapRefOffsets:
PUBLIC
PROC [ref:
REF
ANY, procLeaf:
PROC [offset:
LONG
CARDINAL]] = {
DoMapRefOffsets[LOOPHOLE[ref], 0, MapTiRcmx[GetReferentType[ref]], procLeaf]};
DoMapRefOffsets:
PROC [ptr:
LONG
POINTER, cumulativeOffset:
LONG
CARDINAL, rcmx: RCMap.Index, procLeaf:
PROC [offset:
LONG
CARDINAL]] = {
WITH rcmr: rcmb[rcmx]
SELECT
FROM
simple => {
FOR i: CARDINAL IN [0..rcmr.length) DO IF rcmr.refs[i] THEN procLeaf[cumulativeOffset+i] ENDLOOP};
oneRef => procLeaf[cumulativeOffset+rcmr.offset];
ref => procLeaf[cumulativeOffset];
null => NULL;
nonVariant =>
FOR i:
CARDINAL
IN [0..rcmr.nComponents)
DO
DoMapRefOffsets[ptr + rcmr.components[i].wordOffset, cumulativeOffset+rcmr.components[i].wordOffset,
rcmr.components[i].rcmi,
procLeaf];
ENDLOOP;
variant => {
v:
CARDINAL =
FetchField[ptr + rcmr.fdTag.wordOffset,
[bitFirst: rcmr.fdTag.bitFirst, bitCount: rcmr.fdTag.bitCount]];
IF checking THEN IF v > rcmr.nVariants THEN ERROR;
DoMapRefOffsets[ptr, cumulativeOffset, rcmr.variants[v], procLeaf]};
array =>
FOR i:
CARDINAL
IN [0..rcmr.nElements)
DO
DoMapRefOffsets[ptr + i * rcmr.wordsPerElement, cumulativeOffset + i * rcmr.wordsPerElement, rcmr.rcmi, procLeaf];
ENDLOOP;
sequence => {
length:
CARDINAL =
FetchField[ptr+rcmr.fdLength.wordOffset,
[bitFirst: rcmr.fdLength.bitFirst, bitCount: rcmr.fdLength.bitCount]];
DoMapRefOffsets[ptr, cumulativeOffset, rcmr.commonPart, procLeaf];
FOR i:
CARDINAL
IN [0..length)
DO
DoMapRefOffsets[ptr + rcmr.dataOffset + i * rcmr.wordsPerElement, cumulativeOffset + rcmr.dataOffset + i * rcmr.wordsPerElement, rcmr.rcmi, procLeaf];
ENDLOOP};
ENDCASE => ERROR
};
ASSIGNNEWify:
PROC [ptr:
LONG
POINTER, rcmx: RCMap.Index, d:
LONG
CARDINAL] =
INLINE {
WITH rcmr: rcmb[rcmx]
SELECT
FROM
simple => {
FOR i:
CARDINAL
IN [0..rcmr.length)
DO
IF rcmr.refs[i]
THEN {
LOOPHOLE[ptr+i+d, REF LONG CARDINAL]^ ← 0;
LOOPHOLE[ptr+i+d, REF REF ANY]^ ← LOOPHOLE[ptr+i, LONG POINTER TO REF ANY]^};
ENDLOOP};
oneRef => {
f: CARDINAL = rcmr.offset;
LOOPHOLE[ptr+d+f, REF LONG CARDINAL]^ ← 0;
LOOPHOLE[ptr+d+f, REF REF ANY]^ ← LOOPHOLE[ptr+f, LONG POINTER TO REF ANY]^};
ref => {
LOOPHOLE[ptr+d, REF LONG CARDINAL]^ ← 0;
LOOPHOLE[ptr+d, REF REF ANY]^ ← LOOPHOLE[ptr, LONG POINTER TO REF ANY]^};
null => NULL;
ENDCASE => DoASSIGNNEWify[ptr, rcmx, d]};
DoASSIGNNEWify:
PROC [ptr:
LONG
POINTER, rcmx: RCMap.Index, d:
LONG
CARDINAL] = {
WITH rcmr: rcmb[rcmx]
SELECT
FROM
nonVariant =>
FOR i:
CARDINAL
IN [0..rcmr.nComponents)
DO
ASSIGNNEWify[ptr + rcmr.components[i].wordOffset, rcmr.components[i].rcmi, d];
ENDLOOP;
variant => {
v: CARDINAL = FetchField[ptr + rcmr.fdTag.wordOffset, [bitFirst: rcmr.fdTag.bitFirst, bitCount: rcmr.fdTag.bitCount]];
IF checking THEN IF v > rcmr.nVariants THEN ERROR;
ASSIGNNEWify[ptr, rcmr.variants[v], d]};
array =>
FOR i:
CARDINAL
IN [0..rcmr.nElements)
DO
ASSIGNNEWify[ptr + i * rcmr.wordsPerElement, rcmr.rcmi, d];
ENDLOOP;
sequence => {
length: CARDINAL = FetchField[ptr+rcmr.fdLength.wordOffset, [bitFirst: rcmr.fdLength.bitFirst, bitCount: rcmr.fdLength.bitCount]];
ASSIGNNEWify[ptr, rcmr.commonPart, d];
FOR i:
CARDINAL
IN [0..length)
DO
ASSIGNNEWify[ptr + rcmr.dataOffset + i * rcmr.wordsPerElement, rcmr.rcmi, d];
ENDLOOP;
};
ENDCASE => ERROR
};
ASSIGNify:
PROC [ptr:
LONG
POINTER, rcmx: RCMap.Index, d:
LONG
CARDINAL] =
INLINE {
WITH rcmr: rcmb[rcmx]
SELECT
FROM
simple =>
FOR i:
CARDINAL
IN [0..rcmr.length)
DO
IF rcmr.refs[i]
THEN
LOOPHOLE[ptr+i+d, REF REF ANY]^ ← LOOPHOLE[ptr+i, LONG POINTER TO REF ANY]^;
ENDLOOP;
oneRef => {
f: CARDINAL = rcmr.offset;
LOOPHOLE[ptr+d+f, REF REF ANY]^ ← LOOPHOLE[ptr+f, LONG POINTER TO REF ANY]^};
ref => LOOPHOLE[ptr+d, REF REF ANY]^ ← LOOPHOLE[ptr, LONG POINTER TO REF ANY]^;
null => NULL;
ENDCASE => DoASSIGNify[ptr, rcmx, d]};
DoASSIGNify:
PROC [ptr:
LONG
POINTER, rcmx: RCMap.Index, d:
LONG
CARDINAL] = {
WITH rcmr: rcmb[rcmx]
SELECT
FROM
nonVariant =>
FOR i:
CARDINAL
IN [0..rcmr.nComponents)
DO
ASSIGNify[ptr + rcmr.components[i].wordOffset, rcmr.components[i].rcmi, d];
ENDLOOP;
variant => {
v: CARDINAL = FetchField[ptr + rcmr.fdTag.wordOffset, [bitFirst: rcmr.fdTag.bitFirst, bitCount: rcmr.fdTag.bitCount]];
IF checking THEN IF v > rcmr.nVariants THEN ERROR;
ASSIGNify[ptr, rcmr.variants[v], d]};
array =>
FOR i:
CARDINAL
IN [0..rcmr.nElements)
DO
ASSIGNify[ptr + i * rcmr.wordsPerElement, rcmr.rcmi, d];
ENDLOOP;
sequence => {
length: CARDINAL = FetchField[ptr+rcmr.fdLength.wordOffset, [bitFirst: rcmr.fdLength.bitFirst, bitCount: rcmr.fdLength.bitCount]];
ASSIGNify[ptr, rcmr.commonPart, d];
FOR i:
CARDINAL
IN [0..length)
DO
ASSIGNify[ptr + rcmr.dataOffset + i * rcmr.wordsPerElement, rcmr.rcmi, d];
ENDLOOP};
ENDCASE => ERROR};
NILify:
PROC [ptr:
LONG
POINTER, rcmx: RCMap.Index] =
INLINE {
WITH rcmr: rcmb[rcmx]
SELECT
FROM
simple =>
FOR i:
CARDINAL
IN [0..rcmr.length)
DO
IF rcmr.refs[i] THEN LOOPHOLE[ptr+i, REF REF ANY]^ ← NIL;
ENDLOOP;
oneRef => LOOPHOLE[ptr+rcmr.offset, REF REF ANY]^ ← NIL;
ref => LOOPHOLE[ptr, REF REF ANY]^ ← NIL;
null => NULL;
ENDCASE => DoNILify[ptr, rcmx]};
DoNILify:
PROC [ptr:
LONG
POINTER, rcmx: RCMap.Index] = {
WITH rcmr: rcmb[rcmx]
SELECT
FROM
nonVariant =>
FOR i:
CARDINAL
IN [0..rcmr.nComponents)
DO
NILify[ptr + rcmr.components[i].wordOffset, rcmr.components[i].rcmi];
ENDLOOP;
variant => {
v: CARDINAL = FetchField[ptr + rcmr.fdTag.wordOffset, [bitFirst: rcmr.fdTag.bitFirst, bitCount: rcmr.fdTag.bitCount]];
IF checking THEN IF v > rcmr.nVariants THEN ERROR;
NILify[ptr, rcmr.variants[v]]};
array =>
FOR i:
CARDINAL
IN [0..rcmr.nElements)
DO
NILify[ptr + i * rcmr.wordsPerElement, rcmr.rcmi];
ENDLOOP;
sequence => {
length: CARDINAL = FetchField[ptr+rcmr.fdLength.wordOffset, [bitFirst: rcmr.fdLength.bitFirst, bitCount: rcmr.fdLength.bitCount]];
NILify[ptr, rcmr.commonPart];
FOR i:
CARDINAL
IN [0..length)
DO
NILify[ptr + rcmr.dataOffset + i * rcmr.wordsPerElement, rcmr.rcmi];
ENDLOOP};
ENDCASE => ERROR};
MapComponents:
PROC [ptr:
LONG
POINTER, rcmx: RCMap.Index, procLeaf:
PROC [p:
REF
ANY]] =
INLINE {
WITH rcmr: rcmb[rcmx]
SELECT
FROM
simple =>
FOR i:
CARDINAL
IN [0..rcmr.length)
DO
IF rcmr.refs[i]
THEN {
ref: REF ANY = LOOPHOLE[ptr+i, REF REF ANY]^;
IF ref # NIL THEN procLeaf[ref]};
ENDLOOP;
oneRef => {
ref: REF ANY = LOOPHOLE[ptr+rcmr.offset, REF REF ANY]^;
IF ref # NIL THEN procLeaf[ref]};
ref => {
ref: REF ANY = LOOPHOLE[ptr, REF REF ANY]^;
IF ref # NIL THEN procLeaf[ref]};
null => NULL;
ENDCASE => DoMapComponents[ptr, rcmx, procLeaf]};
DoMapComponents:
PROC [ptr:
LONG
POINTER, rcmx: RCMap.Index, procLeaf:
PROC [p:
REF
ANY]] = {
INLDoMapComponents[ptr, rcmx, procLeaf]};
INLDoMapComponents:
PROC [ptr:
LONG
POINTER, rcmx: RCMap.Index, procLeaf:
PROC [p:
REF
ANY]] =
INLINE {
WITH rcmr: rcmb[rcmx]
SELECT
FROM
nonVariant =>
FOR i:
CARDINAL
IN [0..rcmr.nComponents)
DO
MapComponents[ptr + rcmr.components[i].wordOffset, rcmr.components[i].rcmi, procLeaf];
ENDLOOP;
variant => {
v: CARDINAL = FetchField[ptr + rcmr.fdTag.wordOffset, [bitFirst: rcmr.fdTag.bitFirst, bitCount: rcmr.fdTag.bitCount]];
IF checking THEN IF v > rcmr.nVariants THEN ERROR;
MapComponents[ptr, rcmr.variants[v], procLeaf]};
array =>
FOR i:
CARDINAL
IN [0..rcmr.nElements)
DO
MapComponents[ptr + i * rcmr.wordsPerElement, rcmr.rcmi, procLeaf];
ENDLOOP;
sequence => {
length: CARDINAL = FetchField[ptr+rcmr.fdLength.wordOffset, [bitFirst: rcmr.fdLength.bitFirst, bitCount: rcmr.fdLength.bitCount]];
MapComponents[ptr, rcmr.commonPart, procLeaf];
FOR i:
CARDINAL
IN [0..length)
DO
MapComponents[ptr + rcmr.dataOffset + i * rcmr.wordsPerElement, rcmr.rcmi, procLeaf];
ENDLOOP};
ENDCASE => ERROR};