[_CDCSL_93-16_]<1>Cedar>release>Cirio>RMTWAtomics.mesa

RMTWAtomics.mesa

Sturgis, April 20, 1990 2:22 pm PDT

Last changed by Theimer on November 29, 1989 4:07:26 am PST

Last tweaked by Mike Spreitzer on January 10, 1992 1:12 pm PST

Coolidge, July 18, 1990 11:03 am PDT

Philip James, February 24, 1992 11:22 am PST

Laurie Horton, April 3, 1992 2:39 pm PST

Katsuyuki Komatsu December 22, 1992 8:24 am PST

Willie-s, January 4, 1993 8:26 pm PST

DIRECTORY

Basics,

BasicTime USING[GMT, Period],

CardTab USING[Create, Delete, EachPairAction, Fetch, Insert, Pairs, Ref, Store],

CCTypes USING[CCError, CCErrorCase, GetTargetTypeOfIndirect, GetTypeClass, GetTypeRepresentation],

CedarCode USING[CreateCedarNode, GetDataFromNode, GetNodeRepresentation, OperationsBody, Operator],

CedarNumericTypes USING[CreateNumericNode, CreateNumericType, GetDescriptorFromCedarNumericType, NDFormat, NumericDescriptor],

CedarOtherPureTypes,

CirioMemory,

CirioNubAccess USING[Error, GetConcreteTypecode, GetTypecode, GetTypestring, Handle, RemoteAddress, RemoteAddrFault, Typecode],

CirioTypes,

Convert,

DeferringTypes,

GenericCall,

IO,

LoadStateAccess,

MobAccess USING[BodySE, BTH, BTR, ConstVal, CTXH, CTXR, FetchBTR, FetchCTXR, FetchMDR, FetchSER, GetCtxForCTXH, GetFileForMobCookie, GetMobForSEH, GetRootBTH, GetSeiForSEH, ImportedCTXR, IncludedCTXR, MakeCTXH, MakeMDH, MDH, MDR, MobCookie, MobError, SEH, SER, SimpleCTXR, TypeDesc, TypeInfoConsSE],

MobDefs USING [NullVersion, VersionStamp],

MobObjectFiles,

NewRMTW,

ObjectFiles,

PFS USING [PathFromRope, RopeFromPath],

PFSNames USING [PATH],

Procedures,

RMTWPrivate,

RefTab USING[Create, Delete, Fetch, Ref, Store],

Rope,

SafeStorage,

SimpleFeedback,

SymTab USING[Create, Fetch, Ref, Store],

Symbols USING[CTXIndex, FirstStandardCtx, LastStandardCtx, OwnMdi, SEIndex],

SystemInterface USING[CirioFile, GetNameOfFile, ShowReport],

TypeStrings;

temporary note:

we begin to add the getPointer routines. Here is a list of tentative places

CreateArrayIndirectNode

CreateCedarNode

CreateIndirectToAnUnknownType

CreateIndirectRecordNode

CreateIndirectSequenceNode

Issue: How do the following indirects participate in the @ operation? (Which should return pointer.) (These are the ones using CreateCedarNode.) (In their CedarCode.OperationsBody they must supply UnaryOp (more or less) for $address.)

CreateIndirectBooleanNode

CreateIndirectCharNode

CreateIndirectCedarNumericNode

CreateIndirectEnumeratedNode

CreateIndirectRefNode

Issue: why is there a getPointer procedure in PointerNodeInfoBody? These procedures should only apply to indirects, and a PointerNode is not an indirect, but rather a (target world dependent) pure value. Similarly, why is there a getPointer procedure in RefNodeInfoBody?

Note: @exp reesults in

compiling exp for LHS

applying the unary op: address

(address should result in converting the indirect to a Pointer)

Issue: (about pointers). The code that is issued for @ptr also seems wrong. Pointer nodes really seem to behave like indirects to pointers. Not only is the code wrong, but the right result gets returned. SO THERE IS SOME REWORK TO BE DONE.

RMTWAtomics: CEDAR PROGRAM

IMPORTS BasicTime, CardTab, CCTypes, CedarCode, CedarNumericTypes, CedarOtherPureTypes, CirioMemory, CirioNubAccess, CirioTypes, Convert, DeferringTypes, IO, MobAccess, PFS, RefTab, RMTWPrivate, Rope, SymTab, SystemInterface

EXPORTS NewRMTW, RMTWPrivate

SHARES Rope

BEGIN OPEN LSA:LoadStateAccess, ObjF:ObjectFiles, MA:MobAccess, MOF:MobObjectFiles, RMTWPrivate, TS:TypeStrings;

Operator: TYPE = CedarCode.Operator;

CNTD: TYPE = CedarNumericTypes.NumericDescriptor;

CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE ¬ NIL] ¬ CCTypes.CCError;

Target world dependent parameters

This stuff is adapted from [PCedar2.0]<Mimosa>SymbolOpsImpl and [PCedar2.0]<MachineParms>SparcParms.mesa.

(the later from [PCedar2.0]<top>MachineParms-Source.df)

TargetBitsPerWord: CARD = 32;

BitsForRange: PROC[maxValue: CARD] RETURNS[nBits: CARD ¬ 1] =

BEGIN

fieldMax: CARD ¬ 1;

WHILE nBits < TargetBitsPerWord AND fieldMax < maxValue DO

nBits ¬ nBits + 1;

fieldMax ¬ 2*fieldMax + 1;

ENDLOOP

END;

RemoteMimosaTargetWorldBody: PUBLIC TYPE = RMTWPrivate.RemoteMimosaTargetWorldBody;

Type analysis

AnalyzeTc: PUBLIC PROC [rmtw: RemoteMimosaTargetWorld, tc: CARD] RETURNS [Type] ~ {

ra: REF ANY;

ts, whyNot: ROPE ¬ NIL;

tsDict: TsDict ¬ NIL;

ok: BOOL ¬ FALSE;

ans: Type ¬ NIL;

len, endi: INT;

[ok, ra] ¬ rmtw.tcHash.Fetch[tc];

IF ok THEN RETURN [NARROW[ra]];

[ts, whyNot] ¬ CirioNubAccess.GetTypestring[rmtw.nub, [tc] !CirioNubAccess.Error => CONTINUE];

len ¬ ts.Length[];

IF whyNot#NIL OR len=0 THEN RETURN[CedarOtherPureTypes.CreateUnknownType[rmtw.cc, IO.PutFR["unable to get typestring for code %gD=%xH (because %g)", [cardinal[tc]], [cardinal[tc]], [rope[whyNot]] ]]];

tsDict ¬ MakeTsDict[ts, tc];

[ans, endi] ¬ AnalyzeTs[rmtw, tsDict, 0 !CCE => {

ans ¬ CedarOtherPureTypes.CreateUnknownType[rmtw.cc, IO.PutFR["CCE[%g] parsing typestring for typecode %gD=%xH", [rope[msg]], [cardinal[tc]], [cardinal[tc]] ]];

endi ¬ len;

CONTINUE}];

IF endi # len THEN ans ¬ CedarOtherPureTypes.CreateUnknownType[rmtw.cc, IO.PutFLR["parse of typestring for TC %gD=%xH consumed only %g of the %g bytes", LIST[[cardinal[tc]], [cardinal[tc]], [integer[endi]], [integer[len]]] ]];

[] ¬ rmtw.tcHash.Insert[tc, ans];

RETURN [ans]};

MakeTsDict: PUBLIC PROC [ts: ROPE, tc: CARD] RETURNS [TsDict] ~ {

RETURN [NEW[TsDictPrivate ¬ [tc, ts]]]};

AnalyzeTs: PUBLIC PROC [rmtw: RemoteMimosaTargetWorld, tsd: TsDict, i: INT, opts: TsOptions ¬ ALL[FALSE]] RETURNS [Type, INT] ~ {

byte: NAT ~ GetChar[tsd.ts, i].ORD;

code: TS.Code ¬ definition;

BreakUnary: PROC [expl: ROPE, j: INT] RETURNS [Type, INT] ~ {

sub: Type;

k: INT;

[sub, k] ¬ AnalyzeTs[rmtw, tsd, j];

RETURN [MakeBrokenType[rmtw, expl, 32], k]};

BreakBinary: PROC [expl: ROPE, j: INT] RETURNS [Type, INT] ~ {

sub: Type;

k, l: INT;

[sub, k] ¬ AnalyzeTs[rmtw, tsd, j];

[sub, l] ¬ AnalyzeTs[rmtw, tsd, k];

RETURN [MakeBrokenType[rmtw, expl, 32], l]};

SELECT byte FROM

< TS.Code.FIRST.ORD => CCE[cirioError, IO.PutFR["code (%02xH) too small at pos %g", [cardinal[byte]], [integer[i]] ]];

300B => RETURN [CedarOtherPureTypes.CreateUnknownType[rmtw.cc, "SX-Val"], i.SUCC];

> TS.Code.LAST.ORD => CCE[cirioError, IO.PutFR["code (%02xH) too large at pos %g", [cardinal[byte]], [integer[i]] ]];

ENDCASE => code ¬ VAL[byte];

SELECT code FROM

definition => {

defn: Type;

IF tsd.defs[name] # [] THEN CCE[cirioError, IO.PutFR["double def of %02xH at pos %g", [cardinal[name.ORD]], [integer[i]] ]];

tsd.defs[name] ¬ [i+2, DeferringTypes.CreateDeferringType[rmtw.cc]];

[defn, i] ¬ AnalyzeTs[rmtw, tsd, i+2];

DeferringTypes.SetUndertype[tsd.defs[name].type, defn];

RETURN [tsd.defs[name].type, i]};

name => {

IF tsd.defs[name]=[] THEN RETURN [CedarOtherPureTypes.CreateUnknownType[rmtw.cc, IO.PutFR["undefined reference %02xH at pos %g in TS for TC %g", [cardinal[name.ORD]], [integer[i]], [cardinal[tsd.tc]] ]], i+2];

RETURN [tsd.defs[name].type, i+2]};

union => RETURN AnalPaint[rmtw, tsd, i.SUCC, FALSE];

array => RETURN AnalArrayTs[rmtw, tsd, i.SUCC, opts];

sequence => RETURN BreakBinary["sequence", i.SUCC];

opaque => RETURN AnalPaint[rmtw, tsd, i.SUCC, TRUE];

countedZone => RETURN [MakeBrokenType[rmtw, "countedZone", 32], i.SUCC];

uncountedZone => RETURN [MakeBrokenType[rmtw, "uncountedZone", 32], i.SUCC];

list => RETURN BreakUnary["list", i.SUCC];

relativeRef => RETURN BreakBinary["relativeRef", i.SUCC];

ref => RETURN BreakUnary["ref", i.SUCC];

refAny => RETURN [MakeBrokenType[rmtw, "refAny", 32], i.SUCC];

pointer => RETURN BreakUnary["pointer", i.SUCC];

longPointer => RETURN BreakUnary["longPointer", i.SUCC];

descriptor => RETURN BreakUnary["descriptor", i.SUCC];

longDescriptor => RETURN BreakUnary["longDescriptor", i.SUCC];

port => RETURN BreakBinary["port", i.SUCC];

process => RETURN BreakUnary["process", i.SUCC];

program => RETURN BreakBinary["program", i.SUCC];

type => RETURN [MakeBrokenType[rmtw, "type", 32], i.SUCC];

any => RETURN [MakeBrokenType[rmtw, "any", 32], i.SUCC];

boolean => RETURN [CreateAnalyzedBOOL[rmtw], i.SUCC];

unspecified => RETURN [MakeBrokenType[rmtw, "unspecified", 32], i.SUCC];

procedure => RETURN AnalProcTs[rmtw, tsd, i.SUCC, opts];

signal => RETURN BreakBinary["signal", i.SUCC];

error => RETURN BreakBinary["error", i.SUCC];

cardinal, longCardinal => RETURN [AnalCntd[rmtw, [32, unsigned[full[]]]], i.SUCC];

integer, longInteger => RETURN [AnalCntd[rmtw, [32, signed[full[]]]], i.SUCC];

character => RETURN [MakeBrokenType[rmtw, "character", 32], i.SUCC];

stringBody => RETURN [MakeBrokenType[rmtw, "stringBody", 64], i.SUCC];

text => RETURN [MakeBrokenType[rmtw, "text", 64], i.SUCC];

atomRec => RETURN [

IF rmtw.atomRecRT#NIL

THEN rmtw.atomRecRT

ELSE CedarOtherPureTypes.CreateUnknownType[rmtw.cc, "AtomRec not yet analyzed"],

i.SUCC];

mds => RETURN AnalyzeTs[rmtw, tsd, i.SUCC, TsoSet[opts, mds]];

ordered => RETURN AnalyzeTs[rmtw, tsd, i.SUCC, TsoSet[opts, ordered]];

packed => RETURN AnalyzeTs[rmtw, tsd, i.SUCC, TsoSet[opts, packed]];

readOnly => RETURN AnalyzeTs[rmtw, tsd, i.SUCC, TsoSet[opts, readOnly]];

real => RETURN [AnalCntd[rmtw, [32, real[]]], i.SUCC];

paint => RETURN AnalPaint[rmtw, tsd, i.SUCC, FALSE];

leftParen => RETURN AnalyzeTsRecord[rmtw, tsd, i.SUCC];

safeProc => RETURN BreakBinary["safeProc", i.SUCC];

safe => RETURN AnalyzeTs[rmtw, tsd, i.SUCC, TsoSet[opts, safe]];

var => RETURN BreakUnary["var", i.SUCC];

longUnspecified => RETURN [MakeBrokenType[rmtw, "longUnspecified", 32], i.SUCC];

dcard => RETURN [AnalCntd[rmtw, [64, unsigned[full[]]]], i.SUCC];

dint => RETURN [AnalCntd[rmtw, [64, signed[full[]]]], i.SUCC];

dreal => RETURN [AnalCntd[rmtw, [64, real[]]], i.SUCC];

ENDCASE => CCE[unimplemented, IO.PutFR["unimplemented code %02xH at pos %g", [cardinal[byte]], [integer[i]] ]];

};

GetChar: PROC [ts: ROPE, i: INT] RETURNS [c: CHAR] ~ {

WITH ts SELECT FROM

text: Rope.Text => IF i IN [0..text.length) THEN RETURN [text[i]];

ENDCASE => IF i IN [0..Rope.Length[ts]) THEN RETURN [Rope.Fetch[ts, i]];

ERROR CCE[cirioError, "ran off end of typestring"];

};

GetName: PROC [ts: ROPE, i: INT] RETURNS [name: ROPE, j: INT] ~ {

len: INT ~ GetChar[ts, i].ORD;

GenChar: PROC RETURNS [CHAR] ~ {j ¬ j.SUCC; RETURN [GetChar[ts, j]]};

IF len=0 THEN RETURN ["null name", i.SUCC];

IF len >= 200B THEN CCE[cirioError, "implausible name in typestring"];

j ¬ i;

name ¬ Rope.FromProc[len, GenChar];

j ¬ j.SUCC;

IF name.Fetch[0].ORD = len-1 THEN name ¬ name.Substr[start: 1];

RETURN};

b8: CARD = 256;

GetCard: PROC [ts: ROPE, i: INT] RETURNS [card: CARD, j: INT] ~ {

encodeMod: NAT = 64;

c1: NAT ~ GetChar[ts, i].ORD;

SELECT c1 FROM

< encodeMod*1 => RETURN [c1, i+1];

< encodeMod*2 => RETURN [256*(c1-encodeMod*1) + GetChar[ts, i+1].ORD, i+2];

< encodeMod*3 => RETURN [65536*(c1-encodeMod*2) + b8*GetChar[ts, i+1].ORD + GetChar[ts, i+2].ORD, i+3];

> encodeMod*3 => RETURN [CARD.LAST-(c1-encodeMod*3-1), i+1];

ENDCASE => RETURN [GetChar[ts, i+4].ORD + b8 * (

GetChar[ts, i+3].ORD + b8 * (

GetChar[ts, i+2].ORD + b8 * (

GetChar[ts, i+1].ORD))), i+5]};

AnalPaint: PROC [rmtw: RemoteMimosaTargetWorld, tsd: TsDict, i: INT, isOpaque: BOOL] RETURNS [Type, INT] ~ {

ts: ROPE ~ tsd.ts;

defMob: MA.MobCookie;

vs: MobDefs.VersionStamp;

i2, i3, i4: INT;

IF isOpaque THEN {

Bail: PROC RETURNS [Type] ~ {

mobName: ROPE;

mainBth: MA.BTH; mainBtr: MA.BTR;

mainCtxh: CTXH;

theSeh: SEH;

defMob ¬ GetDefinitionMob[rmtw.cedarModules, vs, NIL];

IF defMob=NIL THEN RETURN CedarOtherPureTypes.CreateUnknownType[rmtw.cc, IO.PutFLR["%g%08x%08x", LIST[[rope[CantFindMobRope]], [rope[name]], [cardinal[vs[0]]], [cardinal[vs[1]]]] ]];

mobName ¬ PFS.RopeFromPath[SystemInterface.GetNameOfFile[MA.GetFileForMobCookie[defMob]]];

mainBth ¬ MA.GetRootBTH[defMob];

mainBtr ¬ MA.FetchBTR[mainBth];

mainCtxh ¬ mainBtr.localCtx;

[theSeh,] ¬ FindSeh[mainCtxh, name, rmtw];

IF theSeh # NIL THEN RETURN AnalyzeSEH[theSeh, rmtw, none]

ELSE RETURN CedarOtherPureTypes.CreateUnknownType[

rmtw.cc,

IO.PutFLR["can't find SEH for %g in %g (VS %08x%08x)",

LIST[[rope[name]], [rope[mobName]],

[cardinal[vs[0]]], [cardinal[vs[1]]]] ]]};

[name, i2] ¬ GetName[ts, i];

[vs[0], i3] ¬ GetCard[ts, i2];

[vs[1], i4] ¬ GetCard[ts, i3];

RETURN [AnalOpaque[rmtw, ts.Substr[start: i-1, len: i4+1-i], Bail], i4]}

ELSE {ctx: CARD;

ctxh: CTXH;

[vs[0], i2] ¬ GetCard[ts, i];

[vs[1], i3] ¬ GetCard[ts, i2];

[ctx, i4] ¬ GetCard[ts, i3];

defMob ¬ GetDefinitionMob[rmtw.cedarModules, vs, NIL];

IF defMob=NIL THEN RETURN[

CedarOtherPureTypes.CreateUnknownType[rmtw.cc, IO.PutFR["%g%08x%08x", [rope[CantFindMobRope]], [cardinal[vs[0]]], [cardinal[vs[1]]] ]],

i4];

ctxh ¬ MA.MakeCTXH[defMob, LOOPHOLE[ctx]];

RETURN [

AnalyzeCTX[ctxh, NIL, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, rmtw, unspecdBA, NIL, NIL].recType,

i4]}};

UnderTypeSEH: PUBLIC PROC[seh: SEH, rmtw: RemoteMimosaTargetWorld] RETURNS[SEH] =

BEGIN

ser: MA.SER ¬ MA.FetchSER[seh];

WITH ser.body SELECT FROM

id: REF id MA.BodySE => IF id.idCtx = NIL

THEN RETURN NormalUnderTypeSEH[seh, rmtw]

ELSE {

ctxInfo: CTXInfo ¬ CheckForSpecialCTX[id.idCtx, rmtw];

RETURN[ctxInfo.underTypeSEH[ctxInfo, seh]];

};

cons: REF cons MA.BodySE => RETURN[seh];

ENDCASE => ERROR;

END;

NormalUnderTypeSEH: PROC[seh: SEH, rmtw: RemoteMimosaTargetWorld] RETURNS[SEH] =

BEGIN

ser: MA.SER ¬ MA.FetchSER[seh];

WITH ser.body SELECT FROM

id: REF id MA.BodySE => {

we simply spin deeper into the Mob type structure

WITH id.idInfoAndValue SELECT FROM

idInfo: REF MobAccess.TypeDesc => {

underSeh: SEH ~ UnderTypeSEH[idInfo.seh, rmtw];

underSer: SER ~ MA.FetchSER[underSeh];

isOpaque: BOOL ~ WITH underSer.body SELECT FROM

x: REF cons MA.BodySE => x.typeInfo.typeTag = opaque,

ENDCASE => FALSE;

idCtxr: CTXR ~ MA.FetchCTXR[id.idCtx];

{

IF id.hash.Length[] < 1 THEN {

SystemInterface.ShowReport[IO.PutFR1["Copied symbol %g has no name - canonicalization ends here.", [rope[FmtSeh[seh, id.hash]]] ], $normal];

GOTO GiveUp};

WITH idCtxr SELECT FROM

incl: MA.IncludedCTXR => {--copied from another mob; go get that one

nextMdr: MA.MDR ~ MA.FetchMDR[incl.module];

nextCookie: MA.MobCookie ~ GetDefinitionMob[rmtw.cedarModules, nextMdr.stamp, PFS.PathFromRope[nextMdr.moduleId] --fileId includes extension--];

nextCtxh: CTXH; nextCtxr: CTXR ¬ NIL;

orgSeh: SEH; orgSer: SER;

IF nextCookie=NIL THEN {

SystemInterface.ShowReport[IO.PutFR["Couldn't get %g.mob (%g) for copied symbol %g - canonicalization ends here.", [rope[nextMdr.moduleId]], [rope[FmtStamp[nextMdr.stamp]]], [rope[FmtSeh[seh, id.hash]]] ], $normal];

GOTO GiveUp};

nextCtxh ¬ MA.MakeCTXH[nextCookie, incl.map];

{ENABLE MA.MobError => {

SystemInterface.ShowReport[IO.PutFR[

"MobAccess.Error[%g] while trying to find original for copied symbol %g - canonicalization ends here.",

[rope[msg]], [rope[FmtSeh[seh, id.hash]]] ], $normal];

GOTO GiveUp};

nextCtxr ¬ MA.FetchCTXR[nextCtxh];

orgSeh ¬ nextCtxr.seList;

WHILE orgSeh#NIL DO

orgSer ¬ MA.FetchSER[orgSeh];

WITH orgSer.body SELECT FROM

orgId: REF id MA.BodySE => IF id.hash.Equal[orgId.hash]

THEN RETURN NormalUnderTypeSEH[orgSeh, rmtw]

ELSE orgSeh ¬ orgId.ctxLink;

ENDCASE => {

SystemInterface.ShowReport[IO.PutFR1[

"Copied symbol %g comes from a context with a non-id SE!",

[rope[FmtSeh[seh, id.hash]]] ], $normal];

orgSeh ¬ NIL};

ENDLOOP;

};

SystemInterface.ShowReport[IO.PutFR1[

"Cannot find original for copied TYPE %g - canonicalization ends here.",

[rope[FmtSeh[seh, id.hash]]] ], $normal];

};

ENDCASE => NULL--not copied (TYPEs are never `imported')--;

EXITS GiveUp => seh ¬ seh};

RETURN[underSeh]};

ENDCASE => ERROR CCE[cirioError, IO.PutFR1["UnderTypeSEH only applicable to TYPEs, not %g", [rope[FmtSeh[seh, id.hash]]] ]];

};

cons: REF cons MA.BodySE => RETURN[seh];

ENDCASE => ERROR;

END;

<<MJS, 1/1/91: Abandoned because it doesn't always work: the idInfo.data doesn't always contain the corresponding SEI.

NormalUnderTypeSEH: PROC[seh: SEH, rmtw: RemoteMimosaTargetWorld] RETURNS[SEH] =

BEGIN

ser: MA.SER ¬ MA.FetchSER[seh];

WITH ser.body SELECT FROM

id: REF id MA.BodySE => {

we simply spin deeper into the Mob type structure

WITH id.idInfoAndValue SELECT FROM

idInfo: REF MobAccess.TypeDesc => {

underSeh: SEH ~ UnderTypeSEH[idInfo.seh, rmtw];

underSer: SER ~ MA.FetchSER[underSeh];

isOpaque: BOOL ~ WITH underSer.body SELECT FROM

x: REF cons MA.BodySE => x.typeInfo.typeTag = opaque,

ENDCASE => FALSE;

nextSei: Table.IndexRep ¬ LOOPHOLE[idInfo.data / BYTES[UNIT]]; --MobMapper doesn't map this!

IF id.idCtx=NIL OR isOpaque--we can't handle these-- THEN NULL

ELSE IF nextSei=LOOPHOLE[Symbols.SENull, Table.IndexRep] THEN SystemInterface.ShowReport[IO.PutFR["idInfo.data=0 for %g, so canonicalization stops here", [rope[FmtSeh[seh, ""]]] ], $normal]

ELSE {--dereference copied contexts

idCtxr: CTXR ~ MA.FetchCTXR[id.idCtx];

WITH idCtxr SELECT FROM

incl: MA.IncludedCTXR => {--copied from another mob; go get that one

nextMdr: MA.MDR ~ MA.FetchMDR[incl.module];

nextCookie: MA.MobCookie ~ GetDefinitionMob[rmtw.cedarModules, nextMdr.stamp, PFS.PathFromRope[nextMdr.moduleId] --fileId includes extension--];

nextSei.tag ¬ Symbols.seTag;

IF nextCookie#NIL THEN {

nextH: SEH ~ MA.MakeSEH[nextCookie, LOOPHOLE[nextSei]];

<<SimpleFeedback.PutF[$Cirio, oneLiner, $Debug, "Does %g match %g?", [rope[FmtSeh[seh, id.hash]]], [rope[FmtSeh[nextH, "?"]]] ];>>

{nextR: SER ~ MA.FetchSER[nextH];

IF nextR#NIL THEN WITH nextR.body SELECT FROM

id2: REF id MA.BodySE => IF id.hash.Equal[id2.hash]

THEN RETURN NormalUnderTypeSEH[nextH, rmtw];

ENDCASE => NULL}}

ELSE {

GOTO GiveUp};

{nextFile: SystemInterface.CirioFile ~ MA.GetFileForMobCookie[nextCookie];

nextFileName: PFSNames.PATH ~ SystemInterface.GetNameOfFile[nextFile];

SystemInterface.ShowReport[IO.PutFR[

"Copied TYPE %g mismatches source (%xH) in %g - canonicalization ends here.",

[rope[FmtSeh[seh, id.hash]]], [cardinal[LOOPHOLE[nextSei]]], [rope[PFS.RopeFromPath[nextFileName]]] ], $normal];

}};

ENDCASE => NULL--not copied (TYPEs are never `imported')--;

EXITS GiveUp => seh ¬ seh};

RETURN[underSeh]};

ENDCASE => ERROR CCE[cirioError, IO.PutFR["UnderTypeSEH only applicable to TYPEs, not %g", [rope[FmtSeh[seh, id.hash]]] ]];

};

cons: REF cons MA.BodySE => RETURN[seh];

ENDCASE => ERROR;

END;

Comment. I have tried several designs. In some designs the primitive action (corresponding to AnalyzeSEH) is to create a type for an SEH. These designs fail for clients who want the private data of the analysis, rather than the type. In some designs the primitive action is to return the private data (which contains the type). But, there are clients who want the type, and do not want to have to discriminate the private data to get it. (e.g., the record type construction wants the type of each of its fields.) So, I have settled on a design in which AnalyzeSEH returns a pair: type and private data. That makes all clients happy. In addition, this pair is cached, so if we have constructed the information for one variety of client, it is ready and waiting for any subsequent clients of the other variety.

Comment: a revised design (as currently implemented) treats an AnalyzedSEH somewhat as an object. That is, it now includes a procedure: createNodeSchema. The invariant is that the analyzedSEH expected by the embedded procedure must be the AnalyzedSEH in which the procedure is embedded. This design removes a messy SELECT that decided which createNodeSchema procedure to call. Unfortunately, there are still some situations in which one does a WITH SELECT on the private field. At the moment these are in the Cedar Numerics code.

Comment(MJS, May 13, 1991): Wishing for simplicity, and not understanding why the private data of an analysis can't be gotten via CCTypes.GetTypeRepresentation, I am trying to eliminate the distinction between type time and structure time. AnalyzeSEH simply returns the CirioTypes.Type.

Comment(MJS, Dec 16, 1991): The deferral of analysis to break cycles in the type graph is being moved from the cases for the individual language features X type info sources to the table lookups for type analysis. Thus, AnalyzeSEH has a deferring type in the table during analysis, and the analysis routines either side-effect this deferring type or return the under type.

AnalyzeSEH: PUBLIC PROC[seh: SEH, rmtw: RemoteMimosaTargetWorld, sk: SehKnowledge] RETURNS[Type] = {

info: StartSEHAnalInfo;

errMsg: Rope.ROPE ¬ NIL;

IF rmtw.setCTC AND BasicTime.Period[from: rmtw.ropeStudyTime, to: rmtw.unknownSymbolFlushTime] > 0 THEN StudyRopes[rmtw];

info ¬ RecordStartOfSEHAnalysis[seh, rmtw];

IF NOT info.valid THEN {

ENABLE {

UNWIND => RecordCancellationOfSEHAnalysis[seh, rmtw];

CCE => {errMsg ¬ msg; GOTO unknownType};

};

analyzed: Type ¬ AnalyzeSEHInner[info.type, seh, rmtw, sk];

RecordAnalyzedSEH[seh, analyzed, rmtw];

RETURN[analyzed];

EXITS unknownType => {

unknown: Type ¬ AnalyzedUnknownSEH[seh, rmtw, errMsg, -1];

RecordAnalyzedSEH[seh, unknown, rmtw];

RETURN[unknown];

};

}

ELSE RETURN[info.type]};

AnalyzeSEHInner: PROC[dft: Type, seh: SEH, rmtw: RemoteMimosaTargetWorld, sk: SehKnowledge] RETURNS[t: Type] = {

ser: MA.SER ¬ MA.FetchSER[seh];

WITH ser.body SELECT FROM

cons: REF cons MA.BodySE =>

WITH cons.typeInfo SELECT FROM

ti: REF ref MA.TypeInfoConsSE =>

RETURN[AnalyzeRefSEH[dft, seh, ser, cons, ti, rmtw, sk]];

ENDCASE => NULL;

WITH ser.body SELECT FROM

id: REF id MA.BodySE => -- we should build definition types

BEGIN

IF id.idCtx # NIL THEN

BEGIN

ctxInfo: CTXInfo ¬ CheckForSpecialCTX[id.idCtx, rmtw];

t ¬ ctxInfo.analyzeSEH[ctxInfo, seh, sk];

END

ELSE t ¬ AnalyzeSEH[UnderTypeSEH[seh, rmtw], rmtw, sk];

END;

cons: REF cons MA.BodySE =>

WITH cons.typeInfo SELECT FROM

ti: REF mode MA.TypeInfoConsSE =>

t ¬ AnalyzedUnknownSEH[seh, rmtw, "MODE", -1];

ti: REF basic MA.TypeInfoConsSE =>

t ¬ AnalyzedUnknownSEH[seh, rmtw, IO.PutFR["BASIC[%g, %g, %g]", [boolean[ti.ordered]], [integer[ti.code]], [cardinal[ti.length]] ], ti.length];

ti: REF signed MA.TypeInfoConsSE =>

t ¬ AnalyzeCedarNumericSEH[seh, ser, cons, rmtw];

ti: REF unsigned MA.TypeInfoConsSE =>

t ¬ AnalyzeCedarNumericSEH[seh, ser, cons, rmtw];

ti: REF real MA.TypeInfoConsSE =>

t ¬ AnalyzeCedarNumericSEH[seh, ser, cons, rmtw];

ti: REF enumerated MA.TypeInfoConsSE =>

t ¬ AnalyzeEnumeratedSEH[seh, ser, cons, ti, rmtw];

ti: REF record MA.TypeInfoConsSE =>

t ¬ AnalyzeRecordSEH[seh, ser, cons, ti, rmtw, sk=RopeRep];

ti: REF ref MA.TypeInfoConsSE =>

CCE[cirioError, "can't happen"];

ti: REF array MA.TypeInfoConsSE =>

t ¬ AnalyzeArraySEH[seh, ser, cons, ti, rmtw];

ti: REF arraydesc MA.TypeInfoConsSE =>

t ¬ AnalyzedUnknownSEH[seh, rmtw, IO.PutFR["ArrayDesc[%g, %g]", [boolean[ti.var]], [boolean[ti.readOnly]], [cardinal[ti.length]] ], ti.length];

ti: REF transfer MA.TypeInfoConsSE => SELECT ti.mode FROM

proc => t ¬ AnalyzeProcedureSEH[ti, cons, ser, seh, rmtw];

ENDCASE => t ¬ AnalyzedUnknownSEH[seh, rmtw, IO.PutFR["TRANSFER[%g, VAL[%g], %g]", [boolean[ti.safe]], [integer[ti.mode.ORD]], [cardinal[ti.length]] ], ti.length];

note: the following two cases should never occur, since they should only be tail cases of Cirio Sequences and Cirio Variant records, in which case the AnalyzedContext record type should never be used, only the field type, which ignores the last entry.

ti: REF union MA.TypeInfoConsSE =>

t ¬ AnalyzedUnknownSEH[seh, rmtw, "union in unexpected place", -1];

ti: REF sequence MA.TypeInfoConsSE =>

t ¬ AnalyzedUnknownSEH[seh, rmtw, "sequence in unexpected place", -1];

ti: REF relative MA.TypeInfoConsSE =>

t ¬ AnalyzedUnknownSEH[seh, rmtw, "RELATIVE", 32];

ti: REF subrange MA.TypeInfoConsSE => {

rangeSEH: SEH ¬ UnderTypeSEH[ti.rangeType, rmtw];

rangeSER: SER ¬ MA.FetchSER[rangeSEH];

WITH rangeSER.body SELECT FROM

rcons: REF cons MA.BodySE =>

WITH rcons.typeInfo SELECT FROM

ti: REF signed MA.TypeInfoConsSE =>

t ¬ AnalyzeCedarNumericSEH[seh, ser, cons, rmtw];

ti: REF unsigned MA.TypeInfoConsSE =>

t ¬ AnalyzeCedarNumericSEH[seh, ser, cons, rmtw];

ti: REF subrange MA.TypeInfoConsSE =>

IF ti.biased

THEN t ¬ AnalyzedUnknownSEH[seh, rmtw, "subrange of unexpected type construction", -1]

ELSE t ¬ AnalyzeCedarNumericSEH[seh, ser, cons, rmtw];

ENDCASE => t ¬ AnalyzedUnknownSEH[seh, rmtw, "subrange of unexpected type construction", -1];

ENDCASE => t ¬ AnalyzedUnknownSEH[seh, rmtw, "subrange of unexpected type", -1];

};

ti: REF opaque MA.TypeInfoConsSE => t ¬ AnalyzeOpaqueSE[seh, ti, rmtw];

ti: REF zone MA.TypeInfoConsSE => t ¬ AnalyzedUnknownSEH[seh, rmtw, "ZONE", ti.length];

ti: REF any MA.TypeInfoConsSE => t ¬ AnalyzedUnknownSEH[seh, rmtw, "ANY", -1];

ti: REF nil MA.TypeInfoConsSE => t ¬ AnalyzedUnknownSEH[seh, rmtw, "Null", 0];

ti: REF unknown MA.TypeInfoConsSE => t ¬ AnalyzedUnknownSEH[seh, rmtw, "UNKNOWN", 0];

ENDCASE => ERROR CCE[cirioError, "unexpected variant of MobAccess.TypeInfoConsSE"];

ENDCASE => ERROR;

DeferringTypes.SetUndertype[dft, t];

RETURN[t]};

AnalyzeOpaqueSE: PROC [seh: SEH, ti: REF opaque MA.TypeInfoConsSE, rmtw: RemoteMimosaTargetWorld] RETURNS [Type] ~ {

mc: MA.MobCookie ~ MA.GetMobForSEH[seh];

sei: Symbols.SEIndex ~ MA.GetSeiForSEH[ti.id];

cf: SystemInterface.CirioFile ~ MA.GetFileForMobCookie[mc];

mobName: ROPE ~ PFS.RopeFromPath[SystemInterface.GetNameOfFile[cf]];

Bail: PROC RETURNS [Type] ~ {

RETURN AnalyzedUnknownSEH[seh, rmtw,

IO.PutFR["OPAQUE[%g, %x]",

[rope[mobName]],

[cardinal[LOOPHOLE[sei]]] ],

IF ti.lengthKnown THEN ti.length ELSE -1]};

idSer: SER ~ MA.FetchSER[ti.id];

idCtxh: CTXH ¬ WITH idSer.body SELECT FROM

x: REF id MA.BodySE => x.idCtx,

x: REF cons MA.BodySE => CCE[cirioError, "an opaque SE's id SE is for a constructor"],

ENDCASE => CCE[cirioError, "unexpected kind of opaque SE id"];

idCtxr: CTXR ¬ MA.FetchCTXR[idCtxh];

idCtxi: Symbols.CTXIndex;

mdh: MA.MDH;

vs: MobDefs.VersionStamp ¬ MobDefs.NullVersion;

WITH idCtxr SELECT FROM--cloned from /r/TypeStringsImpl

x: MA.SimpleCTXR => {

mdh ¬ MA.MakeMDH[mc, Symbols.OwnMdi];

idCtxi ¬ MA.GetCtxForCTXH[idCtxh]};

x: MA.IncludedCTXR => {mdh ¬ x.module; idCtxi ¬ x.map};

x: MA.ImportedCTXR => {

IF x.includeLink=NIL THEN CCE[cirioError, "no include link for an imported opaque SE"];

{link: CTXR ~ MA.FetchCTXR[x.includeLink];

WITH link SELECT FROM

y: MA.IncludedCTXR => {mdh ¬ y.module; idCtxi ¬ y.map};

ENDCASE => CCE[cirioError, "imported opaque SE's include link doesn't point to an included CTXR"];

}};

ENDCASE => CCE[cirioError, "unexpected kind of idCtx for an opaque SE"];

IF idCtxi NOT IN [Symbols.FirstStandardCtx .. Symbols.LastStandardCtx]

THEN vs ¬ MA.FetchMDR[mdh].stamp;

{idSer: SER ~ MA.FetchSER[ti.id];

typeName: ROPE ~ WITH idSer.body SELECT FROM

x: REF id MA.BodySE => x.hash,

ENDCASE => NIL;

IF typeName.Length[]=0 THEN RETURN Bail[];

{vsRope: ROPE ~ Rope.Concat[EncodeCard[vs[0]], EncodeCard[vs[1]]];

typeRope: ROPE ~ Rope.Cat[

Rope.FromChar[VAL[TS.Code[opaque].ORD]],

Rope.FromChar[VAL[1+typeName.Length]],

Rope.FromChar[VAL[typeName.Length]],

typeName,

vsRope];

RETURN AnalOpaque[rmtw, typeRope, Bail]}}};

AnalOpaque: PROC [rmtw: RemoteMimosaTargetWorld, typeString: ROPE, Bail: PROC RETURNS [Type]] RETURNS [Type] ~ {

abstrType, concType: CirioNubAccess.Typecode;

err: ROPE ¬ NIL;

[abstrType, err] ¬ CirioNubAccess.GetTypecode[rmtw.nub, typeString];

IF err#NIL THEN RETURN Bail[];

[concType, err] ¬ CirioNubAccess.GetConcreteTypecode[rmtw.nub, abstrType];

IF err#NIL THEN RETURN Bail[];

IF concType = SafeStorage.nullType.ORD THEN RETURN Bail[];

RETURN AnalyzeTc[rmtw, concType]};

EncodeCard: PROC [c: CARD] RETURNS [ROPE] ~ {

encodeMod: NAT = 64;

ln: Basics.LongNumber = [card[c]];

SELECT c FROM

< encodeMod => RETURN Rope.FromChar[VAL[c]];

< encodeMod*256 => RETURN Rope.FromChar[VAL[encodeMod*1+ln.lh]] .Concat[ Rope.FromChar[VAL[ln.ll]] ];

< encodeMod*LONG[256]*256 => RETURN Rope.FromChar[VAL[encodeMod*2+ln.hl]] .Cat[ Rope.FromChar[VAL[ln.lh]], Rope.FromChar[VAL[ln.ll]] ];

ENDCASE => IF ln.int < 0 AND ln.int > - encodeMod

THEN RETURN Rope.FromChar[VAL[encodeMod*3-ln.int]]

ELSE RETURN Rope.FromChar[VAL[encodeMod*3]] .Cat[ Rope.FromChar[VAL[ln.hh]], Rope.FromChar[VAL[ln.hl]], Rope.FromChar[VAL[ln.lh]], Rope.FromChar[VAL[ln.ll]] ];

};

SEH hash

SehHashEntry: TYPE = REF SehHashEntryBody;

SehHashEntryBody: TYPE = RECORD[

effectiveSymbolFlushTime: BasicTime.GMT,

type: Type ¬ NIL,

analysisRunning: BOOLEAN ¬ TRUE<<,

mark: SehKnowledge ¬ none>>];

We get to use the default Equal and Hash procedures, since ref equality is sufficient.

CreateSehHashTable: PUBLIC PROC RETURNS[SehHashTable] =

{RETURN[NEW[SehHashTableBody ¬ [RefTab.Create[]]]]};

StartSEHAnalInfo: TYPE = RECORD[type: Type, valid: BOOLEAN];

we need the valid flag because sometimes the recorded analyzedSEH is NIL because we don't know how to construct it

we make sure that there is no analysis in progress for the same SEH

We return any previously obtained analysis, if none, then we record the fact that an analysis is in progress.

RecordStartOfSEHAnalysis: PROC[seh: SEH, rmtw: RemoteMimosaTargetWorld] RETURNS[StartSEHAnalInfo] = {

entry: SehHashEntry ¬ NARROW[RefTab.Fetch[rmtw.sehHash.table, seh].val];

IF entry = NIL THEN {

entry ¬ NEW[SehHashEntryBody ¬ [rmtw.unknownSymbolFlushTime, DeferringTypes.CreateDeferringType[rmtw.cc] ]];

IF NOT RefTab.Store[rmtw.sehHash.table, seh, entry] THEN CCE[cirioError]; -- shouldn't happen

RETURN[[entry.type, FALSE]]};

IF BasicTime.Period[entry.effectiveSymbolFlushTime, rmtw.unknownSymbolFlushTime] > 0 THEN-- this entry is now invalid, as some previously unknown types may now be known

{

This is rather a crude mechanism. It basically invalidates all types constructed before the most recent flush time. A better mechanism would be to "re-analyze" the SEH, looking to see if there have actually been any changes. If not, reset the analyzedSEH.effectiveSymbolFlushTime to sehHashTable.flushTime and return it otherwise unchanged. This better mechanism requires the installation of a ReAnalyze procedure, that parallels the analyze procedure, and trots out to leaf procedures for any constructed type.

entry.effectiveSymbolFlushTime ¬ rmtw.unknownSymbolFlushTime;

entry.type ¬ DeferringTypes.CreateDeferringType[rmtw.cc];

entry.analysisRunning ¬ TRUE;

RETURN[[entry.type, FALSE]]};

RETURN[[entry.type, TRUE]]};

RecordCancellationOfSEHAnalysis: PROC[seh: SEH, rmtw: RemoteMimosaTargetWorld] =

BEGIN

entry: SehHashEntry ¬ NARROW[RefTab.Fetch[rmtw.sehHash.table, seh].val];

IF entry = NIL THEN CCE[cirioError]; -- shouldn't happen

IF NOT entry.analysisRunning THEN CCE[cirioError]; -- shouldn't happen

IF NOT RefTab.Delete[rmtw.sehHash.table, seh] THEN CCE[cirioError]; -- shouldn't happen

END;

RecordAnalyzedSEH: PROC[seh: SEH, type: Type, rmtw: RemoteMimosaTargetWorld] = {

entry: SehHashEntry ¬ NARROW[RefTab.Fetch[rmtw.sehHash.table, seh].val];

IF entry = NIL THEN CCE[cirioError]; -- shouldn't happen

IF type = NIL THEN CCE[cirioError]; -- shouldn't happen

IF NOT entry.analysisRunning THEN CCE[cirioError]; -- shouldn't happen

entry.analysisRunning ¬ FALSE;

entry.type ¬ type;

};

<<SetMark: PUBLIC PROC[rmtw: RemoteMimosaTargetWorld, seh: SEH, mark: SehKnowledge] ~ {

entry: SehHashEntry ¬ NARROW[RefTab.Fetch[rmtw.sehHash.table, seh].val];

IF entry = NIL THEN CCE[cirioError, "setting mark on unknown SEH"]; -- shouldn't happen

entry.mark ¬ mark;

RETURN};

GetMark: PUBLIC PROC[rmtw: RemoteMimosaTargetWorld, seh: SEH] RETURNS[mark: SehKnowledge] ~ {

entry: SehHashEntry ¬ NARROW[RefTab.Fetch[rmtw.sehHash.table, seh].val];

IF entry = NIL THEN CCE[cirioError, "setting mark on unknown SEH"]; -- shouldn't happen

RETURN[entry.mark]};>>

Special Contexts

Some contexts are not intended as record defininitions or block definitions, but have other purposes. e.g., the standard context and included contexts.

We begin with the standard context, and will add other possibilities later.

CTXInfo: TYPE = REF CTXInfoBody;

CTXInfoBody: TYPE = RECORD[

effectiveSymbolFlushTime: BasicTime.GMT,

underTypeSEH: PROC[ctxInfo: CTXInfo, seh: SEH] RETURNS[SEH],

analyzeSEH: PROC[ctxInfo: CTXInfo, seh: SEH, sk: SehKnowledge] RETURNS[Type],

rmtw: RemoteMimosaTargetWorld,

private: REF ANY];

Depends upon the fact that ctxh are already hashed by MobAccessImpl, thus the ref that we are holding is unique.

CreateCtxHashTable: PUBLIC PROC RETURNS[CtxHashTable] =

{RETURN[NEW[CtxHashTableBody ¬ [RefTab.Create[]]]]};

GetCTXInfo: PROC[ctxh: CTXH, rmtw: RemoteMimosaTargetWorld] RETURNS[CTXInfo] =

BEGIN

entry: CTXInfo ¬ NARROW[RefTab.Fetch[rmtw.ctxHash.table, ctxh].val];

IF entry # NIL AND BasicTime.Period[entry.effectiveSymbolFlushTime, rmtw.unknownSymbolFlushTime] > 0 THEN

some previously unknown symbols may now be known, so forget everything we thought we knew. (Later we can be less draconian, when we have time to sort things out.)

RETURN[NIL];

RETURN[entry];

END;

CheckForSpecialCTX: PROC[ctxh: CTXH, rmtw: RemoteMimosaTargetWorld] RETURNS[CTXInfo] = {

entry: CTXInfo ← NARROW[RefTab.Fetch[rmtw.ctxHash.table, ctxh].val];

entry: CTXInfo ¬ GetCTXInfo[ctxh, rmtw];

IF entry = NIL THEN {

IF Symbols.FirstStandardCtx = MA.GetCtxForCTXH[ctxh] THEN

entry ¬ CreateStandardContextInfo[rmtw]

ELSE

entry ¬ CreateNormalContextInfo[rmtw];

IF NOT RefTab.Store[rmtw.ctxHash.table, ctxh, entry] THEN CCE[cirioError]

[] ¬ RefTab.Store[rmtw.ctxHash.table, ctxh, entry]

};

RETURN[entry]};

Normal Context

This is the case for contexts internal to the current mob.

CreateNormalContextInfo: PROC[rmtw: RemoteMimosaTargetWorld] RETURNS[CTXInfo] =

{RETURN[NEW[CTXInfoBody¬[

effectiveSymbolFlushTime: rmtw.unknownSymbolFlushTime,

underTypeSEH: NormalContextUnderTypeSEH,

analyzeSEH: NormalContextAnalyzeSEH,

rmtw: rmtw,

private: NIL]]]};

NormalContextUnderTypeSEH: PROC[ctxInfo: CTXInfo, seh: SEH] RETURNS[SEH] =

{RETURN[NormalUnderTypeSEH[seh, ctxInfo.rmtw]]};

NormalContextAnalyzeSEH: PROC[ctxInfo: CTXInfo, seh: SEH, sk: SehKnowledge] RETURNS[Type] =

BEGIN

rmtw: RemoteMimosaTargetWorld ¬ ctxInfo.rmtw;

ser: MA.SER ¬ MA.FetchSER[seh];

WITH ser.body SELECT FROM

id: REF id MA.BodySE => -- we should build definition types

BEGIN

IF id.idCtx = NIL THEN CCE[cirioError];

RETURN[AnalyzeSEH[NormalUnderTypeSEH[seh, rmtw], rmtw, sk]];

END;

ENDCASE => CCE[cirioError];

END;

Standard Context

CreateStandardContextInfo: PROC[rmtw: RemoteMimosaTargetWorld] RETURNS[CTXInfo] =

{RETURN[NEW[CTXInfoBody¬[

effectiveSymbolFlushTime: rmtw.unknownSymbolFlushTime,

underTypeSEH: StandardContextUnderTypeSEH,

analyzeSEH: StandardContextAnalyzeSEH,

rmtw: rmtw,

private: NIL]]]};

StandardContextUnderTypeSEH: PROC[ctxInfo: CTXInfo, seh: SEH] RETURNS[SEH] = {

For the moment we don't do anything special until we find a reason to do so.

RETURN[NormalUnderTypeSEH[seh, ctxInfo.rmtw]]};

StandardContextAnalyzeSEH: PROC[ctxInfo: CTXInfo, seh: SEH, sk: SehKnowledge] RETURNS[Type] = {

This seh is an id seh belonging to the standard context.

Most such sehs can be analyzed by the normal mechanism, and the appropriate information will be constructed. Some require special treatment.

ser: MA.SER ¬ MA.FetchSER[seh];

rmtw: RemoteMimosaTargetWorld ¬ ctxInfo.rmtw;

WITH ser.body SELECT FROM

id: REF id MA.BodySE => -- we should build definition types?

BEGIN

SELECT TRUE FROM

Rope.Equal["BOOL", id.hash],

Rope.Equal["BOOLEAN", id.hash] =>

RETURN[CreateAnalyzedBOOL[rmtw]];

Rope.Equal["CHAR", id.hash],

Rope.Equal["CHARACTER", id.hash] =>

RETURN[CreateAnalyzedChar[rmtw]];

Rope.Equal["ATOM", id.hash] => SELECT sk FROM

none, ATOM => RETURN[AnalyzeSEH[NormalUnderTypeSEH[seh, rmtw], rmtw, ATOM]];

ENDCASE => CCE[cirioError, IO.PutFR1["SehKnowledge conflict for %g", [rope[FmtSeh[seh, "ATOM"]]] ]];

ENDCASE => RETURN[AnalyzeSEH[NormalUnderTypeSEH[seh, rmtw], rmtw, sk]];

END;

ENDCASE => CCE[cirioError]};

Boolean Types

CreateAnalyzedBOOL: PROC[rmtw: RemoteMimosaTargetWorld] RETURNS[Type] = {

bti: CirioTypes.BasicTypeInfo ~ NEW[CirioTypes.BasicTypeInfoPrivate ¬ [CreateIndirectBooleanNode, BooleanBitSize, rmtw]];

type: Type ¬ CedarOtherPureTypes.CreateBooleanType[rmtw.cc, bti];

RETURN[type]};

BooleanBitSize: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type] RETURNS[CARD] = {RETURN[1]};

CreateIndirectBooleanNode: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type, mem: Mem] RETURNS[Node] = {

rmtw: RemoteMimosaTargetWorld ~ NARROW[bti.btiData];

nodeData: REF BoolNodeData ¬ NEW[BoolNodeData ¬ [rmtw, indirectType, targetType, mem]];

RETURN[CedarCode.CreateCedarNode[BooleanOps, indirectType, nodeData]]};

BoolNodeData: TYPE = RECORD[

rmtw: RemoteMimosaTargetWorld,

indirectType, targetType: Type,

mem: Mem];

BooleanOps: REF CedarCode.OperationsBody ¬ NEW[CedarCode.OperationsBody¬[

unaryOp: BooleanUnaryOp,

store: BooleanStore,

load: BooleanLoad]];

BooleanUnaryOp: PROC[op: Operator, type: Type, node: Node, cc: CC] RETURNS[Node] = {

IF op # $address THEN CCE[cirioError] ELSE {

nodeData: REF BoolNodeData ¬ NARROW[CedarCode.GetDataFromNode[node]];

rmtw: RemoteMimosaTargetWorld ¬ nodeData.rmtw;

mem: Mem ¬ nodeData.mem;

RETURN[ConvertFromIndirectToPointer[node, mem, rmtw]]};

};

BooleanStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] = {

nodeData: REF BoolNodeData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];

mem: Mem ¬ nodeData.mem;

rmtw: RemoteMimosaTargetWorld ¬ nodeData.rmtw;

val: REF BOOLEAN ¬ NARROW[CedarCode.GetNodeRepresentation[valNode, cc]];

unlike BooleanLoad, we make no attempt to intercept RemoteAddrFault

There is an issue about the way in which Booleans are represented. They are not necessarily single bit fields, but rather larger fields. My belief is that non-zero means true. As a first cut, I shall write the entire field defined by the BitFieldSchema, writing 1 for true and 0 for false. This parallels the code in BooleanLoad.

mem.MemWrite[IF val THEN 1 ELSE 0, mem.MemGetSize.BaToBits, CirioTypes.zeroBA];

};

BooleanLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = {

nodeData: REF BoolNodeData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];

mem: Mem ¬ nodeData.mem;

rmtw: RemoteMimosaTargetWorld ¬ nodeData.rmtw;

we nest a block to handle unknown address, allowing nodeData to be visible

BEGIN

ENABLE {

CirioNubAccess.RemoteAddrFault => GOTO unknownAddress;

CCE => GOTO unknownAddress};

There is an issue about the way in which Booleans are represented. They are not necessarily single bit fields, but rather larger fields. My belief is that non-zero means true. As a first cut, I shall read the entire field defined by the BitFieldSchema, then treat non-zero as true.

rep: CARD ¬ mem.MemRead[mem.MemGetSize.BaToBits, CirioTypes.zeroBA];

RETURN[CedarOtherPureTypes.CreateBooleanNode[rep#0, cc]];

EXITS

unknownAddress => RETURN[UnimplementedTypeNode[CCTypes.GetTargetTypeOfIndirect[indirectType], rmtw, "bad address"]];

END;

};

Char Types

CreateAnalyzedChar: PROC[rmtw: RemoteMimosaTargetWorld] RETURNS[Type] ={

bti: CirioTypes.BasicTypeInfo ~ NEW[CirioTypes.BasicTypeInfoPrivate ¬ [CharCreateIndirect, CharBitSize, rmtw]];

type: Type ¬ CedarOtherPureTypes.CreateCharType[rmtw.cc, bti];

RETURN[type]};

CharBitSize: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type] RETURNS[CARD]

= {RETURN[8]};

CharCreateIndirect: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type, mem: Mem] RETURNS[Node] = {

rmtw: RemoteMimosaTargetWorld ¬ NARROW[bti.btiData];

nodeData: REF CharNodeData ¬ NEW[CharNodeData ¬ [rmtw, mem]];

RETURN[CedarCode.CreateCedarNode[CharOps, indirectType, nodeData]]};

CharNodeData: TYPE = RECORD[

rmtw: RemoteMimosaTargetWorld,

mem: Mem];

CharOps: REF CedarCode.OperationsBody ¬ NEW[CedarCode.OperationsBody¬[

unaryOp: CharUnaryOp,

store: CharStore,

load: CharLoad]];

CharUnaryOp: PROC[op: Operator, type: Type, node: Node, cc: CC] RETURNS[Node] = {

IF op # $address THEN CCE[cirioError] ELSE {

nodeData: REF CharNodeData ¬ NARROW[CedarCode.GetDataFromNode[node]];

RETURN ConvertFromIndirectToPointer[node, nodeData.mem, nodeData.rmtw];

};

CharStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] = {

nodeData: REF CharNodeData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];

mem: Mem ¬ nodeData.mem;

rmtw: RemoteMimosaTargetWorld ¬ nodeData.rmtw;

val: REF CHAR ¬ NARROW[CedarCode.GetNodeRepresentation[valNode, cc]];

unlike CharLoad, we make no attempt to intercept RemoteAddrFault

fieldSize: BitAddr ¬ mem.MemGetSize[];

we shall write the full field size

mem.MemWrite[ORD[val], fieldSize.BaToBits, zeroBA];

RETURN};

CharLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = {

nodeData: REF CharNodeData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];

mem: Mem ¬ nodeData.mem;

rmtw: RemoteMimosaTargetWorld ¬ nodeData.rmtw;

we nest a block to handle unknown address, allowing nodeData to be visible

{

ENABLE {

CirioNubAccess.RemoteAddrFault => GOTO unknownAddress;

CCE => GOTO unknownAddress};

fieldSize: BitAddr ¬ mem.MemGetSize[];

fieldOffset: BitAddr ¬ fieldSize.BaSub[CirioTypes.BitsToBa[8]];

rep: CARD ¬ mem.MemRead[8, fieldOffset];

RETURN[CedarOtherPureTypes.CreateCharNode[VAL[BYTE[rep]], cc]];

EXITS

unknownAddress => RETURN UnimplementedTypeNode[CCTypes.GetTargetTypeOfIndirect[indirectType], rmtw, "bad address"];

};

Cedar Numeric Types

NumType: TYPE ~ REF NumTypePrivate;

NumTypePrivate: TYPE ~ RECORD [rmtw: RemoteMimosaTargetWorld, desc: CNTD];

AnalyzeCedarNumericSEH: PROC[seh: SEH, ser: SER, cons: REF cons MA.BodySE, rmtw: RemoteMimosaTargetWorld] RETURNS[Type] = {

Anal: PROC[desc: CNTD] RETURNS[Type]

= {RETURN AnalCntd[rmtw, desc]};

WITH cons.typeInfo SELECT FROM

ti: REF real MA.TypeInfoConsSE => RETURN Anal[[ti.length, real[]]];

ti: REF signed MA.TypeInfoConsSE => RETURN Anal[[ti.length, signed[full[]]]];

ti: REF unsigned MA.TypeInfoConsSE => RETURN Anal[[ti.length, unsigned[full[]]]];

ti: REF subrange MA.TypeInfoConsSE =>

BEGIN

range: Type ¬ AnalyzeSEH[UnderTypeSEH[ti.rangeType, rmtw], rmtw, none];

rangeDesc: REF CNTD ¬ CedarNumericTypes.GetDescriptorFromCedarNumericType[range, rmtw.cc];

nBits: CARD ¬ BitsForRange[ti.range];

IF ti.biased

THEN WITH rangeDesc SELECT FROM

rng: REF full signed CNTD =>

RETURN Anal[[nBits, signed[subRange[ti.origin, ti.origin+ti.range]]]];

rng: REF full unsigned CNTD =>

RETURN Anal[[nBits, unsigned[subRange[ti.origin, ti.origin+ti.range]]]];

ENDCASE => RETURN[AnalyzedUnknownSEH[seh, rmtw, "subrange of unexpected supertype", -1]]

ELSE WITH rangeDesc SELECT FROM

rng: REF full signed CNTD =>

RETURN Anal[[nBits, signed[full[]]]];

rng: REF full unsigned CNTD =>

RETURN Anal[[nBits, unsigned[full[]]]];

ENDCASE => RETURN[AnalyzedUnknownSEH[seh, rmtw, "subrange of unexpected supertype", -1]];

END;

ENDCASE => CCE[cirioError]; -- shouldn't happen

};

AnalCntd: PROC[rmtw: RemoteMimosaTargetWorld, desc: CNTD] RETURNS[Type] = {

bti: BasicTypeInfo ~ NEW [BasicTypeInfoPrivate ¬ [NumericCreateIndirect, NumericBitSize, NEW[NumTypePrivate ¬ [rmtw, desc]] ]];

IF desc.nBits>32 THEN RETURN[AnalyzedUnknownSEH[NIL, rmtw, IO.PutFR1["number of unexpected length (%g)", [rope[CedarNumericTypes.NDFormat[desc]]] ], desc.nBits]];

RETURN CedarNumericTypes.CreateNumericType[desc, rmtw.cc, bti]};

NumericBitSize: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type] RETURNS[CARD] = {

nt: NumType ~ NARROW[bti.btiData];

RETURN[nt.desc.nBits]};

NumericCreateIndirect: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type, mem: Mem] RETURNS[Node] = {

nt: NumType ¬ NARROW[bti.btiData];

nodeData: REF NumericNodeData ¬ NEW[NumericNodeData ¬ [nt, mem]];

RETURN[CedarCode.CreateCedarNode[NumericOps, indirectType, nodeData]]};

NumericNodeData: TYPE = RECORD[

nt: NumType,

mem: Mem];

NumericOps: REF CedarCode.OperationsBody ¬ NEW[CedarCode.OperationsBody¬[

unaryOp: NumericUnaryOp,

store: NumericStore,

load: NumericLoad]];

NumericUnaryOp: PROC[op: Operator, type: Type, node: Node, cc: CC] RETURNS[Node] = {

nodeData: REF NumericNodeData ¬ NARROW[CedarCode.GetDataFromNode[node]];

IF op # $address THEN CCE[cirioError];

RETURN ConvertFromIndirectToPointer[node, nodeData.mem, nodeData.nt.rmtw]};

NumericStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] = {

nodeData: REF NumericNodeData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];

mem: Mem ¬ nodeData.mem;

rmtw: RemoteMimosaTargetWorld ¬ nodeData.nt.rmtw;

rep: REF ANY ¬ CedarCode.GetNodeRepresentation[valNode, cc];

fieldSizeBa: BitAddr ¬ mem.MemGetSize;

fieldSize: INT ¬ fieldSizeBa.BaToBits; -- INT to avoid signed/unsigned ambiguity for comparisons with desc.nBits which is an INT

IF fieldSize>32 THEN CCE[cirioError, "not ready for >32-bit numbers"];

WITH nodeData.nt.desc SELECT FROM

desc: real CedarNumericTypes.NumericDescriptor => {

val: REAL ¬ (NARROW[rep, REF REAL]);

bits: CARD ¬ LOOPHOLE[val];

IF fieldSize # 32 THEN CCE[cirioError];

mem.MemWrite[bits, 32, zeroBA];

};

hmm, should I do sign extension if the fieldSize > desc.nBits?

desc: full signed CedarNumericTypes.NumericDescriptor => {

val: INT ¬ (NARROW[rep, REF INT]);

bits: CARD ¬ LOOPHOLE[val];

IF fieldSize < desc.nBits THEN CCE[cirioError];

mem.MemWrite[bits, fieldSize, zeroBA];

};

hmm, should I do sign extension if the fieldSize > desc.nBits?

I assume any val reaching this point is known to be in range.

desc: subRange signed CedarNumericTypes.NumericDescriptor => {

val: INT ¬ (NARROW[rep, REF INT]);

biasedVal: INT ¬ val-desc.bottom;

bits: CARD ¬ LOOPHOLE[biasedVal];

IF fieldSize < desc.nBits THEN CCE[cirioError];

mem.MemWrite[bits, fieldSize, zeroBA];

};

desc: full unsigned CedarNumericTypes.NumericDescriptor => {

val: CARD ¬ (NARROW[rep, REF CARD]);

bits: CARD ¬ val;

IF fieldSize < desc.nBits THEN CCE[cirioError];

mem.MemWrite[bits, fieldSize, zeroBA];

};

desc: subRange unsigned CedarNumericTypes.NumericDescriptor => {

val: CARD ¬ (NARROW[rep, REF CARD]);

biasedVal: CARD ¬ val-desc.bottom;

bits: CARD ¬ biasedVal;

IF fieldSize < desc.nBits THEN CCE[cirioError];

mem.MemWrite[bits, fieldSize, zeroBA];

};

ENDCASE => CCE[cirioError];

};

Note: subrange types need to be fixed to correctly compute the actual bit size of the representation. Currently they use a value in the descriptor that describes the supertype.

NumericLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] ={

targetType: Type ~ CCTypes.GetTargetTypeOfIndirect[indirectType];

nodeData: REF NumericNodeData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];

mem: Mem ¬ nodeData.mem;

rmtw: RemoteMimosaTargetWorld ¬ nodeData.nt.rmtw;

rep: REF ANY;

errMsg: Rope.ROPE ¬ NIL;

fieldSizeBa: BitAddr ¬ mem.MemGetSize;

fieldSize: INT ¬ IF fieldSizeBa = unspecdBA THEN nodeData.nt.desc.nBits ELSE fieldSizeBa.BaToBits;

IF fieldSize>32 THEN CCE[cirioError, "not ready to load >32-bit numbers yet"];

{

ENABLE {

CirioNubAccess.RemoteAddrFault => {errMsg ¬ IO.PutFR["CirioNubAccess.RemoteAddrFault[byteAddress: %x, valid: %g]", [integer[addr.byteAddress]], [boolean[addr.valid]] ]; GOTO unknownAddress};

CCE => {errMsg ¬ msg; GOTO unknownAddress};

};

WITH nodeData.nt.desc SELECT FROM

desc: real CedarNumericTypes.NumericDescriptor => {

bits: CARD ¬ mem.MemRead[fieldSize, zeroBA];

TRUSTED{rep ¬ NEW[REAL ¬ LOOPHOLE[bits, REAL]]};

};

desc: full signed CedarNumericTypes.NumericDescriptor => {

SignExtend: PROC [value: CARD, nBits: INT] RETURNS [CARD]

= TRUSTED MACHINE CODE {

"*#define RCTWAtomics←SignExtend(x, y) (((int)(x) << (y)) >> (y)).RCTWAtomics←SignExtend"

};

bitOffset: INT ~ fieldSize-desc.nBits;

bits: CARD ¬ mem.MemRead[desc.nBits, CirioTypes.BitsToBa[bitOffset]];

TRUSTED {

bits ¬ SignExtend[bits, 32-desc.nBits];

rep ¬ NEW[INT ¬ LOOPHOLE[bits, INT]];

};

desc: subRange signed CedarNumericTypes.NumericDescriptor => {

bitOffset: INT ~ fieldSize-desc.nBits;

bits: CARD ¬ mem.MemRead[desc.nBits, CirioTypes.BitsToBa[bitOffset]];

TRUSTED{rep ¬ NEW[INT ¬ LOOPHOLE[bits, INT]+desc.bottom]};

};

desc: full unsigned CedarNumericTypes.NumericDescriptor => {

bitOffset: INT ~ fieldSize-desc.nBits;

bits: CARD ¬ mem.MemRead[desc.nBits, CirioTypes.BitsToBa[bitOffset]];

rep ¬ NEW[CARD ¬ bits];

};

desc: subRange unsigned CedarNumericTypes.NumericDescriptor => {

bitOffset: INT ~ fieldSize-desc.nBits;

bits: CARD ¬ mem.MemRead[desc.nBits, CirioTypes.BitsToBa[bitOffset]];

rep ¬ NEW[CARD ¬ bits+desc.bottom];

};

ENDCASE => GOTO unknown;

RETURN[CedarNumericTypes.CreateNumericNode[targetType, rep]];

EXITS

unknown => RETURN[UnimplementedTypeNode[targetType, rmtw, errMsg]];

unknownAddress => RETURN[UnimplementedTypeNode[targetType, rmtw, errMsg]];

}

};

Enumerated Types

AnalyzedEnumeratedSEHPrivate: TYPE = REF AnalyzedEnumeratedSEHPrivateBody;

AnalyzedEnumeratedSEHPrivateBody: TYPE = RECORD[

rmtw: RemoteMimosaTargetWorld,

seh: SEH,

ti: REF enumerated MA.TypeInfoConsSE,

range: CARD, -- there are range + 1 values

bitSize: CARD,

indexToItem: CardTab.Ref,

nameToItem: SymTab.Ref,

type: Type

];

EnumItem: TYPE = RECORD[name: Rope.ROPE, value: CARD];

We shall implement with two hash tables. If the values are dense, one could use an array for the map from index to name. Perhaps I shall add that later. (dense means nItems/range is not too small, I will ignore the sparse flag in ti.)

AnalyzeEnumeratedSEH: PROC[seh: SEH, ser: SER, cons: REF cons MA.BodySE, ti: REF enumerated MA.TypeInfoConsSE, rmtw: RemoteMimosaTargetWorld] RETURNS[Type] = {

values: LIST OF EnumItem ¬ NIL;

nItems: CARD ¬ 0;

indexToItem: CardTab.Ref ¬ CardTab.Create[];

nameToItem: SymTab.Ref ¬ SymTab.Create[];

private: AnalyzedEnumeratedSEHPrivate ¬ NEW[AnalyzedEnumeratedSEHPrivateBody¬[

rmtw: rmtw,

seh: seh,

ti: ti,

range: ti.range,

bitSize: IF ti.empty THEN 0 ELSE BitsForRange[ti.range],

indexToItem: indexToItem,

nameToItem: nameToItem]];

here is where we construct the list of values

{

ctx: CTXH;

ctxr: CTXR;

itemSeh: SEH;

[ctx, ctxr] ¬ GetCompleteContext[ti.valueCtx, rmtw];

itemSeh ¬ ctxr.seList;

itemSer: MA.SER ¬ MA.FetchSER[itemSeh];

nItems ¬ nItems+1;

WITH itemSer.body SELECT FROM

id: REF id MA.BodySE => {

value: REF MA.ConstVal ¬ NARROW[id.idInfoAndValue];

values ¬ CONS[[id.hash, value.value], values];

IF id.ctxLink = NIL THEN EXIT ELSE itemSeh ¬ id.ctxLink;

};

ENDCASE => CCE[cirioError];

ENDLOOP;

};

now we can fill the two hash tables

FOR vs: LIST OF EnumItem ¬ values, vs.rest WHILE vs # NIL DO

item: REF EnumItem ¬ NEW[EnumItem ¬ vs.first];

IF NOT CardTab.Store[indexToItem, item.value, item] THEN CCE[cirioError];

IF NOT SymTab.Store[nameToItem, item.name, item] THEN CCE[cirioError];

ENDLOOP;

private.type ¬ CedarOtherPureTypes.CreateEnumeratedType[ti.range+1, EnumTypeProcs, private, rmtw.cc];

RETURN[private.type]};

QUESTION: This is used by the variant records code to obtain the name of the variant record tag index. Should there be a CedarCode.Operation that is like AsIndex, but returns the Name instead? (E.g. AsName?) -- Theimer, November 29, 1989 0:36:12 am PST

EnumeratedTypeIndexToName: PUBLIC PROC [type: Type, index: INT, cc: CC] RETURNS [Rope.ROPE] = {

private: AnalyzedEnumeratedSEHPrivate ¬ NARROW[CCTypes.GetTypeRepresentation[type, cc]];

RETURN[EnumIndexToId[index, private]]};

EnumTypeProcs: REF CedarOtherPureTypes.EnumeratedTypeProcs ¬ NEW[CedarOtherPureTypes.EnumeratedTypeProcs ¬ [

createIndirectNode: EnumeratedCreateIndirect,

getBitSize: EnumeratedBitSize,

getPaint: EnumGetPaint,

comparePaint: EnumComparePaint,

idToIndex: EnumIdToIndex,

indexToId: EnumIndexToId]];

EnumGetPaint: PROC[procsData: REF ANY] RETURNS[REF ANY] ={

private: AnalyzedEnumeratedSEHPrivate ¬ NARROW[procsData];

IF private.ti.painted THEN RETURN[private] ELSE RETURN[NIL]};

EnumComparePaint: PROC[procsData: REF ANY, otherPaint: REF ANY] RETURNS[BOOLEAN] = {

private: AnalyzedEnumeratedSEHPrivate ¬ NARROW[procsData];

IF otherPaint = NIL THEN CCE[cirioError]; -- we shouldn't be called in this situation

WITH otherPaint SELECT FROM

other: AnalyzedEnumeratedSEHPrivate => RETURN[private.seh = other.seh];

ENDCASE => RETURN[FALSE];

};

EnumIdToIndex: PROC[id: Rope.ROPE, procsData: REF ANY] RETURNS[INT] = {

private: AnalyzedEnumeratedSEHPrivate ¬ NARROW[procsData];

item: REF EnumItem ¬ NARROW[SymTab.Fetch[private.nameToItem, id].val];

IF item # NIL THEN RETURN[item.value] ELSE RETURN[private.range+1];

not sure what to return if the id is not known

};

EnumIndexToId: PROC[index: INT, procsData: REF ANY] RETURNS[Rope.ROPE] = {

private: AnalyzedEnumeratedSEHPrivate ¬ NARROW[procsData];

item: REF EnumItem ¬ NARROW[CardTab.Fetch[private.indexToItem, index].val];

IF item # NIL THEN RETURN[item.name] ELSE RETURN[NIL];

};

EnumeratedBitSize: PROC[procsData: REF ANY, cc: CC, indirectType, targetType: Type] RETURNS[CARD] = {

private: AnalyzedEnumeratedSEHPrivate ¬ NARROW[procsData];

RETURN[private.bitSize];

};

EnumeratedCreateIndirect: PROC[procsData: REF ANY, cc: CC, indirectType, targetType: Type, mem: Mem] RETURNS[Node] = {

private: AnalyzedEnumeratedSEHPrivate ¬ NARROW[procsData];

nodeData: REF EnumeratedNodeData ¬ NEW[EnumeratedNodeData ¬ [private, mem]];

RETURN CedarCode.CreateCedarNode[EnumOps, indirectType, nodeData]};

EnumeratedNodeData: TYPE = RECORD[

private: AnalyzedEnumeratedSEHPrivate,

mem: Mem];

EnumOps: REF CedarCode.OperationsBody ¬ NEW[CedarCode.OperationsBody¬[

unaryOp: EnumUnaryOp,

store: EnumStore,

load: EnumLoad]];

EnumUnaryOp: PROC[op: Operator, type: Type, node: Node, cc: CC] RETURNS[Node] = {

nodeData: REF EnumeratedNodeData ¬ NARROW[CedarCode.GetDataFromNode[node]];

rmtw: RemoteMimosaTargetWorld ¬ nodeData.private.rmtw;

mem: Mem ¬ nodeData.mem;

IF op # $address THEN CCE[cirioError];

RETURN ConvertFromIndirectToPointer[node, mem, rmtw]};

EnumStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] = {

nodeData: REF EnumeratedNodeData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];

mem: Mem ¬ nodeData.mem;

rmtw: RemoteMimosaTargetWorld ¬ nodeData.private.rmtw;

fieldSize: CARD ¬ mem.MemGetSize.BaToBits;

neededBits: CARD ¬ nodeData.private.bitSize;

rep: REF CARD ¬ NARROW[CedarCode.GetNodeRepresentation[valNode, cc]];

bits: CARD ¬ rep;

IF neededBits > fieldSize THEN CCE[cirioError];

mem.MemWrite[bits, fieldSize, zeroBA];

RETURN};

EnumLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] =

BEGIN

nodeData: REF EnumeratedNodeData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];

mem: Mem ¬ nodeData.mem;

rmtw: RemoteMimosaTargetWorld ¬ nodeData.private.rmtw;

errMsg: Rope.ROPE ¬ NIL;

we nest a block to handle unknown address, allowing nodeData and msg to be visible

BEGIN

ENABLE {

CirioNubAccess.RemoteAddrFault => {errMsg ¬ IO.PutFR["CirioNubAccess.RemoteAddrFault[byteAddress: %x, valid: %g]", [cardinal[LOOPHOLE[addr.byteAddress]]], [boolean[addr.valid]] ]; GOTO unknownAddress};

CCE => {errMsg ¬ msg; GOTO unknownAddress}

};

allocdBits: INT ¬ mem.MemGetSize.BaToBits;

neededBits: INT ¬ nodeData.private.bitSize;

bitOffset: BitAddr ¬ CirioTypes.BitsToBa[allocdBits-neededBits];

rep: CARD ¬ mem.MemRead[neededBits, bitOffset];

item: REF EnumItem ¬ NARROW[CardTab.Fetch[nodeData.private.indexToItem, rep].val];

IF item # NIL THEN

RETURN[CedarOtherPureTypes.CreateEnumeratedTypeNode[nodeData.private.type, item.name, cc]]

ELSE

BEGIN -- really should return a funny value, in any case I shouldn't be creating an indirect

expl: Rope.ROPE ~ Convert.RopeFromCard[rep];

unknownType: CirioTypes.Type ¬ CedarOtherPureTypes.CreateUnknownType[cc, expl];

RETURN[CedarOtherPureTypes.CreateUnknownTypeNode[unknownType, expl, cc]]

END;

EXITS

unknownAddress => RETURN[UnimplementedTypeNode[indirectType, rmtw, errMsg]];

END;

FmtStamp: PROC [vs: MobDefs.VersionStamp] RETURNS [Rope.ROPE]

~ {RETURN IO.PutFR["%08x%08x", [cardinal[vs[0]]], [cardinal[vs[1]]]]};

FmtSeh: PUBLIC PROC [seh: MA.SEH, name: Rope.ROPE] RETURNS [Rope.ROPE] ~ {

mc: MA.MobCookie ~ MA.GetMobForSEH[seh];

cf: SystemInterface.CirioFile ~ MA.GetFileForMobCookie[mc];

fn: PFSNames.PATH ~ SystemInterface.GetNameOfFile[cf];

sei: CARD ~ LOOPHOLE[MA.GetSeiForSEH[seh]];

RETURN IO.PutFR["%g(%x) in %g", [rope[name]], [cardinal[sei]], [rope[PFS.RopeFromPath[fn]]] ]};

CantFindMobRope: ROPE ¬ "can't find mob for VS ";

FlushUnknownTypeCodes: PUBLIC PROC [rmtw: RemoteMimosaTargetWorld] ~ {

DeleteUnknownTypes: CardTab.EachPairAction ~ {

EachPairAction: TYPE = PROC [key: Key, val: Val] RETURNS [quit: BOOL ← FALSE];

type: CirioTypes.Type ¬ NIL;

explanation: ROPE ¬ NIL;

IF val # NIL THEN type ¬ NARROW[val];

IF type # NIL THEN class ¬ CCTypes.GetTypeClass[type];

IF type # NIL AND class = $unknown THEN {

explanation ¬ NARROW[CCTypes.GetTypeRepresentation[type, rmtw.cc]];

IF NOT Rope.IsEmpty[explanation] AND Rope.Equal[Rope.Substr[explanation, 0, Rope.Length[CantFindMobRope]], CantFindMobRope] THEN

[] ¬ rmtw.tcHash.Delete[key];

};

RETURN[FALSE];

};

IF rmtw.tcHash # NIL THEN [] ¬ rmtw.tcHash.Pairs[DeleteUnknownTypes];

};

END.