RCTWFrames.mesa
Copyright Ó 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Hopcroft, August 18, 1989 11:44:24 am PDT
Sturgis, December 22, 1989 1:49:56 pm PST
Last changed by Theimer on October 9, 1989 2:06:15 pm PDT
Last tweaked by Mike Spreitzer on October 1, 1992 4:09 pm PDT
Philip James, February 22, 1992 9:57 am PST
Laurie Horton, July 20, 1992 11:44 am PDT
Katsuyuki Komatsu December 18, 1992 9:57 am PST
Jas, January 5, 1993 3:19 pm PST
DIRECTORY
CCTypes USING[CCError, CCErrorCase, CreateIndirectNode, GetBitSize, GetIndirectType, GetTargetTypeOfIndirect, GetTypeClass, PrintType],
CedarOtherPureTypes USING[CreateIndirectToAnUnknownType, CreateUnknownType],
CirioMemory,
CirioNubAccess USING[Handle, RemoteAddress, LookupSymEntryByName, SymEntry],
CirioTypes,
DeferringTypes USING [UndertypeStar],
Frames USING[CreateIndirectFrameNode, CreateIndirectFrameType, CreateIndirectGlobalFrameNode, CreateIndirectGlobalFrameType, IndirectFrameData, IndirectFrameTypeData, IndirectGlobalFrameData, IndirectGlobalFrameTypeData],
IO USING[EndOf, EndOfStream, GetChar, PeekChar, PutFR, PutFR1, RIS, RopeFromROS, ROS, STREAM],
ObjectFiles USING[BracketNest, BracketPair, CGrammar, CGrammarOfStab, DescribeModule, GenSymbolStabs, MakeUnknownVarLoc, Module, Stab, VarLocFromStab],
ObjectFilesPrivate,
RCTW,
Records USING[CreateIndirectRecordNode, CreateRecordType, IndirectRecordNodeProcs, RecordTypeProcs],
RefTab USING[Fetch, Key, Ref, Store],
RMTWPrivate,
Rope USING[Cat, Concat, Find, FromChar, IsEmpty, ROPE, Substr],
SymTab USING [Create, Fetch, Insert, Key, Pairs, Ref, Replace, Store, Val],
SystemInterface,
SGI;
RCTWFrames: CEDAR PROGRAM
IMPORTS CCTypes, CedarOtherPureTypes, CirioMemory, CirioNubAccess, DeferringTypes, Frames, IO, ObjectFiles, RCTW, Records, RefTab, RMTWPrivate, Rope, SymTab, SystemInterface
EXPORTS RCTW
= BEGIN OPEN ObjF:ObjectFiles, RCTW;
ROPE: TYPE ~ Rope.ROPE;
RopeList: TYPE ~ LIST OF ROPE;
CCError: ERROR[case: CCTypes.CCErrorCase, msg: ROPE ← NIL] ← CCTypes.CCError;
Following types are defined in ObjectFilesPrivate
Parsed: TYPE = REF ParsedBody;
ParsedBody: PUBLIC TYPE = ObjectFilesPrivate.ParsedBody;
Module: TYPE = REF ModuleBody;
ModuleBody: PUBLIC TYPE = ObjectFilesPrivate.ModuleBody;
zero length records
CreateZeroLengthRecordType:
PROC[cc:
CC]
RETURNS[Type] =
{RETURN[Records.CreateRecordType[ZeroLengthRecordTypeProcs, cc, NIL]]};
ZeroLengthRecordTypeProcs:
REF Records.RecordTypeProcs ←
NEW[Records.RecordTypeProcs←[
getPaint: ZeroLengthRecordGetPaint,
comparePaint: ZeroLengthRecordComparePaint,
nFields: ZeroLengthRecordnFields,
fieldIndexToName: ZeroLengthRecordFieldIndexToName,
nameToFieldIndex: ZeroLengthRecordNameToFieldIndex,
fieldIndexToType: ZeroLengthRecordFieldIndexToType]];
ZeroLengthRecordGetPaint:
PROC[data:
REF
ANY]
RETURNS[
REF
ANY] =
{RETURN[NIL]};
ZeroLengthRecordComparePaint:
PROC[data:
REF
ANY, otherPaint:
REF
ANY]
RETURNS[
BOOLEAN] =
{ERROR};
ZeroLengthRecordnFields:
PROC[data:
REF
ANY]
RETURNS[
INT] =
{RETURN[0]};
ZeroLengthRecordFieldIndexToName:
PROC[index:
INT, data:
REF
ANY]
RETURNS[
ROPE] =
{ERROR};
ZeroLengthRecordNameToFieldIndex:
PROC[name:
ROPE, data:
REF
ANY]
RETURNS[
INT] =
{RETURN[-1]};
ZeroLengthRecordFieldIndexToType:
PROC[index:
INT, cc:
CC, data:
REF
ANY]
RETURNS[Type] =
{ERROR};
Zero length indirect record nodes
CreateZeroLengthRecordNode:
PROC[indirectRecordType: Type, cc:
CC]
RETURNS[Node] =
BEGIN
RETURN[Records.CreateIndirectRecordNode[CCTypes.GetTargetTypeOfIndirect[indirectRecordType], ZeroLengthRecordNodeProcs, NIL, cc]];
END;
ZeroLengthRecordNodeProcs:
REF Records.IndirectRecordNodeProcs ←
NEW[Records.IndirectRecordNodeProcs ← [
selectField: NIL]];
Analyzing block records
CreateArgsRecordType:
PROC [rctw: RCTWData]
RETURNS [type: Type] ~ {
bracketPair:ObjF.BracketPair ← rctw.bracketNest.rest.first;
type ← CreateBlockRecordType[ArgumentListFromRCTW[rctw], bracketPair, rctw];
type ← CCTypes.GetIndirectType[type];
RETURN};
CreateLocalsRecordType:
PROC [bracketPair: ObjF.BracketPair, rctw: RCTWData, procTop:
BOOL]
RETURNS [type: Type] ~ {
locals: RopeList ~ LocalsListFromBracketPair[bracketPair, rctw, procTop];
type ← CreateBlockRecordType[locals, bracketPair, rctw];
type ← CCTypes.GetIndirectType[type];
RETURN};
CreateBlockRecordType:
PROC [argumentList: RopeList, bracketPair: ObjF.BracketPair, rctw: RCTWData]
RETURNS [type: Type] ~ {
numberOfArguments: INT ← RopeListLength[argumentList];
abc: AnalyzedCTX;
index: INT;
abc ← NEW[AnalyzedCTXBody[numberOfArguments]];
index ← 0;
FOR remainingArguments: RopeList ← argumentList, remainingArguments.rest
WHILE remainingArguments #
NIL
DO
dotOListings: DotOListings ← DotOListingsFromRope[remainingArguments.first, rctw, bracketPair];
abc[index].name ← remainingArguments.first;
abc[index].idStab ← dotOListings;
SELECT dotOListings.kind
FROM
ordinary => abc[index].fiValid ← FALSE;
enumerator => {abc[index].fiValid ←
TRUE;
abc[index].fieldCase ← typeTimeConstant;
abc[index].fieldLoc ← abc[index].fieldDirectType ← NIL};
ENDCASE => ERROR;
index ← index + 1
ENDLOOP;
abc.blockRecord ← TRUE;
abc.bitSize ← CirioTypes.unspecdBA;
abc.rctw ← rctw;
abc.recordType ← Records.CreateRecordType[CTXRecordTypeProcs, rctw.cc, abc];
RETURN[abc.recordType]};
IsDigit:
PROC [c:
CHAR]
RETURNS [
BOOL]
= INLINE { RETURN [c IN ['0 .. '9]] };
GetTokenRope:
PUBLIC
PROC [stream:
IO.
STREAM]
RETURNS [
ROPE] ~ {
IsNonDigit:
PROC [c:
CHAR]
RETURNS [
BOOL]
= INLINE { RETURN [c IN ['a .. 'z] OR c IN ['A .. 'Z] OR c='← OR c = '-] };
IsAlphaNum:
PROC [c:
CHAR]
RETURNS [
BOOL]
= INLINE { RETURN [c IN ['0 .. '9] OR c IN ['a .. 'z] OR c IN ['A .. 'Z] OR c='← OR c = '-] };
token: ROPE ← NIL;
IF
NOT
IO.EndOf[stream]
AND IsNonDigit[
IO.PeekChar[stream]]
THEN {
token ← Rope.FromChar[IO.GetChar[stream]];
WHILE
NOT
IO.EndOf[stream]
AND IsAlphaNum[
IO.PeekChar[stream]]
DO
token ← Rope.Concat[token, Rope.FromChar[IO.GetChar[stream]]];
ENDLOOP};
RETURN[token]};
DotOListingsFromRope:
PROC [symbol:
ROPE, rctw: RCTWData, bracketPair: ObjF.BracketPair]
RETURNS [DotOListings] ~ {
bracketEntry: BracketEntry ← GetBracketEntry[bracketPair, rctw];
dotOListings: DotOListings ← NARROW[SymTab.Fetch[bracketEntry.symbolHashTable, symbol].val];
IF dotOListings = NIL THEN CCError[cirioError, Rope.Concat["no .o listings for ", symbol]];
RETURN [dotOListings]};
GetBracketEntry:
PROC [bracketPair: ObjF.BracketPair, rctw: RCTWData]
RETURNS [bracketEntry: BracketEntry] =
BEGIN
ProcessStab:
PROC [stab: ObjF.Stab]
RETURNS [
BOOLEAN] = {
ParseStab[stab, rctw, bracketEntry];
RETURN [FALSE];
};
bracketEntry ← NARROW[RefTab.Fetch[rctw.bracketHashTable, bracketPair].val];
IF bracketEntry =
NIL
THEN
BEGIN
bracketEntry ← NEW[BracketEntryBody];
bracketEntry.symbolHashTable ← SymTab.Create[];
bracketEntry.typeNameHashTable ← SymTab.Create[];
IF
NOT RefTab.Store[rctw.bracketHashTable, bracketPair, bracketEntry]
THEN
CCError[cirioError];
ObjF.GenSymbolStabs[bracketPair, ProcessStab];
END;
RETURN[bracketEntry]
END; -- of GetBracketEntry
GetSymbol:
PROC [sourceStream:
IO.
STREAM]
RETURNS [symbol:
ROPE] ~ {
WHILE
IO.PeekChar[sourceStream] # ':
DO
symbol ← Rope.Concat[symbol, Rope.FromChar[IO.GetChar[sourceStream]]];
ENDLOOP;
RETURN[symbol]
};
This procedure is copied from CCTypesImpl. It should really be promoted to the CCTypes interface.
CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE ← NIL] ← CCTypes.CCError;
FmtType:
PROC [type: Type, printDepth:
INT, printWidth:
INT, cc:
CC, oc: Type ←
NIL]
RETURNS [ans:
ROPE] = {
ENABLE CCE => {ans ← "??"; CONTINUE};
buf1: IO.STREAM ~ IO.ROS[];
CCTypes.PrintType[buf1, type, printDepth, printWidth, cc, oc];
RETURN [buf1.RopeFromROS]};
DebugStabParsing: BOOLEAN ← FALSE;
ParseStab:
PROC [stab: ObjF.Stab, rctw: RCTWData, bracketEntry: BracketEntry] ~ {
Bitch:
PROC [why:
ROPE]
~ {CCError[cirioError, IO.PutFR["%g in stab (X: %g, string: \"%q\") in %g", [rope[why]], [cardinal[stab.stabX]], [rope[stab.rope]], [rope[ObjF.DescribeModule[rctw.module]]] ]]};
Define:
PROC [name:
ROPE, l: ordinary DotOGlorp] ~ {
ls: DotOListings ← NARROW[bracketEntry.symbolHashTable.Fetch[name].val];
IF ls#
NIL
THEN
WITH ls
SELECT
FROM
x: DotOEnumr => CCError[cirioError, IO.PutFR["enumerator (%g=%g) has same name as a non-enumerator (stabX=%g, string=%g) in %g", [rope[name]], [integer[x.value]], [cardinal[stab.stabX]], [rope[stab.rope]], [rope[ObjF.DescribeModule[rctw.module]]] ]];
x: DotOListing =>
IF (x.directType # l.directType)
THEN {
SystemInterface.ShowReport[IO.PutFR["New type (%g) different from other one (%g) in stab (X: %g, string: \"%q\") in %g", [rope[FmtType[l.directType, 2,10, rctw.cc]]], [rope[FmtType[x.directType, 2,10, rctw.cc]]], [cardinal[stab.stabX]], [rope[stab.rope]], [rope[ObjF.DescribeModule[rctw.module]]] ], $normal];
RETURN};
ENDCASE => ERROR;
l.rest ← ls;
ls ← NEW [DotOGlorp[ordinary] ← l];
[] ← bracketEntry.symbolHashTable.Store[name, ls];
IF DebugStabParsing
THEN
SystemInterface.ShowReport[Rope.Cat["Defining symbol ", name, " in ", ObjectFiles.DescribeModule[rctw.module]], $urgent];
RETURN};
ParseStabFromRope:
PROC [stab: ObjF.Stab] ~ {
Type information is stored in an encoded rope.
SELECT stab.stabType FROM
LSym, GSym, PSym, STSym, LCSym, RSym, Fun => {
sourceStream: IO.STREAM ← IO.RIS[stab.rope];
symbol: ROPE ← GetSymbol[sourceStream];
symbolDescriptor: CHAR;
noDescriptor: BOOLEAN ← FALSE;
IF IO.GetChar[sourceStream] # ': THEN Bitch["no colon after symbol"];
symbolDescriptor ← IO.PeekChar[sourceStream ! IO.EndOfStream => Bitch["nothing after colon"]];
SELECT symbolDescriptor
FROM
't, 'T => {
This is a type declaration
type: Type;
IF IO.GetChar[sourceStream] # symbolDescriptor THEN ERROR;
type ← AnalyzeType[sourceStream, bracketEntry, rctw].directType;
IF Rope.IsEmpty[symbol]
THEN {
unnamed type of SunOS 5.x
e.g. "typedef struct {word f0, f1;} W2;" will generate following stab.
":T(0,29)=s8f0:(0,21),0,32;f1:(0,21),32,32;;"
"W2:t(0,30)=(0,29)"
symbol ← Rope.Concat["unnamed", Rope.Substr[stab.rope, 3, Rope.Find[stab.rope, ")"] - 3]];
};
IF
NOT bracketEntry.typeNameHashTable.Insert[symbol, type]
THEN {
oldVal: Type ~ NARROW[bracketEntry.typeNameHashTable.Fetch[symbol].val];
IF NOT (type = oldVal) THEN Bitch["symbol being redefined"];
IF
NOT (DeferringTypes.UndertypeStar[type] = DeferringTypes.UndertypeStar[oldVal])
THEN {
[] ← bracketEntry.typeNameHashTable.Replace[symbol, type];
SystemInterface.ShowReport[Rope.Cat["REDEFINING symbol ", symbol, " in ", ObjectFiles.DescribeModule[rctw.module]], $urgent];
};
};
};
'F, 'f, 'G, 'S, 'V, 'p, 'P, 'r => {
This is a not type symbol declaration
IF symbolDescriptor#'f AND symbolDescriptor#'F AND IO.GetChar[sourceStream]#symbolDescriptor THEN ERROR;
Define[symbol, [
NIL, ordinary[
descriptor: Rope.FromChar[symbolDescriptor],
directType: AnalyzeType[sourceStream, bracketEntry, rctw].directType,
stab: stab]]];
};
'( => {
--This must be either a local variable declaration or a register variable declaration
Define[symbol, [
NIL, ordinary[
descriptor: Rope.FromChar[symbolDescriptor],
directType: AnalyzeType[sourceStream, bracketEntry, rctw].directType,
stab: stab]]];
};
ENDCASE => {
IF IsDigit[symbolDescriptor]
OR symbolDescriptor = '-
THEN {
This must be either a local variable declaration or a register variable declaration
Define[symbol, [
NIL, ordinary[
descriptor: Rope.FromChar[symbolDescriptor],
directType: AnalyzeType[sourceStream, bracketEntry, rctw].directType,
stab: stab]]];
}
ELSE
Bitch["unrecognized descriptor"];
}
}
ENDCASE => {} -- We do not parse these types of stabs
};
ParseStabFromFile:
PROC [stab: ObjF.Stab] =
TRUSTED {
Type information stored in tables in the object file.
DefineFileStab:
PROC [name:
ROPE, l: ordinary DotOGlorp] =
TRUSTED {
ls: DotOListings ← NARROW[bracketEntry.symbolHashTable.Fetch[name].val];
l.rest ← ls;
ls ← NEW [DotOGlorp[ordinary] ← l];
[] ← bracketEntry.symbolHashTable.Store[name, ls];
RETURN
};
ParseTypeFromFile:
PROC [wireTables: SGI.WireTables] =
TRUSTED {
sourceStream: IO.STREAM ← IO.RIS[stab.rope];
symbol: ROPE ← GetSymbol[sourceStream];
auxIndex: INT32;
auxSyms: SGI.AuxSymTable ← wireTables.auxSyms;
typeInfo: SGI.WireTypeInfoBody;
basicType: CARD ← 0;
type: Type ← NIL;
thisSymAuxIndex: INT32;
maxQualifier: CARD = 256;
numQualifiers: INT32 ← 0;
qualifier: ARRAY [0..maxQualifier) OF BYTE; -- for now just make big enough to handle an outrageous number of qualifiers, CHANGE ME!
thisSym: SGI.WireSTEntry;
fdIndex: INT32;
access the current symbol entry and the file descriptor index
IF stab.extRef
THEN
{
thisSym ← LOOPHOLE[@wireTables.extSyms[stab.stabX].sym];
fdIndex ← wireTables.extSyms[stab.stabX].fileDescrIndex;
}
ELSE
{
thisSym ← LOOPHOLE[@wireTables.localSyms[stab.stabX]];
fdIndex ← stab.fdIndex;
};
thisSymAuxIndex ← auxIndex ← wireTables.fileDescr[fdIndex].iauxBase + thisSym.index;
SELECT stab.stabType
FROM
LSym, GSym, PSym, STSym, LCSym, RSym, Fun => {
IF stab.stabType = Fun
THEN
{
skip the endref
thisSymAuxIndex ← auxIndex + 1;
};
typeInfo ← auxSyms[auxIndex].typeInfo;
basicType ← typeInfo.basicType;
IF (basicType = SGI.BTNil)
THEN
RETURN;
count the number of type qualifiers
DO
typeInfo ← auxSyms[auxIndex].typeInfo;
auxIndex ← auxIndex + 1;
IF (typeInfo.typeQual0 = SGI.TQNil)
THEN
EXIT;
qualifier[numQualifiers] ← typeInfo.typeQual0;
numQualifiers ← numQualifiers + 1;
IF (typeInfo.typeQual1 = SGI.TQNil)
THEN
EXIT;
qualifier[numQualifiers] ← typeInfo.typeQual1;
numQualifiers ← numQualifiers + 1;
IF (typeInfo.typeQual2 = SGI.TQNil)
THEN
EXIT;
qualifier[numQualifiers] ← typeInfo.typeQual2;
numQualifiers ← numQualifiers + 1;
IF (typeInfo.typeQual3 = SGI.TQNil)
THEN
EXIT;
qualifier[numQualifiers] ← typeInfo.typeQual3;
numQualifiers ← numQualifiers + 1;
IF (typeInfo.typeQual4 = SGI.TQNil)
THEN
EXIT;
qualifier[numQualifiers] ← typeInfo.typeQual4;
numQualifiers ← numQualifiers + 1;
IF (typeInfo.typeQual5 = SGI.TQNil)
THEN
EXIT;
qualifier[numQualifiers] ← typeInfo.typeQual5;
numQualifiers ← numQualifiers + 1;
IF (numQualifiers > maxQualifier)
THEN
ERROR;
IF (
LOOPHOLE[typeInfo.continued,
CARD] = 0)
THEN
EXIT;
ENDLOOP;
IF numQualifiers # 0
THEN {
i,low,high,bitWidth: INT32;
qualifiers are basically in reverse order...including array dimensions
FOR i
IN [0..numQualifiers)
DO
SELECT qualifier[i]
FROM
SGI.TQNil => NULL; -- do nuthin, we should never get this
SGI.TQPtr => NULL; -- we have a pointer
SGI.TQProc => NULL; -- we have a function
SGI.TQVol => NULL; -- volatile is pretty irrelevant
SGI.TQArray =>
{
-- go past the rndx (it always is the same) and the blank
auxIndex ← auxIndex + 2;
low ← LOOPHOLE[auxSyms[auxIndex].lowIndex];
auxIndex ← auxIndex + 1;
high ← LOOPHOLE[auxSyms[auxIndex].highIndex];
auxIndex ← auxIndex + 1;
bitWidth ← LOOPHOLE[auxSyms[auxIndex].bitWidth];
auxIndex ← auxIndex + 1;
}
ENDCASE => NULL;
ENDLOOP;
SELECT qualifier[i]
FROM
SGI.TQPtr =>
-- we have a pointer
{
DefineFileStab[symbol, [NIL, ordinary[descriptor:Rope.FromChar['z], directType: AnalyzePointerTypeFileStab[thisSymAuxIndex, wireTables, bracketEntry, rctw, stab, stab.stabX].directType, stab: stab]]];
};
SGI.TQProc =>
-- we have a function returning
{
DefineFileStab[symbol, [NIL, ordinary[descriptor:Rope.FromChar['z], directType: AnalyzeProcedureTypeFileStab[thisSymAuxIndex, wireTables, bracketEntry, rctw, stab, stab.stabX].directType, stab: stab]]];
};
SGI.TQVol =>
-- volatile is pretty irrelevant
{
DefineFileStab[symbol, [NIL, ordinary[descriptor:Rope.FromChar['z], directType: AnalyzeTypeFromFile[thisSymAuxIndex, wireTables, bracketEntry, rctw, stab, stab.stabX].directType, stab: stab]]];
};
SGI.TQArray => NULL;
ENDCASE => NULL;
}
ELSE {
No Qualifiers
DefineFileStab[symbol, [NIL, ordinary[descriptor:Rope.FromChar['z], directType: AnalyzeTypeFromFile[thisSymAuxIndex, wireTables, bracketEntry, rctw, stab, stab.stabX].directType, stab: stab]]];
};
}
ENDCASE => {} -- We do not parse these types of stabs
};
module: Module;
parsed: Parsed;
wireTables: SGI.WireTables;
module ← LOOPHOLE[stab.module];
parsed ← module.whole;
wireTables ← LOOPHOLE[parsed.privateInfo];
ParseTypeFromFile[wireTables];
};
SELECT ObjectFiles.CGrammarOfStab[stab]
FROM
SunADotOut, XCOFF => ParseStabFromRope[stab];
SGIOBJ => ParseStabFromFile[stab];
UNKNOWN => NULL;
ENDCASE => Bitch["unrecognized C grammar type"];
};
StabValueAsInt:
PROC [x:
CARD32]
RETURNS [
INT]
~ {RETURN[LOOPHOLE[x, INT]]};
RemoteAddrFromCard:
PROC[rctw: RCTWData, card:
CARD, bitOffset:
CARD ← 0]
RETURNS[CirioNubAccess.RemoteAddress]
= {RETURN[[rctw.nub, card, bitOffset, FALSE, rctw.nub # NIL]]};
VarLocFromDotOListings:
PUBLIC
PROC [dotOListings: DotOListings, rctw: RCTWData]
RETURNS [VarLoc] ~ {
dol: DotOListing ← NIL;
indirectType: Type;
vl: VarLoc;
WHILE dol=
NIL
DO
WITH dotOListings
SELECT
FROM
x: DotOEnumr => CCError[cirioError, "asking for VarLoc of enumerator"];
x: DotOListing => {
goRound: BOOL ← x.stab.stabType#RSym AND dotOListings.rest#NIL;
IF goRound
THEN {
WITH dotOListings.rest
SELECT
FROM
y: DotOEnumr => CCError[cirioError, "mixed dotOListings"];
y: DotOListing => goRound ← y.stab.stabType=RSym;
ENDCASE => ERROR};
IF goRound
THEN dotOListings ← dotOListings.rest
ELSE dol ← x};
ENDCASE => ERROR;
ENDLOOP;
indirectType ← CCTypes.GetIndirectType[dol.directType];
vl ← ObjF.VarLocFromStab[dol.stab];
vl.bitSize ←
SELECT CCTypes.GetTypeClass[indirectType]
FROM
$unknown => 32,
ENDCASE => CCTypes.GetBitSize[indirectType, rctw.cc];
WITH vl
SELECT
FROM
nc:
REF namedCommon VarLocBody => {
EnsureAbsValid[rctw.nub, nc];
IF NOT nc.absFound THEN RETURN ObjF.MakeUnknownVarLoc[IO.PutFR1["named common %g not found", [rope[nc.name]] ]]};
ENDCASE => NULL;
RETURN [vl]};
EnsureAbsValid:
PUBLIC
PROC [nub: CirioNubAccess.Handle, nc:
REF namedCommon VarLocBody] ~ {
IF
NOT nc.absValid
THEN {
se: CirioNubAccess.SymEntry ~ CirioNubAccess.LookupSymEntryByName[nub, nc.name, TRUE, TRUE, 0];
IF se#NIL THEN {nc.absBase ← se.value; nc.absFound ← TRUE}
ELSE nc.absFound ← FALSE;
nc.absValid ← TRUE};
RETURN};
Returns the list of argument names for the current rctw. This is done by looking for
parameter stabs inside the second to last pair of bracket stabs in the current scope's
bracket nest.
ArgumentListFromRCTW:
PROC [rctw: RCTWData]
RETURNS [RopeList] ~ {
argumentList: RopeList ← NIL;
reverseArgumentList: RopeList ← NIL;
MakeArgsList:
PROC [stab: ObjF.Stab]
RETURNS [
BOOLEAN] ~ {
IF stab.stabType = PSym
THEN
BEGIN
sourceStream:IO.STREAM ← IO.RIS[stab.rope];
reverseArgumentList ← CONS[GetSymbol[sourceStream], reverseArgumentList]
END;
RETURN[FALSE]
};
lastBracketPair: ObjF.BracketPair;
lastBracketPair ← rctw.bracketNest.rest.first;
ObjF.GenSymbolStabs[lastBracketPair, MakeArgsList];
FOR remainingArguments: RopeList ← reverseArgumentList, remainingArguments.rest
WHILE remainingArguments #
NIL
DO
argumentList ← CONS[remainingArguments.first, argumentList];
ENDLOOP;
RETURN [argumentList]
};
LocalsListFromBracketPair:
PROC [bracketPair: ObjF.BracketPair, rctw: RCTWData, procTop:
BOOL]
RETURNS [RopeList] ~ {
localsList: RopeList ← NIL;
AddSymbol:
PROC [key:SymTab.Key, val:SymTab.Val]
RETURNS [
BOOLEAN] = {
FOR dotOListings: DotOListings ←
NARROW[val], dotOListings.rest
WHILE dotOListings#
NIL
DO
WITH dotOListings
SELECT
FROM
x: DotOListing => IF procTop AND x.stab.stabType=PSym THEN RETURN [FALSE];
x: DotOEnumr => NULL;
ENDCASE => ERROR;
REPEAT
FINISHED => localsList ← CONS[key, localsList];
ENDLOOP;
RETURN[FALSE]};
bracketEntry: BracketEntry ← GetBracketEntry[bracketPair, rctw];
[] ← SymTab.Pairs[bracketEntry.symbolHashTable, AddSymbol];
RETURN[localsList]};
RopeListLength:
PROC [list: RopeList]
RETURNS [length:
INT] ~ {
length ← 0;
FOR remaining: RopeList ← list, remaining.rest
WHILE remaining #
NIL
DO
length ← length + 1;
ENDLOOP
};
MakeSimpleFrame:
PUBLIC
PROC[frameInfo: ProcedureFrameInfo, rctw: RCTWData]
RETURNS[Node] = {
cc: CC ← rctw.cc;
globalsType: Type; --indirect
argsType: Type; --indirect
blockType: Type;
blockCount:INT ← 0;
blockTypeList: LIST OF Type ← NIL;
igftd: REF Frames.IndirectGlobalFrameTypeData;
igfd: REF Frames.IndirectGlobalFrameData;
iftd: REF Frames.IndirectFrameTypeData;
ifd: REF Frames.IndirectFrameData;
frameType: Type;
frameNode: Node;
frameMem: Mem;
BuildIGFTD:
PROC
RETURNS [
REF Frames.IndirectGlobalFrameTypeData] = {
x: REF Frames.IndirectGlobalFrameTypeData ← NEW[Frames.IndirectGlobalFrameTypeData ← [globalVars: globalsType]];
RETURN[x]};
BuildIGFD:
PROC
RETURNS [
REF Frames.IndirectGlobalFrameData] = {
x: REF Frames.IndirectGlobalFrameData ← NEW[Frames.IndirectGlobalFrameData];
x.globalVars ← CCTypes.CreateIndirectNode[igftd.globalVars, frameMem, rctw.cc];
x.descriptor ← CedarOtherPureTypes.CreateIndirectToAnUnknownType[CedarOtherPureTypes.CreateUnknownType[cc, "C Frame Descriptor"], "C Global Frame", cc];
RETURN[x]};
BuildIFTD:
PROC
RETURNS[
REF Frames.IndirectFrameTypeData] = {
x: REF Frames.IndirectFrameTypeData ← NEW[Frames.IndirectFrameTypeData[blockCount]];
index:INT ← 0;
x.enclosingContext ← Frames.CreateIndirectGlobalFrameType[igftd, cc];
x.args ← argsType;
x.results ← CCTypes.GetIndirectType[CreateZeroLengthRecordType[cc]];
FOR remainingBlocks:
LIST
OF Type ← blockTypeList, remainingBlocks.rest
WHILE remainingBlocks #
NIL
DO
x.blocks[index] ← remainingBlocks.first;
index ← index +1
ENDLOOP;
RETURN[x]};
BuildIFD:
PROC
RETURNS[
REF Frames.IndirectFrameData] = {
x: REF Frames.IndirectFrameData ← NEW[Frames.IndirectFrameData[blockCount]];
x.procedure ← CedarOtherPureTypes.CreateIndirectToAnUnknownType[CedarOtherPureTypes.CreateUnknownType[cc, "no procedure for simple c frame types"], "no procedure for simple c frame types", cc];
x.descriptor ← CedarOtherPureTypes.CreateIndirectToAnUnknownType[CedarOtherPureTypes.CreateUnknownType[cc, "C Frame Descriptor"], "C Frame Descriptor", cc];
x.enclosingContext ← Frames.CreateIndirectGlobalFrameNode[igfd, iftd.enclosingContext, cc];
x.args ← CCTypes.CreateIndirectNode[iftd.args, frameMem, rctw.cc];
x.results ← CreateZeroLengthRecordNode[iftd.results, cc];
FOR index:
INT
IN [0..iftd.nBlocks)
DO
x.blocks[index] ← CCTypes.CreateIndirectNode[iftd.blocks[index], frameMem, rctw.cc];
ENDLOOP;
RETURN[x]};
frameMem ← RMTWPrivate.MakeDualMem[rctw.nub, frameInfo.framePointer, frameInfo.stackPointer, [frameInfo.codeBase, INT.LAST], [frameInfo.dataBase, INT.LAST], [frameInfo.bssBase, INT.LAST], [unspecdBA, unspecdBA], [unspecdBA, unspecdBA] ];
[] ← frameMem.MemReadSegReg["text", 0]; --make sure it got created OK
globalsType ← CreateLocalsRecordType[rctw.bracketNest.first, rctw, FALSE];
igftd ← BuildIGFTD[];
igfd ← BuildIGFD[];
FOR remainingBrackets:ObjectFiles.BracketNest ← rctw.bracketNest.rest, remainingBrackets.rest
WHILE remainingBrackets #
NIL
DO
blockType ← CreateLocalsRecordType[remainingBrackets.first, rctw, blockCount=0];
blockTypeList ← CONS[blockType, blockTypeList];
blockCount ← blockCount + 1
ENDLOOP;
argsType ← CreateArgsRecordType[rctw];
iftd ← BuildIFTD[];
frameType ← Frames.CreateIndirectFrameType[iftd, cc];
ifd ← BuildIFD[];
frameNode ← Frames.CreateIndirectFrameNode[ifd, frameType, cc];
RETURN [frameNode]};
END..