<<>> <> <> <> <> <> <> <> <> <> <> <> DIRECTORY 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, PBasics USING [BITOR, BITSHIFT, LongNumber, Word], PBasics16 USING [BITXOR], 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 CCTypes, CedarCode, CedarOtherPureTypes, CirioMemory, CirioNubAccess, CirioTypes, CNumericTypes, Convert, CPointerTypes, DeferringTypes, IO, LoadStateAccess, ObjectFiles, PBasics, PBasics16, 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] ~ { <<>> <> <> <> <> <> <> <> <<>> <> <> <> <> <> <<>> <> <> <> <<>> 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; <> 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; }; <> 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 <> SGI.BTSet => { -- pascal sets type _ CedarOtherPureTypes.CreateUnknownType[rctw.cc, IO.PutFR["", [rope[ObjF.DescribeModule[rctw.module]]] ]]}; SGI.BTComplex => { -- fortran complex type _ CedarOtherPureTypes.CreateUnknownType[rctw.cc, IO.PutFR["", [rope[ObjF.DescribeModule[rctw.module]]] ]]}; SGI.BTDcomplex => { -- fortran double complex type _ CedarOtherPureTypes.CreateUnknownType[rctw.cc, IO.PutFR["", [rope[ObjF.DescribeModule[rctw.module]]] ]]}; SGI.BTIndirect => NULL; -- forward or unnamed typedef SGI.BTFixeddec => { -- Fixed Decimal type _ CedarOtherPureTypes.CreateUnknownType[rctw.cc, IO.PutFR["", [rope[ObjF.DescribeModule[rctw.module]]] ]]}; SGI.BTFloatdec => { -- Float Decimal type _ CedarOtherPureTypes.CreateUnknownType[rctw.cc, IO.PutFR["", [rope[ObjF.DescribeModule[rctw.module]]] ]]}; SGI.BTPicture => { -- Picture type _ CedarOtherPureTypes.CreateUnknownType[rctw.cc, IO.PutFR["", [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]; }; }; <> <> <> <> <> <> <> <> <> <<};>> <> <<[] _ IO.GetChar[stream];>> <> <> <> <> <> <<};>> <<};>> <<};>> <> <> <> <> <> <> <<};>> <<>> <> <> < {>> <> <> <<};>> <<];>> <<};>> <> <<};>> 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 <> 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]; <>}; }; } 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]; <> 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]; <> 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]; }; <<>> <<>> <> 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] }; <> 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["", [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]]}; <> <<>> 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; <> {ENABLE { CirioNubAccess.RemoteAddrFault => GOTO unknownAddress; CCE => GOTO unknownAddress}; fieldSizeBa: BitAddr _ mem.MemGetSize[]; fieldSize: CARD _ fieldSizeBa.BaToBits[]; addrBits: CARD _ mem.MemRead[bitsPerPtr, zeroBA]; <> {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]]}; <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <<>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <<>> <<>> 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] ~ { <> 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]]; }; <> AnalyzeEnumeratedTypeStab: PROC [sourceStream: IO.STREAM, bracketEntry: BracketEntry, rctw: RCTWData] RETURNS [AnalyzedTypeInfo] ~ { <> 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 { <> 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; <> 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: PBasics.LongNumber ~ [int[NARROW[key, REF INT]^]]; RETURN [PBasics16.BITXOR[lc.lo, lc.hi]]}; <> <<>> 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.PutFR["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]}; <> <<>> 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 <> 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 <> 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 <> 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 <> 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 <> 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"]}; <> 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: PBasics.Word _ LOOPHOLE[mem.MemRead[offset: zeroBA, bitSize: 32], PBasics.Word]; word2: PBasics.Word _ LOOPHOLE[mem.MemRead[offset: oneWord, bitSize: 32], PBasics.Word]; sign: INT _ LOOPHOLE[PBasics.BITSHIFT[word1, -31], CARD] * -2 + 1; exponent: INT _ LOOPHOLE[PBasics.BITSHIFT[word1, -20], CARD]; mantissa: REAL _ LOOPHOLE[PBasics.BITSHIFT[PBasics.BITOR[PBasics.BITSHIFT[word1, 12], PBasics.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]; <> 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; <> AnalyzeRecordTypeStab: PROC[sourceStream: IO.STREAM, bracketEntry: BracketEntry, rctw: RCTWData] RETURNS[AnalyzedTypeInfo] = { analyzedCTX: AnalyzedCTX; RETURN[AnalyzeCTX[sourceStream, bracketEntry, rctw]]; }; <> AnalyzeCTX: PROC[sourceStream: IO.STREAM, bracketEntry: BracketEntry, rctw: RCTWData] RETURNS[AnalyzedTypeInfo] = { <> 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; <> <<>> 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 { <> 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 { <> << 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; <<>> <> endStruct _ wireTables.localSyms[currentIndex].index + symBaseIndex - 1; <> memberIndex _ currentIndex + 1; WHILE memberIndex < endStruct DO ati: AnalyzedTypeInfo; fieldName: Rope.ROPE; stringOffset _ wireTables.localSyms[memberIndex].symStringIndex; fieldName _ RopeFromStringTable[stringTable, stringBaseIndex+stringOffset]; <<>> <> 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; <> <<>> 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]]; <> 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; <> 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 { <> 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"]; <> 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"]; <> 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..