<<>> <> <> <> <> <> <> <> <> <> <> 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; <> <> <> <> <> <> <> <<>> <> <> <> <> <> <> <<>> <<>> <> <> <> <> <<(address should result in converting the indirect to a Pointer)>> <<>> <> <<>> 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; <> <SymbolOpsImpl and [PCedar2.0]SparcParms.mesa.>> <<(the later from [PCedar2.0]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; <> <<>> 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 => { name: CHAR ~ GetChar[tsd.ts, i.SUCC]; 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 => { name: CHAR ~ GetChar[tsd.ts, i.SUCC]; 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 { name: ROPE; 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 => { <> 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; < { <> 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]]; <> {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 { 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}; {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; >> <<>> <> <<>> <> <<>> <> <<>> <> 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; 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]; <> 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]] ]; }; <> <<>> SehHashEntry: TYPE = REF SehHashEntryBody; SehHashEntryBody: TYPE = RECORD[ effectiveSymbolFlushTime: BasicTime.GMT, type: Type ¬ NIL, analysisRunning: BOOLEAN ¬ TRUE<<, mark: SehKnowledge ¬ none>>]; <> CreateSehHashTable: PUBLIC PROC RETURNS[SehHashTable] = {RETURN[NEW[SehHashTableBody ¬ [RefTab.Create[]]]]}; StartSEHAnalInfo: TYPE = RECORD[type: Type, valid: BOOLEAN]; <> <> <> 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 { <> 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; }; <> <<>> <<>> <> <<>> <> <<>> <> 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]; <> 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 <> RETURN[NIL]; RETURN[entry]; END; CheckForSpecialCTX: PROC[ctxh: CTXH, rmtw: RemoteMimosaTargetWorld] RETURNS[CTXInfo] = { <> entry: CTXInfo ¬ GetCTXInfo[ctxh, rmtw]; IF entry = NIL THEN { IF Symbols.FirstStandardCtx = MA.GetCtxForCTXH[ctxh] THEN entry ¬ CreateStandardContextInfo[rmtw] ELSE entry ¬ CreateNormalContextInfo[rmtw]; <> [] ¬ RefTab.Store[rmtw.ctxHash.table, ctxh, entry] }; RETURN[entry]}; <<>> <> <<>> <> <<>> <<>> 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; <<>> <<>> <<>> <> <<>> 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] = { <> RETURN[NormalUnderTypeSEH[seh, ctxInfo.rmtw]]}; StandardContextAnalyzeSEH: PROC[ctxInfo: CTXInfo, seh: SEH, sk: SehKnowledge] RETURNS[Type] = { <> <> 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]}; <<>> <<>> <> 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]]; <<>> <> <<>> <> <<>> 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; <<>> <> BEGIN ENABLE { CirioNubAccess.RemoteAddrFault => GOTO unknownAddress; CCE => GOTO unknownAddress}; <> 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; }; <<>> <> 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]]; <<>> <> fieldSize: BitAddr ¬ mem.MemGetSize[]; <> 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; <<>> <> { 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"]; }; }; <> <<>> 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]; }; < 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]; }; < desc.nBits?>> <> 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]; }; <> 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]]; } }; <> <<>> 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]; <> 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]]; <> { ctx: CTXH; ctxr: CTXR; itemSeh: SEH; [ctx, ctxr] ¬ GetCompleteContext[ti.valueCtx, rmtw]; itemSeh ¬ ctxr.seList; DO 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; }; <> 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]}; <> 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]; <> }; 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; <> 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; 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 ~ { <> type: CirioTypes.Type ¬ NIL; class: CirioTypes.TypeClass; 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.