MobMapperImpl.mesa
Copyright Ó 1988, 1989, 1991 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) November 20, 1989 2:11:27 pm PST
JKF February 22, 1989 2:32:37 pm PST
Willie-s, September 24, 1991 5:18 pm PDT
DIRECTORY
Basics USING [BITLSHIFT, BITRSHIFT, LongNumber, LowHalf],
Literals USING [Base, LTIndex, LTRecord, MSTIndex, STIndex, STRecord],
MobDefs USING [CTIndex, CTRecord, EVIndex, EVRecord, EXPIndex, EXPRecord, FPIndex, FPRecord, FTIndex, FTNull, FTRecord, FTSelf, IMPIndex, IMPRecord, LFIndex, Link, LinkFrag, MobBase, MobOffset, MTIndex, MTRecord, Namee, NameRecord, NTIndex, NTRecord, RefLitFrag, RFIndex, SGIndex, SGRecord, SpaceID, SPIndex, SPRecord, TFIndex, TMIndex, TMRecord, TypeFrag, TYPIndex, TYPRecord, VersionID, VersionStamp],
MobMapper USING [AlterMobResults],
PackageSymbols,
RTMob USING [RefLitItem, RefLitList, RTBase, RTHeader, StampList, TypeItem, TypeList, VersionID],
Symbols,
SymbolSegment USING [biases, BlockDescriptor, bodyType, ExtRecord, ltType, seType, STHeader, stType, treeType],
Table USING [Base, HighBits, IndexRep],
Tree USING [Base, Info, Link, LinkRep, LinkTag, Node, NodeName, NodePtr];
AlterMob:
PUBLIC
PROC [mob: MobBase, base: Base, limit:
CARD]
RETURNS [AlterMobResults] = {
Utility mapping routines
MapCard:
PROC [c:
CARD]
RETURNS [
CARD] =
INLINE {
RETURN [IF swapArith THEN LOOPHOLE[SwapHalves[[card[c]]]] ELSE c];
};
MapInt:
PROC [i:
INT]
RETURNS [
INT] =
INLINE {
RETURN [IF swapArith THEN LOOPHOLE[SwapHalves[[int[i]]]] ELSE i];
};
MapShift:
PROC [c:
CARD]
RETURNS [
CARD] = {
IF
LOOPHOLE[c,
INT] > 0
THEN {
IF rightShiftAddr # 0 THEN c ¬ Basics.BITRSHIFT[c, rightShiftAddr];
IF leftShiftAddr # 0 THEN c ¬ Basics.BITLSHIFT[c, leftShiftAddr];
IF limit # 0 AND c > limit THEN GO TO oops;
IF upc # 1 AND wpc = 1 AND (c MOD upc) # 0 THEN GO TO oops;
IF upc # 1 AND wpc # 1 AND (Basics.LowHalf[c] MOD upc) # 0 THEN GO TO oops;
EXITS oops => ERROR BadMobContents;
};
RETURN [c];
};
MapShiftUnchecked:
PROC [c:
CARD]
RETURNS [
CARD] = {
IF
LOOPHOLE[c,
INT] > 0
THEN {
IF rightShiftAddr # 0 THEN c ¬ Basics.BITRSHIFT[c, rightShiftAddr];
IF leftShiftAddr # 0 THEN c ¬ Basics.BITLSHIFT[c, leftShiftAddr];
};
RETURN [c];
};
MapMobOffset:
PROC [off: MobOffset]
RETURNS [MobOffset] = {
RETURN [LOOPHOLE[MapShift[MapCard[LOOPHOLE[off]]]]];
};
MapRel:
PROC [rp: RelAddr]
RETURNS [RelAddr] = {
RETURN [LOOPHOLE[MapShift[MapCard[LOOPHOLE[rp]]]]];
};
MapFTRel:
PROC [fti: MobDefs.FTIndex]
RETURNS [MobDefs.FTIndex] = {
new: MobDefs.FTIndex ¬ LOOPHOLE[MapShift[MapCard[LOOPHOLE[fti]]]];
IF
LOOPHOLE[new,
INT] < 0
THEN {
Due to ancient definitions of
MobDefs.FTSelf = MobDefs.FTNull - BYTE.SIZE
we do a very forgiving translation here
z: NAT = WORDS[WORD];
<< Workaround for mimosa bug:
SELECT new
FROM
MobDefs.FTNull => {};
MobDefs.FTNull-1*z, MobDefs.FTNull-2*z, MobDefs.FTNull-4*z =>
new ¬ MobDefs.FTSelf;
ENDCASE => ERROR BadMobContents;
>>
ftNull: CARD ¬ LOOPHOLE[MobDefs.FTNull];
nnew: CARD ¬ LOOPHOLE[new];
SELECT nnew
FROM
ftNull => {};
ftNull-1*z, ftNull-2*z, ftNull-4*z => new ¬ MobDefs.FTSelf;
ENDCASE => ERROR BadMobContents;
};
RETURN [new];
};
MapNameRecord:
PROC [name: MobDefs.NameRecord]
RETURNS [MobDefs.NameRecord] = {
RETURN [ [MapInt[name]] ];
};
AlterVersion:
PROC [vp:
LONG
POINTER
TO MobDefs.VersionStamp] = {
vp[0] ¬ MapCard[vp[0]];
vp[1] ¬ MapCard[vp[1]];
};
swapArith: BOOL ¬ FALSE;
rightShiftAddr: ShiftDist ¬ 0;
leftShiftAddr: ShiftDist ¬ 0;
SELECT
TRUE
FROM
mob.mappingStarted => {
This file has already been mapped
IF mob.versionIdent # MobDefs.VersionID THEN RETURN [badVersion];
IF NOT mob.mappingFinished THEN RETURN [badVersion];
RETURN [noop];
};
BITS[
WORD] = 32
AND
BITS[
UNIT] = 8
AND mob.format.bitsPerWord[0] = 32
AND mob.format.bitsPerUnit[0] = 8 => {
IF mob.versionIdent # MobDefs.VersionID THEN RETURN [badVersion];
IF mob.format.sign # FIRST[INT] THEN RETURN [badVersion];
IF NOT debugIdentity THEN RETURN [noop];
};
BITS[
WORD] = 16
AND
BITS[
UNIT] = 16
AND mob.format.bitsPerWord[0] = 16
AND mob.format.bitsPerUnit[0] = 16 => {
IF mob.versionIdent # MobDefs.VersionID THEN RETURN [badVersion];
IF mob.format.sign # FIRST[INT] THEN RETURN [badVersion];
IF NOT debugIdentity THEN RETURN [noop];
};
BITS[
WORD] = 16
AND
BITS[
UNIT] = 16
AND mob.format.bitsPerWord[0] = 32
AND mob.format.bitsPerUnit[0] = 8 => {
rightShiftAddr ¬ 1;
IF mob.format.sign # FIRST[INT] THEN swapArith ¬ TRUE;
};
BITS[
WORD] = 32
AND
BITS[
UNIT] = 8
AND mob.format.bitsPerWord[0] = 16
AND mob.format.bitsPerUnit[0] = 16 => {
leftShiftAddr ¬ 1;
IF mob.format.sign # FIRST[INT] THEN swapArith ¬ TRUE;
};
ENDCASE => RETURN [badVersion];
IF MapInt[mob.versionIdent] # MobDefs.VersionID THEN RETURN [badVersion];
IF mob.format.bytes # [0, 1, 2, 3] THEN ERROR BadMobContents;
IF mob.format.halves # [0, 1] THEN ERROR BadMobContents;
mob.mappingStarted ¬
TRUE;
Show that we have tried to make this work
Translate and verify the header
mob.versionIdent ¬ MapInt[mob.versionIdent];
AlterVersion[@mob.version];
AlterVersion[@mob.creator];
AlterVersion[@mob.sourceVersion];
mob.source ¬ MapNameRecord[mob.source];
mob.nBytes ¬ MapInt[mob.nBytes];
mob.ssOffset ¬ MapMobOffset[mob.ssOffset];
mob.ssLimit ¬ MapMobOffset[mob.ssLimit];
mob.ctOffset ¬ MapMobOffset[mob.ctOffset];
mob.ctLimit ¬ MapRel[mob.ctLimit];
mob.mtOffset ¬ MapMobOffset[mob.mtOffset];
mob.mtLimit ¬ MapRel[mob.mtLimit];
mob.impOffset ¬ MapMobOffset[mob.impOffset];
mob.impLimit ¬ MapRel[mob.impLimit];
mob.expOffset ¬ MapMobOffset[mob.expOffset];
mob.expLimit ¬ MapRel[mob.expLimit];
mob.evOffset ¬ MapMobOffset[mob.evOffset];
mob.evLimit ¬ MapRel[mob.evLimit];
mob.sgOffset ¬ MapMobOffset[mob.sgOffset];
mob.sgLimit ¬ MapRel[mob.sgLimit];
mob.ftOffset ¬ MapMobOffset[mob.ftOffset];
mob.ftLimit ¬ MapRel[mob.ftLimit];
mob.spOffset ¬ MapMobOffset[mob.spOffset];
mob.spLimit ¬ MapRel[mob.spLimit];
mob.ntOffset ¬ MapMobOffset[mob.ntOffset];
mob.ntLimit ¬ MapRel[mob.ntLimit];
mob.typOffset ¬ MapMobOffset[mob.typOffset];
mob.typLimit ¬ MapRel[mob.typLimit];
mob.tmOffset ¬ MapMobOffset[mob.tmOffset];
mob.tmLimit ¬ MapRel[mob.tmLimit];
mob.fpOffset ¬ MapMobOffset[mob.fpOffset];
mob.fpLimit ¬ MapRel[mob.fpLimit];
mob.lfOffset ¬ MapMobOffset[mob.lfOffset];
mob.lfLimit ¬ MapRel[mob.lfLimit];
mob.rfOffset ¬ MapMobOffset[mob.rfOffset];
mob.rfLimit ¬ MapRel[mob.rfLimit];
mob.tfOffset ¬ MapMobOffset[mob.tfOffset];
mob.tfLimit ¬ MapRel[mob.tfLimit];
IF mob.rtLimit.units # 0 THEN {
mob.rtOffset ¬ MapMobOffset[mob.rtOffset];
mob.rtLimit ¬ MapMobOffset[mob.rtLimit];
};
ssOffset: no string table fixup needed
{
ctOffset: config table fixup needed
ctb: Base ¬ base + mob.ctOffset.units;
cti: MobDefs.CTIndex ¬ MobDefs.CTIndex.FIRST;
WHILE cti # mob.ctLimit
DO
ctp: LONG POINTER TO MobDefs.CTRecord = @ctb[cti];
ctp.name ¬ MapNameRecord[ctp.name];
ctp.file ¬ MapFTRel[ctp.file];
ctp.config ¬ MapRel[ctp.config];
FOR i:
NAT
IN [0..ctp.nControls)
DO
ptr: LONG POINTER TO RelAddr = LOOPHOLE[@ctp[i]
+ (SIZE[MobDefs.Namee] - SIZE[RelAddr])];
ptr ¬ MapRel[ptr];
ENDLOOP;
cti ¬ cti + SIZE[MobDefs.CTRecord[ctp.nControls]];
ENDLOOP;
};
{
mtOffset: module table fixup needed
mtb: Base ¬ base + mob.mtOffset.units;
FOR mti: MobDefs.MTIndex ¬ MobDefs.MTIndex.
FIRST, mti+MobDefs.MTRecord.
SIZE
WHILE mti # mob.mtLimit
DO
mtp: LONG POINTER TO MobDefs.MTRecord = @mtb[mti];
mtp.name ¬ MapNameRecord[mtp.name];
mtp.file ¬ MapFTRel[mtp.file];
mtp.config ¬ MapRel[mtp.config];
mtp.code.sgi ¬ MapRel[mtp.code.sgi];
mtp.code.offset ¬ MapInt[mtp.code.offset];
mtp.code.length ¬ MapInt[mtp.code.length];
mtp.sseg ¬ MapRel[mtp.sseg];
mtp.links ¬ MapRel[mtp.links];
mtp.refLiterals ¬ MapRel[mtp.refLiterals];
mtp.types ¬ MapRel[mtp.types];
mtp.frameType ¬ [MapInt[mtp.frameType]];
mtp.framesize ¬ MapCard[mtp.framesize];
mtp.variables ¬ MapRel[mtp.variables];
ENDLOOP;
};
{
impOffset: import table fixup needed
impb: Base ¬ base + mob.impOffset.units;
FOR impi: MobDefs.IMPIndex
¬ MobDefs.IMPIndex.
FIRST, impi+MobDefs.IMPRecord.
SIZE
WHILE impi # mob.impLimit
DO
impp: LONG POINTER TO MobDefs.IMPRecord = @impb[impi];
impp.name ¬ MapNameRecord[impp.name];
impp.file ¬ MapFTRel[impp.file];
ENDLOOP;
};
{
expOffset: export table fixup needed
expb: Base ¬ base + mob.expOffset.units;
expi: MobDefs.EXPIndex ¬ MobDefs.EXPIndex.FIRST;
WHILE expi # mob.expLimit
DO
expp: LONG POINTER TO MobDefs.EXPRecord = @expb[expi];
expp.name ¬ MapNameRecord[expp.name];
expp.file ¬ MapFTRel[expp.file];
expi ¬ expi + SIZE[MobDefs.EXPRecord[expp.nLinks]];
ENDLOOP;
};
{
evOffset: external variable table fixup needed
evb: Base ¬ base + mob.evOffset.units;
evi: MobDefs.EVIndex ¬ MobDefs.EVIndex.FIRST;
WHILE evi # mob.evLimit
DO
evp: LONG POINTER TO MobDefs.EVRecord = @evb[evi];
FOR i:
NAT
IN [1..evp.length]
DO
evp.offsets[i] ¬ MapCard[evp.offsets[i]];
ENDLOOP;
evi ¬ evi + SIZE[MobDefs.EVRecord[evp.length]];
ENDLOOP;
};
{
sgOffset: segment table fixup needed
sgb: Base ¬ base + mob.sgOffset.units;
FOR sgi: MobDefs.SGIndex ¬ MobDefs.SGIndex.
FIRST, sgi+MobDefs.SGRecord.
SIZE
WHILE sgi # mob.sgLimit
DO
sgp: LONG POINTER TO MobDefs.SGRecord = @sgb[sgi];
oldLimit: CARD;
sgp.file ¬ MapFTRel[sgp.file];
oldLimit ¬ limit; -- a hack to work around the fact that Cinder .mob point to
limit ¬ 0; -- segments in other files.
sgp.base ¬ MapMobOffset[sgp.base];
sgp.units ¬ MapMobOffset[sgp.units];
sgp.extraUnits ¬ MapMobOffset[sgp.extraUnits];
limit ¬ oldLimit;
ENDLOOP;
};
{
ftOffset: file table fixup needed
ftb: Base ¬ base + mob.ftOffset.units;
FOR fti: MobDefs.FTIndex ¬ MobDefs.FTIndex.
FIRST, fti+MobDefs.FTRecord.
SIZE
WHILE fti # mob.ftLimit
DO
ftp: LONG POINTER TO MobDefs.FTRecord = @ftb[fti];
ftp.name ¬ MapNameRecord[ftp.name];
AlterVersion[@ftp.version];
ENDLOOP;
};
{
spOffset: space table fixup needed
spb: Base ¬ base + mob.spOffset.units;
spi: MobDefs.SPIndex ¬ MobDefs.SPIndex.FIRST;
WHILE spi # mob.spLimit
DO
spp: LONG POINTER TO MobDefs.SPRecord = @spb[spi];
spp.seg ¬ MapRel[spp.seg];
spp.name ¬ MapNameRecord[spp.name];
FOR i:
NAT
IN [0..spp.length)
DO
spacePtr: LONG POINTER TO MobDefs.SpaceID = @spp.spaces[i];
spacePtr.name ¬ MapNameRecord[spacePtr.name];
ENDLOOP;
spi ¬ spi + SIZE[MobDefs.SPRecord[spp.length]];
ENDLOOP;
};
{
ntOffset: name table fixup needed
ntb: Base ¬ base + mob.ntOffset.units;
FOR nti: MobDefs.NTIndex ¬ MobDefs.NTIndex.
FIRST, nti+MobDefs.NTRecord.
SIZE
WHILE nti # mob.ntLimit
DO
ntp: LONG POINTER TO MobDefs.NTRecord = @ntb[nti];
ptr: LONG POINTER TO RelAddr =
LOOPHOLE[ntp + (SIZE[MobDefs.NTRecord] - SIZE[RelAddr])];
ptr ¬ MapRel[ptr];
ENDLOOP;
};
{
typOffset: type table fixup needed
typb: Base ¬ base + mob.typOffset.units;
FOR typi: MobDefs.TYPIndex ¬ MobDefs.TYPIndex.
FIRST, typi+MobDefs.TYPRecord.
SIZE
WHILE typi # mob.typLimit
DO
typp: LONG POINTER TO MobDefs.TYPRecord = @typb[typi];
typp.version[0] ¬ MapCard[typp.version[0]];
typp.version[1] ¬ MapCard[typp.version[1]];
typp.id ¬ MapInt[typp.id];
ENDLOOP;
};
{
tmOffset: type map table fixup needed
tmb: Base ¬ base + mob.tmOffset.units;
FOR tmi: MobDefs.TMIndex ¬ MobDefs.TMIndex.
FIRST, tmi+MobDefs.TMRecord.
SIZE
WHILE tmi # mob.tmLimit
DO
tmp: LONG POINTER TO MobDefs.TMRecord = @tmb[tmi];
tmp.version[0] ¬ MapCard[tmp.version[0]];
tmp.version[1] ¬ MapCard[tmp.version[1]];
tmp.offset ¬ MapInt[tmp.offset];
tmp.map ¬ MapRel[tmp.map];
ENDLOOP;
};
{
fpOffset: frame pack table fixup needed
fpb: Base ¬ base + mob.fpOffset.units;
fpi: MobDefs.FPIndex ¬ MobDefs.FPIndex.FIRST;
WHILE fpi # mob.fpLimit
DO
fpp: LONG POINTER TO MobDefs.FPRecord = @fpb[fpi];
fpp.name ¬ MapNameRecord[fpp.name];
FOR i:
NAT
IN [0..fpp.length)
DO
fpp.modules[i] ¬ MapRel[fpp.modules[i]];
ENDLOOP;
fpi ¬ fpi + SIZE[MobDefs.FPRecord[fpp.length]];
ENDLOOP;
};
{
lfOffset: link fragment table fixup needed
lfb: Base ¬ base + mob.lfOffset.units;
lfi: MobDefs.LFIndex ¬ MobDefs.LFIndex.FIRST;
WHILE lfi # mob.lfLimit
DO
lfp: LONG POINTER TO MobDefs.LinkFrag = @lfb[lfi];
No fixup for these fields
lfi ¬ lfi + SIZE[MobDefs.LinkFrag[lfp.length]];
ENDLOOP;
};
{
rfOffset: ref literal fragment table fixup needed
rfb: Base ¬ base + mob.rfOffset.units;
rfi: MobDefs.RFIndex ¬ MobDefs.RFIndex.FIRST;
WHILE rfi # mob.rfLimit
DO
rfp: LONG POINTER TO MobDefs.RefLitFrag = @rfb[rfi];
FOR i:
NAT
IN [0..rfp.length)
DO
rfp.frag[i] ¬ [MapInt[rfp.frag[i]]];
ENDLOOP;
rfi ¬ rfi + SIZE[MobDefs.RefLitFrag[rfp.length]];
ENDLOOP;
};
{
tfOffset: type fragment table fixup needed
tfb: Base ¬ base + mob.tfOffset.units;
tfi: MobDefs.TFIndex ¬ MobDefs.TFIndex.FIRST;
WHILE tfi # mob.tfLimit
DO
tfp: LONG POINTER TO MobDefs.TypeFrag = @tfb[tfi];
FOR i:
NAT
IN [0..tfp.length)
DO
tfp.frag[i] ¬ [MapInt[tfp.frag[i]]];
ENDLOOP;
tfi ¬ tfi + SIZE[MobDefs.TypeFrag[tfp.length]];
ENDLOOP;
};
rtOffset: (atom print names, etc.) fixup needed
IF mob.rtLimit.units # 0
THEN {
rtb: RTMob.RTBase = LOOPHOLE[base+mob.rtOffset.units];
AlterRTMob[rtb, swapArith, rightShiftAddr, leftShiftAddr, limit];
};
{
Finally, take care of the symbols (each SGRecord is already mapped)
sgb: Base ¬ base + mob.sgOffset.units;
FOR sgi: MobDefs.SGIndex ¬ MobDefs.SGIndex.
FIRST, sgi+MobDefs.SGRecord.
SIZE
WHILE sgi # mob.sgLimit
DO
sgp: LONG POINTER TO MobDefs.SGRecord = @sgb[sgi];
IF sgp.class = symbols
THEN {
IF sgp.file = MobDefs.FTSelf
THEN {
sgh: SGPointer ¬ LOOPHOLE[base+sgp.base.units];
AlterSymbols[sgh, swapArith, rightShiftAddr, leftShiftAddr, limit];
};
};
ENDLOOP;
};
mob.mappingFinished ¬ TRUE;
RETURN [altered];
};
AlterSymbols:
PROC [
sgh: SGPointer, swapArith:
BOOL,
rightShiftAddr: ShiftDist, leftShiftAddr: ShiftDist, limit:
CARD] = {
Utility mapping routines
MapCard:
PROC [c:
CARD]
RETURNS [
CARD] =
INLINE {
RETURN [IF swapArith THEN LOOPHOLE[SwapHalves[[card[c]]]] ELSE c];
};
MapInt:
PROC [i:
INT]
RETURNS [
INT] =
INLINE {
RETURN [IF swapArith THEN LOOPHOLE[SwapHalves[[int[i]]]] ELSE i];
};
MapShift:
PROC [c:
CARD]
RETURNS [
CARD] = {
IF
LOOPHOLE[c,
INT] > 0
THEN {
IF rightShiftAddr # 0 THEN c ¬ Basics.BITRSHIFT[c, rightShiftAddr];
IF leftShiftAddr # 0 THEN c ¬ Basics.BITLSHIFT[c, leftShiftAddr];
IF limit # 0 AND c > limit THEN GO TO oops;
IF upc # 1 AND wpc = 1 AND (c MOD upc) # 0 THEN GO TO oops;
IF upc # 1 AND wpc # 1 AND (Basics.LowHalf[c] MOD upc) # 0 THEN GO TO oops;
EXITS oops => ERROR BadMobContents;
};
RETURN [c];
};
AlterVersion:
PROC [vp:
LONG
POINTER
TO MobDefs.VersionStamp] = {
vp[0] ¬ MapCard[vp[0]];
vp[1] ¬ MapCard[vp[1]];
};
AlterBlockDescriptor:
PROC [bdp:
LONG
POINTER
TO SymbolSegment.BlockDescriptor] = {
bdp.offset ¬ MapShift[MapCard[bdp.offset]]; -- are the units OK?
bdp.size ¬ MapShift[MapCard[bdp.size]]; -- are the units OK?
IF limit # 0 AND bdp.offset + bdp.size > limit THEN ERROR BadMobContents;
};
MapTagged:
PROC [rp: RelAddr]
RETURNS [RelAddr] = {
old: Table.IndexRep = LOOPHOLE[MapCard[LOOPHOLE[rp]]];
new: Table.IndexRep ¬ old;
IF new.highBits # Table.HighBits.
LAST
THEN {
new.tag ¬ 0;
new ¬ LOOPHOLE[MapShift[LOOPHOLE[new]]];
new.tag ¬ old.tag;
};
RETURN [LOOPHOLE[new]];
};
MapTagged2:
PROC [u: Symbols.
UNSPEC]
RETURNS [Symbols.
UNSPEC] = {
Does the same thing as MapTagged, but assumes that the swap (if necessary) has already taken place. Also, the type mapped is Symbols.UNSPEC.
old: Table.IndexRep = LOOPHOLE[u];
new: Table.IndexRep ¬ old;
IF new.highBits # Table.HighBits.
LAST
THEN {
new.tag ¬ 0;
new ¬ LOOPHOLE[MapShift[LOOPHOLE[new]]];
new.tag ¬ old.tag;
};
RETURN [LOOPHOLE[new]];
};
MapUnspec:
PROC [u: Symbols.
UNSPEC]
RETURNS [Symbols.
UNSPEC] =
INLINE {
RETURN [IF swapArith THEN LOOPHOLE[SwapHalves[LOOPHOLE[u]]] ELSE u];
};
Symbol mapping routines
MapBti:
PROC [bti: Symbols.BTIndex]
RETURNS [Symbols.BTIndex] = {
new: Table.IndexRep ¬ LOOPHOLE[MapTagged[bti]];
IF new.tag # 0 THEN ERROR BadMobContents;
IF
LOOPHOLE[new, Symbols.BTIndex] # Symbols.BTNull
THEN
IF LOOPHOLE[new, CARD] >= bodyLimit THEN ERROR BadMobContents;
RETURN [LOOPHOLE[new]];
};
MapHash:
PROC [hash: Symbols.Name]
RETURNS [Symbols.Name] = {
new: Table.IndexRep ¬ LOOPHOLE[MapTagged[hash]];
IF new.tag # Symbols.htTag THEN ERROR BadMobContents;
RETURN [LOOPHOLE[new]];
};
MapSEIndex:
PROC [index: Symbols.SEIndex]
RETURNS [Symbols.SEIndex] = {
new: Table.IndexRep ¬ LOOPHOLE[MapTagged[index]];
IF new.tag # Symbols.seTag THEN ERROR BadMobContents;
RETURN [LOOPHOLE[new]];
};
MapISEIndex:
PROC [index: Symbols.ISEIndex]
RETURNS [Symbols.ISEIndex] = {
new: Table.IndexRep ¬ LOOPHOLE[MapTagged[index]];
IF new.tag # Symbols.seTag THEN ERROR BadMobContents;
RETURN [LOOPHOLE[new]];
};
MapCSEIndex:
PROC [index: Symbols.CSEIndex]
RETURNS [Symbols.CSEIndex] = {
new: Table.IndexRep ¬ LOOPHOLE[MapTagged[index]];
IF new.tag # Symbols.seTag THEN ERROR BadMobContents;
RETURN [LOOPHOLE[new]];
};
MapCTXIndex:
PROC [ctxi: Symbols.CTXIndex]
RETURNS [Symbols.CTXIndex] = {
RETURN [LOOPHOLE[MapTagged[ctxi]]];
};
AlterSERecord1:
PROC [sep: Symbols.SEPointer]
RETURNS [Symbols.SEPointer] = {
IF sep.sePad1 # 0 THEN ERROR BadMobContents;
IF sep.sePad2 # 0 THEN ERROR BadMobContents;
WITH se: sep
SELECT
FROM
id => {
se.idCtx ¬ MapCTXIndex[se.idCtx];
se.idType ¬ MapSEIndex[se.idType];
IF se.idType = Symbols.typeTYPE
THEN se.idInfo ¬ LOOPHOLE[MapSEIndex[LOOPHOLE[se.idInfo]]]
ELSE se.idInfo ¬ MapUnspec[se.idInfo];
Note: don't map idValue yet, since we don't know how to treat it!
se.hash ¬ MapTagged[se.hash];
WITH link: se
SELECT
FROM
terminal => RETURN [sep + SERecord.id.terminal.SIZE];
sequential => RETURN [sep + SERecord.id.sequential.SIZE];
linked => {
link.link ¬ MapISEIndex[link.link];
RETURN [sep + SERecord.id.linked.SIZE];
};
embedded => {
link.base ¬ MapISEIndex[link.base];
RETURN [sep + SERecord.id.embedded.SIZE];
};
ENDCASE => ERROR BadMobContents;
};
cons => {
WITH sse: se
SELECT
FROM
mode => {RETURN [sep + SERecord.cons.mode.SIZE]};
basic => {RETURN [sep + SERecord.cons.basic.SIZE]};
signed => {
sse.length ¬ MapInt[sse.length];
RETURN [sep + SERecord.cons.signed.SIZE];
};
unsigned => {
sse.length ¬ MapInt[sse.length];
RETURN [sep + SERecord.cons.unsigned.SIZE];
};
real => {
sse.length ¬ MapInt[sse.length];
RETURN [sep + SERecord.cons.real.SIZE];
};
enumerated => {
sse.range ¬ MapCard[sse.range];
sse.valueCtx ¬ MapCTXIndex[sse.valueCtx];
RETURN [sep + SERecord.cons.enumerated.SIZE];
};
record => {
sse.length ¬ MapInt[sse.length];
sse.fieldCtx ¬ MapCTXIndex[sse.fieldCtx];
WITH link: sse
SELECT
FROM
linked => {
link.linkType ¬ MapSEIndex[link.linkType];
RETURN [sep + SERecord.cons.record.linked.SIZE];
};
notLinked => {
RETURN [sep + SERecord.cons.record.notLinked.SIZE];
};
ENDCASE => ERROR BadMobContents;
};
ref => {
sse.refType ¬ MapSEIndex[sse.refType];
RETURN [sep + SERecord.cons.ref.SIZE];
};
array => {
sse.componentType ¬ MapSEIndex[sse.componentType];
sse.indexType ¬ MapSEIndex[sse.indexType];
RETURN [sep + SERecord.cons.array.SIZE];
};
arraydesc => {
sse.describedType ¬ MapSEIndex[sse.describedType];
RETURN [sep + SERecord.cons.arraydesc.SIZE];
};
transfer => {
sse.typeIn ¬ MapCSEIndex[sse.typeIn];
sse.typeOut ¬ MapCSEIndex[sse.typeOut];
RETURN [sep + SERecord.cons.transfer.SIZE];
};
definition => {
sse.defCtx ¬ MapCTXIndex[sse.defCtx];
RETURN [sep + SERecord.cons.definition.SIZE];
};
union => {
sse.caseCtx ¬ MapCTXIndex[sse.caseCtx];
sse.tagSei ¬ MapISEIndex[sse.tagSei];
RETURN [sep + SERecord.cons.union.SIZE];
};
sequence => {
sse.parentType ¬ LOOPHOLE[MapSEIndex[sse.parentType]];
sse.tagSei ¬ MapISEIndex[sse.tagSei];
sse.componentType ¬ MapSEIndex[sse.componentType];
RETURN [sep + SERecord.cons.sequence.SIZE];
};
relative => {
sse.baseType ¬ MapSEIndex[sse.baseType];
sse.offsetType ¬ MapSEIndex[sse.offsetType];
sse.resultType ¬ MapSEIndex[sse.resultType];
RETURN [sep + SERecord.cons.relative.SIZE];
};
subrange => {
sse.rangeType ¬ MapSEIndex[sse.rangeType];
sse.origin ¬ MapInt[sse.origin];
sse.range ¬ MapCard[sse.range];
RETURN [sep + SERecord.cons.subrange.SIZE];
};
opaque => {
sse.id ¬ MapISEIndex[sse.id];
sse.length ¬ MapInt[sse.length];
RETURN [sep + SERecord.cons.opaque.SIZE];
};
zone => RETURN [sep + SERecord.cons.zone.SIZE];
any => RETURN [sep + SERecord.cons.any.SIZE];
nil => RETURN [sep + SERecord.cons.nil.SIZE];
ENDCASE => ERROR BadMobContents;
};
ENDCASE => ERROR BadMobContents;
};
UnderType:
PROC [sei: Symbols.SEIndex]
RETURNS [Symbols.CSEIndex] = {
DO
sep: Symbols.SEPointer = @seb[sei];
WITH se: sep
SELECT
FROM
id => IF se.idType = Symbols.typeTYPE THEN {sei ¬ LOOPHOLE[se.idInfo]; LOOP};
cons => RETURN [LOOPHOLE[sei]];
ENDCASE;
ERROR BadMobContents;
ENDLOOP;
};
AlterSERecord2:
PROC [sep: Symbols.SEPointer]
RETURNS [Symbols.SEPointer] = {
This pass takes place after all of the type have been fixed up, but some of the fields may still have ambigous interpretations.
IF sep.sePad1 # 0 OR sep.sePad2 # 0 THEN ERROR BadMobContents;
WITH se: sep
SELECT
FROM
id => {
We have to carefully decode idValue here. Consult MimosaDebug.PrintSE for more information. When the entry is a link, it should not be mapped in any way!
tp: Symbols.CSEPointer ¬ @seb[UnderType[se.idType]];
mapped: BOOL ¬ FALSE;
isBti: BOOL ¬ FALSE;
SELECT
TRUE
FROM
NOT tp.mark3 => {};
se.constant
AND
NOT se.extended => {
WITH ttse: tp
SELECT
FROM
definition => mapped ¬ TRUE;
transfer =>
SELECT ttse.mode
FROM
proc, signal, error, program => isBti ¬
TRUE;
in this peculiar case, se.idInfo is really a BTI, and se.idValue is really a link, so complete the transformation begun in Pass 1.
ENDCASE;
ENDCASE;
};
se.constant
AND se.extended => {
WITH ttse: tp
SELECT
FROM
transfer =>
SELECT ttse.mode
FROM
proc => isBti ¬
TRUE;
in this peculiar case, se.idInfo is really a BTI, and se.idValue is really a link, so complete the transformation begun in Pass 1.
ENDCASE;
ENDCASE;
};
se.linkSpace => mapped ¬
NOT sgh.definitionsFile;
This field needs no mapping if it is from an implementation file (set by Pass4B??), but needs mapping if it is from a definitions file (set by Pass4L.LayoutInterface).
ENDCASE;
SELECT
TRUE
FROM
mapped => {};
isBti => {
This claims to be a bti, so map it and check the contents a little
bti: Symbols.BTIndex ¬ LOOPHOLE[MapTagged2[se.idInfo]];
se.idInfo ¬ LOOPHOLE[bti];
IF bti # Symbols.BTNull
THEN
IF bb[bti].padTag # 0 THEN ERROR BadMobContents;
};
ENDCASE => se.idValue ¬ MapUnspec[se.idValue];
WITH link: se
SELECT
FROM
terminal => RETURN [sep + SERecord.id.terminal.SIZE];
sequential => RETURN [sep + SERecord.id.sequential.SIZE];
linked => RETURN [sep + SERecord.id.linked.SIZE];
embedded => RETURN [sep + SERecord.id.embedded.SIZE];
ENDCASE => ERROR BadMobContents;
};
cons =>
WITH sse: se
SELECT
FROM
mode => RETURN [sep + SERecord.cons.mode.SIZE];
basic => RETURN [sep + SERecord.cons.basic.SIZE];
signed => RETURN [sep + SERecord.cons.signed.SIZE];
unsigned => RETURN [sep + SERecord.cons.unsigned.SIZE];
real => RETURN [sep + SERecord.cons.real.SIZE];
enumerated => RETURN [sep + SERecord.cons.enumerated.SIZE];
record =>
WITH link: sse
SELECT
FROM
linked => RETURN [sep + SERecord.cons.record.linked.SIZE];
notLinked => RETURN [sep + SERecord.cons.record.notLinked.SIZE];
ENDCASE => ERROR BadMobContents;
ref => RETURN [sep + SERecord.cons.ref.SIZE];
array => RETURN [sep + SERecord.cons.array.SIZE];
arraydesc => RETURN [sep + SERecord.cons.arraydesc.SIZE];
transfer => RETURN [sep + SERecord.cons.transfer.SIZE];
definition => RETURN [sep + SERecord.cons.definition.SIZE];
union => RETURN [sep + SERecord.cons.union.SIZE];
sequence => RETURN [sep + SERecord.cons.sequence.SIZE];
relative => RETURN [sep + SERecord.cons.relative.SIZE];
subrange => RETURN [sep + SERecord.cons.subrange.SIZE];
opaque => RETURN [sep + SERecord.cons.opaque.SIZE];
zone => RETURN [sep + SERecord.cons.zone.SIZE];
any => RETURN [sep + SERecord.cons.any.SIZE];
nil => RETURN [sep + SERecord.cons.nil.SIZE];
ENDCASE => ERROR BadMobContents;
ENDCASE => ERROR BadMobContents;
};
Literal mapping routines
MapLTIndex:
PROC [index: Literals.LTIndex]
RETURNS [Literals.LTIndex] = {
RETURN [LOOPHOLE[MapTagged[index]]];
};
MapSTIndex:
PROC [index: Literals.STIndex]
RETURNS [Literals.STIndex] = {
RETURN [LOOPHOLE[MapTagged[index]]];
};
MapMSTIndex:
PROC [index: Literals.MSTIndex]
RETURNS [Literals.MSTIndex] = {
RETURN [LOOPHOLE[MapTagged[index]]];
};
LTRecordPtr: TYPE = LONG POINTER TO Literals.LTRecord;
AlterLTRecord:
PROC [lp: LTRecordPtr]
RETURNS [LTRecordPtr] = {
lp.link ¬ MapLTIndex[lp.link];
WITH lit: lp
SELECT
FROM
short => {
lit.value ¬ MapUnspec[lit.value];
RETURN [lp + SIZE[Literals.LTRecord.short]];
};
long => {
lit.bits ¬ MapInt[lit.bits];
FOR i: CARD16 IN [0..lit.max) DO lit.value[i] ¬ MapUnspec[lit.value[i]]; ENDLOOP;
RETURN [lp + SIZE[Literals.LTRecord.long[lit.max]]];
};
ENDCASE => ERROR BadMobContents;
};
STRecordPtr: TYPE = LONG POINTER TO Literals.STRecord;
AlterSTRecord:
PROC [sp: STRecordPtr]
RETURNS [STRecordPtr] = {
sp.link ¬ MapMSTIndex[sp.link];
WITH st: sp
SELECT
FROM
master => {
st.info ¬ MapCard[st.info];
RETURN [sp+SIZE[Literals.STRecord.master[st.maxLength]]];
};
copy =>
RETURN [sp+SIZE[Literals.STRecord.copy]];
heap => {
st.type ¬ MapSEIndex[st.type];
st.info ¬ MapCard[st.info];
RETURN [sp+SIZE[Literals.STRecord.heap]]
};
ENDCASE => ERROR BadMobContents;
};
Tree mapping routines
AlterTreeNode:
PROC [tp: Tree.NodePtr]
RETURNS [Tree.NodePtr] = {
nSons: NAT = tp.nSons;
info: Tree.Info = tp.info;
IF
LOOPHOLE[info,
CARD] # 0
THEN
SELECT tp.name
FROM
item, list, null =>
tp.info ¬ LOOPHOLE[MapUnspec[LOOPHOLE[info]]];
block, body, downthru, forseq, upthru =>
tp.info ¬ LOOPHOLE[MapBti[LOOPHOLE[info]]];
assign, bind, broadcast, call, case, caseswitch, casetest, catch, catchmark, checked, continue, decl, do, enable, error, exit, extract, free, goto, if, initlist, join, label, lock, loop, notify, open, reject, restart, result, resume, retry, return, signal, start, stop, subst, syserror, typedecl, unlock, wait, xerror =>
tp.info ¬ LOOPHOLE[MapUnspec[LOOPHOLE[info]]];
abs, addr, all, apply, and, arraydesc, assignx, atom, base, bindx, callx, casex, cast, check, chop, clit, cons, construct, create, dindex, div, dollar, dot, cdot, errorx, exlist, extractx, first, float, fork, gcrt, ifx, in, index, istype, joinx, last, length, lengthen, listcons, llit, loophole, max, min, minus, mod, mwconst, narrow, new, nil, not, notin, openx, or, ord, pad, plus, portcallx, power, pred, proccheck, relE, relG, relGE, relL, relLE, relN, reloc, rowcons, safen, seqindex, sequence, shorten, signalinit, signalx, size, startx, stringinit, substx, succ, syserrorx, textlit, times, typecode, uminus, union, uparrow, val, void =>
tp.info ¬ LOOPHOLE[MapSEIndex[LOOPHOLE[info]]];
anyTC, arraydescTC, arrayTC, basicTC, definitionTC, discrimTC, enumeratedTC, errorTC, frameTC, implicitTC, linkTC, listTC, longTC, monitoredTC, opaqueTC, optionTC, paintTC, pointerTC, portTC, processTC, procTC, programTC, recordTC, refTC, relativeTC, sequenceTC, signalTC, spareTC, subrangeTC, unionTC, variantTC, varTC, zoneTC =>
tp.info ¬ LOOPHOLE[MapSEIndex[LOOPHOLE[info]]];
ENDCASE =>
ERROR BadMobContents;
Anything else we can't handle, and should not see
FOR i: NAT IN [1..nSons] DO tp.son[i] ¬ MapTreeLink[tp.son[i]]; ENDLOOP;
RETURN [tp + SIZE[Tree.Node[nSons]]];
};
MapTreeLink:
PROC [link: Tree.Link]
RETURNS [Tree.Link] = {
mapped: Tree.Link = LOOPHOLE[MapTagged[LOOPHOLE[link]]];
tagged: Tree.LinkRep ¬ LOOPHOLE[mapped];
tagged0: Tree.LinkRep ¬ tagged;
tagged0.tag ¬ VAL[0];
SELECT tagged.tag
FROM
subtree =>
IF LOOPHOLE[tagged0, CARD] >= sgh.treeBlock.size THEN ERROR BadMobContents;
hash =>
IF LOOPHOLE[tagged0, CARD] >= sgh.htBlock.size THEN ERROR BadMobContents;
symbol =>
IF LOOPHOLE[tagged0, CARD] >= sgh.seBlock.size THEN ERROR BadMobContents;
literal =>
IF LOOPHOLE[tagged0, CARD] >= sgh.litBlock.size THEN ERROR BadMobContents;
string =>
IF LOOPHOLE[tagged0, CARD] >= sgh.sLitBlock.size THEN ERROR BadMobContents;
ENDCASE =>
ERROR BadMobContents;
RETURN [mapped];
};
<< -- Should it become necessary to check all of the trees ...
CheckForest:
PROC = {
IF sgh.
treeBlock.size # 0
THEN {
This is here to comfort the (perhaps justly) paranoid.
tp: Tree.NodePtr ¬ LOOPHOLE[sgh + sgh.treeBlock.offset];
lag: Tree.NodePtr ¬ tp;
tpLimit: Tree.NodePtr = tp + sgh.treeBlock.size;
WHILE tp # tpLimit
DO
old: Tree.NodePtr ¬ tp;
IF tp.name.ORD >= Tree.NodeName[invalid].ORD THEN ERROR BadMobContents;
FOR i: NAT IN [1..tp.nSons] DO CheckTreeLink[tp.son[i]]; ENDLOOP;
tp ¬ tp + SIZE[Tree.Node[tp.nSons]];
lag ¬ old;
ENDLOOP;
};
};
CheckTreeLink:
PROC [link: Tree.Link] = {
tagged: Tree.LinkRep ¬ LOOPHOLE[link];
tagged0: Tree.LinkRep ¬ LOOPHOLE[link];
tagged0.tag ¬ VAL[0];
SELECT tagged.tag
FROM
subtree =>
IF LOOPHOLE[tagged0, CARD] >= sgh.treeBlock.size THEN ERROR BadMobContents;
hash =>
IF LOOPHOLE[tagged0, CARD] >= sgh.htBlock.size THEN ERROR BadMobContents;
symbol =>
IF LOOPHOLE[tagged0, CARD] >= sgh.seBlock.size THEN ERROR BadMobContents;
literal =>
IF LOOPHOLE[tagged0, CARD] >= sgh.litBlock.size THEN ERROR BadMobContents;
string =>
IF LOOPHOLE[tagged0, CARD] >= sgh.sLitBlock.size THEN ERROR BadMobContents;
ENDCASE =>
ERROR BadMobContents;
};>>
seb: Symbols.Base ¬ NIL;
bb: Symbols.Base ¬ NIL;
bodyLimit: CARD ¬ 0;
ltb: Literals.Base ¬ NIL;
stb: Literals.Base ¬ NIL;
tb: Tree.Base ¬ NIL;
sgh.versionIdent ¬ MapCard[sgh.versionIdent];
AlterVersion[@sgh.version];
AlterVersion[@sgh.creator];
AlterVersion[@sgh.sourceVersion];
sgh.directoryCtx ¬ MapCTXIndex[sgh.directoryCtx];
sgh.importCtx ¬ MapCTXIndex[sgh.importCtx];
sgh.outerCtx ¬ MapCTXIndex[sgh.outerCtx];
AlterBlockDescriptor[@sgh.hvBlock];
AlterBlockDescriptor[@sgh.htBlock];
AlterBlockDescriptor[@sgh.ssBlock];
AlterBlockDescriptor[@sgh.outerPackBlock];
AlterBlockDescriptor[@sgh.innerPackBlock];
AlterBlockDescriptor[@sgh.constBlock];
AlterBlockDescriptor[@sgh.seBlock];
AlterBlockDescriptor[@sgh.ctxBlock];
AlterBlockDescriptor[@sgh.mdBlock];
AlterBlockDescriptor[@sgh.bodyBlock];
AlterBlockDescriptor[@sgh.extBlock];
AlterBlockDescriptor[@sgh.treeBlock];
AlterBlockDescriptor[@sgh.litBlock];
AlterBlockDescriptor[@sgh.sLitBlock];
AlterBlockDescriptor[@sgh.epMapBlock];
AlterBlockDescriptor[@sgh.spareBlock];
sgh.fgRelBase ¬ MapShift[MapCard[sgh.fgRelBase]];
sgh.fgCount ¬ MapCard[sgh.fgCount];
seb ¬ LOOPHOLE[sgh, Symbols.Base]
+ (sgh.seBlock.offset - SymbolSegment.biases[SymbolSegment.seType]);
bb ¬ LOOPHOLE[sgh, Symbols.Base]
+ (sgh.bodyBlock.offset - SymbolSegment.biases[SymbolSegment.bodyType]);
ltb ¬ LOOPHOLE[sgh, Literals.Base]
+ (sgh.litBlock.offset - SymbolSegment.biases[SymbolSegment.ltType]);
stb ¬ LOOPHOLE[sgh, Literals.Base]
+ (sgh.sLitBlock.offset - SymbolSegment.biases[SymbolSegment.stType]);
tb ¬ LOOPHOLE[sgh, Tree.Base]
+ (sgh.treeBlock.offset - SymbolSegment.biases[SymbolSegment.treeType]);
IF sgh.
hvBlock.size # 0
THEN {
hvp: LONG POINTER TO Symbols.HashVector = LOOPHOLE[sgh+sgh.hvBlock.offset];
FOR hvi: Symbols.HVIndex
IN Symbols.HVIndex
DO
hvp[hvi] ¬ MapTagged[hvp[hvi]];
ENDLOOP;
};
IF sgh.
htBlock.size # 0
THEN {
HTRecordPtr: TYPE = LONG POINTER TO Symbols.HTRecord;
htp: HTRecordPtr ¬ LOOPHOLE[sgh + sgh.htBlock.offset];
htpLimit: HTRecordPtr = htp + sgh.htBlock.size;
WHILE htp # htpLimit
DO
htp.link ¬ MapTagged[htp.link];
htp ¬ htp + Symbols.HTRecord.SIZE;
ENDLOOP;
};
IF sgh.
ssBlock.size # 0
THEN {
<< Nothing to relocate >>
};
IF sgh.
outerPackBlock.size # 0
THEN {
Obsolete
<<OuterPackRecord: TYPE = PackageSymbols.OuterPackRecord;
OuterPackRecordPtr: TYPE = LONG POINTER TO OuterPackRecord;
opp: OuterPackRecordPtr ¬ LOOPHOLE[sgh + sgh.outerPackBlock.offset];
oppLimit: OuterPackRecordPtr = opp + sgh.outerPackBlock.size;
WHILE opp # oppLimit
DO
opp.hti ¬ MapHash[opp.hti];
opp ¬ opp + OuterPackRecord.SIZE;
ENDLOOP;>>
};
IF sgh.
innerPackBlock.size # 0
THEN {
Obsolete
<< Nothing to relocate >>
};
IF sgh.
constBlock.size # 0
THEN {
ConstRecord: TYPE = PackageSymbols.ConstRecord;
ConstRecordPtr: TYPE = LONG POINTER TO ConstRecord;
cbp: ConstRecordPtr ¬ LOOPHOLE[sgh + sgh.constBlock.offset];
cbpLimit: ConstRecordPtr = cbp + sgh.constBlock.size;
WHILE cbp # cbpLimit
DO
cbp.offset ¬ MapCard[cbp.offset];
cbp.length ¬ MapCard[cbp.length];
cbp ¬ cbp + ConstRecord.SIZE;
ENDLOOP;
};
IF sgh.
seBlock.size # 0
THEN {
First pass fixup on SERecords
firstSei: Symbols.SEIndex ¬ Symbols.SEFirst;
sep: Symbols.SEPointer ¬ @seb[firstSei];
lag: Symbols.SEPointer ¬ sep;
sepLimit: Symbols.SEPointer = sep + sgh.seBlock.size;
WHILE sep # sepLimit
DO
old: Symbols.SEPointer ¬ sep;
sep ¬ AlterSERecord1[sep];
lag ¬ old;
ENDLOOP;
};
IF sgh.
ctxBlock.size # 0
THEN {
CTXRecordPtr: TYPE = LONG POINTER TO Symbols.CTXRecord;
ctxp: CTXRecordPtr ¬ LOOPHOLE[sgh + sgh.ctxBlock.offset];
ctxLim: CTXRecordPtr = ctxp + sgh.ctxBlock.size;
lag: CTXRecordPtr ¬ ctxp;
WHILE ctxp # ctxLim
DO
old: CTXRecordPtr = ctxp;
IF LOOPHOLE[ctxp, CARD] > LOOPHOLE[ctxLim, CARD] THEN ERROR BadMobContents;
ctxp.seList ¬ MapISEIndex[ctxp.seList];
WITH ct: ctxp
SELECT
FROM
simple => {
ctxp ¬ ctxp + Symbols.CTXRecord.simple.SIZE;
};
included => {
ct.chain ¬ LOOPHOLE[MapCTXIndex[LOOPHOLE[ct.chain]]];
ct.module ¬ LOOPHOLE[MapTagged[LOOPHOLE[ct.module]]];
ct.map ¬ MapCTXIndex[ct.map];
ctxp ¬ ctxp + Symbols.CTXRecord.included.SIZE;
};
imported => {
ct.includeLink ¬ LOOPHOLE[MapTagged[LOOPHOLE[ct.includeLink]]];
ctxp ¬ ctxp + Symbols.CTXRecord.imported.SIZE;
};
nil => {
ctxp ¬ ctxp + Symbols.CTXRecord.nil.SIZE;
};
ENDCASE => ERROR BadMobContents;
lag ¬ old;
ENDLOOP;
};
IF sgh.
mdBlock.size # 0
THEN {
MDRecordPtr: TYPE = LONG POINTER TO Symbols.MDRecord;
mdp: MDRecordPtr ¬ LOOPHOLE[sgh + sgh.mdBlock.offset];
mdpLimit: MDRecordPtr = mdp + sgh.mdBlock.size;
WHILE mdp # mdpLimit
DO
AlterVersion[@mdp.stamp];
mdp.moduleId ¬ MapHash[mdp.moduleId];
mdp.fileId ¬ MapHash[mdp.fileId];
mdp.ctx ¬ LOOPHOLE[MapCTXIndex[LOOPHOLE[mdp.ctx]]];
mdp.defaultImport ¬ MapCTXIndex[mdp.defaultImport];
mdp ¬ mdp + Symbols.MDRecord.SIZE;
ENDLOOP;
};
bodyLimit ¬ sgh.bodyBlock.size;
IF sgh.treeBlock.size # 0
THEN {
otherDelta: CARD ¬ sgh.treeBlock.offset - sgh.bodyBlock.offset;
IF otherDelta > bodyLimit
THEN {
Due to an unfortunate old bug in ObjectOut, the bodyLimit must be computed specially!
bodyLimit ¬ otherDelta;
sgh.bodyBlock.size ¬ bodyLimit;
};
};
IF bodyLimit # 0
THEN {
BodyRecordPtr: TYPE = LONG POINTER TO Symbols.BodyRecord;
brp: BodyRecordPtr ¬ LOOPHOLE[sgh + sgh.bodyBlock.offset];
brpLimit: BodyRecordPtr = brp + bodyLimit;
WHILE brp # brpLimit
DO
brp.link.index ¬ MapBti[brp.link.index];
brp.firstSon ¬ MapBti[brp.firstSon];
brp.type ¬ LOOPHOLE[MapSEIndex[LOOPHOLE[brp.type]]];
brp.localCtx ¬ MapCTXIndex[brp.localCtx];
brp.sourceIndex ¬ MapCard[brp.sourceIndex];
WITH info: brp.info
SELECT
FROM
Internal => {
Note, the tagged items in here are not necessarily good for the current table, although they should have at one time been valid relative pointers, so we have to turn off limit checking temporarily.
oldLimit: CARD ¬ limit;
limit ¬ 0;
info.bodyTree ¬ MapTagged[info.bodyTree];
info.thread ¬ MapTagged[info.thread];
limit ¬ oldLimit;
};
External => {
info.bytes ¬ MapInt[info.bytes];
info.startIndex ¬ MapInt[info.startIndex];
info.indexLength ¬ MapInt[info.indexLength];
};
ENDCASE => ERROR BadMobContents;
WITH br: brp
SELECT
FROM
Callable => {
br.id ¬ MapISEIndex[br.id];
br.ioType ¬ MapCSEIndex[br.ioType];
br.frameOffset ¬ MapInt[br.frameOffset];
brp ¬ brp + Symbols.BodyRecord.Callable.SIZE;
};
Other => {
br.relOffset ¬ MapInt[br.relOffset];
brp ¬ brp + Symbols.BodyRecord.Other.SIZE;
};
ENDCASE => ERROR BadMobContents;
ENDLOOP;
};
IF sgh.
extBlock.size # 0
THEN {
ExtRecordPtr: TYPE = LONG POINTER TO SymbolSegment.ExtRecord;
exp: ExtRecordPtr ¬ LOOPHOLE[sgh + sgh.extBlock.offset];
expLimit: ExtRecordPtr = exp + sgh.extBlock.size;
WHILE exp # expLimit
DO
exp.sei ¬ MapISEIndex[exp.sei];
exp.tree ¬ MapTreeLink[exp.tree];
exp ¬ exp + SymbolSegment.ExtRecord.SIZE;
ENDLOOP;
};
IF sgh.
treeBlock.size # 0
THEN {
tp: Tree.NodePtr ¬ LOOPHOLE[sgh + sgh.treeBlock.offset];
lag: Tree.NodePtr ¬ tp;
tpLimit: Tree.NodePtr = tp + sgh.treeBlock.size;
WHILE tp # tpLimit
DO
old: Tree.NodePtr ¬ tp;
tp ¬ AlterTreeNode[tp];
lag ¬ old;
ENDLOOP;
};
IF sgh.
litBlock.size # 0
THEN {
lp: LTRecordPtr ¬ LOOPHOLE[sgh + sgh.litBlock.offset];
lpLimit: LTRecordPtr = lp + sgh.litBlock.size;
WHILE lp # lpLimit
DO
lp ¬ AlterLTRecord[lp];
ENDLOOP;
};
IF sgh.
sLitBlock.size # 0
THEN {
sp: STRecordPtr ¬ LOOPHOLE[sgh + sgh.sLitBlock.offset];
spLimit: STRecordPtr = sp + sgh.sLitBlock.size;
WHILE sp # spLimit
DO
sp ¬ AlterSTRecord[sp];
ENDLOOP;
};
IF sgh.
epMapBlock.size # 0
THEN {
<< Nothing to relocate, not used in the compiler >>
ERROR BadMobContents;
};
IF sgh.
fgCount # 0
THEN {
<< Nothing to relocate >>
fgp: LONG POINTER TO SymbolSegment.FGHeader ← LOOPHOLE[sgh];
fgpLimit: LONG POINTER TO SymbolSegment.FGHeader ← fgp + sgh.fgCount / BYTES[UNIT];
WHILE fgp # fgpLimit DO
fgp ← fgp + SymbolSegment.FGHeader.SIZE;
ENDLOOP;
};
IF sgh.
seBlock.size # 0
THEN {
Second pass fixup on SERecords
firstSei: Symbols.SEIndex ¬ Symbols.SEFirst;
sep: Symbols.SEPointer ¬ @seb[firstSei];
lag: Symbols.SEPointer ¬ sep;
sepLimit: Symbols.SEPointer ¬ sep + sgh.seBlock.size;
WHILE sep # sepLimit
DO
old: Symbols.SEPointer ¬ sep;
sep ¬ AlterSERecord2[sep];
lag ¬ old;
ENDLOOP;
};
};
AlterRTMob:
PROC [
rtb: RTMob.RTBase, swapArith:
BOOL,
rightShiftAddr: ShiftDist, leftShiftAddr: ShiftDist, limit:
CARD] = {
MapCard:
PROC [c:
CARD]
RETURNS [
CARD] =
INLINE {
RETURN [IF swapArith THEN LOOPHOLE[SwapHalves[[card[c]]]] ELSE c];
};
MapInt:
PROC [i:
INT]
RETURNS [
INT] =
INLINE {
RETURN [IF swapArith THEN LOOPHOLE[SwapHalves[[int[i]]]] ELSE i];
};
MapShift:
PROC [c:
CARD]
RETURNS [
CARD] = {
IF
LOOPHOLE[c,
INT] > 0
THEN {
IF rightShiftAddr # 0 THEN c ¬ Basics.BITRSHIFT[c, rightShiftAddr];
IF leftShiftAddr # 0 THEN c ¬ Basics.BITLSHIFT[c, leftShiftAddr];
IF limit # 0 AND c > limit THEN GO TO oops;
IF upc # 1 AND wpc = 1 AND (c MOD upc) # 0 THEN GO TO oops;
IF upc # 1 AND wpc # 1 AND (Basics.LowHalf[c] MOD upc) # 0 THEN GO TO oops;
EXITS oops => ERROR BadMobContents;
};
RETURN [c];
};
MapRel:
PROC [rp: RelAddr]
RETURNS [RelAddr] = {
RETURN [LOOPHOLE[MapShift[MapCard[LOOPHOLE[rp]]]]];
};
MapRTRel:
PROC [rp: RTRelAddr]
RETURNS [RTRelAddr] = {
RETURN [LOOPHOLE[MapShift[MapCard[LOOPHOLE[rp]]]]];
};
MapTagged:
PROC [rp: RelAddr]
RETURNS [RelAddr] = {
old: Table.IndexRep = LOOPHOLE[MapCard[LOOPHOLE[rp]]];
new: Table.IndexRep ¬ old;
IF new.highBits # Table.HighBits.
LAST
THEN {
new.tag ¬ 0;
new ¬ LOOPHOLE[MapShift[LOOPHOLE[new]]];
new.tag ¬ old.tag;
};
RETURN [LOOPHOLE[new]];
};
AlterVersion:
PROC [vp:
LONG
POINTER
TO MobDefs.VersionStamp] = {
vp[0] ¬ MapCard[vp[0]];
vp[1] ¬ MapCard[vp[1]];
};
Translate and verify the header
rtb.versionIdent ¬ MapCard[rtb.versionIdent];
IF rtb.versionIdent # RTMob.VersionID
THEN
ERROR BadMobContents;
Can't parse this one, wrong version
IF nullifyRTMob
THEN {
Set the appropriate fields to indicate no RTMob contents
nowhere: RTMob.RTBase RELATIVE LONG POINTER ¬ LOOPHOLE[SIZE[RTMob.RTHeader]];
rtb.refLitTable ¬ nowhere;
rtb.litBase ¬ nowhere;
rtb.litLength ¬ 0;
rtb.rcMapBase ¬ nowhere;
rtb.rcMapLength ¬ 0;
rtb.stampTable ¬ nowhere;
rtb.typeTable ¬ nowhere;
LOOPHOLE[@rtb[nowhere],
LONG
POINTER
TO
CARD] ¬ 0;
This forces the stampTable & typeTable to appear empty
RETURN;
};
rtb.refLitTable ¬ MapRTRel[rtb.refLitTable];
rtb.litBase ¬ MapRTRel[rtb.litBase];
rtb.litLength ¬ MapShift[MapCard[rtb.litLength]];
rtb.rcMapBase ¬ MapRTRel[rtb.rcMapBase];
rtb.rcMapLength ¬ MapShift[MapCard[rtb.rcMapLength]];
rtb.stampTable ¬ MapRTRel[rtb.stampTable];
rtb.typeTable ¬ MapRTRel[rtb.typeTable];
Now translate the interior tables
{
p: LONG POINTER TO RTMob.RefLitList = @rtb[rtb.refLitTable];
FOR i:
NAT
IN [0..p.length)
DO
rp: LONG POINTER TO RTMob.RefLitItem = @p[i];
rp.referentType ¬ [MapInt[rp.referentType]];
rp.offset ¬ MapShift[MapCard[rp.offset]];
rp.length ¬ MapShift[MapCard[rp.length]];
ENDLOOP;
};
{
p: LONG POINTER TO RTMob.StampList = @rtb[rtb.stampTable];
FOR i: NAT IN [1..p.limit) DO AlterVersion[@p[i]]; ENDLOOP;
};
{
p: LONG POINTER TO RTMob.TypeList = @rtb[rtb.typeTable];
oldLimit: CARD ¬ limit;
FOR i:
NAT
IN [0..p.length)
DO
tp: LONG POINTER TO RTMob.TypeItem = @p[i];
tp.table ¬ MapRel[tp.table];
tp.ct ¬ [MapInt[tp.ct]];
tp.ut.version ¬ [MapInt[tp.ut.version]];
tp.rcMap ¬ LOOPHOLE[MapRel[LOOPHOLE[tp.rcMap]]];
limit ¬ 0; -- suspend limit checking for sei's possibly not in this file
tp.sei ¬ MapTagged[tp.sei];
tp.ut.sei ¬ MapTagged[tp.ut.sei];
limit ¬ oldLimit;
ENDLOOP;
};
};