RCTWOrdinaries.mesa
Copyright Ó 1989, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
Hopcroft, August 18, 1989 6:25:15 pm PDT
Last changed by Theimer on October 9, 1989 2:06:28 pm PDT
Sturgis, January 2, 1990 12:21:25 pm PST
Last tweaked by Mike Spreitzer on April 10, 1992 6:19 pm PDT
Philip James, February 24, 1992 10:22 am PST
Laurie Horton, June 24, 1992 6:47 pm PDT
Chauser, June 1, 1992 1:10 pm PDT
Katsuyuki Komatsu December 17, 1992 5:59 pm PST
Jas, January 5, 1993 12:04 pm PST
Willie-s, January 22, 1993 5:50 pm PST
DIRECTORY
Basics,
Basics16,
CCTypes USING[CCError, CCErrorCase, CreateIndirectNode, GetAnyTargetType, GetBitSize, GetIndirectCreateNode, GetIndirectType, GetRTargetType, GetTypeClass, Operator],
CedarCode USING[CreateCedarNode, GetDataFromNode, GetNodeRepresentation, OperationsBody],
CedarOtherPureTypes USING[CreateIndirectToAnUnknownType, CreateUnknownType, CreateUnknownTypeNode],
CirioMemory,
CirioNubAccess USING[Handle, RemoteAddress, RemoteAddrFault],
CirioTypes,
CPointerTypes USING [CreatePointerType, PointerNodeInfo, PointerNodeInfoBody, CreatePointerNode],
CNumericTypes USING [CreateNumericNode, CreateNumericType, GetDescriptorFromCNumericType, NumericDescriptor, NumericDescriptorBody, PrimaryTag],
Convert USING [Error, IntFromRope, RopeFromChar],
DeferringTypes,
IO,
LoadStateAccess USING [BasicPCInfo, GetBasicPCInfo, LoadStateHandle],
ObjectFiles,
ObjectFilesPrivate,
Procedures,
RCTW,
RefTab USING [Create, Key, Ref, Store],
RealFns USING [Power],
Records USING[CreateIndirectRecordNode, CreateRecordType, FieldCase, IndirectRecordNodeProcs, RecordTypeProcs],
RMTWPrivate,
Rope USING[Cat, Concat, Equal, FromChar, ROPE],
SGI,
SymTab,
SystemInterface;
RCTWOrdinaries: CEDAR PROGRAM
IMPORTS Basics, Basics16,CCTypes, CedarCode, CedarOtherPureTypes, CirioMemory, CirioNubAccess, CirioTypes, CNumericTypes, Convert, CPointerTypes, DeferringTypes, IO, LoadStateAccess, ObjectFiles, Procedures, RCTW, RealFns, Records, RefTab, RMTWPrivate, Rope, SGI, SymTab, SystemInterface
EXPORTS RCTW
= BEGIN OPEN LSA:LoadStateAccess, ObjF:ObjectFiles, RCTW;
CC: TYPE = CirioTypes.CompilerContext;
CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE ¬ NIL] ¬ CCTypes.CCError;
SIRep: TYPE ~ INT;
LIRep: TYPE ~ INT;
SCRep: TYPE ~ CARD;
LCRep: TYPE ~ CARD;
AnalyzeType: PUBLIC PROC[sourceStream: IO.STREAM, bracketEntry: BracketEntry, rctw: RCTWData] RETURNS[ati: RCTW.AnalyzedTypeInfo] ~ {
If this is a definition, then check if already defined.
If so, then ERROR.
Otherwise,
Create a DeferringType that is undefined.
Do the analysis (recursively).
Set the DeferringType to the result of the analysis.
Return the DeferringType.
If a typeref but not a definition, then check if defined.
If not, create an UnknownType.
Return the UnknownType.
Otherwise,
Return the Type.
If not a typeref, then
Do the analysis (recursively).
Return the Type.
temp: CHAR ¬ IO.PeekChar[sourceStream];
ati ¬ NIL;
SELECT TRUE FROM
IsDigit[temp] OR temp = '( OR temp = '- => -- This might be a definition
RETURN[AnalyzeTypeDef[sourceStream, bracketEntry, rctw]];
temp = '* => --This is a pointer type
ati ¬ AnalyzePointerTypeStab[sourceStream, bracketEntry, rctw];
temp = 'a => --This is an array type - create a pointer
ati ¬ AnalyzePointerTypeStab[sourceStream, bracketEntry, rctw];
temp = 'b => --This is a bitwise type (SunOS 5.0)
ati ¬ AnalyzeBitwiseTypeStab[sourceStream, bracketEntry, rctw];
temp = 'R => --This is a floating point type (SunOS 5.0)
ati ¬ AnalyzeRealTypeStab[sourceStream, bracketEntry, rctw];
temp = 'r => --This is a subrange or a floating point type
ati ¬ AnalyzeNumericTypeStab[sourceStream, bracketEntry, rctw];
temp = 's OR temp = 'u => --This is a bit field, record or union type.
ati ¬ AnalyzeRecordTypeStab[sourceStream, bracketEntry, rctw];
temp = 'e => --This is an enumerated type
ati ¬ AnalyzeEnumeratedTypeStab[sourceStream, bracketEntry, rctw];
temp = 'f OR temp = 'F => --This is a procedure type
ati ¬ AnalyzeProcedureTypeStab[sourceStream, bracketEntry, rctw];
temp = 'x => --This is a structure (or union?) reference
ati ¬ AnalyzeReferenceTypeStab[sourceStream, bracketEntry, rctw];
ENDCASE =>
RETURN[AnalyzedUnknownType[Rope.FromChar[temp].Concat[" and then some"], rctw]]; -- for typeClass SELECT
IF ati = NIL THEN CCE[cirioError, IO.PutFR1["ati is NIL in RCTWOrdinaries.AnalyzeType for type beginning with: %g", [character[temp]]]];
RETURN;
};
AnalyzeTypeFromFile: PUBLIC PROC[auxIndex: INT32, wireTables: SGI.WireTables, bracketEntry: BracketEntry, rctw: RCTWData, stab: ObjF.Stab, symTabIndex: CARD] RETURNS[ati: RCTW.AnalyzedTypeInfo ¬ NIL] ~ TRUSTED {
i,structIndex,auxCount,basicType, numQualifiers: CARD ¬ 0;
typeInfo: SGI.WireTypeInfoBody;
auxSyms: SGI.AuxSymTable ¬ wireTables.auxSyms;
type: Type ¬ NIL;
IndexNil: CARD = 0FFFFFH; -- max valid index for aux entries
fdIndex: INT32;
thisSym: SGI.WireSTEntry;
access the current symbol entry and the file descriptor index
IF stab.extRef THEN
{
thisSym ¬ LOOPHOLE[@wireTables.extSyms[symTabIndex].sym];
fdIndex ¬ wireTables.extSyms[symTabIndex].fileDescrIndex;
}
ELSE
{
thisSym ¬ LOOPHOLE[@wireTables.localSyms[symTabIndex]];
fdIndex ¬ stab.fdIndex;
};
IF auxIndex = IndexNil THEN
{
type ¬ AnalyzeNumericFileStab[[primary: signed, secondary: integer], 32, rctw].directType;
RETURN[NEW[AnalyzedTypeInfoBody¬[atiValid: TRUE, atiIsProc: FALSE, directType: type, rctw: rctw]]];
};
typeInfo ¬ auxSyms[auxIndex].typeInfo;
basicType ¬ typeInfo.basicType;
SELECT basicType FROM
SGI.BTChar => -- character
{ 
type ¬ AnalyzeNumericFileStab[[primary: signed, secondary: character], 8, rctw].directType;
};
SGI.BTUchar => -- unsigned character
{ 
type ¬ AnalyzeNumericFileStab[[primary: unsigned, secondary: character], 8, rctw].directType;
};
SGI.BTShort => -- short
{ 
type ¬ AnalyzeNumericFileStab[[primary: signed, secondary: shortInteger], 16, rctw].directType;
};
SGI.BTUshort => -- unsigned short
{ 
type ¬ AnalyzeNumericFileStab[[primary: unsigned, secondary: shortInteger], 16, rctw].directType;
};
SGI.BTRange, -- subrange of int
SGI.BTInt,  -- integer  
SGI.BTLong => -- long
{ 
type ¬ AnalyzeNumericFileStab[[primary: signed, secondary: integer], 32, rctw].directType;
};
SGI.BTAdr,  -- address
SGI.BTUint,  -- unsigned int
SGI.BTUlong => -- unsigned long
{ 
type ¬ AnalyzeNumericFileStab[[primary: unsigned, secondary: integer], 32, rctw].directType;
};
SGI.BTFloat,   -- float (real)
SGI.BTDouble => -- Double (real
{ 
type ¬ AnalyzeNumericFileStab[[primary: float], 32, rctw].directType;
};
SGI.BTVoid => -- void
{ -- void
type ¬ AnalyzeNumericFileStab[[primary: signed, secondary: integer], 0, rctw].directType;
};
Record Types
SGI.BTStruct, -- Structure (Record)
SGI.BTUnion => -- Union (variant)
{
type ¬ AnalyzeStructTypeFileStab[auxIndex, fdIndex, wireTables, bracketEntry, rctw, stab, symTabIndex].directType;
};
SGI.BTEnum => -- Enumerated
{ 
type ¬ AnalyzeEnumeratedTypeFileStab[auxIndex, fdIndex, wireTables, bracketEntry, rctw, stab, symTabIndex].directType;
};
SGI.BTTypedef => -- defined via a typedef, isymRef points
{ 
type ¬ AnalyzeTypeDefFileStab[auxIndex, fdIndex, wireTables, bracketEntry, rctw, stab, symTabIndex].directType;
};
SGI.BTString => NULL; -- Varying Length Character String
SGI.BTBit => NULL; -- Aligned Bit String
Unknown Types
SGI.BTSet => {  -- pascal sets
type ¬ CedarOtherPureTypes.CreateUnknownType[rctw.cc, IO.PutFR1["<unimplemented .o type pascal sets from %g>", [rope[ObjF.DescribeModule[rctw.module]]] ]]};
SGI.BTComplex => {  -- fortran complex
type ¬ CedarOtherPureTypes.CreateUnknownType[rctw.cc, IO.PutFR1["<unimplemented .o type fortran complex from %g>", [rope[ObjF.DescribeModule[rctw.module]]] ]]};
SGI.BTDcomplex => { -- fortran double complex
type ¬ CedarOtherPureTypes.CreateUnknownType[rctw.cc, IO.PutFR1["<unimplemented .o type fortran double complex from %g>", [rope[ObjF.DescribeModule[rctw.module]]] ]]};
SGI.BTIndirect => NULL; -- forward or unnamed typedef
SGI.BTFixeddec => { -- Fixed Decimal
type ¬ CedarOtherPureTypes.CreateUnknownType[rctw.cc, IO.PutFR1["<unimplemented .o type Fixed Decimal from %g>", [rope[ObjF.DescribeModule[rctw.module]]] ]]};
SGI.BTFloatdec => { -- Float Decimal
type ¬ CedarOtherPureTypes.CreateUnknownType[rctw.cc, IO.PutFR1["<unimplemented .o type Float Decimal from %g>", [rope[ObjF.DescribeModule[rctw.module]]] ]]};
SGI.BTPicture => { -- Picture
type ¬ CedarOtherPureTypes.CreateUnknownType[rctw.cc, IO.PutFR1["<unimplemented .o type Picture from %g>", [rope[ObjF.DescribeModule[rctw.module]]] ]]};
ENDCASE => ERROR;
RETURN[NEW[AnalyzedTypeInfoBody¬[atiValid: TRUE, atiIsProc: FALSE, directType: type, rctw: rctw]]];
};
IsDigit: PROC [c: CHAR] RETURNS [BOOL]
= INLINE { RETURN [c IN ['0 .. '9]] };
IsHexDigit: PROC [c: CHAR] RETURNS [BOOL]
= INLINE { RETURN [c IN ['0 .. '9] OR c IN ['a .. 'f] OR c IN ['A .. 'F]] };
RopeFromStream: PROC [sourceStream: IO.STREAM, start: INT] RETURNS [Rope.ROPE] ~ {
current: INT ¬ sourceStream.GetIndex;
copyStream: IO.STREAM ~ IO.ROS[];
sourceStream.SetIndex[start];
FOR index: INT IN [start..current) DO
copyStream.PutChar[sourceStream.GetChar];
ENDLOOP;
sourceStream.SetIndex[current];
RETURN[copyStream.RopeFromROS[]];
};
GetDecimal: PROC [stream: IO.STREAM] RETURNS [INT] ~ {
token: Rope.ROPE ¬ "";
{ENABLE Convert.Error => GOTO doesntConvert;
{ ENABLE IO.EndOfStream => GOTO finishUp;
token: Rope.ROPE ¬ "";
char: CHAR ¬ IO.PeekChar[stream];
IF char = '- OR char = '+ THEN
BEGIN
token ¬ Rope.FromChar[IO.GetChar[stream]];
char ¬ IO.PeekChar[stream]
END;
IF char = '0 THEN
BEGIN
[] ¬ IO.GetChar[stream];
token ¬ Rope.Concat[token, "0"];
char ¬ IO.PeekChar[stream];
IF char = 'x THEN BEGIN
[] ¬ IO.GetChar[stream];
WHILE IsHexDigit[IO.PeekChar[stream]] DO
token ¬ Rope.Concat[token, Rope.FromChar[IO.GetChar[stream]]];
ENDLOOP;
RETURN[Convert.IntFromRope[token, 16]]
END
END;
WHILE IsDigit[IO.PeekChar[stream]] DO
token ¬ Rope.Concat[token, Rope.FromChar[IO.GetChar[stream]]];
ENDLOOP;
RETURN[Convert.IntFromRope[token]];
EXITS
finishUp => RETURN[Convert.IntFromRope[token]];
};
EXITS
doesntConvert => RETURN[-1];
};
};
GetDecimal: PROC [stream: IO.STREAM] RETURNS [INT] ~ {
token: Rope.ROPE ← "";
value: INT ← -1;
base: CARD ← 10;
parsed: BOOL ← FALSE;
char: CHAR ← IO.PeekChar[stream];
IF char = '- OR char = '+ THEN {
token ← Rope.FromChar[IO.GetChar[stream]];
char ← IO.PeekChar[stream];
};
IF char = '0 THEN {
[] ← IO.GetChar[stream];
token ← Rope.Concat[token, "0"];
base ← 10;
parsed ← FALSE;
IF NOT IO.EndOf[stream] THEN {
parsed ← TRUE;
char ← IO.PeekChar[stream];
IF char = 'x THEN {
[] ← IO.GetChar[stream];
WHILE NOT IO.EndOf[stream] AND IsHexDigit[IO.PeekChar[stream]] DO
token ← Rope.Concat[token, Rope.FromChar[IO.GetChar[stream]]];
ENDLOOP;
base ← 16;
parsed ← TRUE;
};
};
};
IF NOT parsed THEN {
WHILE NOT IO.EndOf[stream] AND IsDigit[IO.PeekChar[stream]] DO
token ← Rope.Concat[token, Rope.FromChar[IO.GetChar[stream]]];
ENDLOOP;
base ← 10;
parsed ← TRUE;
};
IF parsed THEN {
value ← Convert.IntFromRope[token, base !
Convert.Error => {
value ← LOOPHOLE[(Convert.CardFromRope[token, base]), INT];
CONTINUE;
};
];
};
RETURN[value];
};
DebugStabParsing: BOOLEAN ¬ FALSE;
AnalyzeTypeDef: PROC[sourceStream:IO.STREAM, bracketEntry: RCTW.BracketEntry, rctw: RCTW.RCTWData] RETURNS [RCTW.AnalyzedTypeInfo] ~ {
typeRef: ROPE ¬ ObjF.GetTypeRef[rctw.module, sourceStream];
ati: RCTW.AnalyzedTypeInfo ¬ NIL;
dti: RCTW.AnalyzedTypeInfo;
IF NOT IO.EndOf[sourceStream] AND IO.PeekChar[sourceStream] = '= THEN {--This is a typedef
analyzedTypeInfo: RCTW.AnalyzedTypeInfo;
IF IO.GetChar[sourceStream]#'= THEN ERROR; -- remove the '= from the stream
Create a DeferringType as a place holder and put it in the hash table
dti ¬ DeferringType[rctw];
IF DebugStabParsing THEN
SystemInterface.ShowReport[Rope.Cat["Creating DeferringType for ", typeRef, " in ", ObjectFiles.DescribeModule[rctw.module]], $urgent];
IF NOT SymTab.Insert
[rctw.typeRefHashTable, typeRef, dti] THEN
CCE[cirioError, Rope.Concat["redefinition of typeRef ", typeRef]];
analyzedTypeInfo ¬ RCTW.AnalyzeType[sourceStream, bracketEntry, rctw];
IF DebugStabParsing THEN
SystemInterface.ShowReport[Rope.Cat["Defining ", typeRef, " in ", ObjectFiles.DescribeModule[rctw.module]], $urgent];
IF NOT SymTab.Insert[rctw.typeRefHashTable, typeRef, analyzedTypeInfo] THEN {
old: RCTW.AnalyzedTypeInfo ~ NARROW[rctw.typeRefHashTable.Fetch[typeRef].val];
IF old=analyzedTypeInfo THEN ati ¬ old
ELSE
IF DeferringTypes.IsDeferring[old.directType] THEN {
DeferringTypes.SetUndertype[old.directType, analyzedTypeInfo.directType];
IF DebugStabParsing THEN
SystemInterface.ShowReport[Rope.Cat["Setting UnderType for ", typeRef, " in ", ObjectFiles.DescribeModule[rctw.module]], $urgent];
[] ¬ SymTab.Replace[rctw.typeRefHashTable, typeRef, analyzedTypeInfo];
ati ¬ old}
ELSE
IF
DeferringTypes.IsDeferring[analyzedTypeInfo.directType]
THEN {
DeferringTypes.SetUndertype[ analyzedTypeInfo.directType, old.directType];
ati ¬ analyzedTypeInfo}
ELSE {
SystemInterface.ShowReport[Rope.Cat["redefinition of typeRef ", typeRef, " in ", ObjectFiles.DescribeModule[rctw.module]], $urgent];
[] ¬ SymTab.Replace[rctw.typeRefHashTable, typeRef, analyzedTypeInfo];
<<CCError[cirioError, Rope.Concat["redefinition of typeRef ", typeRef]];>>};
};
}
ELSE { -- # '= --
found: BOOLEAN;
refany: REF ANY;
[found, refany] ¬ rctw.typeRefHashTable.Fetch[typeRef];
ati ¬ NARROW[refany];
IF NOT found THEN ati ¬ AnalyzedUnknownType[typeRef, rctw];
IF DebugStabParsing THEN
IF found THEN {
SystemInterface.ShowReport[Rope.Cat[typeRef, " FOUND in ", ObjectFiles.DescribeModule[rctw.module]], $urgent];
}
ELSE {
SystemInterface.ShowReport[Rope.Cat[typeRef, " NOT FOUND in ", ObjectFiles.DescribeModule[rctw.module]], $urgent];
};
};
IF ati = NIL THEN CCE[cirioError, IO.PutFR1["ati is NIL in RCTWOrdinaries.AnalyzeTypeDef for typeRef %g", [rope[typeRef]]]];
RETURN[ati];
};
AnalyzeTypeDefFileStab: PROC[auxIndex: INT32, fdIndex: INT32, wireTables: SGI.WireTables, bracketEntry: RCTW.BracketEntry, rctw: RCTW.RCTWData, stab: ObjF.Stab, symTabIndex: CARD] RETURNS [RCTW.AnalyzedTypeInfo] ~ TRUSTED {
ati: RCTW.AnalyzedTypeInfo ¬ NIL;
dti: RCTW.AnalyzedTypeInfo;
typeRef: ROPE;
auxSyms: SGI.AuxSymTable ¬ wireTables.auxSyms;
symBaseIndex, symIndex, stringOffset: CARD;
stringBaseIndex: CARD;
analyzedTypeInfo: RCTW.AnalyzedTypeInfo;
stringTable: SGI.StringTable ¬ wireTables.localStrings;
currentIndex: CARD;
relIndex: SGI.WireRelIndexBody;
relFileIndex: INT32;
relFileOffset: INT32;
relIndex ¬ auxSyms[auxIndex+1].relIndex;
IF relIndex.relFileDescrIndex = 0FFFH THEN
{
relFileIndex ¬ auxSyms[auxIndex+2].relFileIndex;
}
ELSE
{
relFileIndex ¬ relIndex.relFileDescrIndex;
};
relFileOffset ¬ wireTables.fileDescr[fdIndex].rfdBase + relFileIndex;
IF relFileOffset # 0 THEN
fdIndex ¬ wireTables.relFiles[relFileOffset];
symIndex ¬ relIndex.index;
symBaseIndex ¬ wireTables.fileDescr[fdIndex].isymBase;
stringBaseIndex ¬ wireTables.fileDescr[fdIndex].issBase;
currentIndex ¬ symIndex + symBaseIndex;
stringOffset ¬ wireTables.localSyms[currentIndex].symStringIndex;
typeRef ¬ RopeFromStringTable[stringTable, stringBaseIndex+stringOffset];
Create a DeferringType as a place holder and put it in the hash table
dti ¬ DeferringType[rctw];
IF DebugStabParsing THEN
SystemInterface.ShowReport[Rope.Cat["Creating DeferringType for ", typeRef, " in ", ObjectFiles.DescribeModule[rctw.module]], $urgent];
[] ¬ SymTab.Insert[rctw.typeRefHashTable, typeRef, dti];
the new auxIndex is the stTypedef symbols` auxIndex
auxIndex ¬ wireTables.fileDescr[fdIndex].iauxBase + wireTables.localSyms[currentIndex].index;
analyzedTypeInfo ¬ AnalyzeTypeFromFile[auxIndex, wireTables, bracketEntry, rctw, stab, currentIndex];
IF DebugStabParsing THEN
SystemInterface.ShowReport[Rope.Cat["Defining ", typeRef, " in ", ObjectFiles.DescribeModule[rctw.module]], $urgent];
IF NOT SymTab.Insert[rctw.typeRefHashTable, typeRef, analyzedTypeInfo] THEN {
old: RCTW.AnalyzedTypeInfo ~ NARROW[rctw.typeRefHashTable.Fetch[typeRef].val];
IF old=analyzedTypeInfo THEN ati ¬ old
ELSE
IF DeferringTypes.IsDeferring[old.directType] THEN {
DeferringTypes.SetUndertype[old.directType, analyzedTypeInfo.directType];
IF DebugStabParsing THEN
SystemInterface.ShowReport[Rope.Cat["Setting UnderType for ", typeRef, " in ", ObjectFiles.DescribeModule[rctw.module]], $urgent];
[] ¬ SymTab.Replace[rctw.typeRefHashTable, typeRef, analyzedTypeInfo];
ati ¬ old}
ELSE
IF
DeferringTypes.IsDeferring[analyzedTypeInfo.directType]
THEN {
DeferringTypes.SetUndertype[ analyzedTypeInfo.directType, old.directType];
ati ¬ analyzedTypeInfo}
ELSE {
ati ¬ analyzedTypeInfo;
<<[] ¬ SymTab.Replace[rctw.typeRefHashTable, typeRef, analyzedTypeInfo];
CCError[cirioError, Rope.Concat["redefinition of typeRef ", typeRef]];>>};
};
IF ati = NIL THEN CCE[cirioError, IO.PutFR1["ati is NIL in RCTWOrdinaries.AnalyzeTypeDef for typeRef %g", [rope[typeRef]]]];
RETURN[ati];
};
Deferring Types
DeferringType: PROC [rctw: RCTWData] RETURNS [RCTW.AnalyzedTypeInfo] ~ {
deferringType: Type ¬ DeferringTypes.CreateDeferringType[rctw.cc];
analyzedTypeInfo: AnalyzedTypeInfo ¬ NEW[AnalyzedTypeInfoBody ¬ [atiValid: TRUE, atiIsProc: FALSE, directType: deferringType, rctw: rctw]];
RETURN[analyzedTypeInfo]
};
Unknown Types
AnalyzeReferenceTypeStab: PROC [sourceStream: IO.STREAM, bracketEntry: BracketEntry, rctw: RCTWData] RETURNS[ati: AnalyzedTypeInfo] ~ {
x: CHAR ~ sourceStream.GetChar[];
kind: CHAR ~ sourceStream.GetChar[];
peek, colon: CHAR;
ref, dot: ROPE;
IF x#'x THEN ERROR;
IF kind#'s AND kind#'u THEN CCE [syntax, Rope.Concat["x", Rope.FromChar[kind]]];
peek ¬ sourceStream.PeekChar[];
IF RefTok[peek] # other THEN CCE [syntax, Rope.Cat["x", Rope.FromChar[kind], Rope.FromChar[peek]]];
ref ¬ IO.GetTokenRope[sourceStream, RefTok].token;
colon ¬ sourceStream.GetChar[];
dot ¬ Rope.Cat["x", Rope.FromChar[kind], ref, Rope.FromChar[colon]];
IF colon#': THEN CCE [syntax, dot];
RETURN AnalyzedUnknownType[dot, rctw]};
RefTok: PROC [char: CHAR] RETURNS [IO.CharClass]
~ {RETURN [SELECT char FROM ': => break, ENDCASE => other]};
AnalyzedUnknownType: PUBLIC PROC [typeRef: Rope.ROPE, rctw: RCTWData] RETURNS [AnalyzedTypeInfo] ~ {
analyzedTypeInfo: AnalyzedTypeInfo ¬ NEW[AnalyzedTypeInfoBody ¬ [
atiValid: TRUE, atiIsProc: FALSE,
directType: CedarOtherPureTypes.CreateUnknownType[rctw.cc, IO.PutFR["<unimplemented .o type %g from %g>", [rope[typeRef]], [rope[ObjF.DescribeModule[rctw.module]]] ]],
rctw: rctw]];
RETURN[analyzedTypeInfo]
};
UnimplementedTypeNode: PROC[indirectType: Type, rctw: RCTWData, explanation: Rope.ROPE, indirect: BOOL] RETURNS[Node] = {
targetType: Type ~ CedarOtherPureTypes.CreateUnknownType[rctw.cc, explanation];
IF indirect THEN RETURN[CedarOtherPureTypes.CreateIndirectToAnUnknownType[targetType, explanation, rctw.cc]];
RETURN[CedarOtherPureTypes.CreateUnknownTypeNode[targetType, explanation, rctw.cc]]};
PointerTypes
AnalyzedPointerTypeStab: TYPE = REF AnalyzedPointerTypeStabBody;
AnalyzedPointerTypeStabBody: TYPE = RECORD[
rctw: RCTWData,
directType: Type,
size: CARD,
directTargetType: Type
];
AnalyzePointerTypeStab: PROC[sourceStream: IO.STREAM, bracketEntry: BracketEntry, rctw: RCTWData] RETURNS[AnalyzedTypeInfo] ~ {
array: BOOL ~ SELECT sourceStream.GetChar[] FROM '* => FALSE, 'a => TRUE, ENDCASE => ERROR CCE[cirioError, "can't happen: AnalyzePointerTypeStab called with stream at non-* non-a char"];
indexATI: AnalyzedTypeInfo ~ IF array THEN AnalyzeType[sourceStream, bracketEntry, rctw] ELSE NIL;
sep: Rope.ROPE ~ IF array
THEN SELECT sourceStream.GetChar[] FROM
'; => ";",
ENDCASE => ERROR CCE[cirioError, "found array type constructor (in DBX stab) without semicolon between index and element types"]
ELSE NIL;
targetATI: AnalyzedTypeInfo ~ AnalyzeType[sourceStream, bracketEntry, rctw];
IF array THEN RETURN AnalyzedUnknownType["Arrays aren't implemented yet.", rctw]; --arrays are NOT just pointers - rather than duplicate the code in RMTWCompounds, wait 'till we can call it
{private: AnalyzedPointerTypeStab ~ NEW[AnalyzedPointerTypeStabBody¬[
rctw: rctw,
size: 32,
directTargetType: targetATI.directType]];
bti: BasicTypeInfo ~ NEW [BasicTypeInfoPrivate ¬ [CreatePointerIndirect, GetPointerBitSize, private]];
private.directType ¬ CPointerTypes.CreatePointerType[private.directTargetType, rctw.cc, bti];
RETURN[NEW[AnalyzedTypeInfoBody¬[atiValid: TRUE, atiIsProc: FALSE, directType: private.directType, rctw: rctw]]]}};
AnalyzePointerTypeFileStab: PUBLIC PROC[auxIndex: INT32, wireTables: SGI.WireTables, bracketEntry: BracketEntry, rctw: RCTWData, stab: ObjF.Stab, symTabIndex: CARD] RETURNS[AnalyzedTypeInfo] ~ {
targetType: Type ~ AnalyzeTypeFromFile[auxIndex, wireTables, bracketEntry, rctw, stab, symTabIndex].directType;
{private: AnalyzedPointerTypeStab ~ NEW[AnalyzedPointerTypeStabBody¬[
rctw: rctw,
size: 32,
directTargetType: targetType]];
bti: BasicTypeInfo ~ NEW [BasicTypeInfoPrivate ¬ [CreatePointerIndirect, GetPointerBitSize, private]];
private.directType ¬ CPointerTypes.CreatePointerType[private.directTargetType, rctw.cc, bti];
RETURN[NEW[AnalyzedTypeInfoBody¬[atiValid: TRUE, atiIsProc: FALSE, directType: private.directType, rctw: rctw]]]}};
GetPointerBitSize: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type] RETURNS[CARD] ~ {
private: AnalyzedPointerTypeStab ¬ NARROW[bti.btiData];
RETURN[private.size]};
CreatePointerIndirect: PROC [bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
private: AnalyzedPointerTypeStab ¬ NARROW[bti.btiData];
nodeData: REF PointerNodeData ¬ NEW[PointerNodeData ¬ [private, mem]];
RETURN[CedarCode.CreateCedarNode[PointerOps, indirectType, nodeData]]};
PointerNodeData: TYPE = RECORD[
private: AnalyzedPointerTypeStab,
mem: Mem];
PointerOps: REF CedarCode.OperationsBody ¬ NEW[CedarCode.OperationsBody¬[
store: PointerStore,
load: PointerLoad]];
PointerDirect: TYPE ~ REF PointerDirectPrivate;
PointerDirectPrivate: TYPE ~ RECORD [
addr: CARD,
eltSize: INT,
pnd: REF PointerNodeData,
targetMem: Mem];
PointerStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] = {
nodeData: REF PointerNodeData ~ NARROW[CedarCode.GetDataFromNode[indirectNode]];
rctw: RCTWData ~ nodeData.private.rctw;
mem: Mem ~ nodeData.mem;
pointerSize: CARD ~ nodeData.private.size;
valInfo: REF ANY ~ CedarCode.GetDataFromNode[valNode];
WITH valInfo SELECT FROM
valPni: CPointerTypes.PointerNodeInfo => {
valPD: PointerDirect ~ NARROW[valPni.data];
mem.MemWrite[valPD.addr, 32, zeroBA]};
ENDCASE => CCE[operation, "Can't store a non-C pointer into a C pointer"];
RETURN};
cNIL: CARD ¬ 0;
PointerLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = {
nodeData: REF PointerNodeData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];
rctw: RCTWData ¬ nodeData.private.rctw;
mem: Mem ¬ nodeData.mem;
pointerSize: CARD ¬ nodeData.private.size;
we nest a block to handle unknown address, allowing nodeData to be visible
{ENABLE {
CirioNubAccess.RemoteAddrFault => GOTO unknownAddress;
CCE => GOTO unknownAddress};
fieldSizeBa: BitAddr ¬ mem.MemGetSize[];
fieldSize: CARD ¬ fieldSizeBa.BaToBits[];
addrBits: CARD ¬ mem.MemRead[bitsPerPtr, zeroBA];
<<IF (addr.byteAddress = cNIL AND addr.bitOffset = 0) OR addr.nil OR NOT addr.valid THEN RETURN[CPointerTypes.CreateNilPointerNode[cc]];>>
{directTargetType: Type ~ nodeData.private.directTargetType;
indirectTargetType: Type ~ CCTypes.GetIndirectType[directTargetType];
referentSize: CARD ¬ 0;
referentSizeBa: BitAddr ¬ unspecdBA;
targetMem: Mem;
info: CPointerTypes.PointerNodeInfo;
{ --MJS, January 10, 1992: Made the targetMem use the referentSize, so that NumericLoad will have a meaningful fieldSize
ENABLE CCE => CONTINUE;
referentSize ¬ CCTypes.GetBitSize[indirectTargetType, cc];
referentSizeBa ¬ CirioMemory.BitsToBa[referentSize]};
targetMem ¬ CirioMemory.CreateSimpleMem[[rctw.nub, LOOPHOLE[addrBits], 0, addrBits=0 OR addrBits=CARD.LAST, TRUE], referentSizeBa];
info ¬ NEW[CPointerTypes.PointerNodeInfoBody ¬ [
clientTargetType: directTargetType,
indirectToClientTarget: CCTypes.CreateIndirectNode[indirectTargetType, targetMem, cc],
add: PointerAdd,
subtract: PointerSubtract,
compare: PointerCompare,
data: NEW [PointerDirectPrivate ¬ [addrBits, referentSize, nodeData, targetMem]] ]];
RETURN[CPointerTypes.CreatePointerNode[nodeData.private.directType, info, cc]];
};
EXITS
unknownAddress => RETURN[UnimplementedTypeNode[indirectType, rctw, "pointer at (not to) bad address", FALSE]];
}};
PointerAdd: PROC [node: Node, offsetNode: Node, info: CPointerTypes.PointerNodeInfo, cc: CC] RETURNS [Node]
~ {RETURN OffsetPointer[node, offsetNode, +1, info, cc]};
PointerSubtract: PROC [leftNode: Node, rightNode: Node, cc: CC] RETURNS [Node] ~ {
WITH CedarCode.GetDataFromNode[leftNode] SELECT FROM
pni: CPointerTypes.PointerNodeInfo => RETURN OffsetPointer[leftNode, rightNode, -1, pni, cc];
ENDCASE => CCE[cirioError, "C PointerSubtract called with left node not a C pointer"]};
OffsetPointer: PROC [node: Node, offsetNode: Node, sgn: [-1..+1], pni: CPointerTypes.PointerNodeInfo, cc: CC] RETURNS [Node] ~ {
pd: PointerDirect ~ NARROW[pni.data];
pnd: REF PointerNodeData ~ pd.pnd;
rctw: RCTWData ~ pnd.private.rctw;
bitOffset: INT ~ sgn*pd.eltSize*(WITH CedarCode.GetDataFromNode[offsetNode] SELECT FROM
ri: REF INT => ri­,
rc: REF CARD => LOOPHOLE[rc­, INT],
rc: REF CHAR => rc­.ORD,
ENDCASE => CCE[operation, "can't add something besides an integer to a pointer"]);
byteOffset: INT ~ bitOffset/8;
IF pd.eltSize=0 THEN CCE[operation, "can't shift that pointer"];
IF bitOffset # byteOffset*8 THEN CCE[operation, "pointer addition must yield a byte-aligned offset"];
{
newAddr: INT ~ LOOPHOLE[pd.addr, INT] + byteOffset;
shiftedMem: Mem ~ pd.targetMem.MemShift[CirioTypes.BitsToBa[bitOffset]];
referentIndirect: Node ~ CCTypes.GetIndirectCreateNode[pnd.private.directTargetType, shiftedMem, cc];
newPni: CPointerTypes.PointerNodeInfo ~ NEW[CPointerTypes.PointerNodeInfoBody ¬ [
clientTargetType: pni.clientTargetType,
indirectToClientTarget: referentIndirect,
add: PointerAdd,
subtract: PointerSubtract,
compare: PointerCompare,
data: NEW [PointerDirectPrivate ¬ [LOOPHOLE[newAddr], pd.eltSize, pnd, pd.targetMem]]
]];
RETURN[CPointerTypes.CreatePointerNode[pnd.private.directType, newPni, cc]]}};
PointerCompare: PROC [leftNode: Node, rightNode: Node, op: CCTypes.Operator, cc: CC] RETURNS [Node] ~ {
leftPni: CPointerTypes.PointerNodeInfo ~ WITH CedarCode.GetDataFromNode[leftNode] SELECT FROM
pni: CPointerTypes.PointerNodeInfo => pni,
ENDCASE => CCE[cirioError, "C pointer compare called with non-pointer left arg"];
leftPd: PointerDirect ~ NARROW[leftPni.data];
rightPni: CPointerTypes.PointerNodeInfo ~ WITH CedarCode.GetDataFromNode[rightNode] SELECT FROM
pni: CPointerTypes.PointerNodeInfo => pni,
ENDCASE => CCE[cirioError, "C pointer compare called with non-pointer right arg"];
rightPd: PointerDirect ~ NARROW[rightPni.data];
ans: BOOL ~ SELECT op FROM
$eq => leftPd.addr = rightPd.addr,
$ne => leftPd.addr # rightPd.addr,
$le => leftPd.addr <= rightPd.addr,
$lt => leftPd.addr < rightPd.addr,
$ge => leftPd.addr >= rightPd.addr,
$gt => leftPd.addr > rightPd.addr,
ENDCASE => CCE[cirioError, IO.PutFR1["unexpected comparison op (%g) between C pointers", [atom[op]] ]];
ansType: Type ~ CNumericTypes.CreateNumericType[NEW[CNumericTypes.NumericDescriptorBody ¬ [signed, integer]], cc, NIL];
RETURN CNumericTypes.CreateNumericNode[ansType, NEW [INT ¬ IF ans THEN 1 ELSE 0]]};
PointerAdd: PROC [node: Node, offsetNode: Node, info: CPointerTypes.PointerNodeInfo, cc: CC] RETURNS [Node] ~ {
nodeData: REF PointerNodeData ← NARROW[CedarCode.GetDataFromNode[node]];
bfs: BitFieldSchema ← nodeData.nsData.bfs;
mem: Mem ← nodeData.mem;
addr: CirioNubAccess.RemoteAddress ← bfs.procs.followPointer[bfs, nodeData.mem];
offset: INT ← NARROW[CedarCode.GetDataFromNode[offsetNode], REF INT]^;
bitSize: CARD ← nodeData.nsData.private.analyzedTargetTypeStab.bitSize[ nodeData.nsData.private.analyzedTargetTypeStab, cc];
normalizedAddr: CirioNubAccess.RemoteAddress ← RemoteAddressNormalize[addr];
newAddr: CirioNubAccess.RemoteAddress ← [nub: normalizedAddr.nub, byteAddress: normalizedAddr.byteAddress + (offset * bitSize) / 8, bitOffset: normalizedAddr.bitOffset + (offset * bitSize) MOD 8, nil: FALSE, valid: normalizedAddr.valid];
newMem: Mem ← CreateRawMem[newAddr];
newNodeData: REF PointerNodeData ← NEW[PointerNodeData ← [nsData: nodeData.nsData, mem: newMem]];
RETURN[CPointerTypes.CreatePointerNode[nodeData.nsData.private.type, info, cc]];
};
PointerSubtract: PROC [leftNode: Node, rightNode: Node, cc: CC] RETURNS [Node] ~ {
leftNodeData: REF PointerNodeData ← NARROW[CedarCode.GetDataFromNode[leftNode]];
leftrctw: RCTWData ← leftNodeData.nsData.private.rctw;
leftBfs: BitFieldSchema ← leftNodeData.nsData.bfs;
leftMem: Mem ← leftNodeData.mem;
leftAddr: CirioNubAccess.RemoteAddress ← leftBfs.procs.followPointer[leftBfs, leftMem];
bitSize: CARD ← leftNodeData.nsData.private.analyzedTargetTypeStab.bitSize[ leftNodeData.nsData.private.analyzedTargetTypeStab, leftrctw];
rightNodeData: REF PointerNodeData ← NARROW[CedarCode.GetDataFromNode[rightNode]];
rightBfs: BitFieldSchema ← rightNodeData.nsData.bfs;
rightMem: Mem ← rightNodeData.mem;
rightAddr: CirioNubAccess.RemoteAddress ← rightBfs.procs.followPointer[rightBfs, rightMem];
difference: INT ← RemoteAddressByteDifference[leftAddr, rightAddr, bitSize];
newType: Type ← CNumericTypes.CreateNumericType[NEW[CNumericTypes.NumericDescriptorBody ← [primary: signed, secondary: integer]], cc];
RETURN[CNumericTypes.CreateNumericNode[newType, NEW[INT ← difference]]];
};
PointerCompare: PROC [leftNode: Node, rightNode: Node, op: CCTypes.Operator, cc: CC] RETURNS [Node] ~ {
leftNodeData: REF PointerNodeData ← NARROW[CedarCode.GetDataFromNode[leftNode]];
leftrctw: RCTWData ← leftNodeData.nsData.private.rctw;
leftBfs: BitFieldSchema ← leftNodeData.nsData.bfs;
leftMem: Mem ← leftNodeData.mem;
leftAddr: CirioNubAccess.RemoteAddress ← leftBfs.procs.followPointer[leftBfs, leftMem];
bitSize: CARD ← leftNodeData.nsData.private.analyzedTargetTypeStab.bitSize[ leftNodeData.nsData.private.analyzedTargetTypeStab, leftrctw];
rightNodeData: REF PointerNodeData ← NARROW[CedarCode.GetDataFromNode[rightNode]];
rightBfs: BitFieldSchema ← rightNodeData.nsData.bfs;
rightMem: Mem ← rightNodeData.mem;
rightAddr: CirioNubAccess.RemoteAddress ← rightBfs.procs.followPointer[rightBfs, rightMem];
returnValue: INT ← RemoteAddressCompare[leftAddr, rightAddr, op];
newType: Type ← CNumericTypes.CreateNumericType[NEW[CNumericTypes.NumericDescriptorBody ← [primary: signed, secondary: integer]], cc];
RETURN[CNumericTypes.CreateNumericNode[newType, NEW[INT ← returnValue]]];
};
RemoteAddressNormalize: PROC [address: CirioNubAccess.RemoteAddress] RETURNS [CirioNubAccess.RemoteAddress] ~ {
newAddress: CirioNubAccess.RemoteAddress ¬ IF address.nil THEN
[h: address.h, byteAddress: 0 , bitOffset: 0, nil: address.nil, valid: address.valid]
ELSE
[h: address.h, byteAddress: address.byteAddress + address.bitOffset / 8, bitOffset: address.bitOffset MOD 8, nil: address.nil, valid: address.valid];
RETURN[newAddress]
};
RemoteAddressByteDifference: PROC [left: CirioNubAccess.RemoteAddress, right: CirioNubAccess.RemoteAddress, bitSize: CARD] RETURNS [diff: CARD, negative: BOOL] ~ {
newLeft: CirioNubAccess.RemoteAddress;
newRight: CirioNubAccess.RemoteAddress;
IF NOT(left.valid AND right.valid) THEN
CCE[cirioError];
newLeft ¬ RemoteAddressNormalize[left];
newRight ¬ RemoteAddressNormalize[right];
IF newLeft.bitOffset # 0 OR newRight.bitOffset # 0 THEN
CCE[cirioError];
RETURN[ABS[(newLeft.byteAddress - newRight.byteAddress) / bitSize], newLeft.byteAddress < newRight.byteAddress];
};
IntFromBool: PROC [b: BOOL] RETURNS [INT] ~ {
Should be inline eventually
IF b THEN
RETURN[1]
ELSE
RETURN[0]
};
RemoteAddressCompare: PROC [left: CirioNubAccess.RemoteAddress, right: CirioNubAccess.RemoteAddress, op: CCTypes.Operator] RETURNS [INT] ~ {
difference: CARD;
negative: BOOLEAN;
[difference, negative] ¬ RemoteAddressByteDifference[left, right, 1];
RETURN[
SELECT op FROM
$le => IntFromBool[negative OR difference = 0],
$lt => IntFromBool[negative],
$eq => IntFromBool[difference = 0],
$ne => IntFromBool[difference # 0],
$gt => IntFromBool[difference # 0 AND ~negative],
$ge => IntFromBool[~negative],
$le => IntFromBool[difference <= 0],
$lt => IntFromBool[difference < 0],
$eq => IntFromBool[difference = 0],
$ne => IntFromBool[difference # 0],
$gt => IntFromBool[difference > 0],
$ge => IntFromBool[difference >= 0],
ENDCASE => CCE[cirioError]];
};
Enumerated Types
AnalyzeEnumeratedTypeStab: PROC [sourceStream: IO.STREAM, bracketEntry: BracketEntry, rctw: RCTWData] RETURNS [AnalyzedTypeInfo] ~ {
This is an enumerated type
desc: CNumericTypes.NumericDescriptor;
type: Type;
private: AnalyzedNumericTypeStabPrivate;
constantsHashTable: RefTab.Ref ¬ RefTab.Create[17, RefIntEqual, RefIntHash];
listed: LIST OF DotOListings ¬ NIL;
bti: BasicTypeInfo;
char: CHAR ¬ IO.GetChar[sourceStream];
WHILE NOT IO.EndOf[sourceStream] AND IO.PeekChar[sourceStream] # '; DO
value: INT;
symbol: Rope.ROPE ¬ GetTokenRope[sourceStream];
ls: DotOListings ¬ NARROW[bracketEntry.symbolHashTable.Fetch[symbol].val];
IF IO.GetChar[sourceStream] # ':
THEN CCE[cirioError, "missing colon in enumerated type construction"];
value ¬ GetDecimal[sourceStream];
IF ls#NIL THEN CCE[cirioError, IO.PutFR["enumerator (%g=%g) clashes with some existing symbol in the same scope", [rope[symbol]], [integer[value]] ]];
listed ¬ CONS[NEW[DotOGlorp[enumerator] ¬ [NIL, enumerator[symbol, value, NIL]]], listed];
IF NOT bracketEntry.symbolHashTable.Insert[symbol, listed.first] THEN ERROR;
[] ¬ RefTab.Store[constantsHashTable, NEW[INT ¬ value], symbol];
IF IO.PeekChar[sourceStream] = ', THEN char ¬ IO.GetChar[sourceStream];
ENDLOOP;
desc ¬ NEW[CNumericTypes.NumericDescriptorBody ¬ [primary: signed, secondary: enumeration, enumerationConstants: constantsHashTable]];
private ¬ NEW[AnalyzedNumericTypeStabPrivateBody¬[rctw: rctw, desc: desc, bitSize: 32]];
bti ¬ NEW [BasicTypeInfoPrivate ¬ [CreateNumericIndirect, GetNumericBitSize, private]];
type ¬ CNumericTypes.CreateNumericType[desc, rctw.cc, bti];
FOR listed ¬ listed, listed.rest WHILE listed#NIL DO
WITH listed.first SELECT FROM
x: DotOEnumr => x.type ¬ type;
ENDCASE => ERROR;
ENDLOOP;
RETURN[NEW[AnalyzedTypeInfoBody ¬ [
atiValid: TRUE, atiIsProc: FALSE,
directType: type,
rctw: rctw]]]
};
AnalyzeEnumeratedTypeFileStab: PROC [auxIndex: INT32, fdIndex: INT32, wireTables: SGI.WireTables, bracketEntry: BracketEntry, rctw: RCTWData, stab: ObjF.Stab, symTabIndex: CARD] RETURNS [AnalyzedTypeInfo] ~ TRUSTED {
This is an enumerated type
desc: CNumericTypes.NumericDescriptor;
type: Type;
private: AnalyzedNumericTypeStabPrivate;
constantsHashTable: RefTab.Ref ¬ RefTab.Create[17, RefIntEqual, RefIntHash];
listed: LIST OF DotOListings ¬ NIL;
bti: BasicTypeInfo;
symBaseIndex, symIndex, currentIndex: CARD;
auxSyms: SGI.AuxSymTable ¬ wireTables.auxSyms;
endIndex: CARD;
stringOffset, stringBaseIndex: CARD;
stringTable: SGI.StringTable ¬ wireTables.localStrings;
relIndex: SGI.WireRelIndexBody;
relFileIndex: INT32;
relFileOffset: INT32;
relIndex ¬ auxSyms[auxIndex+1].relIndex;
IF relIndex.relFileDescrIndex = 0FFFH THEN
{
relFileIndex ¬ auxSyms[auxIndex+2].relFileIndex;
}
ELSE
{
relFileIndex ¬ relIndex.relFileDescrIndex;
};
relFileOffset ¬ wireTables.fileDescr[fdIndex].rfdBase + relFileIndex;
IF relFileOffset # 0 THEN
fdIndex ¬ wireTables.relFiles[relFileOffset];
symIndex ¬ relIndex.index;
symBaseIndex ¬ wireTables.fileDescr[fdIndex].isymBase;
stringBaseIndex ¬ wireTables.fileDescr[fdIndex].issBase;
currentIndex ¬ symIndex + symBaseIndex;
endIndex ¬ wireTables.localSyms[currentIndex].index - 1;
set the current index to the first stMember
currentIndex ¬ currentIndex + 1;
WHILE currentIndex < endIndex DO
value: INT;
symbol: Rope.ROPE;
ls: DotOListings;
stringOffset ¬ wireTables.localSyms[currentIndex].symStringIndex;
value ¬ wireTables.localSyms[currentIndex].value;
symbol ¬ RopeFromStringTable[stringTable, stringBaseIndex+stringOffset];
ls ¬ NARROW[bracketEntry.symbolHashTable.Fetch[symbol].val];
IF ls#NIL THEN CCE[cirioError, IO.PutFR["enumerator (%g=%g) clashes with some existing symbol in the same scope", [rope[symbol]], [integer[value]] ]];
listed ¬ CONS[NEW[DotOGlorp[enumerator] ¬ [NIL, enumerator[symbol, value, NIL]]], listed];
IF NOT bracketEntry.symbolHashTable.Insert[symbol, listed.first] THEN ERROR;
[] ¬ RefTab.Store[constantsHashTable, NEW[INT ¬ value], symbol];
currentIndex ¬ currentIndex +1;
ENDLOOP;
desc ¬ NEW[CNumericTypes.NumericDescriptorBody ¬ [primary: signed, secondary: enumeration, enumerationConstants: constantsHashTable]];
private ¬ NEW[AnalyzedNumericTypeStabPrivateBody¬[rctw: rctw, desc: desc, bitSize: 32]];
bti ¬ NEW [BasicTypeInfoPrivate ¬ [CreateNumericIndirect, GetNumericBitSize, private]];
type ¬ CNumericTypes.CreateNumericType[desc, rctw.cc, bti];
FOR listed ¬ listed, listed.rest WHILE listed#NIL DO
WITH listed.first SELECT FROM
x: DotOEnumr => x.type ¬ type;
ENDCASE => ERROR;
ENDLOOP;
RETURN[NEW[AnalyzedTypeInfoBody ¬ [
atiValid: TRUE, atiIsProc: FALSE,
directType: type,
rctw: rctw]]]
};
RefIntEqual: PROC [key1, key2: RefTab.Key] RETURNS [BOOL] ~ {
RETURN [NARROW[key1, REF INT]­ = NARROW[key2, REF INT]­]
};
RefIntHash: PROC [key: RefTab.Key] RETURNS [CARDINAL] ~ {
lc: Basics.LongNumber ~ [int[NARROW[key, REF INT]­]];
RETURN [Basics16.BITXOR[lc.lo, lc.hi]]};
C Procedures
AnalyzedProcedure: TYPE ~ REF AnalyzedProcedurePrivate;
AnalyzedProcedurePrivate: TYPE ~ RECORD [
rctw: RCTWData,
resultATI: AnalyzedTypeInfo
];
AnalyzeProcedureTypeStab: PROC[sourceStream: IO.STREAM, bracketEntry: BracketEntry, rctw: RCTWData] RETURNS[AnalyzedTypeInfo] = {
f: CHAR ~ sourceStream.GetChar[];
IF f#'f AND f#'F THEN CCE[cirioError, "AnalyzeProcedureTypeStab[not f]"];
{protoResult: AnalyzedTypeInfo ~ AnalyzeType[sourceStream, bracketEntry, rctw];
ap: AnalyzedProcedure ~ NEW[AnalyzedProcedurePrivate ¬ [rctw, protoResult]];
bti: BasicTypeInfo ~ NEW [BasicTypeInfoPrivate ¬ [CreateProcIndirect, BitSizeIs32, ap]];
procType: Type ~ Procedures.CreateProcedureType[CCTypes.GetAnyTargetType[rctw.cc], protoResult.directType, rctw.cc, bti];
RETURN[NEW[AnalyzedTypeInfoBody ¬ [
atiValid: TRUE, atiIsProc: TRUE,
directType: procType,
rctw: rctw]]]}};
AnalyzeProcedureTypeFileStab: PUBLIC PROC [auxIndex: INT32, wireTables: SGI.WireTables, bracketEntry: BracketEntry, rctw: RCTWData, stab: ObjF.Stab, symTabIndex: CARD] RETURNS[AnalyzedTypeInfo] = {
{protoResult: AnalyzedTypeInfo ~ AnalyzeTypeFromFile[auxIndex, wireTables, bracketEntry, rctw, stab, symTabIndex];
ap: AnalyzedProcedure ~ NEW[AnalyzedProcedurePrivate ¬ [rctw, protoResult]];
bti: BasicTypeInfo ~ NEW [BasicTypeInfoPrivate ¬ [CreateProcIndirect, BitSizeIs32, ap]];
procType: Type ~ Procedures.CreateProcedureType[CCTypes.GetAnyTargetType[rctw.cc], protoResult.directType, rctw.cc, bti];
RETURN[NEW[AnalyzedTypeInfoBody ¬ [
atiValid: TRUE, atiIsProc: TRUE,
directType: procType,
rctw: rctw]]]}};
BitSizeIs32: PROC [bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type] RETURNS [CARD]
~ {RETURN[32]};
ProcIndirectData: TYPE ~ REF ProcIndirectDataPrivate;
ProcIndirectDataPrivate: TYPE ~ RECORD [ap: AnalyzedProcedure, directType: Type, mem: Mem];
CreateProcIndirect: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type, mem: Mem] RETURNS[Node] ~ {
ap: AnalyzedProcedure ~ NARROW[bti.btiData];
pid: ProcIndirectData ~ NEW[ProcIndirectDataPrivate ¬ [ap, targetType, mem]];
RETURN CedarCode.CreateCedarNode[ProcIndirectOps, indirectType, pid]};
ProcIndirectOps: REF CedarCode.OperationsBody ¬ NEW[CedarCode.OperationsBody¬[
store: ProcStore,
load: ProcLoad]];
ProcDirectData: TYPE ~ REF ProcDirectDataPrivate;
ProcDirectDataPrivate: TYPE ~ RECORD [
lsh: LSA.LoadStateHandle,
pc: CARD,
desc: Rope.ROPE ¬ NIL];
ProcStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] ~ {
CCE[operation, "Can't store into a C procedure location"]};
ProcLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] ~ {
pid: ProcIndirectData ~ NARROW[CedarCode.GetDataFromNode[indirectNode]];
rctw: RCTWData ~ pid.ap.rctw;
directType: Type ~ pid.directType;
pdd: ProcDirectData ~ NEW[ProcDirectDataPrivate ¬ [rctw.lsh, 0]];
pni: Procedures.ProcedureNodeInfo ~ NEW [Procedures.ProcedureNodeInfoBody ¬ [
call: CallProc, show: DescribeProc, data: pdd]];
codeStart: BitAddr ~ pid.mem.MemGetStart[];
pdd.pc ¬ codeStart.BaToPtr[];
RETURN Procedures.CreateProcedureNode[directType, pni]};
CallProc: PROC[args: Node, cc: CC, data: REF ANY] RETURNS[Node]
~ {CCE[unimplemented, "C procedure call not implemented"]};
DescribeProc: PROC[to: IO.STREAM, data: REF ANY, depth, width: INT] ~ {
pdd: ProcDirectData ~ NARROW[data];
IF pdd.desc=NIL THEN {
lsh: LSA.LoadStateHandle ~ pdd.lsh;
bpi: REF LSA.BasicPCInfo ~ LSA.GetBasicPCInfo[lsh, pdd.pc];
IF bpi=NIL THEN pdd.desc ¬ IO.PutFR1["pc=0x%x (not known to dynamic loader)", [cardinal[pdd.pc]] ]
ELSE {
entryPC: CARD ~ bpi.lsi[text].base + bpi.moduleRelativeBaseAddr + bpi.procedureModuleRelativeBaseAddr;
IF entryPC=pdd.pc
THEN pdd.desc ¬ bpi.procedureName
ELSE pdd.desc ¬ IO.PutFR["%g+0x%x", [rope[bpi.procedureName]], [cardinal[pdd.pc-entryPC]] ];
};
};
to.PutRope[pdd.desc]};
C Numeric Types
AnalyzedNumericTypeStabPrivate: TYPE = REF AnalyzedNumericTypeStabPrivateBody;
AnalyzedNumericTypeStabPrivateBody: TYPE = RECORD[
rctw: RCTWData,
desc: CNumericTypes.NumericDescriptor,
bitSize: CARD];
Analyze: PROC[body: CNumericTypes.NumericDescriptorBody, length: CARD, rctw: RCTWData] RETURNS[AnalyzedTypeInfo] =
BEGIN
desc: CNumericTypes.NumericDescriptor ~ NEW [CNumericTypes.NumericDescriptorBody ¬ body];
private: AnalyzedNumericTypeStabPrivate ~ NEW[AnalyzedNumericTypeStabPrivateBody ¬ [rctw: rctw, desc: desc, bitSize: length]];
bti: BasicTypeInfo ~ NEW [BasicTypeInfoPrivate ¬ [CreateNumericIndirect, GetNumericBitSize, private]];
type: Type ~ CNumericTypes.CreateNumericType[desc, rctw.cc, bti];
RETURN[NEW[AnalyzedTypeInfoBody ¬ [
atiValid: TRUE, atiIsProc: FALSE,
directType: type,
rctw: rctw]]];
END;
AnalyzeBitwiseTypeStab: PROC[sourceStream: IO.STREAM, bracketEntry: BracketEntry, rctw: RCTWData] RETURNS[AnalyzedTypeInfo] =
BEGIN
This is a bitwise type (SunOS 5.0)
initialIndex: INT ¬ sourceStream.GetIndex;
byteSizeVal: INT;
minVal: INT;
maxVal: INT;
primaryTag: CNumericTypes.PrimaryTag;
char: CHAR ¬ IO.GetChar[sourceStream];
char ¬ IO.GetChar[sourceStream];
SELECT char FROM
's => primaryTag ¬ signed;
'u => primaryTag ¬ unsigned;
ENDCASE => CCE[cirioError, "missing 's or 'u in num type const"];
IF IO.PeekChar[sourceStream] = 'c THEN [] ¬ IO.GetChar[sourceStream];
byteSizeVal ¬ GetDecimal[sourceStream];
IF IO.GetChar[sourceStream] # '; THEN CCE[cirioError, "missing ; in num type const"];
minVal ¬ GetDecimal[sourceStream];
IF IO.GetChar[sourceStream] # '; THEN CCE[cirioError, "missing ; in num type const"];
maxVal ¬ GetDecimal[sourceStream];
SELECT TRUE FROM
byteSizeVal = BYTES[INT32] AND minVal = 0 AND maxVal = BITS[INT32] =>
RETURN Analyze[[primary: primaryTag, secondary: integer], 32, rctw];
byteSizeVal = BYTES[BYTE] AND minVal = 0 AND maxVal = BITS[BYTE] =>
RETURN Analyze[[primary: primaryTag, secondary: character], 8, rctw];
byteSizeVal = BYTES[INT16] AND minVal = 0 AND maxVal = BITS[INT16] =>
RETURN Analyze[[primary: primaryTag, secondary: shortInteger], 16, rctw];
byteSizeVal = BYTES[INT64] AND minVal = 0 AND maxVal = BITS[INT64] =>
RETURN Analyze[[primary: primaryTag, secondary: longInteger], 64, rctw];
ENDCASE =>
RETURN[AnalyzedUnknownType[RopeFromStream[sourceStream, initialIndex], rctw]];
END;
AnalyzeRealTypeStab: PROC[sourceStream: IO.STREAM, bracketEntry: BracketEntry, rctw: RCTWData] RETURNS[AnalyzedTypeInfo] =
BEGIN
This is a floating point type (SunOS 5.0)
initialIndex: INT ¬ sourceStream.GetIndex;
tagVal: INT;
byteSizeVal: INT;
char: CHAR ¬ IO.GetChar[sourceStream];
tagVal ¬ GetDecimal[sourceStream];
IF IO.GetChar[sourceStream] # '; THEN CCE[cirioError, "missing ; in num type const"];
byteSizeVal ¬ GetDecimal[sourceStream];
SELECT byteSizeVal FROM
4 => --This is a single precision floating point
RETURN[Analyze[[primary: float], 32, rctw]];
8 => --This is a double precision floating point
RETURN[Analyze[[primary: double], 64, rctw]];
16 => --This is a double precision floating point
RETURN[Analyze[[primary: longDouble], 128, rctw]];
ENDCASE =>
RETURN[AnalyzedUnknownType[RopeFromStream[sourceStream, initialIndex], rctw]];
END;
AnalyzeNumericFileStab: PUBLIC PROC[body: CNumericTypes.NumericDescriptorBody, length: CARD, rctw: RCTWData] RETURNS[RCTW.AnalyzedTypeInfo] =
BEGIN
desc: CNumericTypes.NumericDescriptor ~ NEW [CNumericTypes.NumericDescriptorBody ¬ body];
private: AnalyzedNumericTypeStabPrivate ~ NEW[AnalyzedNumericTypeStabPrivateBody ¬ [rctw: rctw, desc: desc, bitSize: length]];
bti: BasicTypeInfo ~ NEW [BasicTypeInfoPrivate ¬ [CreateNumericIndirect, GetNumericBitSize, private]];
type: Type ~ CNumericTypes.CreateNumericType[desc, rctw.cc, bti];
RETURN[NEW[AnalyzedTypeInfoBody ¬ [
atiValid: TRUE, atiIsProc: FALSE,
directType: type,
rctw: rctw]]];
END;
AnalyzeNumericTypeStab: PROC[sourceStream: IO.STREAM, bracketEntry: BracketEntry, rctw: RCTWData] RETURNS[AnalyzedTypeInfo] =
BEGIN
This is a subrange or a floating point type
initialIndex: INT ¬ sourceStream.GetIndex;
minVal: INT;
maxVal: INT;
ati: RCTW.AnalyzedTypeInfo;
char: CHAR ¬ IO.GetChar[sourceStream];
ati ¬ AnalyzeTypeDef[sourceStream, bracketEntry, rctw];
IF IO.GetChar[sourceStream] # '; THEN CCE[cirioError, "missing ; in num type const"];
minVal ¬ GetDecimal[sourceStream];
IF IO.GetChar[sourceStream] # '; THEN CCE[cirioError, "missing ; in num type const"];
maxVal ¬ GetDecimal[sourceStream];
IF maxVal = 0 THEN
BEGIN
This is a floating point type
SELECT minVal FROM
4 => --This is a single precision floating point
RETURN[Analyze[[primary: float], 32, rctw]];
8 => --This is a double precision floating point
RETURN[Analyze[[primary: double], 64, rctw]];
ENDCASE =>
RETURN[AnalyzedUnknownType[RopeFromStream[sourceStream, initialIndex], rctw]];
END
ELSE
BEGIN
This is a subrange type
SELECT TRUE FROM
minVal = INT32.FIRST AND maxVal = INT32.LAST =>
RETURN Analyze[[primary: signed, secondary: integer], 32, rctw];
minVal = 0 AND maxVal = 127 =>
RETURN Analyze[[primary: signed, secondary: character], 8, rctw];
minVal = 0 AND maxVal = 255 =>
RETURN Analyze[[primary: unsigned, secondary: character], 8, rctw];
minVal = FIRST[INT16] AND maxVal = LAST[INT16] =>
RETURN Analyze[[primary: signed, secondary: shortInteger], 16, rctw];
minVal = 0 AND maxVal = LAST[CARD16] =>
RETURN Analyze[[primary: unsigned, secondary: shortInteger], 16, rctw];
minVal = 0 AND LOOPHOLE[maxVal, CARD] = LAST[CARD] =>
RETURN Analyze[[primary: unsigned, secondary: integer], 32, rctw];
ENDCASE =>
RETURN[AnalyzedUnknownType[RopeFromStream[sourceStream, initialIndex], rctw]];
END
END;
GetNumericBitSize: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type] RETURNS[CARD] = {
private: AnalyzedNumericTypeStabPrivate ¬ NARROW[bti.btiData];
RETURN[private.bitSize]};
CreateNumericIndirect: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type, mem: Mem] RETURNS[Node] = {
private: AnalyzedNumericTypeStabPrivate ¬ NARROW[bti.btiData];
nodeData: REF NumericNodeData ¬ NEW[NumericNodeData ¬ [private.rctw, private.desc, targetType, mem]];
RETURN[CedarCode.CreateCedarNode[NumericOps, indirectType, nodeData]]};
NumericNodeData: TYPE = RECORD[
rctw: RCTWData,
desc: CNumericTypes.NumericDescriptor,
targetType: Type,
mem: Mem];
NumericOps: REF CedarCode.OperationsBody ¬ NEW[CedarCode.OperationsBody¬[
store: NumericStore,
load: NumericLoad]];
NumericStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] = {
nodeData: REF NumericNodeData ~ NARROW[CedarCode.GetDataFromNode[indirectNode]];
mem: Mem ~ nodeData.mem;
type: Type ~ CCTypes.GetRTargetType[indirectType, cc];
descriptor: CNumericTypes.NumericDescriptor ~ CNumericTypes.GetDescriptorFromCNumericType[type, cc];
valRep: REF ANY ~ CedarCode.GetNodeRepresentation[valNode, cc];
Bitch: PROC ~ {CCE[operation, "storing non-C numbers into C numeric locations"]};
fieldSize: BitAddr ~ mem.MemGetSize[];
SELECT fieldSize.BaToBits[] FROM
0 => CCE[operation, "storing into 0-bit numeric location"];
8 => WITH valRep SELECT FROM
x: REF CHAR => mem.MemWrite[x­.ORD, 8, zeroBA];
ENDCASE => Bitch[];
16 => SELECT descriptor.primary FROM
signed => WITH valRep SELECT FROM
x: REF INTEGER => mem.MemWrite[offset:zeroBA, bitSize:16, bits: IF x­>=0 THEN CARD[x­] ELSE CARD[INT[x­]+65536]];
ENDCASE => Bitch[];
unsigned => WITH valRep SELECT FROM
x: REF CARDINAL => mem.MemWrite[offset:zeroBA, bitSize:16, bits:x­];
ENDCASE => Bitch[];
ENDCASE => CCE[cirioError, "unexpected 16-bit descriptor"];
32 => SELECT descriptor.primary FROM
signed =>WITH valRep SELECT FROM
x: REF INT => mem.MemWrite[offset:zeroBA, bitSize:32, bits:LOOPHOLE[x­]];
ENDCASE => Bitch[];
unsigned => WITH valRep SELECT FROM
x: REF CARD => mem.MemWrite[offset:zeroBA, bitSize:32, bits:x­];
ENDCASE => Bitch[];
float => WITH valRep SELECT FROM
x: REF REAL => mem.MemWrite[offset:zeroBA, bitSize:32, bits:LOOPHOLE[x­]];
ENDCASE => Bitch[];
ENDCASE => CCE[cirioError, "unexpected 32-bit descriptor"];
64 => CCE[unimplemented, "double store"];
ENDCASE => CCE[cirioError, "strange numeric width"]};
Note: subrange types need to be fixed to correctly compute the actual bit size of the representation. Currently they use a value in the descriptor that describes the supertype.
NumericLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] ~ {
nodeData: REF NumericNodeData ~ NARROW[CedarCode.GetDataFromNode[indirectNode]];
mem: Mem ~ nodeData.mem;
type: Type ~ CCTypes.GetRTargetType[indirectType, cc];
descriptor: CNumericTypes.NumericDescriptor ~ CNumericTypes.GetDescriptorFromCNumericType[type, cc];
{ENABLE CirioNubAccess.RemoteAddrFault => GOTO unknownAddress;
fieldSize: BitAddr ~ mem.MemGetSize[];
SELECT fieldSize.BaToBits[] FROM
0 => RETURN[LoadFromUnknownIndirect[indirectType, indirectNode, cc]];
8 => {
bits: CARD ¬ mem.MemRead[offset: zeroBA, bitSize: 8];
char: CHAR ¬ VAL[BYTE[bits]];
RETURN CNumericTypes.CreateNumericNode[type, NEW[CHAR ¬ char]]};
16 => SELECT descriptor.primary FROM
signed => {
bits: CARD ¬ mem.MemRead[offset: zeroBA, bitSize: 16];
word: INTEGER ¬ IF bits <= LAST[INT16] THEN bits ELSE INT[bits] - INT[LAST[CARD16]].SUCC;
RETURN CNumericTypes.CreateNumericNode[type, NEW[SIRep ¬ word]]};
unsigned => {
bits: CARD ¬ mem.MemRead[offset: zeroBA, bitSize: 16];
RETURN CNumericTypes.CreateNumericNode[type, NEW[SCRep ¬ bits]]};
ENDCASE => CCE[cirioError, "NumericLoad: unrecognized 16-bit primary"];
32 => {
typeClass: CirioTypes.TypeClass ¬ CCTypes.GetTypeClass[type];
SELECT typeClass FROM
$numeric => {
SELECT descriptor.primary FROM
signed => {
bits: CARD ¬ mem.MemRead[offset: zeroBA, bitSize: 32];
word: INT ¬ LOOPHOLE[bits];
RETURN CNumericTypes.CreateNumericNode[type, NEW[LIRep ¬ word]]};
unsigned => {
word: CARD ¬ mem.MemRead[offset: zeroBA, bitSize: 32];
RETURN CNumericTypes.CreateNumericNode[type, NEW[LCRep ¬ word]]};
float => {
bits: CARD ¬ mem.MemRead[offset: zeroBA, bitSize: 32];
word: REAL ¬ LOOPHOLE[bits];
RETURN CNumericTypes.CreateNumericNode[type, NEW[REAL ¬ word]]};
ENDCASE => CCE[cirioError, "NumericLoad: unrecognized 32-bit primary"];
};
ENDCASE => CCE[cirioError, "NumericLoad: unrecognized 32-bit type class"];
};
64 => RETURN[NumericLoad64BitsIndirect[indirectType, indirectNode, cc]];
ENDCASE => RETURN[NumericLoadBitFieldIndirect[indirectType, indirectNode, cc]];
EXITS unknownAddress => RETURN[LoadFromUnknownIndirect[indirectType, indirectNode, cc]]}};
NumericLoad64BitsIndirect: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = {
oneWord: BitAddr ~ CirioTypes.BitsToBa[32];
nodeData: REF NumericNodeData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];
mem: Mem ¬ nodeData.mem;
type: Type ¬ CCTypes.GetRTargetType[indirectType, cc];
word1: WORD ¬ LOOPHOLE[mem.MemRead[offset: zeroBA, bitSize: 32], WORD];
word2: WORD ¬ LOOPHOLE[mem.MemRead[offset: oneWord, bitSize: 32], WORD];
sign: INT ¬ LOOPHOLE[Basics.BITSHIFT[word1, -31], CARD] * -2 + 1;
exponent: INT ¬ LOOPHOLE[Basics.BITSHIFT[word1, -20], CARD];
mantissa: REAL ¬ LOOPHOLE[Basics.BITSHIFT[Basics.BITOR[Basics.BITSHIFT[word1, 12], Basics.BITSHIFT[word2, -20]], -1], CARD] * RealFns.Power[2, -32] *2 + 1;
word:REAL ¬ sign * RealFns.Power[2, exponent - 1023] * mantissa;
wordNode: Node ¬ CNumericTypes.CreateNumericNode[type, NEW[REAL ¬ word]];
RETURN[wordNode]};
NumericLoadBitFieldIndirect: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = {
nodeData: REF NumericNodeData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];
mem: Mem ¬ nodeData.mem;
type: Type ¬ CCTypes.GetRTargetType[indirectType, cc];
typeClass: CirioTypes.TypeClass ¬ CCTypes.GetTypeClass[type];
SELECT typeClass FROM
$numeric =>
BEGIN
descriptor: CNumericTypes.NumericDescriptor ¬ CNumericTypes.GetDescriptorFromCNumericType[type, cc];
SELECT descriptor.primary FROM
signed =>
BEGIN
SELECT descriptor.secondary FROM
integer =>
BEGIN
bits: CARD ¬ mem.MemRead[offset: zeroBA, bitSize: 32];
Theimer: Need to eventually change the 32 to a more general constant defn.
word: INT ¬ LOOPHOLE[bits];
wordNode: Node ¬ CNumericTypes.CreateNumericNode[type, NEW[LIRep ¬ word]];
RETURN[wordNode];
END;
ENDCASE => CCE[cirioError]; -- descriptor.secondary
END;
ENDCASE => CCE[cirioError]; -- descriptor.primary
END;
ENDCASE => CCE[cirioError]; -- typeClass
};
LoadFromUnknownIndirect: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] =
BEGIN
wordType: Type ¬ CedarOtherPureTypes.CreateUnknownType[cc, "Unimplemented type"];
wordNode: Node ¬ CedarOtherPureTypes.CreateIndirectToAnUnknownType[wordType, "Unimplemented type", cc];
RETURN[wordNode];
END;
Record Types
AnalyzeRecordTypeStab: PROC[sourceStream: IO.STREAM, bracketEntry: BracketEntry, rctw: RCTWData] RETURNS[AnalyzedTypeInfo] = {
analyzedCTX: AnalyzedCTX;
RETURN[AnalyzeCTX[sourceStream, bracketEntry, rctw]];
};
As a special dispensation, in order to handle empty argument/result records, this procedure will accept ctxh=NIL to produce an effectively empty record.
AnalyzeCTX: PROC[sourceStream: IO.STREAM, bracketEntry: BracketEntry, rctw: RCTWData] RETURNS[AnalyzedTypeInfo] = {
Note: Assuming that no C records have variants.
fieldCount: INT ¬ 0;
fieldNameList: LIST OF Rope.ROPE ¬ NIL;
atiList: LIST OF AnalyzedTypeInfo ¬ NIL;
bitOffsetList: LIST OF INT ¬ NIL;
bitSizeList: LIST OF INT ¬ NIL;
byteSize: INT;
lastBitOffset: INT ¬ -1; -- Assume there are no negative offsets
lastBitSize: INT;
totalBitSize: CARD;
result: AnalyzedCTX;
resultATI: AnalyzedTypeInfo;
char: CHAR ¬ IO.GetChar[sourceStream];
byteSize ¬ GetDecimal[sourceStream];
WHILE NOT IO.EndOf[sourceStream] DO
bitSize: INT;
bitOffset: INT;
ati: AnalyzedTypeInfo;
fieldName: Rope.ROPE;
IF IO.PeekChar[sourceStream] = '; THEN EXIT;
fieldName ¬ GetTokenRope[sourceStream];
IF IO.GetChar[sourceStream] # ': THEN CCE[cirioError];
ati ¬ AnalyzeType[sourceStream, bracketEntry, rctw];
IF IO.GetChar[sourceStream] # ', THEN CCE[cirioError];
bitOffset ¬ GetDecimal[sourceStream];
IF IO.GetChar[sourceStream] # ', THEN CCE[cirioError];
bitSize ¬ GetDecimal[sourceStream];
IF IO.GetChar[sourceStream] # '; THEN CCE[cirioError];
fieldNameList ¬ CONS[fieldName, fieldNameList];
atiList ¬ CONS[ati, atiList];
bitOffsetList ¬ CONS[bitOffset, bitOffsetList];
bitSizeList ¬ CONS[bitSize, bitSizeList];
IF bitOffset > lastBitOffset THEN {
lastBitOffset ¬ bitOffset;
lastBitSize ¬ bitSize;
};
fieldCount ¬ fieldCount +1
ENDLOOP;
totalBitSize ¬ lastBitOffset + lastBitSize;
now we can build the result
result ¬ NEW[AnalyzedCTXBody[fieldCount]];
result.blockRecord ¬ FALSE;
result.rctw ¬ rctw;
result.bitSize ¬ CirioTypes.BitsToBa[totalBitSize];
FOR i:INT DECREASING IN [0..fieldCount) DO
result[i] ¬ [
name: fieldNameList.first,
fiValid: TRUE,
fiIsProc: atiList.first.atiIsProc,
fieldDirectType: atiList.first.directType,
fieldCase: nodeTimeReadWrite,
fieldLoc: NEW[BitStretch ¬ [CirioTypes.BitsToBa[bitOffsetList.first], CirioTypes.BitsToBa[bitSizeList.first] ]]
];
fieldNameList ¬ fieldNameList.rest;
atiList ¬ atiList.rest;
bitOffsetList ¬ bitOffsetList.rest;
bitSizeList ¬ bitSizeList.rest;
ENDLOOP;
result.recordType ¬ Records.CreateRecordType[CTXRecordTypeProcs, rctw.cc, result];
resultATI ¬ NEW[AnalyzedTypeInfoBody ¬ [atiValid: TRUE, atiIsProc: FALSE, directType: result.recordType, rctw: rctw]];
RETURN[resultATI]};
RopeFromStringTable: PROC [table: SGI.StringTable, offset: CARD]
RETURNS [name: Rope.ROPE ¬ NIL] =
TRUSTED
{
c: CHAR;
DO
c ¬ LOOPHOLE[table[offset]];
IF (c = VAL[0]) THEN
EXIT;
name ¬ name.Concat[Convert.RopeFromChar[from: c, quote: FALSE]];
offset ¬ offset + 1;
ENDLOOP;
RETURN
};
AnalyzeStructTypeFileStab: PROC[auxIndex: INT32, fdIndex: INT32, wireTables: SGI.WireTables, bracketEntry: BracketEntry, rctw: RCTWData, stab: ObjF.Stab, symTabIndex: CARD] RETURNS[AnalyzedTypeInfo] = TRUSTED {
Note: Assuming that no C records have variants.
fieldCount: INT ¬ 0;
fieldNameList: LIST OF Rope.ROPE ¬ NIL;
atiList: LIST OF AnalyzedTypeInfo ¬ NIL;
bitOffsetList: LIST OF INT ¬ NIL;
bitSizeList: LIST OF INT ¬ NIL;
lastBitOffset: INT ¬ -1; -- Assume there are no negative offsets
lastBitSize: INT;
totalBitSize: CARD;
result: AnalyzedCTX;
resultATI: AnalyzedTypeInfo;
auxSyms: SGI.AuxSymTable ¬ wireTables.auxSyms;
symBaseIndex, symIndex, currentIndex, memberIndex: CARD;
stringBaseIndex: CARD;
endStruct: CARD;
stringOffset: CARD;
bitSize: INT32;
bitOffset: INT32 ¬ 0;
stringTable: SGI.StringTable ¬ wireTables.localStrings;
relIndex: SGI.WireRelIndexBody;
relFileIndex: INT32;
relFileOffset: INT32;
IF auxSyms[auxIndex+1].symIndex = -1 THEN
{
there was a pointer to an undefined structure that never got dereferenced.
just return a void
resultATI ¬ NEW[AnalyzedTypeInfoBody ¬ [atiValid: TRUE, atiIsProc: FALSE, directType: AnalyzeNumericFileStab[[primary: signed, secondary: integer], 0, rctw].directType, rctw: rctw]];
RETURN[resultATI]
};
relIndex ¬ auxSyms[auxIndex+1].relIndex;
IF relIndex.relFileDescrIndex = 0FFFH THEN
{
relFileIndex ¬ auxSyms[auxIndex+2].relFileIndex;
}
ELSE
{
relFileIndex ¬ relIndex.relFileDescrIndex;
};
relFileOffset ¬ wireTables.fileDescr[fdIndex].rfdBase + relFileIndex;
IF relFileOffset # 0 THEN
fdIndex ¬ wireTables.relFiles[relFileOffset];
symIndex ¬ relIndex.index;
symBaseIndex ¬ wireTables.fileDescr[fdIndex].isymBase;
stringBaseIndex ¬ wireTables.fileDescr[fdIndex].issBase;
currentIndex ¬ symIndex + symBaseIndex;
the index field is the reference to one symbol past the stEnd symbol for the structure
endStruct ¬ wireTables.localSyms[currentIndex].index + symBaseIndex - 1;
set the current index to the first stMember
memberIndex ¬ currentIndex + 1;
WHILE memberIndex < endStruct DO
ati: AnalyzedTypeInfo;
fieldName: Rope.ROPE;
stringOffset ¬ wireTables.localSyms[memberIndex].symStringIndex;
fieldName ¬ RopeFromStringTable[stringTable, stringBaseIndex+stringOffset];
the new auxIndex is the stMember symbols` auxIndex
auxIndex ¬ wireTables.fileDescr[fdIndex].iauxBase + wireTables.localSyms[memberIndex].index;
ati ¬ AnalyzeTypeFromFile[auxIndex, wireTables, bracketEntry, rctw, stab, memberIndex];
bitSize ¬ SGI.CalcSymbolSize[memberIndex, fdIndex, wireTables, FALSE];
bitOffset ¬ wireTables.localSyms[memberIndex].value;
fieldNameList ¬ CONS[fieldName, fieldNameList];
atiList ¬ CONS[ati, atiList];
bitOffsetList ¬ CONS[bitOffset, bitOffsetList];
bitSizeList ¬ CONS[bitSize, bitSizeList];
IF bitOffset > lastBitOffset THEN {
lastBitOffset ¬ bitOffset;
lastBitSize ¬ bitSize;
};
fieldCount ¬ fieldCount +1;
memberIndex ¬ memberIndex +1
ENDLOOP;
totalBitSize ¬ lastBitOffset + lastBitSize;
now we can build the result
result ¬ NEW[AnalyzedCTXBody[fieldCount]];
result.blockRecord ¬ FALSE;
result.rctw ¬ rctw;
result.bitSize ¬ CirioTypes.BitsToBa[totalBitSize];
FOR i:INT DECREASING IN [0..fieldCount) DO
result[i] ¬ [
name: fieldNameList.first,
fiValid: TRUE,
fiIsProc: atiList.first.atiIsProc,
fieldDirectType: atiList.first.directType,
fieldCase: nodeTimeReadWrite,
fieldLoc: NEW[BitStretch ¬ [CirioTypes.BitsToBa[bitOffsetList.first], CirioTypes.BitsToBa[bitSizeList.first] ]]
];
fieldNameList ¬ fieldNameList.rest;
atiList ¬ atiList.rest;
bitOffsetList ¬ bitOffsetList.rest;
bitSizeList ¬ bitSizeList.rest;
ENDLOOP;
result.recordType ¬ Records.CreateRecordType[CTXRecordTypeProcs, rctw.cc, result];
resultATI ¬ NEW[AnalyzedTypeInfoBody ¬ [atiValid: TRUE, atiIsProc: FALSE, directType: result.recordType, rctw: rctw]];
RETURN[resultATI]};
CTXRecordTypeProcs: PUBLIC REF Records.RecordTypeProcs ¬ NEW[Records.RecordTypeProcs¬[
createIndirectNode: CTXRecordsCreateIndirectNode,
getBitSize: CTXRecordsGetBitSize,
getPaint: CTXRecordsGetPaint,
comparePaint: CTXRecordsComparePaint,
nFields: CTXRecordsNFields,
fieldIndexToName: CTXRecordsFieldIndexToName,
nameToFieldIndex: CTXRecordsNameToFieldIndex,
fieldIndexToType: CTXRecordsFieldIndexToType,
fieldIndexToFieldCase: CTXRecordsFieldIndexToFieldCase,
fieldIndexToCompileTimeConstantValue: CTXRecordsFieldIndexToTypeTimeConstant]];
we shall use the address of the record data as the paint. Note that we are trusting the assorted hash table mechanisms to prevent the construction of more than one RecordData for a given record type.
CTXRecordsGetPaint: PROC[data: REF ANY] RETURNS[REF ANY] = {
ac: AnalyzedCTX ¬ NARROW[data];
RETURN[ac]};
CTXRecordsComparePaint: PROC[data: REF ANY, otherPaint: REF ANY] RETURNS[BOOLEAN] =
BEGIN
ac: AnalyzedCTX ¬ NARROW[data];
IF otherPaint = NIL THEN CCE[cirioError]; -- we shouldn't be called in this situation
WITH otherPaint SELECT FROM
other: AnalyzedCTX => RETURN[ac = other];
ENDCASE => RETURN[FALSE];
END;
CTXRecordsNFields: PROC[data: REF ANY] RETURNS[INT] =
BEGIN
ac: AnalyzedCTX ¬ NARROW[data];
RETURN[ac.nFields];
END;
CTXRecordsFieldIndexToName: PROC[index: INT, data: REF ANY] RETURNS[Rope.ROPE] =
BEGIN
ac: AnalyzedCTX ¬ NARROW[data];
RETURN[ac.fields[index].name];
END;
We could speed this up by using atoms
CTXRecordsNameToFieldIndex: PROC[name: Rope.ROPE, data: REF ANY] RETURNS[INT] =
BEGIN
ac: AnalyzedCTX ¬ NARROW[data];
FOR I: INT IN [0..ac.nFields) DO
IF Rope.Equal[name, ac.fields[I].name] THEN RETURN[I];
ENDLOOP;
RETURN[-1];
END;
CTXRecordsFieldIndexToType: PROC[index: INT, cc: CC, data: REF ANY] RETURNS [Type] ~ {
ac: AnalyzedCTX ~ NARROW[data];
IF NOT ac.fields[index].fiValid THEN {
here is where we finally compute the field type, after we haved exited from the local type construction routine for the record as a whole.
directType: Type ~ IF ac.blockRecord
THEN NARROW[ac.fields[index].idStab, DotOListing].directType
ELSE ac.fields[index].directType;
ac.fields[index].fieldDirectType ¬ directType;
ac.fields[index].fieldCase ¬ IF ac.blockRecord AND ac.fields[index].fiIsProc THEN nodeTimeConstant ELSE nodeTimeReadWrite;
ac.fields[index].fiValid ¬ TRUE;
IF ac.blockRecord THEN ac.fields[index].fieldLoc ¬ VarLocFromDotOListings[ac.fields[index].idStab, ac.rctw];
};
RETURN [ac.fields[index].fieldDirectType]};
CTXRecordsFieldIndexToFieldCase: PROC[index: INT, cc: CC, data: REF ANY] RETURNS[Records.FieldCase] ~ {
ac: AnalyzedCTX ~ NARROW[data];
[] ¬ CTXRecordsFieldIndexToType[index, cc, data]; --ensure ac.fields[index].fiValid
RETURN [ac.fields[index].fieldCase]};
CTXRecordsFieldIndexToTypeTimeConstant: PROC[index: INT, cc: CC, data: REF ANY] RETURNS[Node] ~ {
ac: AnalyzedCTX ~ NARROW[data];
IF NOT ac.blockRecord THEN CCE[cirioError, "asking for type-time constant from a non-block C record"];
WITH ac[index].idStab SELECT FROM
x: DotOEnumr => RETURN CNumericTypes.CreateNumericNode[x.type, NEW[LIRep ¬ x.value]];
x: DotOListing => CCE[cirioError, IO.PutFR1["asking for field %g as type-time constant", [integer[index]] ]];
ENDCASE => ERROR;
};
CTXRecordsGetBitSize: PROC[indirectType: Type, cc: CC, data: REF ANY] RETURNS[CARD] = {
ac: AnalyzedCTX ~ NARROW[data];
RETURN [ac.bitSize.BaToBits[]]};
CTXRecordsCreateIndirectNode: PROC [cc: CC, data: REF ANY, indirectType, targetType: Type, mem: CirioTypes.Mem] RETURNS [Node] ~ {
ac: AnalyzedCTX ~ NARROW[data];
nodeData: REF RecordNodeData ~ NEW [RecordNodeData ¬ [ac, targetType, mem]];
RETURN[Records.CreateIndirectRecordNode[targetType, RecordProcs, nodeData, ac.rctw.cc]]};
RecordNodeData: TYPE = RECORD[
private: AnalyzedCTX,
targetType: Type,
mem: Mem];
RecordProcs: REF Records.IndirectRecordNodeProcs ¬ NEW[Records.IndirectRecordNodeProcs¬[
selectField: RecordSelectField,
fieldIndexToNodeTimeConstantValue: RecordIndexToNTConstant]];
RecordSelectField: PROC[index: INT, indirectFieldType: Type, data: REF ANY, cc: CC] RETURNS[Node] = {
nodeData: REF RecordNodeData ~ NARROW[data];
ac: AnalyzedCTX ~ nodeData.private;
rctw: RCTWData ~ ac.rctw;
fieldType: Type;
subMem: Mem;
IF ac.blockRecord THEN {
varLoc: VarLoc ¬ NARROW[ac.fields[index].fieldLoc];
IF NOT ac.fields[index].fiValid THEN CCE[cirioError, "select block record field with NOT fiValid"];
should never happen, this field should have been filled in when someone inspected the type of the field.
subMem ¬ RMTWPrivate.SelectVarLoc[rctw.nub, nodeData.mem, varLoc];
RETURN CCTypes.CreateIndirectNode[indirectFieldType, subMem, cc]}
ELSE {
fieldLoc: REF BitStretch ¬ NARROW[ac.fields[index].fieldLoc];
IF NOT ac.fields[index].fiValid THEN CCE[cirioError, "trying to select an unanalyzed field"];
should never happen, this field should have been filled in when someone inspected the type of the field.
IF fieldLoc = NIL THEN RETURN UnimplementedTypeNode[indirectFieldType, rctw, IO.PutFR1["ordinary record field (index %g) with unknown location", [integer[index]]], TRUE];
subMem ¬ nodeData.mem.MemSubfield[fieldLoc­];
RETURN CCTypes.CreateIndirectNode[indirectFieldType, subMem, cc]}};
RecordIndexToNTConstant: PROC[index: INT, fieldType: Type, data: REF ANY, cc: CC] RETURNS[Node] ~ {
nodeData: REF RecordNodeData ~ NARROW[data];
ac: AnalyzedCTX ~ nodeData.private;
rctw: RCTWData ~ ac.rctw;
fieldLoc: REF ANY ~ ac.fields[index].fieldLoc;
IF NOT ac.fields[index].fiValid THEN CCE[cirioError, "trying to construct the node-time constant value for an unanalyzed field"];
IF ac.fields[index].fieldCase#nodeTimeConstant THEN CCE[cirioError, ac.fields[index].name.Concat[" is not a node-time constant"]];
WITH fieldLoc SELECT FROM
vl: VarLoc => {
codeMem: Mem ~ RMTWPrivate.SelectVarLoc[rctw.nub, nodeData.mem, vl];
pcBa: BitAddr ~ codeMem.MemGetStart[];
pc: CARD ~ pcBa.BaToPtr[];
pdd: ProcDirectData ~ NEW[ProcDirectDataPrivate ¬ [rctw.lsh, pc]];
pni: Procedures.ProcedureNodeInfo ~ NEW [Procedures.ProcedureNodeInfoBody ¬ [
call: CallProc, show: DescribeProc, data: pdd]];
RETURN Procedures.CreateProcedureNode[fieldType, pni]};
ENDCASE => CCE[cirioError, "RecordIndexToNTConstant[fieldLoc not a Varloc"]};
END..