[_CDCSL_93-16_]<1>Cedar>release>MimosaOnly>Pass3D.mesa

Pass3D.mesa

Russ Atkinson (RRA) May 15, 1989 5:30:55 pm PDT

Satterthwaite, June 18, 1986 12:21:40 pm PDT

JKF August 15, 1988 2:45:28 pm PDT

DIRECTORY

Alloc USING [Notifier],

MimData USING [idANY, idCARD, idDREAL, idINT, interface, mainCtx, moduleCtx, seAnon, textIndex, typeStringBody, wordAlignment],

MimosaLog USING [Error, ErrorHti, ErrorRope, ErrorSei, ErrorTree],

MimP3 USING [Attr, NPUse, SequenceNP, fullAttr, voidAttr, mark, pathNP, phraseNP, CheckDisjoint, ClearRefStack, CopyTree, EnterComposite, EnterType, Exp, FindSe, InterfaceCtx, MakeFrameRecord, PopCtx, PushCtx, RAttrPop, RecordLhs, RecordMention, Rhs, RPop, RPush, RType, SafetyAttr, SealRefStack, SearchCtxList, SelectVariantType, TopCtx, UnsealRefStack, VariantUnionType, VoidExp],

Pass3Attributes USING [AssignableType, Default, DefaultInit, IndexType, OrderedType, TargetType, TypeForTree, Voidable, VoidItem],

OSMiscOps USING [WordOr],

SourceMap USING [Loc],

SymbolOps USING [ArgCtx, CopyXferType, CtxLevel, DecodeCard, DecodeTreeIndex, DecodeType, EncodeCard, EncodeType, EnterExtension, EqTypes, FromType, LinkMode, MakeNonCtxSe, NormalType, own, RCType, ReferentType, ToBti, ToType, TypeForm, TypeLink, UnderType, XferMode],

Symbols USING [Base, bodyType, CBTIndex, CSEIndex, CSENull, CTXIndex, CTXNull, ctxType, ISEIndex, ISENull, lG, lZ, mdType, Name, nullType, RecordSEIndex, RefSEIndex, SERecord, seType, Type, typeANY, typeTYPE],

Target: TYPE MachineParms USING [bitsPerLongWord, bitsPerReal, bitsPerRef, bitsPerWord],

Tree USING [Base, Index, Link, lsbitOption, Map, msbitOption, nativeOption, Null, nullIndex, packedOption, Scan, SubInfo, treeType, word16Option, word32Option, word64Option, word8Option],

TreeOps USING [FreeTree, GetHash, GetNode, GetSe, GetTag, IdentityMap, ListHead, ListLength, NthSon, OpName, ScanList, ToLoc, UpdateList];

Pass3D: PROGRAM

IMPORTS MimData, MimosaLog, MimP3, Pass3Attributes, OSMiscOps, SymbolOps, TreeOps

EXPORTS MimP3 = {

OPEN MimP3, TreeOps, Symbols;

tb: Tree.Base; -- tree base address (local copy)

seb: Symbols.Base; -- se table base address (local copy)

ctxb: Symbols.Base; -- context table base address (local copy)

mdb: Symbols.Base; -- module table base address (local copy)

bb: Symbols.Base; -- body table base address (local copy)

DeclNotify: PUBLIC Alloc.Notifier = {

called by allocator whenever table area is repacked

tb ¬ base[Tree.treeType];

seb ¬ base[seType];

ctxb ¬ base[ctxType];

mdb ¬ base[mdType];

bb ¬ base[bodyType];

};

signals for type loop detection

CheckTypeLoop: SIGNAL [loopNode: Tree.Index] RETURNS [BOOL] = CODE;

LogTypeLoop: SIGNAL [loopNode: Tree.Index] = CODE;

declaration processing

ItemId: PROC [t: Tree.Link] RETURNS [ISEIndex] = {

WITH t SELECT GetTag[t] FROM

symbol => RETURN [index];

subtree => t ¬ tb[index].son[1];

ENDCASE => ERROR;

ENDLOOP;

};

FirstId: PUBLIC PROC [node: Tree.Index] RETURNS [ISEIndex] = {

RETURN [ItemId[ListHead[tb[node].son[1]]]];

};

DeclList: PUBLIC Tree.Scan = {

ScanList[t, DeclA];

ScanList[t, DeclBInit];

};

DeclA: Tree.Scan = {

node: Tree.Index = GetNode[t];

IF tb[node].attr3 # MimP3.mark THEN {

type: Type;

saveIndex: SourceMap.Loc = MimData.textIndex;

son1: Tree.Link ¬ tb[node].son[1];

son2: Tree.Link ¬ tb[node].son[2];

tb[node].attr3 ¬ MimP3.mark;

MimData.textIndex ¬ ToLoc[tb[node].info];

son2 ¬ tb[node].son[2] ¬ TypeLink[son2

! CheckTypeLoop => {IF loopNode = node THEN RESUME [TRUE]};

LogTypeLoop => {IF loopNode = node THEN RESUME}];

type ¬ Pass3Attributes.TypeForTree[son2];

SELECT tb[node].name FROM

typedecl => DefineTypeSe[son1, type];

decl => DefineSeType[son1, type, tb[node].attr1];

ENDCASE => ERROR;

ClearRefStack[];

MimData.textIndex ¬ saveIndex;

};

DeclBField: Tree.Scan = {DeclBDefault[t, FALSE]};

DeclBVarField: Tree.Scan = {DeclBDefault[t, TRUE]};

DeclBDefault: PROC [t: Tree.Link, varOK: BOOL¬FALSE] = {

node: Tree.Index = GetNode[t];

IF tb[node].attr2 # MimP3.mark THEN {

saveIndex: SourceMap.Loc = MimData.textIndex;

tb[node].attr2 ¬ MimP3.mark;

MimData.textIndex ¬ ToLoc[tb[node].info];

TypeAttr[typeExp: tb[node].son[2], varOK: varOK];

SELECT tb[node].name FROM

typedecl => {};

decl => {

type: Type = Pass3Attributes.TypeForTree[tb[node].son[2]];

son1: Tree.Link ¬ tb[node].son[1];

son3: Tree.Link ¬ tb[node].son[3];

IF ~ComponentType[type] THEN MimosaLog.ErrorTree[typeLength, tb[node].son[2]];

IF son3 # Tree.Null THEN {

ScanList[son1, RecordDeclInit];

son3 ¬ tb[node].son[3] ¬ DefaultExp[t: son3, type: type, ids: son1];

};

DefineSeValue[son1, FALSE];

};

ENDCASE => ERROR;

ClearRefStack[];

MimData.textIndex ¬ saveIndex;

};

DeclBInit: Tree.Scan = {

node: Tree.Index = GetNode[t];

IF tb[node].attr2 # MimP3.mark THEN {

saveIndex: SourceMap.Loc = MimData.textIndex;

son1: Tree.Link ¬ tb[node].son[1];

son2: Tree.Link ¬ tb[node].son[2];

son3: Tree.Link ¬ tb[node].son[3];

ctx: CTXIndex = TopCtx[];

type: Type;

tb[node].attr2 ¬ MimP3.mark;

MimData.textIndex ¬ ToLoc[tb[node].info];

[] ¬ CheckPositions[son1, FieldAttrs[]];

SELECT tb[node].name FROM

typedecl => {

TypeAttr[son2];

type ¬ Pass3Attributes.TypeForTree[son2];

IF son3 # Tree.Null THEN {

tb[node].son[3] ¬ DefaultExp[t: son3, type: type, ids: son1];

[] ¬ ProcessDefault[node]; -- note: alters tb[node].son[3]

};

IF GlobalContext[ctx] THEN {

RRA: this could be an exported type, so enter it to be sure that we eventually have a type code for it.

CheckPublic: Tree.Scan = {

WITH t SELECT GetTag[t] FROM

symbol => {

sei: ISEIndex = index;

IF notYet AND seb[sei].public THEN {

MimP3.EnterType[type];

notYet ¬ FALSE;

};

ENDCASE;

};

notYet: BOOL ¬ TRUE;

ScanList[son1, CheckPublic];

};

decl => {

constFlag, extFlag: BOOL;

TypeAttr[typeExp: son2, varOK: InterfaceContext[ctx]];

type ¬ Pass3Attributes.TypeForTree[son2];

IF NOT ComponentType[type] THEN MimosaLog.ErrorTree[typeLength, son2];

IF son3 = Tree.Null

THEN {

IF NOT InterfaceContext[ctx] AND NOT tb[node].attr1 THEN {

IF Pass3Attributes.Default[type] = nonVoid THEN

A type with defaults forces the appearance of initialization

(RRA, May 15, 1989 5:15:05 pm PDT)

ScanList[son1, RecordDeclInit];

son3 ¬ tb[node].son[3] ¬ Pass3Attributes.DefaultInit[type];

pathNP ¬ SequenceNP[pathNP][phraseNP];

RPop[];

};

constFlag ¬ FALSE;

}

ELSE {

[son3, extFlag] ¬ InitialExp[son3, type];

tb[node].son[3] ¬ son3;

IF extFlag AND ~tb[node].attr1 THEN MimosaLog.ErrorTree[misusedInline, son3];

pathNP ¬ SequenceNP[pathNP][phraseNP];

constFlag ¬ RAttrPop[].const AND tb[node].attr1;

IF son3 # Tree.Null THEN ScanList[son1, RecordDeclInit];

};

SELECT TRUE FROM

(son3 = Tree.Null) => {

IF ~InterfaceContext[ctx] AND NOT Pass3Attributes.Voidable[type] THEN

MimosaLog.ErrorSei[missingInit, FirstId[node]];

};

GlobalContext[ctx] =>

SELECT SymbolOps.RCType[SymbolOps.own, type] FROM

composite =>

EnterComposite[SymbolOps.UnderType[SymbolOps.own, type], son3, TRUE];

ENDCASE;

ENDCASE => NULL;

DefineSeValue[son1, constFlag];

};

ENDCASE => ERROR;

ClearRefStack[];

MimData.textIndex ¬ saveIndex;

};

RecordDeclInit: Tree.Scan = {

sei: ISEIndex = ItemId[t];

RecordMention[sei];

RecordLhs[sei];

};

DefaultExp: PROC [t: Tree.Link, type: Type, ids: Tree.Link] RETURNS [v: Tree.Link] = {

subType: Type = Pass3Attributes.TargetType[type];

ExpInit: PROC [t: Tree.Link] RETURNS [val: Tree.Link] = {

val ¬ Rhs[t, subType];

RPop[];

};

v ¬ UpdateList[t, ExpInit];

IF Pass3Attributes.VoidItem[v]
AND NOT Pass3Attributes.Voidable[type] THEN MimosaLog.ErrorSei[defaultForm, ItemId[ids]];

};

InitialExp: PUBLIC PROC [t: Tree.Link, type: Type]
RETURNS [v: Tree.Link, extended: BOOL] = {

v ¬ t;

extended ¬ FALSE;

phraseNP ¬ none;

SELECT OpName[t] FROM

body => {

defer processing of bodies (see Body)

subType: CSEIndex = SymbolOps.UnderType[SymbolOps.own, type];

expNode: Tree.Index = GetNode[t];

bti: CBTIndex = LOOPHOLE[SymbolOps.ToBti[tb[expNode].info]];

attr: Attr ¬ voidAttr;

SELECT SymbolOps.XferMode[SymbolOps.own, type] FROM

proc, program => NULL;

ENDCASE =>

IF SymbolOps.TypeForm[SymbolOps.own, type] = $definition
THEN attr ¬ fullAttr
ELSE MimosaLog.Error[bodyType];

bb[bti].ioType ¬ SELECT seb[type].seTag FROM

cons => subType,

ENDCASE => SymbolOps.CopyXferType[subType, IdentityMap];

RPush[type, attr];

extended ¬ tb[expNode].attr3; -- inline

CheckBodyType[subType, expNode];

};

inline => {

expNode: Tree.Index = GetNode[t];

CodeBody: Tree.Map = {

WITH e: t SELECT GetTag[t] FROM

string => v ¬ t;

No processing needed

ENDCASE => v ¬ UpdateList[t, NumericConst];

};

IF SymbolOps.XferMode[SymbolOps.own, type] # proc THEN

MimosaLog.Error[inlineType];

IF tb[expNode].attr1 THEN MimosaLog.Error[inlineChecked];

tb[expNode].son[1] ¬ UpdateList[tb[expNode].son[1], CodeBody];

RPush[type, fullAttr];

extended ¬ TRUE;

CheckBodyType[SymbolOps.UnderType[SymbolOps.own, type], expNode];

};

apply => {

expNode: Tree.Index = GetNode[t];

IF tb[expNode].son[1] = Tree.Null

AND SymbolOps.EqTypes[SymbolOps.own,
SymbolOps.ReferentType[SymbolOps.own, type], MimData.typeStringBody]

AND ListLength[tb[expNode].son[2]] = 1 THEN

tb[expNode].name ¬ stringinit;

v ¬ Rhs[t, Pass3Attributes.TargetType[type]];

};

signalinit => RPush[type, voidAttr];

void => {v ¬ FreeTree[t]; RPush[type, voidAttr]};

ENDCASE => v ¬ Rhs[t, Pass3Attributes.TargetType[type]];

};

RecordField: PROC [ctx: CTXIndex] RETURNS [BOOL] = INLINE {

RETURN [ctx = CTXNull
OR (SymbolOps.CtxLevel[SymbolOps.own, ctx] = lZ AND ctx # MimData.moduleCtx)];

};

GlobalContext: PROC [ctx: CTXIndex] RETURNS [BOOL] = INLINE {

RETURN [~MimData.interface AND SymbolOps.CtxLevel[SymbolOps.own, ctx] = lG];

};

InterfaceContext: PROC [ctx: CTXIndex] RETURNS [BOOL] = INLINE {

RETURN [MimData.interface AND ctx = MimData.mainCtx];

};

InterfaceSe: PROC [sei: ISEIndex] RETURNS [BOOL] = INLINE {

RETURN [InterfaceContext[seb[sei].idCtx]];

};

CheckBodyType: PROC [type: CSEIndex, node: Tree.Index] = {

WITH t: seb[type] SELECT FROM

transfer => {

IF SymbolOps.TypeForm[SymbolOps.own, t.typeIn] = $any
OR SymbolOps.TypeForm[SymbolOps.own, t.typeOut] = $any THEN

MimosaLog.Error[bodyType];

IF t.safe AND SafetyAttr[node] = none THEN MimosaLog.Error[unsafeBlock];

};

ENDCASE;

};

DefineTypeSe: PROC [t: Tree.Link, info: Type] = {

first: BOOL ¬ TRUE;

UpdateSe: Tree.Scan = {

sei: ISEIndex = ItemId[t];

seb[sei].idType ¬ typeTYPE; seb[sei].idInfo ¬ SymbolOps.EncodeType[info];

seb[sei].immutable ¬ seb[sei].constant ¬ TRUE;

IF first THEN {info ¬ sei; first ¬ FALSE};

seb[sei].mark3 ¬ TRUE;

};

ScanList[t, UpdateSe];

};

DefineSeType: PROC [t: Tree.Link, type: Type, fixed: BOOL] = {

UpdateSe: Tree.Scan = {

sei: ISEIndex = ItemId[t];

seb[sei].idType ¬ type; seb[sei].constant ¬ FALSE;

IF InterfaceSe[sei]

THEN seb[sei].immutable ¬ seb[sei].immutable OR fixed

ELSE seb[sei].immutable ¬ fixed;

seb[sei].mark3 ¬ TRUE;

};

ScanList[t, UpdateSe];

};

DefineSeValue: PROC [t: Tree.Link, const: BOOL] = {

UpdateSe: Tree.Scan = {

sei: ISEIndex = ItemId[t];

seb[sei].constant ¬ const;

IF InterfaceSe[sei] AND SymbolOps.LinkMode[SymbolOps.own, sei] = val THEN seb[sei].immutable ¬ TRUE;

};

ScanList[t, UpdateSe];

};

ProcessDefault: PROC [node: Tree.Index] RETURNS [nonVoid: BOOL] = {

copy: BOOL ¬ FALSE;

v: Tree.Link = tb[node].son[3];

DefineDefault: Tree.Scan = {

SymbolOps.EnterExtension[ItemId[t], default, IF copy THEN CopyTree[v] ELSE v];

copy ¬ TRUE;

};

SELECT OpName[v] FROM

stringinit => MimosaLog.ErrorSei[defaultForm, FirstId[node]];

lengthen =>

IF OpName[NthSon[v, 1]] = stringinit THEN

MimosaLog.ErrorSei[defaultForm, FirstId[node]];

void => nonVoid ¬ FALSE;

ENDCASE => nonVoid ¬ TRUE;

ScanList[tb[node].son[1], DefineDefault];

tb[node].son[3] ¬ Tree.Null;

};

forward reference resolution

ResolveType: PUBLIC PROC [sei: ISEIndex] = {

currentCtx: CTXIndex = TopCtx[];

IF seb[sei].idCtx # currentCtx

THEN {

PopCtx[];

ResolveType[sei];

PushCtx[currentCtx];

}

ELSE {

SealRefStack[];

DeclA[[subtree[index: SymbolOps.DecodeTreeIndex[seb[sei].idValue]]]];

UnsealRefStack[];

};

ResolveValue: PUBLIC PROC [sei: ISEIndex] = {

currentCtx: CTXIndex = TopCtx[];

IF seb[sei].idCtx # currentCtx

THEN {

PopCtx[];

ResolveValue[sei];

PushCtx[currentCtx];

}

ELSE {

index: Tree.Index;

SealRefStack[];

index ¬ SymbolOps.DecodeTreeIndex[seb[sei].idValue];

IF RecordField[currentCtx]

THEN DeclBDefault[[subtree[index: index]]]

ELSE DeclBInit[[subtree[index: index]]];

UnsealRefStack[];

}

};

type expressions

CheckTypeId: PROC [sei: ISEIndex] RETURNS [BOOL] = {

SELECT TRUE FROM

(sei = ISENull) => RETURN [FALSE];

seb[sei].mark3 => RETURN [seb[sei].idType = typeTYPE];

ENDCASE => {

node: Tree.Index = SymbolOps.DecodeTreeIndex[seb[sei].idValue];

RETURN [node = Tree.nullIndex OR tb[node].name = typedecl];

};

TypeSymbol: PROC [sei: ISEIndex] RETURNS [val: Tree.Link] = {

entryIndex: SourceMap.Loc = MimData.textIndex;

circular: BOOL ¬ FALSE;

IF ~seb[sei].mark3 THEN {

ENABLE

LogTypeLoop => {

saveIndex: SourceMap.Loc = MimData.textIndex;

MimData.textIndex ¬ entryIndex;

MimosaLog.ErrorSei[circularType, sei];

circular ¬ TRUE;

MimData.textIndex ¬ saveIndex;

};

declNode: Tree.Index = SymbolOps.DecodeTreeIndex[seb[sei].idValue];

IF tb[declNode].attr3 # MimP3.mark

THEN ResolveType[sei]

ELSE IF SIGNAL CheckTypeLoop[declNode] THEN SIGNAL LogTypeLoop[declNode];

};

IF CheckTypeId[sei] AND ~circular

THEN val ¬ [symbol[index: sei]]

ELSE {

IF ~circular AND sei # MimData.seAnon THEN MimosaLog.ErrorSei[nonTypeId, sei];

val ¬ [symbol[index: MimData.idANY]];

};

PushArgCtx: PROC [sei: CSEIndex] = {

ctx: CTXIndex = SymbolOps.ArgCtx[SymbolOps.own, sei];

IF ctx # CTXNull THEN PushCtx[ctx];

};

PopArgCtx: PROC [sei: CSEIndex] = {

IF SymbolOps.ArgCtx[SymbolOps.own, sei] # CTXNull THEN PopCtx[];

};

TypeExp: PUBLIC PROC [typeExp: Tree.Link] RETURNS [val: Tree.Link] = {

val ¬ TypeLink[typeExp];

TypeAttr[val];

};

TypeAppl: PUBLIC PROC [typeExp: Tree.Link] RETURNS [val: Tree.Link] = {

attr: Attr ¬ fullAttr;

IF OpName[typeExp] = apply

THEN {

node: Tree.Index = GetNode[typeExp];

son1: Tree.Link ¬ tb[node].son[1] ¬ TypeExp[tb[node].son[1]];

rType: Type ¬ Pass3Attributes.TypeForTree[son1];

uType: Type ¬ SymbolOps.UnderType[SymbolOps.own, rType];

vuType: Type ¬ VariantUnionType[rType];

tb[node].info ¬ SymbolOps.FromType[rType];

SELECT TRUE FROM

(SymbolOps.UnderType[SymbolOps.own, rType] = MimData.typeStringBody),
(SymbolOps.TypeForm[SymbolOps.own, vuType] = $sequence) => {

tb[node].son[2] ¬ Rhs[tb[node].son[2], MimData.idINT];

attr ¬ RAttrPop[];

};

(SymbolOps.TypeForm[SymbolOps.own, vuType] = $union) => {

TypeDiscrim[rType, node];

phraseNP ¬ none;

};

ENDCASE => {

MimosaLog.ErrorTree[noApplication, son1];

tb[node].son[2] ¬ Exp[tb[node].son[2], typeANY];

attr ¬ RAttrPop[];

};

val ¬ typeExp;

}

ELSE {

val ¬ TypeExp[typeExp];

phraseNP ¬ none;

};

RPush[typeTYPE, attr];

};

ClusterExp: PROC [t: Tree.Link] RETURNS [val: Tree.Link] = {

WITH t SELECT GetTag[t] FROM

hash => {

sei: ISEIndex = FindSe[index].symbol;

IF ~CheckTypeId[sei] THEN

prevent duplicate error messages

RETURN [Exp[IF sei = MimData.seAnon THEN [symbol[sei]] ELSE t, typeANY]];

val ¬ TypeSymbol[sei];

};

symbol => {

sei: ISEIndex = index;

IF ~CheckTypeId[sei] THEN RETURN [Exp[t, typeANY]];

val ¬ TypeSymbol[sei];

};

ENDCASE => val ¬ TypeLink[t];

RPush[typeTYPE, fullAttr];

};

TypeDot: PROC [rType: Type, node: Tree.Index] = TypeDiscrim;

for now, should do other possible cluster items

TypeDiscrim: PROC [rType: Type, node: Tree.Index] = {

t2: Tree.Link = tb[node].son[2];

WITH h: t2 SELECT GetTag[t2] FROM

hash => {

iSei: ISEIndex = SelectVariantType[rType, h.index];

IF iSei # ISENull

THEN {

tb[node].info ¬ SymbolOps.FromType[iSei];

tb[node].son[2] ¬ [symbol[index: iSei]];

tb[node].name ¬ discrimTC;

}

ELSE {

IF rType # typeANY THEN MimosaLog.ErrorTree[unknownVariant, t2];

tb[node].info ¬ SymbolOps.FromType[MimData.idANY];

};

ENDCASE => {

MimosaLog.ErrorTree[unknownVariant, t2];

tb[node].son[2] ¬ VoidExp[t2];

};

linkType: Type ¬ nullType; -- to find list link type

TypeLink: PROC [typeExp: Tree.Link] RETURNS [val: Tree.Link] = {

WITH typeExp SELECT GetTag[typeExp] FROM

hash => {

sei: ISEIndex = FindSe[index].symbol;

IF sei # ISENull

THEN val ¬ TypeSymbol[sei]

ELSE {MimosaLog.ErrorHti[nonTypeId, index]; val ¬ [symbol[MimData.idANY]]};

};

symbol => val ¬ TypeSymbol[index];

subtree => {

node: Tree.Index = index;

SELECT tb[node].name FROM

longTC => {

son1: Tree.Link = tb[node].son[1] ¬ TypeLink[tb[node].son[1]];

tb[node].info ¬ SymbolOps.FromType[MakeLongType[Pass3Attributes.TypeForTree[son1]]];

};

optionTC => {

son1: Tree.Link = tb[node].son[1] ¬ TypeLink[tb[node].son[1]];

sonType: Type ¬ Pass3Attributes.TypeForTree[son1];

ut: CSEIndex = SymbolOps.UnderType[SymbolOps.own, sonType];

subInfo: Tree.SubInfo ¬ tb[node].subInfo;

ok: BOOL ¬ FALSE;

SELECT subInfo FROM

Tree.packedOption => {

WITH t: seb[ut] SELECT FROM

array => ok ¬ t.packed;

sequence => ok ¬ t.packed;

record => ok ¬ t.packed;

ENDCASE => ok ¬ FALSE;

WITH st: son1 SELECT GetTag[son1] FROM

subtree => IF tb[st.index].name = optionTC THEN ok ¬ FALSE;

ENDCASE;

};

Tree.msbitOption, Tree.lsbitOption, Tree.nativeOption => {

link: Tree.Link ¬ son1;

isRecord: BOOL ¬ FALSE;

WITH t: seb[ut] SELECT FROM

record => ok ¬ isRecord ¬ t.machineDep;

array => ok ¬ t.packed;

arraydesc => ok ¬ TRUE;

ENDCASE => ok ¬ FALSE;

WITH st: link SELECT GetTag[link] FROM

subtree => IF tb[st.index].name = optionTC THEN

SELECT tb[st.index].subInfo FROM

Tree.word8Option, Tree.word16Option,
Tree.word32Option, Tree.word64Option => {

link ¬ tb[st.index].son[1];

IF isRecord THEN LOOP;

ok ¬ FALSE;

};

Tree.packedOption => {

link ¬ tb[st.index].son[1];

IF NOT isRecord THEN LOOP;

ok ¬ FALSE;

};

ENDCASE => ok ¬ FALSE;

ENDCASE;

EXIT;

ENDLOOP;

};

Tree.word8Option, Tree.word16Option,
Tree.word32Option, Tree.word64Option => {

link: Tree.Link ¬ son1;

WITH t: seb[ut] SELECT FROM

record => ok ¬ t.machineDep;

ENDCASE => ok ¬ FALSE;

WITH st: link SELECT GetTag[link] FROM

subtree => IF tb[st.index].name = optionTC THEN

SELECT tb[st.index].subInfo FROM

Tree.msbitOption, Tree.lsbitOption, Tree.nativeOption => {

link ¬ tb[st.index].son[1];

LOOP;

};

ENDCASE => ok ¬ FALSE;

ENDCASE;

EXIT;

ENDLOOP;

};

ENDCASE;

IF NOT ok THEN MimosaLog.ErrorRope[other, "invalid type attribute combination"];

tb[node].info ¬ SymbolOps.FromType[sonType];

};

discrimTC => {

son1: Tree.Link ¬ tb[node].son[1] ¬ TypeLink[tb[node].son[1]];

TypeDiscrim[Pass3Attributes.TypeForTree[son1], node];

};

apply => {

son1: Tree.Link ¬ tb[node].son[1] ¬ TypeLink[tb[node].son[1]];

rType: Type ¬ Pass3Attributes.TypeForTree[tb[node].son[1]];

tb[node].info ¬ SymbolOps.FromType[rType];

SELECT SymbolOps.TypeForm[SymbolOps.own, VariantUnionType[rType]] FROM

$union => TypeDiscrim[rType, node];

$sequence => MimosaLog.ErrorTree[unimplemented, typeExp];

ENDCASE => MimosaLog.ErrorTree[noApplication, son1];

};

dot => {

id: Name = GetHash[tb[node].son[2]];

nDerefs: CARDINAL ¬ 0;

next: Type;

ctx: CTXIndex ¬ CTXNull;

son1: Tree.Link ¬ tb[node].son[1] ¬ ClusterExp[tb[node].son[1]];

FOR type: Type ¬ RType[], next DO

sei: CSEIndex = SymbolOps.UnderType[SymbolOps.own, type];

WITH t: seb[sei] SELECT FROM

mode => GO TO type;

definition, transfer => {

ctx ¬ InterfaceCtx[sei, son1];

GO TO cluster;

};

record => {

ctx ¬ t.fieldCtx;

GO TO cluster;

};

ref => {IF (nDerefs ¬ nDerefs+1) > 63 THEN GO TO cluster; next ¬ t.refType};

subrange => next ¬ t.rangeType;

ENDCASE => GO TO cluster;

REPEAT

type => TypeDot[Pass3Attributes.TypeForTree[son1], node];

cluster => {

iSei: ISEIndex;

found: BOOL;

[found, iSei] ¬ SearchCtxList[id, ctx];

IF ~found THEN {

iSei ¬ MimData.idANY;

MimosaLog.ErrorHti[unknownField, id];

};

tb[node].name ¬ cdot;

tb[node].info ¬ SymbolOps.FromType[iSei];

tb[node].son[2] ¬ TypeSymbol[iSei];

};

ENDLOOP;

RPop[];

};

paintTC => {

son1: Tree.Link ¬ tb[node].son[1] ¬ TypeLink[tb[node].son[1]];

son2: Tree.Link ¬ tb[node].son[2] ¬ TypeLink[tb[node].son[2]];

tb[node].info ¬ SymbolOps.FromType[Pass3Attributes.TypeForTree[son2]];

};

linkTC => tb[node].info ¬ SymbolOps.FromType[linkType];

implicitTC => {};

frameTC => {

son1: Tree.Link ¬ tb[node].son[1] ¬ Exp[tb[node].son[1], typeANY];

RPop[];

tb[node].info ¬ SymbolOps.FromType[MakeFrameRecord[son1]];

};

ENDCASE => {

type: CSEIndex = SymbolOps.UnderType[
SymbolOps.own, SymbolOps.ToType[tb[node].info]];

WITH t: seb[type] SELECT FROM

record => {

PushCtx[t.fieldCtx];

ScanList[tb[node].son[1], DeclA];

PopCtx[];

};

ref => {

oldLink: Type ¬ linkType;

newLink: Type ¬ linkType ¬ type;

son1: Tree.Link ¬ tb[node].son[1] ¬ TypeLink[tb[node].son[1]

! CheckTypeLoop => {RESUME [FALSE]}];

subType: Type ¬ t.refType ¬ Pass3Attributes.TypeForTree[son1];

IF t.list THEN {

ut: CSEIndex = SymbolOps.UnderType[SymbolOps.own, subType];

WITH se: seb[ut] SELECT FROM

record => {

The record type is for a LIST

se.list ¬ TRUE;

se.machineDep ¬ se.painted ¬ FALSE;

};

ENDCASE;

};

linkType ¬ oldLink;

};

array => {

son1: Tree.Link ¬ tb[node].son[1];

son2: Tree.Link ¬ tb[node].son[2];

IF son1 = Tree.Null

THEN t.indexType ¬ MimData.idCARD

ELSE {

son1 ¬ tb[node].son[1] ¬ TypeLink[son1];

t.indexType ¬ Pass3Attributes.TypeForTree[son1];

};

son2 ¬ tb[node].son[2] ¬ TypeLink[son2];

t.componentType ¬ Pass3Attributes.TypeForTree[son2];

};

arraydesc => {

son1: Tree.Link ¬ tb[node].son[1] ¬ TypeLink[tb[node].son[1]

! CheckTypeLoop => {RESUME [FALSE]}];

t.describedType ¬ Pass3Attributes.TypeForTree[son1];

};

transfer => {

ENABLE CheckTypeLoop => {RESUME [FALSE]};

CheckDisjoint[SymbolOps.ArgCtx[SymbolOps.own, t.typeIn], SymbolOps.ArgCtx[SymbolOps.own, t.typeOut]];

PushArgCtx[t.typeIn];

IF OpName[tb[node].son[1]] # anyTC THEN

ScanList[tb[node].son[1], DeclA];

PushArgCtx[t.typeOut];

IF OpName[tb[node].son[2]] # anyTC THEN

ScanList[tb[node].son[2], DeclA];

PopArgCtx[t.typeOut];

PopArgCtx[t.typeIn];

};

definition => t.defCtx ¬ MimData.mainCtx;

union => {

DeclA[tb[node].son[1]];

ScanList[tb[node].son[2], DeclA];

};

sequence => {

DeclA[tb[node].son[1]];

t.componentType ¬ Pass3Attributes.TypeForTree[
tb[node].son[2] ¬ TypeLink[tb[node].son[2]]];

};

relative => {

son1: Tree.Link ¬ tb[node].son[1] ¬ TypeLink[tb[node].son[1]

! CheckTypeLoop => {RESUME [FALSE]}];

t.baseType ¬ Pass3Attributes.TypeForTree[son1];

t.resultType ¬ t.offsetType ¬ Pass3Attributes.TypeForTree[
tb[node].son[2] ¬ TypeLink[tb[node].son[2]]];

};

opaque =>

IF t.id = ISENull OR ~InterfaceSe[t.id] THEN MimosaLog.Error[misplacedType];

subrange => {

t.range ¬ LOOPHOLE[node]; -- to allow symbolic evaluation

t.rangeType ¬ Pass3Attributes.TypeForTree[tb[node].son[1] ¬ TypeLink[tb[node].son[1]]];

};

ENDCASE;

seb[type].mark3 ¬ TRUE;

};

val ¬ typeExp;

};

ENDCASE => ERROR;

};

TypeAttr: PROC [typeExp: Tree.Link, indirect, varOK: BOOL ¬ FALSE] = {

WITH typeExp SELECT GetTag[typeExp] FROM

symbol =>

IF ~indirect THEN {

sei: ISEIndex = index;

IF seb[sei].mark3 AND ~seb[sei].mark4 THEN {

declNode: Tree.Index = SymbolOps.DecodeTreeIndex[seb[sei].idValue];

IF tb[declNode].attr2 # MimP3.mark THEN ResolveValue[sei];

}

};

subtree => {

node: Tree.Index = index;

SELECT tb[node].name FROM

discrimTC, longTC, optionTC => TypeAttr[tb[node].son[1], indirect];

cdot => TypeAttr[tb[node].son[2], indirect];

paintTC => {

TypeAttr[tb[node].son[1]];

TypeAttr[tb[node].son[2], indirect];

MimosaLog.Error[unimplemented];

};

implicitTC, linkTC, frameTC, dot => NULL;

apply => tb[node].son[2] ¬ VoidExp[tb[node].son[2]];

ENDCASE => {

type: CSEIndex = SymbolOps.UnderType[
SymbolOps.own, SymbolOps.ToType[tb[node].info]];

WITH t: seb[type] SELECT FROM

enumerated =>

IF AssignedEnumeration[tb[node].son[1]] AND ~t.machineDep THEN

MimosaLog.Error[machDep];

record => {

saveNP: NPUse = pathNP;

son1: Tree.Link ¬ tb[node].son[1];

PushCtx[t.fieldCtx];

pathNP ¬ none;

ScanList[son1, DeclBField];

WITH s: t SELECT FROM

linked => CheckDisjointPrefix[t.fieldCtx, s.linkType];

notLinked => {

attrs: FieldAttrs = CollectAttrs[
son1, FieldAttrs[positionValid: t.machineDep]];

UpdateHints[LOOPHOLE[type], attrs];

tb[node].attr1 ¬ AssignedPositions[attrs];

};

ENDCASE => ERROR;

PopCtx[];

pathNP ¬ saveNP;

};

ref => {

IF t.var AND ~varOK THEN MimosaLog.Error[var];

TypeAttr[tb[node].son[1], TRUE];

};

array => {

IF tb[node].son[1] # Tree.Null THEN TypeAttr[tb[node].son[1]];

IF NOT Pass3Attributes.IndexType[t.indexType] THEN {

t.indexType ¬ typeANY;

MimosaLog.Error[nonOrderedType];

};

TypeAttr[tb[node].son[2], indirect];

IF NOT ComponentType[t.componentType] THEN

MimosaLog.ErrorTree[typeLength, tb[node].son[2]]

};

arraydesc => {

TypeAttr[tb[node].son[1], TRUE];

IF SymbolOps.TypeForm[SymbolOps.own, t.describedType] # $array THEN

MimosaLog.Error[descriptor];

};

transfer => {

saveNP: NPUse = pathNP;

IF t.mode = error THEN t.safe ¬ FALSE;

PushArgCtx[t.typeIn];

ArgAttr[t.typeIn, tb[node].son[1], t.mode = proc OR t.mode = signal];

PushArgCtx[t.typeOut];

ArgAttr[t.typeOut, tb[node].son[2], FALSE];

PopArgCtx[t.typeOut];

PopArgCtx[t.typeIn];

pathNP ¬ saveNP;

};

definition, zone, any => {};

union => {

tagType: CSEIndex;

DeclBDefault[tb[node].son[1]];

seb[t.tagSei].immutable ¬ TRUE;

tagType ¬ SymbolOps.UnderType[
SymbolOps.own, Pass3Attributes.TargetType[seb[t.tagSei].idType]];

IF seb[tagType].typeTag # enumerated THEN {

MimosaLog.ErrorSei[nonTagType, t.tagSei];

tagType ¬ typeANY;

};

VariantList[tb[node].son[2], tagType];

};

sequence => {

DeclBDefault[tb[node].son[1]];

seb[t.tagSei].immutable ¬ TRUE;

IF NOT Pass3Attributes.IndexType[seb[t.tagSei].idType] THEN

MimosaLog.ErrorSei[nonTagType, t.tagSei];

TypeAttr[tb[node].son[2], indirect];

IF NOT ComponentType[t.componentType] THEN

MimosaLog.ErrorTree[typeLength, tb[node].son[2]]

};

relative => {

subType, vType: CSEIndex;

nt: CSEIndex ¬ SymbolOps.NormalType[SymbolOps.own, t.baseType];

TypeAttr[tb[node].son[1], TRUE];

IF nt = nullType OR seb[nt].typeTag # ref THEN MimosaLog.Error[relative];

TypeAttr[tb[node].son[2]];

vType ¬ SymbolOps.UnderType[SymbolOps.own, t.offsetType];

subType ¬ SymbolOps.NormalType[SymbolOps.own, vType];

SELECT SymbolOps.TypeForm[SymbolOps.own, subType] FROM

$ref, $arraydesc => {};

ENDCASE => {MimosaLog.Error[relative]; subType ¬ typeANY};

t.resultType ¬ subType;

};

opaque => {

son1: Tree.Link ¬ tb[node].son[1];

IF son1 # Tree.Null THEN {

son1 ¬ tb[node].son[1] ¬ Rhs[son1, MimData.idINT];

IF ~RAttrPop[].const THEN MimosaLog.ErrorTree[nonConstant, son1];

};

subrange => {

target: Type;

subNode: Tree.Index = GetNode[tb[node].son[2]];

TypeAttr[tb[node].son[1], indirect];

target ¬ t.rangeType;

SELECT TRUE FROM

(SymbolOps.TypeForm[SymbolOps.own, target] = $ref) =>

target ¬ MimData.idINT;

Pass3Attributes.OrderedType[target] => {

subType: CSEIndex = SymbolOps.UnderType[SymbolOps.own, target];

WITH s: seb[subType] SELECT FROM

real => MimosaLog.Error[subrangeNesting];

ENDCASE;

target ¬ Pass3Attributes.TargetType[target];

};

ENDCASE => {MimosaLog.Error[nonOrderedType]; target ¬ typeANY};

tb[subNode].son[1] ¬ EndPoint[tb[subNode].son[1], target];

tb[subNode].son[2] ¬ EndPoint[tb[subNode].son[2], target];

};

ENDCASE => ERROR;

};

ENDCASE => ERROR;

};

EndPoint: PROC [t: Tree.Link, target: Type] RETURNS [v: Tree.Link] = {

v ¬ Rhs[t, target];

IF ~RAttrPop[].const THEN MimosaLog.ErrorTree[nonConstant, v];

};

ComponentType: PROC [type: Type] RETURNS [BOOL] = {

sei: CSEIndex = SymbolOps.UnderType[SymbolOps.own, type];

WITH t: seb[sei] SELECT FROM

mode, any, nil => RETURN [FALSE];

record =>

IF t.hints.variant THEN

SELECT seb[MimP3.VariantUnionType[sei]].typeTag FROM

sequence => RETURN [FALSE];

ENDCASE;

opaque => RETURN [t.lengthKnown];

ENDCASE;

RETURN [TRUE];

};

record attribute collection

FieldAttrs: TYPE = MACHINE DEPENDENT RECORD [

positionValid: BOOL ¬ FALSE,

noAssign: BOOL ¬ FALSE,

refField, unVoidable, default: BOOL ¬ FALSE,

positions: PACKED ARRAY {implicit, explicit} OF BOOL ¬ [FALSE, FALSE]];

MergeAttrs: PROC [a1, a2: FieldAttrs] RETURNS [FieldAttrs] = INLINE {

RETURN [LOOPHOLE [OSMiscOps.WordOr[LOOPHOLE[a1, WORD], LOOPHOLE[a2, WORD]]]];

};

UpdateHints: PROC [rSei: RecordSEIndex, attrs: FieldAttrs] = {

seb[rSei].hints.assignable ¬ ~attrs.noAssign;

seb[rSei].hints.refField ¬ attrs.refField;

seb[rSei].hints.voidable ¬ ~attrs.unVoidable;

seb[rSei].hints.default ¬ attrs.default;

};

AssignedPositions: PROC [attrs: FieldAttrs] RETURNS [assigned: BOOL ¬ FALSE] = {

IF attrs.positionValid THEN {

IF attrs.positions = [TRUE, TRUE] THEN MimosaLog.Error[mixedPositions];

assigned ¬ attrs.positions[explicit];

};

CollectAttrs: PROC [t: Tree.Link, attrs: FieldAttrs] RETURNS [FieldAttrs] = {

ProcessField: Tree.Scan = {

node: Tree.Index = GetNodeNoOptions[t];

type: Type = Pass3Attributes.TypeForTree[tb[node].son[2]];

subType: CSEIndex = SymbolOps.UnderType[SymbolOps.own, type];

attrs ¬ CheckPositions[tb[node].son[1], attrs];

IF (IF tb[node].son[3] = Tree.Null

THEN Pass3Attributes.Default[type] = nonVoid

ELSE ProcessDefault[node]) THEN attrs.default ¬ TRUE;

WITH t: seb[subType] SELECT FROM

union => {

subNode: Tree.Index = GetNodeNoOptions[tb[node].son[2]];

IF t.controlled THEN ProcessField[tb[subNode].son[1]];

attrs ¬ MergeVariantAttrs[tb[subNode].son[2], attrs];

t.hints.refField ¬ attrs.refField; t.hints.voidable ¬ ~attrs.unVoidable;

t.hints.default ¬ attrs.default;

tb[subNode].attr1 ¬ attrs.positions[explicit];

};

sequence => {

subNode: Tree.Index = GetNodeNoOptions[tb[node].son[2]];

IF t.controlled THEN ProcessField[tb[subNode].son[1]];

IF SymbolOps.RCType[SymbolOps.own, t.componentType] # none THEN {

IF ~t.controlled THEN MimosaLog.Error[attrClash];

attrs.refField ¬ --attrs.unVoidable ¬-- TRUE};

attrs.noAssign ¬ TRUE;

tb[subNode].attr1 ¬ attrs.positions[explicit];

};

ENDCASE => {

IF ~attrs.refField AND SymbolOps.RCType[SymbolOps.own, subType] # none THEN

attrs.refField ¬ attrs.unVoidable ¬ TRUE;

IF NOT attrs.unVoidable AND NOT Pass3Attributes.Voidable[type] THEN

attrs.unVoidable ¬ TRUE;

IF NOT Pass3Attributes.AssignableType[subType, FALSE] THEN

attrs.noAssign ¬ TRUE;

};

ScanList[t, ProcessField];

RETURN [attrs];

};

GetNodeNoOptions: PROC [t: Tree.Link] RETURNS [Tree.Index] = {

WITH e: t SELECT GetTag[t] FROM

subtree => {

IF tb[e.index].name = optionTC THEN {t ¬ tb[e.index].son[1]; LOOP};

RETURN [e.index];

};

ENDCASE => ERROR;

ENDLOOP;

};

ArgAttr: PROC [rSei: CSEIndex, t: Tree.Link, varOK: BOOL] = {

IF rSei # CSENull THEN

WITH seb[rSei] SELECT FROM

record => {

ScanList[t, IF varOK THEN DeclBVarField ELSE DeclBField];

UpdateHints[LOOPHOLE[rSei], CollectAttrs[t, FieldAttrs[]]];

};

ENDCASE

};

machine dependent layout

NumericConst: Tree.Map = {v ¬ Rhs[t, MimData.idINT]; RPop[]};

AssignedEnumeration: PROC [t: Tree.Link] RETURNS [assigned: BOOL] = {

AssignElement: Tree.Scan = {

WITH t SELECT GetTag[t] FROM

subtree => {

node: Tree.Index = index;

tb[node].son[2] ¬ NumericConst[tb[node].son[2]]; assigned ¬ TRUE};

ENDCASE => NULL;

};

assigned ¬ FALSE;

ScanList[t, AssignElement];

};

CheckPositions: PROC [t: Tree.Link, attrs: FieldAttrs] RETURNS [FieldAttrs] = {

CheckPosition: Tree.Scan = {

WITH t SELECT GetTag[t] FROM

subtree => {

node: Tree.Index = GetNode[tb[index].son[2]];

IF ~attrs.positionValid THEN MimosaLog.ErrorSei[position, ItemId[tb[index].son[1]]];

tb[node].son[1] ¬ NumericConst[tb[node].son[1]];

IF tb[node].son[2] # Tree.Null THEN {

subNode: Tree.Index = GetNode[tb[node].son[2]];

tb[subNode].son[1] ¬ NumericConst[tb[subNode].son[1]];

tb[subNode].son[2] ¬ NumericConst[tb[subNode].son[2]];

};

attrs.positions[explicit] ¬ TRUE;

};

ENDCASE => attrs.positions[implicit] ¬ TRUE

};

ScanList[t, CheckPosition];

RETURN [attrs];

};

variants

CheckDisjointPrefix: PROC [ctx: CTXIndex, link: Type] = {

FOR sei: Type ¬ link, SymbolOps.TypeLink[SymbolOps.own, sei] UNTIL sei = nullType DO

type: CSEIndex = SymbolOps.UnderType[SymbolOps.own, sei];

WITH t: seb[type] SELECT FROM

record => CheckDisjoint[ctx, t.fieldCtx];

ENDCASE;

ENDLOOP;

};

VariantList: PROC [t: Tree.Link, tagType: CSEIndex] = {

DefineTag: Tree.Scan = {

sei: ISEIndex = GetSe[t];

seb[sei].idValue ¬ SymbolOps.EncodeCard[TagValue[seb[sei].hash, tagType]];

};

VariantItem: Tree.Scan = {

node: Tree.Index = GetNode[t];

saveIndex: SourceMap.Loc = MimData.textIndex;

MimData.textIndex ¬ ToLoc[tb[node].info];

ScanList[tb[node].son[1], DefineTag];

DeclBDefault[t];

MimData.textIndex ¬ saveIndex;

};

ScanList[t, VariantItem];

};

TagValue: PROC [tag: Name, tagType: CSEIndex] RETURNS [CARD] = {

WITH t: seb[tagType] SELECT FROM

enumerated => {

matched: BOOL;

sei: ISEIndex;

[matched, sei] ¬ SearchCtxList[tag, t.valueCtx];

IF matched THEN RETURN [SymbolOps.DecodeCard[seb[sei].idValue]];

};

ENDCASE;

MimosaLog.ErrorHti[unknownTag, tag];

RETURN [0];

};

MergeVariantAttrs: PROC
[list: Tree.Link, prefixAttrs: FieldAttrs] RETURNS [mergedAttrs: FieldAttrs] = {

ProcessVariant: Tree.Scan = {

node: Tree.Index = GetNode[t];

ProcessLabel: Tree.Scan = {

sei: ISEIndex = GetSe[t];

type: Type = SymbolOps.DecodeType[seb[sei].idInfo];

WITH v: seb[type] SELECT FROM

cons =>

WITH r: v SELECT FROM

record => {

subNode: Tree.Index = GetNode[tb[node].son[2]];

attrs: FieldAttrs = CollectAttrs[tb[subNode].son[1], prefixAttrs];

UpdateHints[LOOPHOLE[type], attrs];

r.hints.default ¬ TRUE;

tb[subNode].attr1 ¬ attrs.positions[explicit];

mergedAttrs ¬ MergeAttrs[mergedAttrs, attrs];

};

ENDCASE;

};

ScanList[tb[node].son[1], ProcessLabel];

};

mergedAttrs ¬ prefixAttrs;

ScanList[list, ProcessVariant];

mergedAttrs.default ¬ prefixAttrs.default;

};

type construction

MakeLongType: PUBLIC PROC [rType, hint: Type ¬ nullType] RETURNS [type: Type] = {

subType: CSEIndex = SymbolOps.UnderType[SymbolOps.own, rType];

protoType: CSEIndex = SymbolOps.UnderType[SymbolOps.own, hint];

WITH t: seb[subType] SELECT FROM

basic =>

IF t.length = Target.bitsPerLongWord THEN RETURN [rType];

ref =>

IF t.length = Target.bitsPerLongWord THEN RETURN [rType];

signed =>

IF t.length = Target.bitsPerLongWord THEN RETURN [rType];

unsigned =>

IF t.length = Target.bitsPerLongWord THEN RETURN [rType];

real =>

SELECT t.length FROM

Target.bitsPerReal => RETURN [MimData.idDREAL];

Target.bitsPerReal*2 => RETURN [MimData.idDREAL];

ENDCASE => ERROR;

relative => {

oType: Type = MakeLongType[t.offsetType, t.resultType];

type ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.relative.SIZE];

seb[type] ¬ [mark3: TRUE, mark4: TRUE, body: cons[

align: unknown,

typeInfo: relative[baseType: t.baseType, offsetType: oType, resultType: oType]]];

RETURN;

};

arraydesc => {

longLength: NAT = Target.bitsPerLongWord+Target.bitsPerWord;

shortLength: NAT = Target.bitsPerWord+Target.bitsPerWord;

SELECT t.length FROM

longLength => RETURN [rType];

shortLength => {

type ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.relative.SIZE];

seb[type] ¬ [mark3: TRUE, mark4: TRUE, body: cons[

align: MimData.wordAlignment,

typeInfo: arraydesc[
describedType: t.describedType,
var: t.var,
readOnly: t.readOnly,
bitOrder: t.bitOrder,
length: longLength]]];

RETURN [type];

};

ENDCASE => ERROR;

};

ENDCASE;

MimosaLog.Error[long];

RETURN [rType];

};

MakeRefType: PUBLIC PROC
[cType, hint: Type, bits: NAT, readOnly, counted, var: BOOL]
RETURNS [type: RefSEIndex] = {

protoType: CSEIndex = SymbolOps.UnderType[SymbolOps.own, hint];

WITH p: seb[protoType] SELECT FROM

ref =>

IF ~p.ordered AND p.readOnly = readOnly AND p.counted = counted AND p.var = var AND SymbolOps.EqTypes[SymbolOps.own, p.refType, cType] THEN

RETURN [LOOPHOLE[protoType]];

ENDCASE;

IF bits < Target.bitsPerWord THEN bits ¬ Target.bitsPerWord;

type ¬ LOOPHOLE[SymbolOps.MakeNonCtxSe[SERecord.cons.ref.SIZE]];

seb[type] ¬ [mark3: TRUE, mark4: TRUE, body: cons[

align: MimData.wordAlignment,

typeInfo: ref[

counted: counted,

var: var,

readOnly: readOnly, ordered: FALSE, list: FALSE, basing: FALSE,

refType: cType,

length: IF counted THEN Target.bitsPerRef ELSE bits]]];

};

Russ Atkinson (RRA) July 31, 1987 7:07:07 pm PDT

Added handling of optionTC (replaces use of packedTC)