From VisualWorks®, 7.6 of February 1, 2008 on February 1, 2008 at 12:28:09 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>ExtendedCompiler</name> <environment>Kernel</environment> <super>Kernel.Compiler</super> <private>false</private> none external <imports></imports> <category>DLLCC-Parsing</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> Kernel.ExtendedCompiler
The class ExtendedCompiler is used in conjunction with ExtendedParser. Together they implement the extended syntax for external declarations ('<C: ...>'). ExtendedCompiler is responsible for constructing the proper CompiledMethod once the ExtendedParser has parsed the declaration syntax. Instance Variables: external <ExternalObject | CType | CMacroDefinition|nil> The external that is being parsed, or nil if there is none.
</comment> <class> <name>ExtendedParser</name> <environment>Kernel</environment> <super>Kernel.Parser</super> <private>false</private> none externals external <imports></imports> <category>DLLCC-Parsing</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> Kernel.ExtendedParser
I specialize in dealing with <C:..> constructs and, in the future, possibly with similar constructs for other external languages. I invoke an external language parser to parse what's inside <C: .. >. When the external language parser is missing, as in a runtime environment, I skip the <C:..> construct or generate an error message, whichever is more appropriate. Instance Variables: externals <ExternalDictionary> the dictionary of externals owned by the parser's class. external <ExternalObject | CType | CMacroDefinition | Association > the external that was generated during the parse.
</comment> <class> <name>CScanner</name> <environment>External</environment> <super>Kernel.Scanner</super> <private>false</private> none requestor failBlock reservedWords sourceUsesCRLF typeTable reservedWords methodInfo <imports></imports> <category>DLLCC-CParsing</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> External.CScanner
Copyright © 1993-1999 ObjectShare, Inc., All Rights Reserved. The class CScanner break an input stream into tokens suitable for use by C language parsers. It puts each token found into token and its type (a Symbol) into tokenType. Note that the mark (start of current token) and prevEnd (end of previous token) are 1-origin character indices (in a text or string object), not a 0-origin stream position. While this may cause some confusion, it seems preferable to the alternative. Instance Variables: requestor <CompilerErrorHandler | nil> object from which parsing was invoked. If not nil, this object will be sent #notify: prior to evaluating the failBlock failBlock <BlockContext> to be evaluated in case of parse errors reservedWords <Dictionary | false> sourceUsesCRLF <Boolean> is true if the receiver is scanning a stream that uses CRLF line-end conventions, otherwise false. Class Instance Variables typeTable <ScannerTable | nil> maps characters to Symbols, which identify the type of token the character may introduce reservedWords <Dictionary | false | nil> a collection of all the reserved words found in the grammar expressions methodInfo <(Dictionary keys: Symbol values: (Array new: 3)) | nil>
</comment> <class> <name>ExternalInterfaceBuilder</name> <environment>Tools</environment> <super>UI.ApplicationModel</super> <private>false</private> none categoryList currentSubCanvas externalMultiSelectionSubCanvas externalSingleSelectionSubCanvas externalSingleSelectionList externalMultiSelectionList externalSelectionDictionary includeFiles includeDirectories externalInterfaceHolder <imports></imports> <category>DLLCC-Interface</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> Tools.ExternalInterfaceBuilder
The class ExternalInterfaceBuilder provides a visual interface to the CDeclarationParser; the tool that is used to parse C language header files and generate an ExternalInterface class from those declarations. The parser tool is divided into two panes. The first pane contains a list of categories. The first two categories are configurable by the user and are used to specify the C language include file names and the directories those files are contained in respectively. The second pane is used to display the entries from the first pane. The 'Parse Files' button is used to parse the specified header files and build the declaration entries. The 'Define Class' button is used to build the interface class using the selected declarations. The right hand pane contains a multi-selection in list view that you can use to select the various declarations that should be included in your interface class. The tool will automatically traverse a particular declaration in order to select any dependent declarations. This builder can be opened from the ExternalInterfaceFinder, or as a separate tool using 'ExternalInterfaceBuilder open'. Instance Variables: categoryList <SelectionInList> The list of categories that comprise a header file declaration currentSubCanvas <Symbol> Define as #single if the right-hand pane is a selection in list view, otherise the right-hand pane is a multi-selection in list view externalMultiSelectionSubCanvas <UISpecification> The right-hand pane canvas when in multi-selection mode externalSingleSelectionSubCanvas <UISpecification> The right-hand pane canvas when in single-selection mode externalSingleSelectionList <SelectionInList> The right-hand pane model when in single-selection mode externalMultiSelectionList <MultiSelectionInList> The right-hand pane model when in multi-selection mode externalSelectionDictionary <IdentityDictionary key: Symbol value: (Association key: List value: Set)> A mapping between the C language declarations and the actual declarations that were parsed from a file includeFiles <List of: String> A list of include file names includeDirectories <List of: String> A list of include directory names externalInterfaceHolder <ExternalInterfaceHolder> The holder for the ExternalDictionary that was generated from parsing a header file Class Variables: MenuBarMenu <Menu> The menu bar menu for the main builder window.
</comment> <class> <name>ExternalInterfaceFinder</name> <environment>Tools</environment> <super>UI.ApplicationModel</super> <private>false</private> none externalList categoryList classNameList externalInterfaceHolder filter <imports></imports> <category>DLLCC-Interface</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> Tools.ExternalInterfaceFinder
The class ExternalInterfaceFinder is a specialized browser for ExternalInterface classes. The lefthand (class) pane of the finder shows only these classes. The list can be further filtered according to whether the classes are user-defined or were recently browsed. The menu in this pane and under the 'View' button on the menu bar provides for selecting among these filters, and for updating the list of classes after filing or defing classes via Browser, FileList or ChangeList tools. The pane is automatically updated as new interfaces are installed, added, or removed via the finder. Instance Variables externalList <SelectionInList> The model behind the external pane categoryList <SelectionInList> The model behind the category pane classNameList <SelectionInList> The model behind the class pane externalInterfaceHolder <ExternalInterfaceHolder> The object that understands accessing protocol for external interface dictionaries filter <Symbol> What sorts of application classes are to be shown in the class pane Class Variables ClassListMenu <Menu> Used when no class is selected ExternalInterfaceClasses <Set of: Symbol> All external interfaces known in the system ExternalListMenu <Menu> Used when no external is selected MenuBarMenu <Menu> The menu bar when no class is selected RecentlyVisitedClasses <OrderedCollection of: Symbol> The last <n> classes visited
</comment> <class> <name>ExternalInterfaceTypeDefinitionCompiled</name> <environment>Kernel</environment> <super>Core.Notification</super> <private>false</private> none <imports></imports> <category>DLLCC-Interface</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> Kernel.ExternalInterfaceTypeDefinitionCompiled
This notification is raised by the ExtendedCompiler when, after pragma parsing is complete, a type definition is detected. The point of this notification is so that the compiling class can infer the need to recompile its methods after a type definition is compiled.
</comment> <class> <name>CStructureTypeInspector</name> <environment>Tools.Trippy</environment> <super>Tools.Trippy.PartListAbstractInspector</super> <private>false</private> none parts <imports></imports> <category>Tools-Trippy</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> Tools.Trippy.CStructureTypeInspector
This is an inspector for C structure types. It displays the type and the offset of all members of the structure. All of them are presented using TextAttributes since they are only useful for looking at. Instance Variables: parts <SequenceableCollection of: TextAttribute> Parts presenting the type and offset information of all fields of the structure.
</comment> <class> <name>CEnumerationTypeInspector</name> <environment>Tools.Trippy</environment> <super>Tools.Trippy.CStructureTypeInspector</super> <private>false</private> none <imports></imports> <category>Tools-Trippy</category> <attributes> <package>DLLCC</package> </attributes> </class> <class> <name>CParser</name> <environment>External</environment> <super>External.CScanner</super> <private>false</private> none declarations stack backupStack cachedParser <imports></imports> <category>DLLCC-CParsing</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> External.CParser
The abstract class CParser is an abstract class for C preprocessing and parsing. CParser contains a dictionary of symbols which define the current parsing environment. A preprocessor uses this environment to store #define symbols, while a parser uses this environment to declaration names. Please consult the subclass comments for further details on C preprocessing and parsing. You should not create direct instances of CParser. Subclasses must implement the following messages: class protocol class accessing preprocessorClass Instance Variables: declarations <ExternalDictionary> used to contain environment symbols (accumulated dynamically) stack <OrderedCollection> used by generated parsers to hold partially completed parse trees; see the documentation in ParserCompiler class for details backupStack <OrderedCollection> holds backup information that is needed whenever the parser must abandon the current grammar rule and return to an alternative one Class Instance Variables: cachedParser <CParser | nil> a cached parser so that initialization is faster.
</comment> <class> <name>CExpressionParser</name> <environment>External</environment> <super>External.CParser</super> <private>false</private> none <imports></imports> <category>DLLCC-CParsing</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> External.CExpressionParser
The class CExpressionParser is used to parse C language expressions. The current scope of expression evaluation is constrained to expressions that evaluate to constants (i.e. Numbers and Strings). This parser should be expanded to include general C language expressions. Uses of this class are for run-time debuggers that may wish to evaluate an expression in the context of a particular environment. For example: '*(int *) &someVariable' would evaluate to the integer pointed to by someVariable (after coercion).
</comment> <class> <name>CStructureInspector</name> <environment>Tools.Trippy</environment> <super>Tools.Trippy.PartListAbstractInspector</super> <private>false</private> none parts <imports></imports> <category>Tools-Trippy</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> Tools.Trippy.CStructureInspector
This is an inspector for C structures (and pointers to structures). Instance Variables: parts <SequenceableCollection of: CStructMember> Parts of the C structure.
</comment> <class> <name>ExternalInterfaceClassFinder</name> <environment>Tools</environment> <super>Tools.ClassFinder</super> <private>false</private> none isOptimized isVirtual <imports></imports> <category>DLLCC-Interface</category> <attributes> <package>DLLCC</package> </attributes> </class> <class> <name>CPreprocessor</name> <environment>External</environment> <super>External.CExpressionParser</super> <private>false</private> none includeDirectories includeStack directiveTakenStack saveReservedWords skipLevel ignoreSkipLevel inMacroScan lastDefine outputStream saveDefines assertDefines continuationCount dontStepPastEnd <imports></imports> <category>DLLCC-CParsing</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> External.CPreprocessor
The class CPreprocessor is used to preprocess an input string or stream into a sequence of C language tokens. All C preprocessor directives are executed. The following grammar for the preprocessor simply summarizes the control line structure. It cannot be used for mechanized parsing and hence the difference between what is stated here and the implementation within this class: <controlLine> ::= #if <identifier> tokenSequence #define <identifier> $( <identifier>, ..., <identifier> $) <tokenSequence> #undef <identifier> #include $< <filename> $> #include $" <filename> $" #include <tokenSequence> *Not supported* #line <constant> $" <filename> $" *Parsed but not supported* #line <constant> *Parsed but not supported* #error <tokenSequence> #pragma <tokenSequence> *Parsed but not supported* # #assert <predicate>(<tokenSequence>) #assert <predicate> #unassert <predicate>(<tokenSequence>) #unassert <predicate> <preprocessorConditional> <preprocessorConditional> ::= <ifLine> <text> <elifParts> [<elsePart>] # endif <ifLine> ::= # if <constantExpression> # ifdef <identifier> # ifndef <identifier> <elifParts> ::= <elifLine> <text> [<elifParts>] <elifLine> ::= # elif <constantExpression> <elsePart> ::= <elseLine> <text> <elseLine> ::= # else Note that the current implementation uses an include stack to save state when encountered #include directives. This stack should really contain instances of this class rather than stream information. This may change in future implementations. Instance Variables: "The following are set at instance initialization." includeDirectories <SequenceableCollection of: String> directories for #include searching "The following are changed dynamically." includeStack <OrderedCollection of: Array> save state for #include directiveTakenStack <OrderedCollection> A collection of Boolean indicating if directive conditionals evaluated to true or not. saveReservedWords <Dictionary> save reserved words / macros while processing a directive skipLevel <Integer> depth of nesting in false conditionals ignoreSkipLevel <Integer> skip over tokens while skipLevel > ignoreSkipLevel inMacroScan <Boolean> true if the parser is currently scanning a macro's arguments. lastDefine <CMacroDefinition> the last #define processed. dontStepPastEnd <Boolean> is true when the look-ahead machinery should not step past the end of a stream and re-install the previous stream. This is used when streams are stacked during preprocessing. outputStream <Stream> the stream where all preprocessor output is to be placed. saveDefines <Dictionary> whenever a #define overrides a delcaration, the declaration is placed here so it can be reinstated when the #define is #undef'ined. assertDefines <Dictionary> the repository for all assertions declared using #assert. continuationCount <Integer> a count of the number of continuation character ($\) encountered since the last time the variable was set. This is typically used to recalculate character counts on platforms that use CRLF line-end conventions. We define the reservedWords instance variable to hold a Dictionary in which the keys are the names of reserved words or macros (the latter overriding the former), and the value is true for a reserved word, or the definition for a macro. Class Variables: ATypeTable <Array|nil> an alternate typeTable for parsing macro arguments DTypeTable <Array|nil> an alternate typeTable for parsing directives
</comment> <class> <name>CStructureInspector</name> <environment>Tools</environment> <super>Tools.Inspector</super> <private>false</private> none <imports></imports> <category>Tools-Inspector</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> Tools.CStructureInspector
A CStructureInspector is an inspector which provides an improved user view on a CComposite or CCompositePointer datum by augmenting the basic CDatum instance data view to add direct access to each member value and a byte-level view on the actual contents of the structure data.
</comment> <class> <name>CCompositeTypeInspector</name> <environment>Tools</environment> <super>Tools.Inspector</super> <private>false</private> none <imports></imports> <category>Tools-Inspector</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> Tools.CCompositeTypeInspector
CCompositeTypeInspector is an inspector which provides an improved user view on the low-level encoding of member information in a CCompositeType definition of a structure or union. For each member, an assoc with the offset and type of the member is displayed, along with an associated list containing the argument kind value and the CDatum class which is instantiated by an accessor on this member. Note that member definitions should not be edited from this view, as the viewing representation does not map precisely onto the underlying object state representation.
</comment> <class> <name>CStructMember</name> <environment>Tools.Trippy</environment> <super>Tools.Trippy.KeyedElement</super> <private>false</private> none <imports></imports> <category>Tools-Trippy</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> Tools.Trippy.CStructMember
This is a kind of KeyedElement used with C composite types. It is just like a regular KeyedElement, except that it uses #memberAt: and #memberAt:put: for element access.
</comment> <class> <name>ExternalInterfaceHolder</name> <environment>External</environment> <super>Core.Object</super> <private>false</private> none externalInterface externalDictionary <imports></imports> <category>DLLCC-Interface</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> External.ExternalInterfaceHolder
The class ExternalInterfaceHolder is used to hold either an ExternalInterface or an ExternalDictionary. This holder provides common protocol to both objects. It is used by the external interface browser classes when requesting and setting information in an ExternalDictionary. Please see the accessing protocol for a description of the messages this class understands. Instance Variables externalInterface <ExternalInterface class | nil> The interface the receiver contains; nil if the holder contains only a dictionary. externalDictionary <ExternalDictionary> The dictionary the receiver contains. This is either externalInterface's dictionary if externalInterface is not nil, otherwise it is simply an arbitrary dictionary.
</comment> <class> <name>CDeclarationParser</name> <environment>External</environment> <super>External.CExpressionParser</super> <private>false</private> none <imports></imports> <category>DLLCC-CParsing</category> <attributes> <package>DLLCC</package> </attributes> </class> <comment> External.CDeclarationParser
The class CDeclarationParser provides the ability to parse a token sequence (usually generated by the CPreprocessor class) into a set of C language declaration objects (typically instances of CType). These objects are contained in the parser's declaration dictionary, which may be retrieved after the parse completes. This class implements the full C language syntax for variable and type declarations. It does not support parsing arbitrary C language source code (we leave this to the yet unwritten CStatementParser class).
</comment> <name>MenuBarMenu</name> <environment>Tools.ExternalInterfaceFinder</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>DLLCC</package> </attributes> <name>ClassListMenu</name> <environment>Tools.ExternalInterfaceFinder</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>DLLCC</package> </attributes> <name>RecentlyVisitedClasses</name> <environment>Tools.ExternalInterfaceFinder</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <initializer>OrderedCollection new</initializer> <attributes> <package>DLLCC</package> </attributes> <name>ExternalListMenu</name> <environment>Tools.ExternalInterfaceFinder</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>DLLCC</package> </attributes> <name>ExternalInterfaceClasses</name> <environment>Tools.ExternalInterfaceFinder</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>DLLCC</package> </attributes> <name>DTypeTable</name> <environment>External.CPreprocessor</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>DLLCC</package> </attributes> <name>ATypeTable</name> <environment>External.CPreprocessor</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>DLLCC</package> </attributes> <name>MenuBarMenu</name> <environment>Tools.ExternalInterfaceBuilder</environment> <private>false</private> <constant>false</constant> <category>As yet unclassified</category> <attributes> <package>DLLCC</package> </attributes> <methods> Kernel.ExtendedCompiler <category>accessing</category>
external "Answer the external object the receiver is compiling." ^external
external: anExternal "Remember the external object the receiver is compiling." external := anExternal
methodClass "Answer the class to be used for creating methods." "We delegate this responsibility to the external object which can determine the type of method to use." external isNil ifTrue: [^super methodClass] ifFalse: [^external methodClassIn: self targetClass]
targetClass "Answer the target interface class the receiver is compiling code for." ^targetClass instanceBehavior
</methods> <methods> Kernel.ExtendedCompiler <category>private</category>
translate: aStream noPattern: noPattern ifFail: failBlock needSourceMap: mapFlag handler: handler "noPattern is true for evaluation, false for compilation" | methodNode holder codeStream method parser strongPointers | "Make special provisions for compiling methods in classes that still use the old parser." parser := class parserClass new. methodNode := parser parse: aStream class: class environment: self environment noPattern: noPattern context: context notifying: handler builder: ProgramNodeBuilder new saveComments: mapFlag ifFail: [^failBlock value]. (BlockAnalyzer new analyze: methodNode inClass: class context: context) storeHintsForStandardSmalltalk. handler selector: methodNode selector. "save selector in case of error" codeStream := self newCodeStream. strongPointers := OrderedCollection new. self external: parser external. self external notifyCompilationOfTypeDefinition. parser externals notNil ifTrue: [| targetClassExternals | targetClassExternals := self targetClass externals. [parser externals ownKeysAndValuesDo: [:key :anExternal | targetClassExternals installAt: key put: anExternal. strongPointers add: (targetClassExternals associationAt: key). targetClassExternals weakenAt: key]] on: Object errorSignal do: [:ex | Dialog warn: ex description. failBlock value]]. codeStream class: targetClass outerScope: (self scopeForMethod: methodNode); requestor: handler. mapFlag ifTrue: [codeStream saveSourceMap]. noPattern ifTrue: [methodNode emitValue: codeStream inContext: context] ifFalse: [methodNode emitEffect: codeStream]. method := codeStream makeMethod: methodNode. "The following seems like a hack but there doesn't seem to be a clean way to initialize the new method given the current external unless CompiledMethod is taught about externals which doesn't seem right either." [method for: (self targetClass externals associationAt: self external name) selector: methodNode selector] on: Object messageNotUnderstoodSignal do: [:ex | ex return]. "Generate methods for implicit externals, such as for 'bar' in 'typedef struct bar {..} foo'. But be careful not to overwrite methods that have yet to be compiled, i.e. as happens on recompiling Parcel loads." strongPointers do: [:assoc | assoc key ~~ self external name ifTrue: [(self targetClass includesSelector: assoc key) ifFalse: [self targetClass generateMethodsForExternal: assoc value]]]. "If the method contains an attribute, reset the method to be an AnnotatedMethod. Note that AnnotatedMethods are mutually exclusive with ExternalMethods -- one can't have both yet." method := method withAdditionalPropertiesFrom: methodNode. holder := self newMethodHolder. holder node: methodNode. holder method: method. mapFlag ifTrue: [holder sourceInfo: codeStream sourceInfo]. ^holder
</methods> <methods> Kernel.ExtendedCompiler class <category>parsing</category>
preferredParserClass ^ExtendedParser
</methods> <methods> Kernel.ExtendedParser <category>externals</category>
external ^external
externalCallWithArguments: argNames "Generate an external language declaration using the external function argument names indicated by the argument. Answer nil if the generation failed, otherwise answer a Stream containing the contents of the external declaration." "Currently only <C: > syntax is supported." ExternalInterface externalCompilerClass isNil ifTrue: [(requestor isKindOf: SilentCompilerErrorHandler) ifTrue: [self skipPrimitive. ^'' readStream] "doing explain" ifFalse: [^ExternalInterface externalCompilerMissingError]]. (self matchToken: 'C:') ifTrue: [^self externalCCallWithArguments: argNames]. ^nil
externalCCallWithArguments: argNames "Invoke a CParser on source, which parses a C declaration until and including the $> token. Set the source pointer back to the point right after this token for subsequent parsing of the failure code by self (the Smalltalk parser). Generate and return Smalltalk code (as a stream) that calls the C function, to be subsequently parsed by self. argNames, the method's arguments, are used as arguments for the C call." | interfaceClass assignedName | self resetSourceToLastToken. interfaceClass := self interfaceClass. externals := interfaceClass tempExternals. external := self parseDefineOrSingleDeclaration: externals. (external isKindOf: Association) ifTrue: [assignedName := external key. external := external value]. ^external callStreamArgs: argNames assign: assignedName interface: interfaceClass
externals ^externals
skipPrimitive [token == #>] whileFalse: [self scanToken]
</methods> <methods> Kernel.ExtendedParser <category>statements</category>
statements | stmts returnStart | stmts := OrderedCollection new. [tokenType == #upArrow ifTrue: [returnStart := mark. self scanToken. self expression ifFalse: [^self expected: 'Expression to return']. self addComment. parseNode := builder newReturnValue: parseNode. parseNode sourcePosition: (returnStart to: self endOfLastToken). stmts addLast: parseNode. self match: #period. "allow optional trailing . after ^" false] ifFalse: [self expression ifTrue: [self addComment. stmts addLast: parseNode. self match: #period] ifFalse: [self addComment. false]]] whileTrue: []. ^stmts
statementsArgs: argNodes temps: oldTemps statements: oldStatements "oldTemps is nil if temps should be parsed. This is for compatibility with the old language, so that temps can be parsed before the primitive specification." | tempNodes stmts start blockComment returnStart | tempNodes := oldTemps isNil ifTrue: [self temporaries] ifFalse: [oldStatements isNil ifTrue: [oldTemps] ifFalse: [oldTemps, self temporaries]]. stmts := oldStatements isNil ifTrue: [OrderedCollection new] ifFalse: [oldStatements]. "give initial comment to block, since others trail statements" blockComment := currentComment. currentComment := nil. start := endTemps. [tokenType == #upArrow ifTrue: [returnStart := mark. self scanToken. self expression ifFalse: [^self expected: 'Expression to return']. parseNode := builder newReturnValue: parseNode. self addComment. parseNode sourcePosition: (returnStart to: self endOfLastToken). stmts addLast: parseNode. self match: #period. "allow optional trailing . after ^" false] ifFalse: [self expression ifTrue: [self addComment. stmts addLast: parseNode. self match: #period] ifFalse: [false]]] whileTrue. self addComment. (stmts size = 1 and: [blockComment == nil and: [parseNode := stmts first. parseNode sourcePosition == nil and: [tempNodes isEmpty]]]) ifTrue: ["No point in building a sequence"] ifFalse: [parseNode := builder newSequenceTemporaries: tempNodes statements: stmts. parseNode addComment: blockComment]. parseNode sourcePosition: (start to: self endOfLastToken+1). parseNode := builder newBlockArguments: argNodes body: parseNode
</methods> <methods> Kernel.ExtendedParser <category>public access</category>
parseArgsAndTemps: aString notifying: req "For the explainer, parse the string and answer with an Array of Strings (the arg and temp names)." ^self initPattern: aString notifying: req saveComments: false return: [:pattern | (self matchToken: #<) ifTrue: [self skipPrimitive]. "skip primitive if any" self temporaries collect: [:param | param name asString]]
</methods> <methods> Kernel.ExtendedParser <category>scanning</category>
resetSourceToLastToken source position: self endOfLastToken.
</methods> <methods> Kernel.ExtendedParser <category>expression types-^value/error</category>
pragmaKeywords "Answer an Array of Symbols that identify the method pragma keywords supported by the receiver." ^super pragmaKeywords, #(#C:)
</methods> <methods> Kernel.ExtendedParser <category>private</category>
interfaceClass "Answer the class that represents the external interface for the receiver's parsed code." ^requestor theClass instanceBehavior
parseDefineOrSingleDeclaration: declarationDictionary "Parse a single #define or single declaration. Answer the declaration." | preprocessor savedPosition isStream | isStream := source isCharacters not. isStream ifTrue: [savedPosition := source position]. preprocessor := CPreprocessor parseWithNoPreprocess: source as: #defineOrSingleDeclaration declarations: declarationDictionary requestor: requestor. preprocessor lastDefine isNil ifFalse: [^preprocessor lastDefine]. isStream ifTrue: [source position: savedPosition]. ^(CDeclarationParser parseWithNoPreprocess: source as: #defineOrSingleDeclaration declarations: declarationDictionary requestor: requestor) result
</methods> <methods> Kernel.ExtendedParser <category>method</category>
method: fromDoIt context: ctxt "pattern [ | temporaries ] block => MethodNode" | start pat block messageComment methodNode tempNodes statementNodes externalCallStream | start := mark. pat := fromDoIt ifTrue: [ctxt == nil ifTrue: [Array with: #DoIt with: #()] ifFalse: [Array with: #DoItIn: with: (Array with: (builder newParameterVariable: (builder newVariableName: 'DOITCONTEXT')))]] ifFalse: [self pattern]. "pat={selector, arguments}" messageComment := currentComment. currentComment := nil. "Parse temporaries before primitive, to allow for old language." methodNode := builder newMethodSelector: (pat at: 1). tempNodes := tokenType == #verticalBar ifTrue: [self temporaries] ifFalse: [newLanguage ifTrue: [nil] ifFalse: [#()]]. (fromDoIt not and: [self matchToken: #<]) ifTrue: ["First try external declaration" | argNames | argNames := (pat at:2) collect: [:arg | arg name]. externalCallStream := [self externalCallWithArguments: argNames] on: Object errorSignal do: [:ex | ^self notify: (ex messageText size > 0 ifTrue: ['syntax error, ', ex messageText] ifFalse: ['syntax error'])]. externalCallStream notNil ifTrue: [ | oldSource atomicMethod | oldSource := source. self scan: externalCallStream. atomicMethod := self readStandardPragmas: methodNode temps: tempNodes. atomicMethod isNil ifTrue: [ tempNodes := self temporaries. statementNodes := self statements]. self scan: oldSource. atomicMethod isNil ifFalse: [tempNodes := self temporaries]] ifFalse: ["Now try regular primitive" self privateReadStandardPragmas: methodNode temps: tempNodes]]. self statementsArgs: (pat at: 2) temps: tempNodes statements: statementNodes. block := parseNode. tokenType == #doIt ifFalse: [^self expected: 'Nothing more']. methodNode block: block. methodNode addComment: messageComment. methodNode sourcePosition: (start to: self endOfLastToken). ^methodNode
</methods> <methods> External.CScanner <category>private-scanning</category>
scanChar "Scan a C character, possibly an escape. Accumulate the decoded character(s)." | theChar code | theChar := hereChar. self step. "True if there are two backslashes, iff hereChar is a backslash, or if neither character is a backslash." (theChar ~~ $\ or: [hereChar == $\]) ifTrue: [buffer nextPut: theChar. "If we have two adjacent backslashes, then write one to the buffer and advance the stream." theChar == $\ ifTrue:[self step]. ^true]. hereChar isDigit ifTrue: [code := hereChar digitValue. self step. hereChar isDigit ifTrue: [code := code * 8 + hereChar digitValue. self step. hereChar isDigit ifTrue: [code := code * 8 + hereChar digitValue. self step]]. buffer nextPutAll: ((ByteArray with: code) asStringEncoding: #default). ^true]. hereChar = $x ifTrue: [self step. code := hereChar digitValue. self step. hereChar = $' ifTrue: [buffer nextPutAll: ((ByteArray with: code) asStringEncoding: #default). ^true] ifFalse: [code := code * 16 + hereChar digitValue]. buffer nextPutAll: ((ByteArray with: code) asStringEncoding: #default). self step. ^true]. (code := 'ntvbrfa\?''"' indexOf: hereChar) > 0 ifTrue: [buffer nextPut: (#(8r12 8r11 8r13 8r10 8r15 8r14 8r07 $\ $? $' $") at: code) asCharacter. self step. ^true]. ^false
scanToken "Scan the input stream for a single token." | skipped | [skipped := 0. [hereChar == nil ifTrue: "end of input" ["skipLevel > 0 ifTrue: [self offEnd: 'Unterminated conditional']." prevEnd := source position. mark := prevEnd + 1. tokenType := #doIt. ^token := nil]. (tokenType := typeTable at: hereChar asInteger) == #xDelimiter] whileTrue: "Skip delimiters fast, there almost always is one." [skipped := skipped + 1. "open code step for speed" [hereChar := source next. hereChar == $\ and: [source peekFor: Character cr]] whileTrue: [skipped := skipped + 1]]. mark := source position. "The following is a hack for platforms that support CRLF - the mark should be adjusted." (hereChar == Character cr and: [sourceUsesCRLF]) ifTrue: [mark := mark - 1]. prevEnd := mark - skipped - 1. tokenType isSymbol ifTrue: "single-character token" [token := hereChar. self step] ifFalse: [buffer reset. [tokenType isSymbol] whileFalse: [buffer nextPut: hereChar. self step. tokenType := tokenType value at: hereChar ifAbsent: [tokenType key]]. (tokenType at: 1) == $x ifTrue: [self perform: tokenType] ifFalse: [token := buffer contents]]. tokenType isNil] whileTrue. "loop until we have a real token" ^token
sourcePosition "return the source position of here" ^mark - 1
sourcePosition: pos "set the source position of here" source position: pos. self step. "fill character buffer" self scanToken. "fill scanner buffer"
step "Override the super class implementation handle line-splicing with \." | aChar | [aChar := hereChar. hereChar := source next. hereChar == $\ and: [source peekFor: Character cr]] whileTrue. ^aChar
xCharacter "Parse a character constant (possibly a multi-character constant). Answer the receiver. A side effect is to set the token to either a Character (for a character constant) or an Integer (for a mulit-character constant) and the tokenType to #character or #number." buffer reset. [self scanChar. hereChar = $'] whileFalse. self step. token := self numberFromString: buffer contents. tokenType := #number
xComment "Skip a (non-nested) C comment. hereChar is the initial *. The initial / is in the buffer." | prev | hereChar := nil. [prev := hereChar. self step. prev == $* and: [hereChar == $/]] whileFalse. self step. tokenType := nil
xComment1 "Skip a one-line C comment. hereChar is the second /. The initial / is in the buffer." | cr | cr := Character cr. [hereChar == nil or: [(source peek == cr) or: [hereChar := source next. false]]] whileFalse. hereChar == nil ifFalse: [hereChar := source next]. tokenType := nil
xCR "We just saw a CR - skip any whitespace." self skipWhitespace. tokenType := nil. ^self
xHexadecimal "Parse a hexadecimal constant. If the constant contains leading zeros, answer a LargePositiveInteger containing the leading zeros. Although this integer may be compressed into a SmallInteger, we use it as a container for initializers where the leading zeros are important." token := ''. [hereChar := source next. hereChar notNil and: [hereChar digitValue between: 0 and: 15]] whileTrue: [token := token copyWith: hereChar]. hereChar == nil ifFalse: [hereChar asUppercase == $U ifTrue: [hereChar := source next. (hereChar notNil and: [hereChar asUppercase == $L]) ifTrue: [hereChar := source next]] ifFalse: [hereChar asUppercase == $L ifTrue: [hereChar := source next. (hereChar notNil and: [hereChar asUppercase == $U]) ifTrue: [hereChar := source next]]]]. token := self hexNumberFromString: token. tokenType := #number. hereChar == nil ifTrue: [self step]
xInteger "Handle an integer constant. We don't distinguish unsigned or long yet, but for correct expression evaluation, we will have to." | tokenSize | token := buffer contents. (token = '0' and: [hereChar == $x]) ifTrue: [^self xHexadecimal]. (token first == $0 and: [hereChar ~~ $.]) ifTrue: [^self xOctal]. tokenSize := token size. (token at: tokenSize) asUppercase == $U ifTrue: [tokenSize := tokenSize - 1. (token at: tokenSize) asUppercase == $L ifTrue: [tokenSize := tokenSize - 1]] ifFalse: [(token at: tokenSize) asUppercase == $L ifTrue: [tokenSize := tokenSize - 1]. (token at: tokenSize) asUppercase == $U ifTrue: [tokenSize := tokenSize - 1]]. token := token copyFrom: 1 to: tokenSize. (hereChar notNil and: ['.eEdD' includes: hereChar]) ifTrue: [token := self xLimitedPrecisionReal: token] ifFalse: [token := Integer readFrom: token readStream]. tokenType := #number
xLetter "form a word, keyword, or reserved word" | type char | buffer reset. buffer nextPut: hereChar. [char := source next. char notNil and: [type := typeTable at: char asInteger. type == #xLetter or: [type == #xDigit]]] whileTrue: [buffer nextPut: char]. tokenType := #word. hereChar := char. token := buffer contents. reservedWords == false ifFalse: [(reservedWords includes: token) ifTrue: [tokenType := token asSymbol]]
xLimitedPrecisionReal: prefixToken "Answer a token that represents a limited precision real number (float or double). The integral part of the number is represented by the argument. If the parse fails or results in an invalid real, the argument is answered." | realToken prevChar | realToken := prefixToken. (hereChar = $. or: [realToken isEmpty]) ifTrue: [| fractionExists | fractionExists := false. hereChar = $. ifTrue: [prevChar := hereChar. realToken := realToken copyWith: hereChar. hereChar := source next] ifFalse: [realToken := '0.' copy]. [hereChar notNil and: [hereChar digitValue between: 0 and: 9]] whileTrue: [fractionExists := true. realToken := realToken copyWith: hereChar. hereChar := source next]. fractionExists ifFalse: [realToken := realToken copyWith: $0]]. (hereChar notNil and: ['eEdD' includes: hereChar]) ifTrue: [realToken := realToken copyWith: $e. prevChar := hereChar. hereChar := source next. (hereChar notNil and: [('+-' includes: hereChar) and: [(hereChar ~~ $+) or: [('dD' includes: prevChar) not]]]) ifTrue: [hereChar = $+ ifFalse: [realToken := realToken copyWith: hereChar]. hereChar := source next]. [hereChar notNil and: [hereChar digitValue between: 0 and: 9]] whileTrue: [realToken := realToken copyWith: hereChar. hereChar := source next]]. (hereChar notNil and: ['fF' includes: hereChar]) ifTrue: [hereChar := source next. ^[(Float readFrom: realToken readStream) asFloat] on: ArithmeticValue rangeErrorSignal do: [:ex1 | ex1 return: ([(Double readFrom: realToken readStream) asDouble] on: ArithmeticValue rangeErrorSignal do: [:ex2 | ex2 return: prefixToken])]] ifFalse: [(hereChar notNil and: ['lL' includes: hereChar]) ifTrue: [hereChar := source next]]. ^[(Double readFrom: realToken readStream) asDouble] on: ArithmeticValue rangeErrorSignal do: [:ex | ex return: prefixToken]
xOctal "Handle an octal constant. We don't handle unsigned and long constants, but we will have to for correct expression evaluation." | tokenSize | tokenSize := token size. (token at: tokenSize) asUppercase == $U ifTrue: [tokenSize := tokenSize - 1. (token at: tokenSize) asUppercase == $L ifTrue: [tokenSize := tokenSize - 1]] ifFalse: [(token at: tokenSize) asUppercase == $L ifTrue: [tokenSize := tokenSize - 1]. (token at: tokenSize) asUppercase == $U ifTrue: [tokenSize := tokenSize - 1]]. token :=token copyFrom: 1 to: tokenSize. token do: [:aChar | (aChar digitValue between: 0 and: 7) ifFalse: [^self expected: (#octalConstant << #dllcc >> 'octal constant')]]. token := Integer readFrom: token readStream radix: 8. tokenType := #number
xOperator "Make an operator into a symbol." token := buffer contents asSymbol. (token == #/ and: [hereChar == $=]) ifTrue: [self step. token := #/=]. token == #'||' ifTrue: [tokenType := #'||'] ifFalse: [ token == #| ifTrue: [tokenType := #verticalBar] ifFalse: [ token == #'^' ifTrue: [tokenType := #upArrow] ifFalse: [ tokenType := #binary]]]. "not really binary, but this is what the ParserGenerator expects"
xPeriod "A period ($.) was encountered in the input stream. Answer the correct token, which may be a #number (limited precision reals may start with a period with no 0 prefix), or a #period." (hereChar notNil and: [hereChar digitValue between: 0 and: 9]) ifTrue: [token := self xLimitedPrecisionReal: ''. ^tokenType := #number]. token := $.. ^tokenType := #period
xString "Handle a string constant." [[hereChar == $"] whileFalse: [hereChar == nil ifTrue: [self notify: (#UnmatchedQuote << #dllcc >> 'Unmatched "'). ^self scanToken]. self scanChar]. self step. self skipWhitespace. hereChar == $" and: [self step. true]] whileTrue. buffer nextPut: $". token := buffer contents. "scanChar converts escaped backslashes (\\) to a single backslash. Within the string they must be restored to double backslashes." (token includes: $\) ifTrue: [token := token copyReplaceAll: '\' with: '\\']. tokenType := #string
xWord "Handle a word." | tokenSymbolOrNil | token := buffer contents. ((tokenSymbolOrNil := Symbol findInterned: token) ~~ nil and: [(reservedWords at: tokenSymbolOrNil ifAbsent: [nil]) == true]) ifTrue: [tokenType := tokenSymbolOrNil] ifFalse: [tokenType := #word]
</methods> <methods> External.CScanner <category>private</category>
fastInit "Provide a fast initialization feature. The default is to do nothing; clients should override." sourceUsesCRLF := false. ^self
hexNumberFromString: aString "Answer an Integer number whose bytes consists of the character encodings found in the argument. The first character in the argument is the most significant byte of the answered number. If the hexadecimal constant contains leading zeros remember them also by creating an uncompressed LargePositiveInteger object to use as a container." | hexNumber byteIndex stringSize | stringSize := aString size. byteIndex := 0. hexNumber := LargePositiveInteger basicNew: stringSize + 1 // 2. stringSize to: 1 by: -2 do: [:i | | byte | byte := (aString at: i) digitValue. i > 1 ifTrue: [byte := byte + ((aString at: i - 1) digitValue bitShift: 4)]. hexNumber basicAt: (byteIndex := byteIndex + 1) put: byte]. ^hexNumber
init: streamOrString notifying: req failBlock: aBlock "Initialize the scanner. Return the initial position in the source stream, so that we can back up over an initial scan if necessary." | sourceStream startPos | (streamOrString isKindOf: Stream) ifTrue: [startPos := streamOrString position. sourceStream := streamOrString] ifFalse: [startPos := 1. sourceStream := streamOrString asString readStream]. requestor := req. failBlock := aBlock. self scan: sourceStream. ^startPos
numberFromString: aString "Answer an Integer number whose bytes consists of the character encodings found in the argument. The first character in the argument is the most significant byte of the answered number." | multiChar stringSize bytes | bytes := aString asByteArrayEncoding: #default. stringSize := bytes size. multiChar := Integer new: stringSize neg: false. 1 to: stringSize do: [:i | multiChar digitAt: stringSize - i + 1 put: (bytes at: i)]. ^multiChar compressed
printHexNumber: aLargePositiveInteger on: aStream "Print a representation of the the argument, aLargePositiveInteger, onto the argument aStream. If the number's most significant digit is zero, print a hexadecimal representation of the receiver, including any leading zeros, on aStream. This method will ensure hexadecimal constants with leading zeros are maintained." | digitLength | digitLength := aLargePositiveInteger digitLength. (aLargePositiveInteger digitAt: digitLength) isZero ifTrue: [| hexCodes | hexCodes := '0123456789ABCDEF'. aStream nextPutAll: '0x'. "'aLargePositiveInteger printOn: aStream radix: 16' doesn't quite do the right thing." aLargePositiveInteger digitLength to: 1 by: -1 do: [:i | | byte | byte := aLargePositiveInteger digitAt: i. aStream nextPut: (hexCodes at: (byte bitShift: -4) + 1); nextPut: (hexCodes at: (byte bitAnd: 16rf) + 1)]] ifFalse: [aLargePositiveInteger printOn: aStream]
skipWhitespace "Skip any whitespace." [hereChar notNil and: [(tokenType := typeTable at: hereChar asInteger) == #xDelimiter]] whileTrue: [self step]
source: sourceStream "Set the current scanner source stream to the argument." source := sourceStream. sourceUsesCRLF := self streamUsesCRLF: sourceStream
tokensFrom: string "Answer a collection of tokens scanned from the argument." | result | self on: (ReadStream on: string). result := OrderedCollection new. [hereChar = nil] whileFalse: [self scanToken. result addLast: (Array with: tokenType with: token)]. ^result
</methods> <methods> External.CScanner <category>accessing</category>
endOfLastToken "Answer the position of end of last expression parsed." ^prevEnd
requestor ^requestor
requestor: aRequestor requestor := aRequestor
resetSourceToLastToken source position: self endOfLastToken.
streamUsesCRLF: aStream "Answer true if the argument has a CRLF line-end convention, otherwise answer false." ^(aStream respondsTo: #lineEndConvention) and: [ aStream lineEndConvention = (IOConstants at: #LineEndCRLF)]
</methods> <methods> External.CScanner <category>initialize-release</category>
initScanner super initScanner. typeTable := self class typeTable. reservedWords := self class reservedWords copy. self fastInit
on: inputStream "Redefine this to preload a CR." self source: inputStream. hereChar := Character cr. prevEnd := 0
</methods> <methods> External.CScanner <category>error handling</category>
abort | exitBlock | exitBlock := failBlock. failBlock := nil. ^exitBlock value
expected: aString "Notify a problem at token 'here'" ^self notify: (#syntaxErrorHere << #dllcc >> 'syntax error ->') at: mark
notify: aString "Notify problem at token before 'here'" ^self notify: aString at: source position
notify: stringOrUserMessage at: location "A syntax error has occurred -- display string at location in the current stream." |string| string := stringOrUserMessage asString. requestor == nil ifTrue: [SyntaxError errorInClass: nil withCode: ((source reset; contents) copyReplaceFrom: location to: location - 1 with: string) errorString: string] ifFalse: [requestor syntaxError: string at: location]. self abort
offEnd: aString " notify a problem beyond 'here' (in lookAhead token). Don't be offEnded!" ^ self notify: aString at: mark
unexpectedError self notify: #syntaxError << #dllcc >> 'syntax error'
</methods> <methods> External.CScanner class <category>private-parser compiler</category>
abandonParserCompiler "CScanner abandonParserCompiler" | parserCompilerCategory | parserCompilerCategory := #'private-parser compiler'. self withAllSubclasses do: [:aClass | (aClass compilerClass respondsTo: #isGrammarExpression:) ifTrue: [ aClass selectors do: [:sel | | src | (aClass compilerClass isGrammarExpression: (src := (aClass compiledMethodAt: sel) getSource)) ifTrue: [| tree | tree := aClass compilerClass new parse: src in: aClass notifying: nil. tree := tree node. src := tree printString. aClass compile: src classified: (aClass organization categoryOfElement: sel)]]]]. self class compile: self generateComputeBasicTablesMethod classified: #private. self withAllSubclasses do: [:aClass | (aClass class organization listAtCategoryNamed: parserCompilerCategory) do: [:sel | aClass class removeSelector: sel]. aClass class organization removeCategory: parserCompilerCategory]. methodInfo := nil. self computeTables.
computeBasicTables "Compute the character type, reserved word tables, and keyword flag from the information associated with each method." | words types info typeInfo | words := Set new. types := TypeTable "copy". self methodInfo keys do: [:selector | "(methodDict includesKey: selector) ifTrue: ["info := methodInfo at: selector. words addAll: (info at: 1). typeInfo := info at: 2. typeInfo isEmpty ifFalse: [types == TypeTable ifTrue: [types := types copy]. typeInfo associationsDo: [:char | types at: char key asInteger put: char value]]"] ifFalse: [methodInfo removeKey: selector]"]. reservedWords := words isEmpty ifTrue: [false] ifFalse: [words]. typeTable := types.
generateComputeBasicTablesMethod "CScanner generateComputeBasicTablesMethod" | str | self computeBasicTables. str := String new writeStream. str nextPutAll: 'computeBasicTables'. str crtab; nextPutAll: '"Compute the character type, reserved word tables, and'. str crtab; nextPutAll: 'keyword flag from the information associated with each method."'. str cr; crtab; nextPutAll: 'reservedWords := '; store: reservedWords asArray; nextPutAll: '.'. str crtab; nextPutAll: 'typeTable := TypeTable copy.'. 1 to: 255 do: [:i | (typeTable at: i) = (TypeTable at: i) ifFalse: [str crtab; nextPutAll: 'typeTable at: '; print: i; nextPutAll: ' put: '; store: (typeTable at: i); nextPutAll: '.']]. ^str contents
methodInfo methodInfo == nil ifTrue: [methodInfo := Dictionary new]. reservedWords := typeTable := nil. "Clear cache" ^methodInfo
</methods> <methods> External.CScanner class <category>binary storage</category>
codeWriterTraceOnto: tracer super codeWriterTraceOnto: tracer. tracer trace: typeTable. tracer trace: reservedWords. tracer trace: methodInfo.
readInitializationObjectsOn: aBinaryCodeReader super readInitializationObjectsOn: aBinaryCodeReader. typeTable := aBinaryCodeReader readObject. reservedWords := aBinaryCodeReader readObject. methodInfo := aBinaryCodeReader readObject.
storeInitializationObjectsOn: aBinaryCodeWriter aBinaryCodeWriter trace: typeTable. aBinaryCodeWriter trace: reservedWords. aBinaryCodeWriter trace: methodInfo.
</methods> <methods> External.CScanner class <category>private</category>
computeTables "Compute the character type, reserved word tables, and keyword flag from the information associated with each method." "CScanner computeTables." self computeBasicTables. "Construct the type table. This is not a simple mapping from characters to symbols: it is more like a finite-state machine description." typeTable at: 26 "^Z" put: #xDelimiter. "Window EOF" self initReservedWords. self initIdentifiers: typeTable. self initNumbers: typeTable. self initOperators: typeTable. self initCharsAndStrings: typeTable. self initComments: typeTable. self initCR: typeTable. self initMacroTokens: typeTable
decode: tree | dict | ^tree isSymbol ifTrue: [tree] ifFalse: [dict := IdentityDictionary new. 2 to: tree size do: [:i | dict at: (tree at: i) first put: (self decode: (tree at: i) last)]. (self decode: tree first) -> dict]
in: tree digits: next '0123456789' do: [:char | tree at: char put: next]
initCharsAndStrings: newTypeTable "Characters and strings." newTypeTable at: $' asInteger put: (self decode: #(xCharacter)). newTypeTable at: $" asInteger put: (self decode: #(xString)).
initComments: newTypeTable "Comments." newTypeTable at: $/ asInteger put: (self decode: #(xOperator ($* xComment) ($/ xComment1)))
initCR: newTypeTable "CR -- for detecting preprocessor directives." newTypeTable at: Character cr asInteger put: (self decode: #(xCR)).
initIdentifiers: newTypeTable "Identifiers" | id | id := #xWord -> (IdentityDictionary new: 128). (($a asInteger to: $z asInteger), ($A asInteger to: $Z asInteger) copyWith: $_ asInteger) do: [:ascii | newTypeTable at: ascii put: id. id value at: (Character value: ascii) put: id]. self in: id value digits: id.
initMacroTokens: newTypeTable "Tokens used in macros for stringization and concatenation." newTypeTable at: $# asInteger put: (self decode: #(xOperator ($# (xOperator)))). newTypeTable at: $\ asInteger put: (self decode: #(xOperator ($# (xOperator)))).
initNumbers: newTypeTable "numbers - only decimal integers for now" | num | num := self decode: #(xInteger ($l (xInteger)) ($L (xInteger)) ($u (xInteger ($l (xInteger)))) ($U (xInteger ($L (xInteger))))). self in: num value digits: num. newTypeTable atAll: ($0 asInteger to: $9 asInteger) put: num. newTypeTable at: $. asInteger put: (self decode: #(xPeriod))
initOperators: newTypeTable "Operators" #( ($% (xOperator ($= (xOperator)))) ($^ (xOperator ($= (xOperator)))) ($& (xOperator ($& (xOperator)) ($= (xOperator)))) ($* (xOperator ($= (xOperator)))) ($- (xOperator ($- (xOperator)) ($= (xOperator)) ($> (xOperator)))) ($+ (xOperator ($= (xOperator)) ($+ (xOperator)))) ($< (xOperator ($= (xOperator)) ($< (xOperator ($= (xOperator)))))) ($= (xOperator ($= (xOperator)))) ($! (xOperator ($= (xOperator)))) ($> (xOperator ($= (xOperator)) ($> (xOperator ($= (xOperator)))))) ($~ (xOperator ($= (xOperator)))) ($| (xOperator ($| (xOperator)) ($= (xOperator)))) ) do: [:op | newTypeTable at: op first asInteger put: (self decode: op last)]
initReservedWords "Change the reservedWords to a Dictionary." | rWords | rWords := Dictionary new. reservedWords == false ifFalse: [reservedWords do: [:rw | rWords at: rw asSymbol put: true]]. reservedWords := rWords
</methods> <methods> External.CScanner class <category>flushing</category>
flushCache "Flush any cached information." reservedWords := nil
flushCaches "Flush any cached information." self withAllSubclasses do: [:ea| ea flushCache] "CScanner flushCaches"
</methods> <methods> External.CScanner class <category>class initialization</category>
initialize "Perform any class-specific initialization. Answer the receiver." "CScanner initialize" ChangeSet current addPatch: self version
</methods> <methods> External.CScanner class <category>parcel load/unload</category>
preUnloadFor: theDLLCCParcel "Close any open applications implemented by this parcel. Remove the DLLCC patch Id form the system patches." ApplicationModel checkUnloadOfApplicationsDefinedBy: theDLLCCParcel. [ChangeSet patches includes: self version] whileTrue: [ChangeSet patches remove: self version]
</methods> <methods> External.CScanner class <category>accessing</category>
reservedWords reservedWords == nil ifTrue: [self computeTables]. ^reservedWords
typeTable typeTable == nil ifTrue: [self computeTables]. ^typeTable
version "Answer the current version of the receiver." ^'CScanner Release 3.2'
</methods> <methods> External.CScanner class <category>scanning</category>
tokensFrom: aString "CScanner tokensFrom: 'typedef struct point_s { int x, y; } point;'" ^self new tokensFrom: aString
</methods> <methods> Tools.ExternalInterfaceBuilder <category>aspects</category>
categoryList "Answer the selection-in-list object that contains the builder's categories." ^categoryList isNil ifTrue: [categoryList := SelectionInList new] ifFalse: [categoryList]
externalMultiSelectionList "Answer the external pane's multi-selection-in-list. The list's contents change depending on the selected category, but will typically contain external declaration objects." ^externalMultiSelectionList
externalSingleSelectionList "Answer the external pane's single-selection-in-list. This list typically contains the builders include files and directories." ^externalSingleSelectionList
</methods> <methods> Tools.ExternalInterfaceBuilder <category>private</category>
addExternalForCategory: aCategory "Prompt the user for information to add to the given category. If it is not a category where information can be added, do nothing. Answer the receiver." | categorySymbol | categorySymbol := aCategory asSymbol. categorySymbol == #'include files' ifTrue: [^self addIncludeFile]. categorySymbol == #'include directories' ifTrue: [^self addIncludeDirectory]
categories "Answer an array of symbols that define the values in the receiver's category view pane." ^#( #'include files' #'include directories' #procedures #variables #typedefs #structs #unions #enums #defines #macros ) copy
categoryChange "A category in the receiver's category pane was selected or deselected. Update the receiver's view based on this new selection. Answer the receiver." | selection | selection := self category. selection isNil ifTrue: [^self updateCategoryNotSelected] ifFalse: [selection := selection asSymbol]. self updateCategorySelected. self updateExternalLabel
computeCategoryList "Answer a List of categories that should appear in the receiver's category pane. Modify the include file and include directory items to be italicized text." | categories | categories := self categories. 1 to: 2 do: [:i | | aCategory | aCategory := categories at: i. categories at: i put: (aCategory asText emphasizeFrom: 1 to: aCategory size with: #italic)]. ^List withAll: categories
declarations "Answer the ExternalDictionary of declarations the receiver is currently building. If no externals have been parsed answer nil." externalInterfaceHolder isNil ifTrue: [^nil]. ^externalInterfaceHolder externalDictionary
declarations: declarations "Set the receiver's declarations to the argument. Update the category selection list based on these declarations. Answer the receiver." self externalInterface: declarations. externalSelectionDictionary := IdentityDictionary new. #(procedures variables typedefs structs unions enums defines macros) do: [:category | externalSelectionDictionary at: category put: (self listAtCategory: category)->Set new]
externalChange "An external in the receiver's external pane was selected or deselected. Update the receiver's view based on this new selection. Answer the receiver." | removeButton menu | removeButton := builder componentAt: #removeButton. menu := ((builder aspectAt: #menuBar) menuItemAt: 3) submenu. self external isNil ifTrue: [removeButton disable. (menu menuItemAt: 2) disable] ifFalse: [removeButton enable. (menu menuItemAt: 2) enable]
externalInterface: anInterface "Inform the receiver to be building an interface for the given argument. Answer the receiver." externalInterfaceHolder isNil ifTrue: [externalInterfaceHolder := ExternalInterfaceHolder on: anInterface] ifFalse: [externalInterfaceHolder on: anInterface]
initializeSelections "Initialize the external selections that appear in the receiver's external view pane." externalSelectionDictionary := IdentityDictionary new. externalSelectionDictionary at: #procedures put: List new -> Set new; at: #variables put: List new -> Set new; at: #typedefs put: List new -> Set new; at: #structs put: List new -> Set new; at: #unions put: List new -> Set new; at: #enums put: List new -> Set new; at: #defines put: List new -> Set new; at: #macros put: List new -> Set new.
listAtCategory: category "Answer the list of externals at the given category -- typically a classification of external object like procedure, typedef, struct, etc. If no category is selected, do nothing. If the receiver is not editing an interface, do nothing." | externals | externalInterfaceHolder isNil ifTrue: [^List new]. externals := externalInterfaceHolder externalsAtCategory: category. ^externals reject: [:anExternal | anExternal isCharacters]
removeExternalForCategory: aCategory "Remove the currently selected external from the given category. If the category is not one where externals can be removed, do nothing. Answer the receiver." | categorySymbol | categorySymbol := aCategory asSymbol. categorySymbol == #'include files' ifTrue: [^self removeIncludeFile]. categorySymbol == #'include directories' ifTrue: [^self removeIncludeDirectory]
selectedKeys "Answer an IdentitySet of externals that are selected in the reciever's external view pane." | selectedKeys | selectedKeys := IdentitySet new. externalInterfaceHolder isNil ifTrue: [^selectedKeys]. #(defines macros typedefs structs unions enums variables procedures) do: [:category | | selections externals | selections := (externalSelectionDictionary at: category) value. selections isEmpty ifFalse: [ externals := externalInterfaceHolder externalsAtCategory: category. selections do: [:anIndex | selectedKeys add: (externals at: anIndex) name]]]. ^selectedKeys
</methods> <methods> Tools.ExternalInterfaceBuilder <category>actions</category>
add "Add an object to the currently selected category. The behavior of this message changes depending on the category. Answer the receiver." ^self addExternalForCategory: self category
addDirectory "Add a directory to the list of directories that will be searched when parsing header files." ^self addExternalForCategory: #'include directories'
addFile "Add a file to the list of header files that are parsed when building the external objects." ^self addExternalForCategory: #'include files'
addMethods "Prompt the user for a interface class name. Compile into that class methods for the current type selection set." | class defaultClassName | (externalInterfaceHolder isNil or: [externalInterfaceHolder externalDictionary isNil]) ifTrue: [^Dialog warn: #MustParseHeadersFirst << #dllcc >> 'You must parse header files first.' for: builder window]. defaultClassName := externalInterfaceHolder externalInterface notNil ifTrue: [externalInterfaceHolder externalInterface fullName] ifFalse: ['']. defaultClassName := Dialog request: (#ClassName << #dllcc >> 'Class name:') initialAnswer: defaultClassName for: builder window. defaultClassName isEmpty ifTrue: [^self]. class := defaultClassName asQualifiedReference valueOrDo: [nil]. (class isNil or: [(class inheritsFrom: ExternalInterface) not]) ifTrue: [^Dialog warn: (#sNotAnExternalClass << #dllcc >> '<1s> is not an ExternalInterface class' expandMacrosWith: defaultClassName) for: builder window]. Cursor execute showWhile: [class generateMethodsFrom: self declarations selectedKeys: self selectedKeys]. ObjectMemory quickGC
browseClass "Open a browser on the class currently associated with the receiver. If no class is defined, simply do nothing. Answer the receiver." (externalInterfaceHolder isNil or: [externalInterfaceHolder externalInterface isNil]) ifTrue: [^Dialog warn: #noInterfaceClass << #dllcc >> 'No interface class has been defined.' for: builder window]. SmalltalkWorkbench browseClass: externalInterfaceHolder externalInterface
defineClass "Prompt the user for relevant information to define a new ExternalInterface class and compile that class into the system. Answer the receiver." | finder newClass | finder := ExternalInterfaceClassFinder new. finder createMode. finder findClass. newClass := finder selectedClass. newClass isNil ifTrue: [^self]. (newClass inheritsFrom: ExternalInterface) ifFalse: [^Dialog warn: #mustBeExternalInterfaceSubclass << #dllcc >> 'The superclass must be a subclass of ExternalInterface.' for: self builder window]. ExternalInterfaceFinder addClass: newClass fullyQualifiedReference. externalInterfaceHolder isNil ifTrue: [self declarations: newClass] ifFalse: [externalInterfaceHolder externalInterface: newClass]. includeDirectories notNil ifTrue: [newClass includeDirectories addAll: includeDirectories]. includeFiles notNil ifTrue: [newClass includeFiles addAll: includeFiles]. Cursor execute showWhile: [newClass generateMethodsFrom: self declarations selectedKeys: self selectedKeys]. ObjectMemory quickGC. self updateClassDefined
deselectAllExternals "Deselect all the externals in the externals pane of the receiver's view associated with the current category. If no category is selected, do nothing. Answer the receiver." | externals category | (category := self category) isNil ifTrue: [^self]. externals := externalSelectionDictionary at: category ifAbsent: [^self]. externals value: Set new. self categoryChange
helpContents "Open a help browser displaying the top-most book for the DLL and C Connect kit. Answer the receiver." ^ExternalInterfaceFinder helpContents
parse "Parse the current set of include files. Search for those files in the current set of incude directories. Add all the externals found in those files to the receiver's externals collection and update all views. Display an error dialog if any problems occur during the parse." | declarations | includeFiles isEmpty ifTrue: [^Dialog warn: #pleaseParse << #dllcc >> 'Please add the include files to parse.' for: builder window]. declarations := ExternalDictionary new. Cursor execute showWhile: [([CDeclarationParser parseIncludeFiles: includeFiles declarations: declarations includeDirectories: includeDirectories requestor: nil] on: Object errorSignal do: [:ex | | output | (output := String new writeStream) nextPutAll: (#followingErrorOccurred << #dllcc >> 'The following error occurred during the parse:') asString; nextPut: Character cr; nextPutAll: ex description. Dialog warn: output contents for: builder window. ex return: nil]) notNil ifTrue: [self declarations: declarations. (builder componentAt: #defineButton) enable. (builder componentAt: #addMethodsButton) enable]]
remove "Remove the currently selected external which is typically an include file or directory. Answer the receiver." ^self removeExternalForCategory: self category
selectAllExternals "Select all the externals in the externals pane of the receiver's view associated with the current category. If no category is selected, do nothing. Answer the receiver." | externals category selected | (category := self category) isNil ifTrue: [^self]. externals := externalSelectionDictionary at: category ifAbsent: [^self]. selected := externals value. 1 to: externals key size do: [:i | selected add: i]. self categoryChange
</methods> <methods> Tools.ExternalInterfaceBuilder <category>private-updating</category>
updateCategoryNotSelected "Update the receiver's view state (buttons and menus) when a category is deselected. Answer the receiver." | menu | currentSubCanvas == #single ifTrue: [externalSingleSelectionList list: List new] ifFalse: [externalMultiSelectionList list: List new]. #(#addButton #removeButton) do: [:name | (builder componentAt: name) disable]. menu := ((builder aspectAt: #menuBar) menuItemAt: 3) submenu. 1 to: 4 do: [:i | (menu menuItemAt: i) disable]
updateCategorySelected "Update the receiver's view state (buttons and menus) when a category is selected. Answer the receiver." | selection widget menu | selection := self category asSymbol. widget := (self builder componentAt: #ExternalSubCanvas) widget. (selection == #'include files' or: [selection == #'include directories']) ifTrue: [selection == #'include files' ifTrue: [externalSingleSelectionList list: includeFiles] ifFalse: [externalSingleSelectionList list: includeDirectories]. currentSubCanvas == #single ifFalse: [ widget client: self spec:externalSingleSelectionSubCanvas. currentSubCanvas := #single]. self external isNil ifFalse: [(builder componentAt: #removeButton) enable]. (builder componentAt: #addButton) enable. menu := ((builder aspectAt: #menuBar) menuItemAt: 3) submenu. (menu menuItemAt: 1) enable. (menu menuItemAt: 3) disable. (menu menuItemAt: 4) disable.] ifFalse: [selection := externalSelectionDictionary at: self category ifAbsent: [^self]. externalMultiSelectionList list: selection key. externalMultiSelectionList selectionIndexes: selection value. currentSubCanvas == #multi ifFalse: [ widget client: self spec: externalMultiSelectionSubCanvas. currentSubCanvas := #multi]. #(#addButton #removeButton) do: [:name | (builder componentAt: name) disable]. menu := ((builder aspectAt: #menuBar) menuItemAt: 3) submenu. (menu menuItemAt: 1) disable. (menu menuItemAt: 3) enable. (menu menuItemAt: 4) enable]
updateClassDefined "Update the receiver's view state (buttons and menus) when a class is defined. Answer the receiver." | button menu | button := builder componentAt: #addMethodsButton. menu := ((builder aspectAt: #menuBar) menuItemAt: 2) submenu. (externalInterfaceHolder isNil or: [externalInterfaceHolder externalInterface isNil]) ifTrue: [button disable. (menu menuItemAt: 2) disable. (menu menuItemAt: 3) disable] ifFalse: [button enable. (menu menuItemAt: 2) enable. (menu menuItemAt: 3) enable]
updateExternalLabel "Update the receiver's external view pane label when a new category is selected. Answer the receiver." | label selection | selection := self category. selection isNil ifTrue: [(builder componentAt: #ExternalListLabel) labelString: (#Externals << #dllcc >> 'Externals')] ifFalse: [selection := selection asSymbol. label := selection asString. label at: 1 put: (label first asUppercase). (builder componentAt: #ExternalListLabel) labelString: label]
updateHelpAvailable "Check if help is available." | helpAvailable | helpAvailable := #{HelpBrowser} isDefined. (MenuBarMenu menuItemAt: 4) enabled: helpAvailable. ((MenuBarMenu menuItemAt: 4) submenu menuItemAt: 1) enabled: helpAvailable.
</methods> <methods> Tools.ExternalInterfaceBuilder <category>interface dialogs</category>
addIncludeDirectory "Prompt the user for an include directory name and add it to the builder's list of include directories that are searched when parsing an include file. Answer the receiver." | directory external | directory := Dialog request: #addIncludeDirectory << #dllcc >> 'Include Directory:' for: builder window. (directory isNil or: [directory isEmpty]) ifTrue: [^self]. external := self external. external isNil ifTrue: [includeDirectories addLast: directory] ifFalse: [includeDirectories add: directory before: external]
addIncludeFile "Prompt the user for an include file name and add it to the builder's list of include files that can be parsed to build the list of external objects that can be added to an interface class. Answer the receiver." | file external | file := Dialog request: #addIncludeFile << #dllcc >> 'Include File:' for: builder window. (file isNil or: [file isEmpty]) ifTrue: [^self]. external := self external. external isNil ifTrue: [includeFiles addLast: file] ifFalse: [includeFiles add: file before: external]. (builder componentAt: #parseButton) enable
removeIncludeDirectory "Remove the currently selected include directory from the list of directories the receiver searches when parsing an include file. If no include directory is selected do nothing. Answer the receiver." | external | external := self external. external isNil ifTrue: [^self]. includeDirectories remove: external
removeIncludeFile "Remove the currently selected include file from the list of files the receiver can parse to produce the list of externals that can be added to an interface class. If no include file is selected do nothing. Answer the receiver." | external | external := self external. external isNil ifTrue: [^self]. includeFiles remove: external. includeFiles isEmpty ifTrue: [(builder componentAt: #parseButton) disable]
</methods> <methods> Tools.ExternalInterfaceBuilder <category>accessing</category>
category "Answer the String representing the currently selected category." ^self categoryList selection
external "Answer the currently selected external. If no external is selected, answer nil. The external can be a String (include file or include directory), ExternalObject, or CMacroDefinition." ^self externalSingleSelectionList selection
menuBar "Answer the receiver's interface menu bar." ^MenuBarMenu
</methods> <methods> Tools.ExternalInterfaceBuilder <category>interface opening</category>
postOpenWith: aBuilder "After the receiver's view is open, update all menu and button states depending on the receiver's current set-up. Answer the value of the superclass #postOpenWith: method." | parseButton | parseButton := builder componentAt: #parseButton. includeFiles isEmpty ifTrue: [parseButton disable] ifFalse: [parseButton enable]. self updateCategoryNotSelected. self updateClassDefined. self updateHelpAvailable. ^super postOpenWith: aBuilder
</methods> <methods> Tools.ExternalInterfaceBuilder <category>initialize-release</category>
initialize "Initialize a new instance of the receiver. Answer the receiver." super initialize. externalInterfaceHolder := nil. categoryList := SelectionInList new. categoryList list: self computeCategoryList. categoryList selectionIndexHolder onChangeSend: #categoryChange to: self. currentSubCanvas := #single. includeFiles := List new. includeDirectories := List new. externalSingleSelectionList := SelectionInList new. externalSingleSelectionList selectionIndexHolder onChangeSend: #externalChange to: self. externalMultiSelectionList := MultiSelectionInList new. externalMultiSelectionSubCanvas := UISpecification readFromClass: self class methodName: #externalMultiSelectionSubCanvas. externalSingleSelectionSubCanvas := UISpecification readFromClass: self class methodName: #externalSingleSelectionSubCanvas. self initializeSelections
on: anInterface "Answer an initialized instance of the receiver. The receiver can optionally modify the argument, as opposed to requiring a class definition action." self initialize. self declarations: anInterface. includeFiles addAll: anInterface includeFiles. includeDirectories addAll: anInterface includeDirectories
</methods> <methods> Tools.ExternalInterfaceBuilder class <category>instance creation</category>
on: anInterface "Answer a new instance of the receiver used to build external interfaces. The argument specifies the ExternalInterface class that the builder can modify." ^self new on: anInterface
</methods> <methods> Tools.ExternalInterfaceBuilder class <category>class initialization</category>
initialize "ExternalInterfaceBuilder initialize" MenuBarMenu := Menu new addItem: ((MenuItem labeled: #Builder << #dllcc >> 'Builder') submenu: (Menu new addItemGroup: (Array with: (MenuItem labeled: #AddIncludeFilesDot << #dllcc >> 'Add Include File...') with: (MenuItem labeled: #AddIncludeDirectoryDot << #dllcc >> 'Add Include Directory...')) values: #(#addFile #addDirectory); addItemGroup: (Array with: (MenuItem labeled: #ParseFiles << #dllcc >> 'Parse Files')) values: #(#parse))); addItem: ((MenuItem labeled: #Class << #dllcc >> 'Class') submenu: (Menu new addItemGroup: (Array with: (MenuItem labeled: #DefineDot << #dllcc >> 'Define...') with: (MenuItem labeled: #AddMethodsToDot << #dllcc >> 'Add Methods To...')) values: #(#defineClass #addMethods); addItemGroup: (Array with: ((MenuItem labeled: #Browse << #dllcc >> 'Browse') shortcutKeyCharacter: $B)) values: #(#browseClass))); addItem: ((MenuItem labeled: #Externals << #dllcc >> 'Externals') submenu: (Menu new addItemGroup: (Array with: (MenuItem labeled: #AddDot << #dllcc >> 'Add...') with: (MenuItem labeled: #Remove << #dllcc >> 'Remove')) values: #(#add #remove); addItemGroup: (Array with: (MenuItem labeled: #SelectAll << #dllcc >> 'Select All') with: (MenuItem labeled: #DeselectAll << #dllcc >> 'Deselect All')) values: #(#selectAllExternals #deselectAllExternals))); addItem: ((MenuItem labeled: #Help << #dllcc >> 'Help') submenu: (Menu new addItemGroup: (Array with: (MenuItem labeled: #Contents << #dllcc >> 'Contents')) values: #(#helpContents)))
</methods> <methods> Tools.ExternalInterfaceFinder <category>events</category>
windowEvent: anEvent from: aWindow "Intercept #close and #release events so the receiver can be released. Answer the receiver." super windowEvent: anEvent from: aWindow. (#(#close #release) includes: anEvent key) ifTrue: [self release]
</methods> <methods> Tools.ExternalInterfaceFinder <category>private-updating</category>
updateCategoryNotSelected "A category was deselected, update all views, menus, and buttons." | subMenu | (ExternalListMenu menuItemAt: 1) disable. subMenu := (MenuBarMenu menuItemAt: 3) submenu. (subMenu menuItemAt: 1) disable. self hasClassSelected ifTrue: [(builder componentAt: #removeButton) enable. (builder componentAt: #ExternalListLabel) labelString: (#Externals << #dllcc >> 'Externals')]
updateCategorySelected "A category was selected, update all views, menus, and buttons." | subMenu | (ExternalListMenu menuItemAt: 1) enable. subMenu := (MenuBarMenu menuItemAt: 3) submenu. (subMenu menuItemAt: 1) enable. (self hasClassSelected and: [self category notNil]) ifTrue: [| label | label := self category copy asString. label at: 1 put: label first asUppercase. (builder componentAt: #removeButton) disable. (builder componentAt: #ExternalListLabel) labelString: label]
updateClassNotSelected "A class was deselected, update all views, menus, and buttons." | subMenu | subMenu := (MenuBarMenu menuItemAt: 2) submenu. 3 to: 8 do: [:menuItemIndex | (subMenu menuItemAt: menuItemIndex) disable]. 5 to: 10 do: [:menuItemIndex | (ClassListMenu menuItemAt: menuItemIndex) disable]. #(#browseButton #removeButton #regenerateButton) do: [:name | (builder componentAt: name) disable].
updateClassSelected "A category was selected, update all views, menus, and buttons." | subMenu | subMenu := (MenuBarMenu menuItemAt: 2) submenu. 3 to: 8 do: [:menuItemIndex | (subMenu menuItemAt: menuItemIndex) enable]. 5 to: 10 do: [:menuItemIndex | (ClassListMenu menuItemAt: menuItemIndex) enable]. #(#browseButton #removeButton #regenerateButton) do: [:name | (builder componentAt: name) enable].
updateExternalNotSelected "An external was deselected, update all views, menus, and buttons." | subMenu | (ExternalListMenu menuItemAt: 2) disable. subMenu := (MenuBarMenu menuItemAt: 3) submenu. (subMenu menuItemAt: 2) disable. self category notNil ifTrue: [(builder componentAt: #removeButton) disable]
updateExternalSelected "An external was selected, update all views, menus, and buttons." | subMenu | (self isRemoveableCategory: self category) ifTrue: [(ExternalListMenu menuItemAt: 2) enable]. subMenu := (MenuBarMenu menuItemAt: 3) submenu. (subMenu menuItemAt: 2) enable. (self isRemoveableCategory: self category) ifTrue: [(builder componentAt: #removeButton) enable]
updateHelpAvailable "Check if help is available." | helpAvailable | helpAvailable := #{HelpBrowser} isDefined. (MenuBarMenu menuItemAt: 4) enabled: helpAvailable. ((MenuBarMenu menuItemAt: 4) submenu menuItemAt: 1) enabled: helpAvailable.
</methods> <methods> Tools.ExternalInterfaceFinder <category>menus</category>
classNameListMenu "Answer the pop-up menu for the class list pane." ^ClassListMenu
externalListMenu "Answer the pop-up menu for the external list pane." ^ExternalListMenu
menuBar "Answer the menu bar menu for the receiver's view." ^MenuBarMenu
typeMenu "Answer a menu consisting of a few often used standard types and some user-defined types" | mb maxUserDefined userDefinedCount | mb := MenuBuilder new. mb add: 'char'->'char'; add: 'short'->'short'; add: 'int'->'int'; add: 'float'->'float'; add: 'double'->'double'; add: 'unsigned char'->'unsigned char'; add: 'unsigned short'->'unsigned short'; add: 'unsigned int'->'unsigned int'; add: 'char *'->'char *'. maxUserDefined := 15. userDefinedCount := 1. externalInterfaceHolder externalDictionary do: [:ext | (ext isKindOf: CType) ifTrue: [userDefinedCount := userDefinedCount + 1. mb add: ext printString-> ext printString. userDefinedCount = maxUserDefined ifTrue: [^mb menu]]]. ^mb menu
</methods> <methods> Tools.ExternalInterfaceFinder <category>actions</category>
browseClass "Open a browser on the currently selected class. Use the current user-preference browser. If no class is selected, do nothing. Answer the receiver." | cl | self hasClassSelected ifFalse: [(builder componentAt: #ClassNameList) flash. ^self]. cl := self selectedClassOrDo: [^self classGone]. ExternalInterfaceFinder visited: cl. SmalltalkWorkbench browseClass: cl
browseExternal: anExternal "Open a browser on anExternal. Answer the receiver." self openListBrowserOnSelectorsMatching: anExternal name , '*' label: #ExternalMethod << #dllcc >> 'External method'
browseSelection "Browse the currently selected object. This could be a class or an external object. If no object is selected, do nothing. Answer the receiver." |anExternal| self hasClassSelected ifFalse: [^self]. anExternal := self external. (anExternal isNil or: [anExternal isCharacters]) ifTrue: [^self browseClass]. ^self browseExternal: anExternal
fileOutClass "File out the given class. Prompt for the resulting file name. If no class is selected, do nothing. Answer the receiver." | cl fileName fileManager | cl := self selectedClassOrDo: [^self classGone]. fileName := Dialog requestNewFileName: #FileOutOn << #dllcc >> 'File out on' default: (Filename filterFilename: cl printString, '.st') for: builder window. fileName = '' ifTrue: [^nil]. fileManager := SourceCodeStream write: fileName. [fileManager timeStamp. cl fileOutSourceOn: fileManager.] ensure: [fileManager close].
forgetRecentlyVisitedClasses "Force the receiver to forget all recently visited classes. Answer the receiver." self class resetRecentlyVisited
helpContents "Open a help browser displaying the top-most book for the DLL and C Connect kit. Answer the receiver." ^self class helpContents
newBuilder "Open a new external interface builder tool. Answer the receiver." | interfaceBuilder | interfaceBuilder := ExternalInterfaceBuilder. self hasClassSelected ifFalse: [interfaceBuilder open] ifTrue: [| class | class := self selectedClassOrDo: [nil]. class isNil ifTrue: [interfaceBuilder open] ifFalse: [interfaceBuilder openOn: (interfaceBuilder on: class)]]
newClass "Prompt the user for all relevant information to build a new interface class and actually build the class if all the information is valid. Update the receiver's views so that the new class selected. Answer the receiver." | finder newClass | finder := ExternalInterfaceClassFinder new. finder createMode. finder findClass. newClass := finder selectedClass. newClass isNil ifTrue: [^self]. (newClass inheritsFrom: ExternalInterface) ifFalse: [^Dialog warn: #mustBeExternalInterfaceSubclass << #dllcc >> 'The superclass must be a subclass of ExternalInterface.' for: self builder window]. self class addClass: newClass fullyQualifiedReference. self classNameList selection: newClass fullyQualifiedReference.
newExternal "Prompt the user for information relevant for adding a new external based on the currently selected category. If the information is correct, add the new external to the category's external list, otherwise do nothing." ^self addExternalForCategory: self category
newInterface "Prompt the user for information relevant for adding a new interface based on the currently selected category. If the information is correct, add the new external to the category's external list, otherwise do nothing. If no category is selected, prompt for the creation of a new interface class." self category isNil ifTrue: [^self newClass]. ^self newExternal
parcelOutClass "Open a dialog to confirm or collect the basic information required to Parcel-out an external interface." | parcelOutHierarchy class useBossInstead | class := self selectedClassOrDo: [^self]. (class isKindOf: ExternalInterface class) ifFalse: [^self]. class subclasses isEmpty ifFalse: [parcelOutHierarchy := true asValue]. (self respondsTo: #bossOutClass) ifTrue: [useBossInstead := false asValue. useBossInstead compute: [:v| v == true ifTrue: [^self bossOutClass]. v value]]. (Parcel name: class name) saveParcelDialogFor: nil preOpen: [:dialog| nil == parcelOutHierarchy ifFalse: [dialog addCheckLabels: (Array with: #hierarchy << #dllcc >> 'hierarchy') values: (Array with: parcelOutHierarchy) equalize: true columns: 1]. nil == useBossInstead ifFalse: [dialog addCheckLabels: (Array with: #useBOSS << #dllcc >> 'use BOSS') values: (Array with: useBossInstead) equalize: true columns: 1]] preSave: [:parcel| nil == useBossInstead ifFalse: [useBossInstead value ifTrue: [^self bossOutClass]]. class parcelClasses: (parcelOutHierarchy value ifTrue: [class withAllSubclasses] ifFalse: [Array with: class]) toParcel: parcel]
regenerate "For the current interface class, parse its include files and recompile all existing access methods. If any error occurs during the parse or recompilation and warning dialog is displayed and regeneration stops. Answer the receiver." Cursor execute showWhile: [[externalInterfaceHolder externalInterface regenerateMethods. ObjectMemory quickGC. self update] on: Object errorSignal do: [:ex | | output | output := String new writeStream. output nextPutAll: (#FollowingRegenerationError << #dllcc >> 'The following error occurred during regeneration:') asString; nextPut: Character cr; nextPutAll: ex description. Dialog warn: output contents for: builder window. ex return: nil]]
remove "Remove the currently selected external. If no external is selected, attempt to remove the currently selected class. If no class or external is selected, do nothing. Answer the receiver." self external isNil ifTrue: [^self removeClass]. ^self removeExternal
removeClass "Prompt the user to remove the currently selected class. If the user concers, remove the class, otherwise do nothing. Answer the receiver." | cl | cl := self selectedClassOrDo: [^self classGone]. self removeClass: cl
removeExternal "Remove the currently selected external if it is one that may be removed. Answer the receiver." ^self removeExternalForCategory: self category
renameClass "Prompt the user for the currently selected class' new name and rename it to such. Answer the receiver." | cl clName aString newName | cl := self selectedClassOrDo: [^self classGone]. aString := Dialog request: (#EnterNewClassName << #dllcc >> 'Enter new ClassName') initialAnswer: cl printString for: builder window. aString isEmpty ifTrue: [^self]. newName := SystemUtils validateClassName: aString for: builder window. newName == nil ifTrue: [^self]. clName := cl fullyQualifiedReference. SmalltalkWorkbench rename: cl to: newName do: [:cls :nm | ExternalInterfaceClasses remove: clName. ExternalInterfaceClasses add: cls fullyQualifiedReference. RecentlyVisitedClasses remove: clName ifAbsent: []. RecentlyVisitedClasses add: cls fullyQualifiedReference. self class changed: #externalInterfaceClasses. self classNameList selection: cls fullyQualifiedReference] for: builder window browser: nil
showAllClasses "Set the current class view pane to show all external interfaces in the system. Answer the receiver." filter := #showAllClasses. (builder componentAt: #ClassNameListLabel) labelString: (#Class << #dllcc >> 'Class'). self showClasses: ExternalInterfaceClasses
showRecentlyVisitedClasses "Set the current class view pane to show all recently visited external interfaces in the system. Answer the receiver." filter := #showRecentlyVisitedClasses. (builder componentAt: #ClassNameListLabel) widget labelString: (#RecentlyVisitedClass << #dllcc >> 'Recently Visited Class'). self showClasses: RecentlyVisitedClasses
</methods> <methods> Tools.ExternalInterfaceFinder <category>accessing</category>
category "Answer the currently selected category from the receiver's category pane." ^self categoryList selection
classID "Answer the currently selected class from the receiver's class list pane." | sel | sel := self classNameList selection. ^sel == nil ifTrue: [nil] ifFalse: [sel asQualifiedReference]
className "Answer the currently selected class from the receiver's class list pane." | sel | sel := self classNameList selection. ^sel == nil ifTrue: [nil] ifFalse: [sel asSymbol]
external "Answer the currently selected external from the receiver's external pane." ^self externalList selection
hasClassSelected ^self classNameList selection notNil
selectedClassOrDo: aBlock | sel | sel := self classNameList selection. ^sel == nil ifTrue: [aBlock value] ifFalse: [sel asQualifiedReference valueOrDo: aBlock]
</methods> <methods> Tools.ExternalInterfaceFinder <category>private-category</category>
addExternalForCategory: aCategory "Given the selected category, prompt the user for the required information in order to create a new external for that category. Answer the receiver." | categorySymbol | categorySymbol := aCategory asSymbol. categorySymbol == #procedures ifTrue: [^self addProcedure]. categorySymbol == #variables ifTrue: [^self addVariable]. categorySymbol == #typedefs ifTrue: [^self addTypedef]. categorySymbol == #structs ifTrue: [^self addStruct]. categorySymbol == #unions ifTrue: [^self addUnion]. categorySymbol == #enums ifTrue: [^self addEnum]. categorySymbol == #defines ifTrue: [^self addDefine]. categorySymbol == #macros ifTrue: [^self addMacro]. categorySymbol == #'include files' ifTrue: [^self addIncludeFile]. categorySymbol == #'include directories' ifTrue: [^self addIncludeDirectory]. categorySymbol == #'library files' ifTrue: [^self addLibraryFile]. categorySymbol == #'library directories' ifTrue: [^self addLibraryDirectory].
categories "Answer a list of symbols that will appear in the receiver's category list pane." ^#( #'include files' #'include directories' #'library files' #'library directories' #procedures #variables #typedefs #structs #unions #enums #defines #macros ) copy
changedCategory "A new category was selected or deselected, update the views accordingly." | category | (category := self category) isNil ifTrue: [self updateCategoryNotSelected. externalList list: List new. ^self]. self updateCategorySelected. externalList list: (self listAtCategory: category)
computeCategoryList "Answer the list of objects that will appear in the receiver's category list pane. This includes italicizing certain entries." | categories | self hasClassSelected ifFalse: [^List new]. categories := self categories. 1 to: 4 do: [:i | | aCategory | aCategory := categories at: i. categories at: i put: (aCategory asText emphasizeFrom: 1 to: aCategory size with: #italic)]. ^List withAll: categories
isRemoveableCategory: category "Answer true if the argument contains removable externals, otherwise answer false." | categorySymbol | categorySymbol := category asSymbol. ^categorySymbol == #'include files' or: [categorySymbol == #'include directories' or: [categorySymbol == #'library files' or: [categorySymbol == #'library directories']]]
listAtCategory: category "Answer a List of externals at the given category." | categorySymbol list | categorySymbol := category asSymbol. list := externalInterfaceHolder externalsAtCategory: category. (categorySymbol == #'include files' or: [ categorySymbol == #'include directories' or: [ categorySymbol == #'library files' or: [ categorySymbol == #'library directories']]]) ifTrue: [^list copy] ifFalse: [^list]
removeExternalForCategory: aCategory "Remove the currently selected external in the given category. If the category does not contain removable externals, do nothing. Answer the receiver." | categorySymbol | categorySymbol := aCategory asSymbol. categorySymbol == #'include files' ifTrue: [^self removeIncludeFile]. categorySymbol == #'include directories' ifTrue: [^self removeIncludeDirectory]. categorySymbol == #'library files' ifTrue: [^self removeLibraryFile]. categorySymbol == #'library directories' ifTrue: [^self removeLibraryDirectory].
</methods> <methods> Tools.ExternalInterfaceFinder <category>private</category>
addDefineForInterface: defineInterfaceSpec "Open a dialog to confirm or collect the basic information required to create a new access method for a #define that is either a constant or macro (that accepts arguments). Answer a two element array. The first element is the CMacroDefiniton object (or nil), the second argument is a Boolean indicating if the macro should be browsed after creation." | dialog externalName db doBrowse newMacro macroValue define | doBrowse := false. dialog := SimpleDialog new. db := dialog builder. db aspectAt: #externalName put: (externalName := '' asValue). db aspectAt: #macroValue put: (macroValue := '' asValue). db aspectAt: #doAbort put: [dialog close. ^#(nil nil)]. db aspectAt: #doOK put: [externalName value isEmpty ifTrue: [(dialog builder componentAt: #externalNameField) flash] ifFalse: [dialog close]]. db aspectAt: #doBrowse put: [externalName value isEmpty ifTrue: [(dialog builder componentAt: #externalNameField) flash] ifFalse: [doBrowse := true. dialog close]]. dialog allButOpenFrom: (self class interfaceSpecFor: defineInterfaceSpec). "Make CR behave like tab in name field" db openDialog. dialog cancel value ifTrue: [^#(nil nil)]. externalName := externalName value. macroValue := macroValue value. (define := String new writeStream) nextPutAll: '#define '; nextPutAll: externalName; nextPut: Character space; nextPutAll: macroValue; nextPut: Character cr. define := define contents. newMacro := [ | preprocessor | preprocessor := CPreprocessor new. preprocessor preprocess: define declarations: externalInterfaceHolder externalInterface tempExternals includeDirectories: #(). preprocessor lastDefine] on: Object errorSignal do: [:ex | Dialog warn: #syntaxError << #dllcc >> 'syntax error' for: builder window. nil]. ^Array with: newMacro with: doBrowse
changedClassName "A class name was selected or deselected. Update all views, menus, and buttons." self hasClassSelected ifFalse: [self updateClassNotSelected] ifTrue: [self updateClassSelected. externalInterfaceHolder := ExternalInterfaceHolder on: (self selectedClassOrDo: [^self classGone])]. categoryList list: self computeCategoryList
changedExternal "An external was selected or deselected. Update all views, menus, and buttons." (self external notNil and: [self isRemoveableCategory: self category]) ifTrue: [self updateExternalSelected] ifFalse: [self updateExternalNotSelected]
classGone "Inform the user that the current class no longer exists, then remove any notion the receiver has of the class. Answer the receiver." | classID | Dialog warn: (#class1sNoLongerExists << #dllcc >> 'class <1s> no longer exists' expandMacrosWith: (classID := self classID) asString) for: builder window. ExternalInterfaceClasses remove: classID ifAbsent: []. RecentlyVisitedClasses remove: classID ifAbsent: []. ExternalInterfaceFinder changed: #externalInterfaceClasses. #(#browseButton #removeButton #regenerateButton) do: [:n | (builder componentAt: n) disable]
pruneRemovedClasses "Update the internal interface class caches maintained by the receiver such that removed classes are fogotten. Answer the receiver." | deaders | deaders := OrderedCollection new. ExternalInterfaceClasses do: [:classID | classID isDefined ifFalse: [deaders add: classID]]. deaders isEmpty ifFalse: [deaders do: [:ddr | ExternalInterfaceClasses remove: ddr. RecentlyVisitedClasses remove: ddr ifAbsent: []]. ExternalInterfaceFinder changed: #externalInterfaceClasses]
removeClass: aClass "Prompt the user to confirm removal of a class. If the removal is confirmed, actually remove the class from the system." | classID | classID := aClass fullyQualifiedReference. (Dialog confirm: ((#certainRemoveClass << #dllcc >> 'Are you certain that you want to remove<n>class <1p> from the system?') expandMacrosWith: aClass) for: builder window) ifFalse: [^self]. (aClass subclasses isEmpty or: [Dialog confirm: ((#classHasSubclassesQueryProceed << #dllcc >> '<1p> has subclasses.<n>Proceed with removal?') expandMacrosWith: aClass) for: builder window]) ifTrue: [aClass removeFromSystem. ExternalInterfaceClasses remove: classID. RecentlyVisitedClasses remove: classID ifAbsent: []. self update]
showClasses: aSet "Given a set of external interface classes defined by the argument, update the class list view to display the new classes. Remember the current selection sequence. Answer the receiver." | oldClassName oldCategory oldExternal | oldClassName := self classNameList selection. oldCategory := self category. oldExternal := self external. classNameList list: (List withAll: (aSet asSortedCollection: [:x :y | x asString < y asString])). oldClassName notNil ifTrue: [classNameList selection: oldClassName]. oldCategory notNil ifTrue: [categoryList selection: oldCategory]. oldExternal notNil ifTrue: [externalList selection: oldExternal]
</methods> <methods> Tools.ExternalInterfaceFinder <category>updating</category>
update "Update the class view pane. Answer the receiver." self class computeExternalInterfaceClasses
update: anAspect with: aParameter from: anObject "Watch for updated recently visited classes and updated external interface classes and update views accordingly. Answer the value of the superclass #update:with:from: method." | class | anAspect == #recentlyVisited ifTrue: [ filter == #showRecentlyVisitedClasses ifTrue: [self showRecentlyVisitedClasses]. class := aParameter at: 1. class == nil ifFalse: [class := class fullyQualifiedReference]. (classNameList list includes: class) not ifTrue: [self perform: filter]. "(self classID == class and: ((aParameter at: 2) notNil and: [(self selectorList list includes: (aParameter at: 2)) not])) ifTrue: [self showSelectors: self computeSelectorList]." ^self]. anAspect == #externalInterfaceClasses ifTrue: [self perform: filter]. ^super update: anAspect with: aParameter from: anObject
</methods> <methods> Tools.ExternalInterfaceFinder <category>aspects</category>
categoryList "Answer the List of categories in the category pane." ^categoryList
classNameList "Answer the List of objects in the class pane." ^classNameList
externalList "Answer the List of externals in the external pane." ^externalList
</methods> <methods> Tools.ExternalInterfaceFinder <category>initialize-release</category>
initialize super initialize. ExternalInterfaceFinder dependents isEmpty ifTrue: [self class computeExternalInterfaceClasses]. (classNameList := SelectionInList new) list: (List withAll: (ExternalInterfaceClasses asSortedCollection: [:x :y | x asString < y asString])). categoryList := SelectionInList new. externalList := SelectionInList new. externalInterfaceHolder := nil. filter := #showAllClasses. classNameList selectionIndexHolder onChangeSend: #changedClassName to: self. categoryList selectionIndexHolder onChangeSend: #changedCategory to: self. externalList selectionIndexHolder onChangeSend: #changedExternal to: self
release ExternalInterfaceFinder removeDependent: self. ^super release
</methods> <methods> Tools.ExternalInterfaceFinder <category>interface dialogs</category>
addDefine "Open a dialog to confirm or collect the basic information required to create a new access method." | define macro doBrowse | define := self addDefineForInterface: #defineMethodCreationDialog. macro := define at: 1. doBrowse := define at: 2. macro isNil ifTrue: [^nil]. macro numArgs notNil ifTrue: [Dialog warn: #defineTakesNoArguments << #dllcc >> 'The #define should accept no arguments.' for: builder window. ^self addDefine]. externalInterfaceHolder externalInterface generateMethodsForExternal: macro. self update. doBrowse ifTrue: [self browseAccessMethodsFor: macro name wildcard: true]
addEnum "Open a dialog to collect the basic information required to create a new access method, create the method, and if specified open a browser. The latter allows the user to fine tune the access method." | enumName newEnum | enumName := Dialog request: #addEnum << #dllcc >> 'Enum Name:' for: builder window. (enumName isNil or: [enumName isEmpty]) ifTrue: [^self]. enumName := enumName asSymbol. newEnum := CEnumerationType new name: enumName. newEnum at: #red put: 10. newEnum at: #white put: 20. newEnum at: #blue put: 30. externalInterfaceHolder externalInterface generateMethodsForExternal: newEnum. self browseAccessMethodsFor: enumName wildcard: false. self update
addIncludeDirectory "Open a dialog to collect the basic information required to add a new include directory to the list of directories that are searched when parsing header files." | directory interface | directory := Dialog request: #addIncludeDirectory << #dllcc >> 'Include Directory:' for: builder window. (directory isNil or: [directory isEmpty]) ifTrue: [^self]. interface := externalInterfaceHolder externalInterface. interface includeDirectories: (interface includeDirectoriesArray copyWith: directory). self update
addIncludeFile "Open a dialog to collect the basic information required to add a new include file to the list of files that can be parsed to generate interface externals." | file interface | file := Dialog request: #addIncludeFile << #dllcc >> 'Include File:' for: builder window. (file isNil or: [file isEmpty]) ifTrue: [^self]. interface := externalInterfaceHolder externalInterface. interface includeFiles: (interface includeFiles copyWith: file). self update
addLibraryDirectory "Open a dialog to collect the basic information required to add a new include directory to the list of directories that are searched when attempting to load a dynamic-link library." | directory interface | directory := Dialog request: #addLibraryDirectory << #dllcc >> 'Library Directory:' for: builder window. (directory isNil or: [directory isEmpty]) ifTrue: [^self]. interface := externalInterfaceHolder externalInterface. interface libraryDirectories: (interface libraryDirectoriesArray copyWith: directory). self update
addLibraryFile "Open a dialog to collect the basic information required to add a new library file to the list of files that can dynamically loaded by an interface class." | file interface | file := Dialog request: #addLibraryFile << #dllcc >> 'Library File:' for: builder window. (file isNil or: [file isEmpty]) ifTrue: [^self]. interface := externalInterfaceHolder externalInterface. interface libraryFiles: (interface libraryFilesArray copyWith: file). self update
addMacro "Open a dialog to collect the basic information required to create a new access method, create the method, and if specified open a browser. The latter allows the user to fine tune the access method " | define macro doBrowse | define := self addDefineForInterface: #macroMethodCreationDialog. macro := define at: 1. doBrowse := define at: 2. macro isNil ifTrue: [^nil]. macro numArgs isNil ifTrue: [Dialog warn: #defineTakesArguments << #dllcc >> 'The #define macro should accept arguments.' for: builder window. ^self addMacro]. externalInterfaceHolder externalInterface generateMethodsForExternal: macro. self update. doBrowse ifTrue: [self browseAccessMethodsFor: macro name wildcard: true]
addProcedure "Open a dialog to collect the basic information required to create a new procedure call method, create the method, and if specified open a browser. The latter allows the user to fine tune the access method." | conventions conventionsMenu callingConvention dialog externalName db argumentTypes argumentNames returnType newCProcedureType newExternalProcedure doBrowse returnTypeString argumentTypeString argumentNamesList currentArgumentIndex argCount argTypes acceptBlock | conventions := Array with: #isCdecl -> (#isCdecl << #dllcc >> 'C 32-bit') asString with: #isStdcall -> (#isStdcall << #dllcc >> 'C Stdcall 32-bit') asString with: #isFar -> (#isFar << #dllcc >> 'C 16-bit') asString with: #isPascal -> (#isPascal << #dllcc >> 'Pascal 16-bit') asString. conventionsMenu := MenuBuilder new. conventions do: [:assoc| conventionsMenu add: assoc value -> assoc key]. conventionsMenu := conventionsMenu menu. conventions := Dictionary withAll: conventions. doBrowse := false. argumentTypes := Array new: 15. argumentNames := OrderedCollection new. argTypes := OrderedCollection new. dialog := SimpleDialog new. db := dialog builder. db aspectAt: #externalName put: (externalName := '' asValue). db aspectAt: #callingConvention put: (callingConvention := (conventions at: #isCdecl) asValue). db aspectAt: #typeMenu put: self typeMenu. db aspectAt: #returnTypeString put: (returnTypeString := nil asValue). db aspectAt: #argumentTypeString put: (argumentTypeString := nil asValue). db aspectAt: #argumentNamesList put: (argumentNamesList := SelectionInList with: ((1 to: 15) collect: [:i| #arg << #dllcc >> 'argument <1p>' expandMacrosWith: i])). argumentNamesList selectionIndexHolder compute: [:v | currentArgumentIndex := v. argumentTypeString value: ((v = 0 or: [(argumentTypes at: v) isNil]) ifTrue: [''] ifFalse: [(argumentTypes at: v) printString])]. returnTypeString compute: [:aString | returnType := [returnType := (CDeclarationParser parseWithNoPreprocess: aString as: #singleDeclaration declarations: externalInterfaceHolder externalInterface tempExternals requestor: self) result] on: Object errorSignal do: [:ex | ex return: nil]. (returnType isKindOf: CType) ifFalse: [(dialog builder componentAt: #returnTypeField) flash. returnType := nil]]. argumentTypeString compute: [:aString | currentArgumentIndex = 0 ifFalse: [currentArgumentIndex isNil ifTrue: [Dialog warn: 'No argument selected' for: builder window] ifFalse: [argumentTypes at: currentArgumentIndex put: (aString isEmpty ifTrue: [nil] ifFalse: [| result | result := [result := (CDeclarationParser parseWithNoPreprocess: aString as: #singleDeclaration declarations: externalInterfaceHolder externalInterface tempExternals requestor: self) result] on: Object errorSignal do: [:ex | ex return: nil]. (result isKindOf: CType) ifTrue: [result] ifFalse: [(dialog builder componentAt: #argumentTypeField) flash. nil]])]]]. db aspectAt: #callingConventionMenu put: conventionsMenu. db aspectAt: #doAbort put: [dialog close. ^nil]. acceptBlock := [| accept | accept := true. externalName value isEmpty ifTrue: [(dialog builder componentAt: #externalNameField) flash. accept := false] ifFalse: [(accept := (returnType == nil) not) ifFalse: [(dialog builder componentAt: #returnTypeField) flash]]. accept ifTrue: [dialog close]. accept]. db aspectAt: #doOK put: acceptBlock. db aspectAt: #doBrowse put: [acceptBlock value ifTrue: [doBrowse := true]]. dialog allButOpenFrom: (self class interfaceSpecFor: #procMethodCreationDialog). "Make CR behave like tab in name field" db openDialog. dialog cancel value ifTrue: [^nil]. externalName := externalName value. callingConvention := callingConvention value. argCount := argumentTypes findLast: [:t | t notNil]. 1 to: argCount do: [:i | argTypes add: ((argumentTypes at: i) notNil ifTrue: [argumentTypes at: i] ifFalse: [CIntegerType int]). argumentNames add: ('arg', i printString)]. returnType isNil ifTrue: [returnType := CIntegerType int]. newCProcedureType := CProcedureType resultType: returnType argumentTypes: argTypes argumentNames: argumentNames. callingConvention = (conventions at: #isPascal) ifTrue: [newCProcedureType beFar; bePascal]. callingConvention = (conventions at: #isStdcall) ifTrue: [newCProcedureType beStdcall]. callingConvention = (conventions at: #isFar) ifTrue: [newCProcedureType beFar]. newExternalProcedure := ExternalProcedure new name: externalName; type: newCProcedureType. externalInterfaceHolder externalInterface generateMethodsForExternal: newExternalProcedure. ObjectMemory quickGC. self update. doBrowse ifTrue: [self browseAccessMethodsFor: newExternalProcedure name wildcard: true]
addStruct "Open a dialog to collect the basic information required to create a new access method, create the method, and if specified open a browser. The latter allows the user to fine tune the access method " | structName newStruct | structName := Dialog request: #addStruct << #dllcc >> 'New Struct Name:' for: builder window. (structName isNil or: [structName isEmpty]) ifTrue: [^self]. structName := structName asSymbol. newStruct := CCompositeType new beStructure name: structName. newStruct at: #firstMember put: 0->CIntegerType int. newStruct at: #secondMember put: 1->CIntegerType char. newStruct at: #thirdMember put: 2->CIntegerType long. externalInterfaceHolder externalInterface generateMethodsForExternal: newStruct. self browseAccessMethodsFor: structName wildcard: false. self update
addTypedef "Open a dialog to collect the basic information required to create a new typedef method, create the method, and if specified open a browser. The latter allows the user to fine tune the access method." | dialog externalName db doBrowse type typeString newExternalVariable acceptBlock | doBrowse := false. dialog := SimpleDialog new. db := dialog builder. db aspectAt: #externalName put: (externalName := '' asValue). db aspectAt: #typeMenu put: self typeMenu. db aspectAt: #typeString put: (typeString := nil asValue). typeString compute: [:aString | type := [(CDeclarationParser parseWithNoPreprocess: aString as: #singleDeclaration declarations: externalInterfaceHolder externalInterface tempExternals requestor: self) result] on: Object errorSignal do: [:ex | ex return: nil]. (type isKindOf: CType) ifFalse: [(dialog builder componentAt: #typeField) flash. type := nil]]. db aspectAt: #doAbort put: [dialog close. ^nil]. acceptBlock := [| accept | accept := true. externalName value isEmpty ifTrue: [(dialog builder componentAt: #externalNameField) flash. accept := false] ifFalse: [type == nil ifTrue: [(dialog builder componentAt: #typeField) flash. accept := false]]. accept ifTrue: [dialog close]. accept]. db aspectAt: #doOK put: acceptBlock. db aspectAt: #doBrowse put: [acceptBlock value ifTrue: [doBrowse := true]]. dialog allButOpenFrom: (self class interfaceSpecFor: #typedefMethodCreationDialog). "Make CR behave like tab in name field" db openDialog. dialog cancel value ifTrue: [^nil]. externalName := externalName value. type isNil ifTrue: [type := CVoidType void]. newExternalVariable := CTypedefType new name: externalName; type: type. externalInterfaceHolder externalInterface generateMethodsForExternal: newExternalVariable. self update. doBrowse ifTrue: [self browseAccessMethodsFor: newExternalVariable name wildcard: true]
addUnion "Open a dialog to collect the basic information required to create a new access method, create the method, and if specified open a browser. The latter allows the user to fine tune the access method " | unionName newUnion | unionName := Dialog request: #addUnion << #dllcc >> 'New Union Name:' for: builder window. (unionName isNil or: [unionName isEmpty]) ifTrue: [^self]. unionName := unionName asSymbol. newUnion := CCompositeType new beUnion name: unionName. newUnion at: #firstMember put: 0->CIntegerType int. newUnion at: #secondMember put: 1->CIntegerType char. newUnion at: #thirdMember put: 2->CIntegerType long. externalInterfaceHolder externalInterface generateMethodsForExternal: newUnion. self browseAccessMethodsFor: unionName wildcard: false. self update
addVariable "Open a dialog to collect the basic information required to create a new access method, create the method, and if specified open a browser. The latter allows the user to fine tune the access method." | dialog externalName db doBrowse type typeString newExternalVariable acceptBlock | doBrowse := false. dialog := SimpleDialog new. db := dialog builder. db aspectAt: #externalName put: (externalName := '' asValue). db aspectAt: #typeMenu put: self typeMenu. db aspectAt: #typeString put: (typeString := nil asValue). typeString compute: [:aString | type := [(CDeclarationParser parseWithNoPreprocess: aString as: #singleDeclaration declarations: externalInterfaceHolder externalInterface tempExternals requestor: self) result] on: Object errorSignal do: [:ex | ex return: nil]. (type isKindOf: CType) ifFalse: [(dialog builder componentAt: #typeField) flash. type := nil]]. db aspectAt: #doAbort put: [dialog close. ^nil]. acceptBlock := [| accept | accept := true. externalName value isEmpty ifTrue: [(dialog builder componentAt: #externalNameField) flash. accept := false] ifFalse: [type == nil ifTrue: [(dialog builder componentAt: #typeField) flash. accept := false]]. accept ifTrue: [dialog close]. accept]. db aspectAt: #doOK put: acceptBlock. db aspectAt: #doBrowse put: [acceptBlock value ifTrue: [doBrowse := true]]. dialog allButOpenFrom: (self class interfaceSpecFor: #varMethodCreationDialog). "Make CR behave like tab in name field" db openDialog. dialog cancel value ifTrue: [^nil]. externalName := externalName value. type isNil ifTrue: [type := CVoidType void]. newExternalVariable := ExternalVariable new name: externalName; type: type. externalInterfaceHolder externalInterface generateMethodsForExternal: newExternalVariable. self update. doBrowse ifTrue: [self browseAccessMethodsFor: newExternalVariable name wildcard: true]
browseAccessMethodsFor: aString wildcard: aBoolean "Open a list browser on the access methods matchingaString in the receiver's interface." self openListBrowserOnSelectorsMatching: (aBoolean ifTrue: [aString, '*'] ifFalse: [aString]) label: #accessMethod << #dllcc >> 'Access method'
openListBrowserOnSelectorsMatching: aString label: labelString "Open a list browser on every method that matches aString in the receiver's interface. If there is no match, answer the receiver." | interface selectors | interface := externalInterfaceHolder externalInterface. interface isNil ifTrue: [^self]. selectors := interface selectors asArray select: [:sel | aString match: sel]. selectors isEmpty ifTrue: [^self]. MethodCollector new openListBrowserOn: (selectors collect: [:sel | MethodDefinition class: interface selector: sel]) label: labelString initialSelection: nil
removeIncludeDirectory "Remove the currently selected include directory from the interface's include directory list. If no include directory is selected, do nothing. Update the receiver's views. Answer the receiver." | directory interface | directory := self external. interface := externalInterfaceHolder externalInterface. interface includeDirectories: (interface includeDirectoriesArray copyWithout: directory). self update
removeIncludeFile "Remove the currently selected include file from the interface's include file list. If no include file is selected, do nothing. Update the receiver's views. Answer the receiver." | file interface | file := self external. interface := externalInterfaceHolder externalInterface. interface includeFiles: (interface includeFiles copyWithout: file). self update
removeLibraryDirectory "Remove the currently selected library directory from the interface's library directory list. If no library directory is selected, do nothing. Update the receiver's views. Answer the receiver." | directory interface | directory := self external. interface := externalInterfaceHolder externalInterface. interface libraryDirectories: (interface libraryDirectoriesArray copyWithout: directory). self update
removeLibraryFile "Remove the currently selected library file from the interface's library file list. If no library file is selected, do nothing. Update the receiver's views. Answer the receiver." | file interface | file := self external. interface := externalInterfaceHolder externalInterface. interface libraryFiles: (interface libraryFilesArray copyWithout: file). self update
</methods> <methods> Tools.ExternalInterfaceFinder <category>interface opening</category>
error: type with: message at: position "Intercept error message to display a 'syntax error' message." self error: #syntaxError << #dllcc >> 'syntax error'
postOpenWith: aBuilder "Delay adding ourselves to ExternalInterfaceFinder's dependents until the very last possible moment." ExternalInterfaceFinder addDependent: self. self updateHelpAvailable. self changedClassName. ^super postOpenWith: aBuilder
</methods> <methods> Tools.ExternalInterfaceFinder class <category>accessing</category>
addClass: fullyQualifiedReference ExternalInterfaceClasses add: fullyQualifiedReference. self changed: #externalInterfaceClasses
</methods> <methods> Tools.ExternalInterfaceFinder class <category>private</category>
computeExternalInterfaceClasses "Answer a collection of all the interface classes defined in the system. Update the receiver's notion of these classes, and recently visited classes, based on new and removed interfaces." | deadRecents | ExternalInterfaceClasses := Set new. self externalInterfaceClass allSubclasses do: [:aClass | ExternalInterfaceClasses add: aClass fullyQualifiedReference]. deadRecents := RecentlyVisitedClasses select: [:classID | (ExternalInterfaceClasses includes: classID) not]. deadRecents isEmpty ifFalse: [RecentlyVisitedClasses removeAll: deadRecents]. self changed: #externalInterfaceClasses. ^ExternalInterfaceClasses
</methods> <methods> Tools.ExternalInterfaceFinder class <category>class accessing</category>
externalInterfaceClass "Answer the class that defines the root of all external interface classes." ^ExternalInterface
helpBookName "Answer a String representing the the receiver's help book name. Please see the HelpBrowser class comments for further information on help books." ^#dcc
helpContents "Open a help browser displaying the top-most book for the DLL and C Connect kit. Answer the receiver." (#{HelpBrowser} valueOrDo: [^self error: (#helpUnavailable << #dllcc >> 'help unavailable')]) openTo: self helpBookName
</methods> <methods> Tools.ExternalInterfaceFinder class <category>interface opening</category>
open "Open a view on the receiver." "ExternalInterfaceFinder open" | bldr inst | bldr := (inst := self new) openInterface: #windowSpec. #(#browseButton #removeButton #regenerateButton ) do: [:n | (bldr componentAt: n) disable]. inst builder: bldr. (bldr window) application: inst; sendWindowEvents: #(#close #release)
openOnClass: aClass "Open a view of the receiver editing the given class." "ExternalInterfaceFinder openOnClass: SomeClass" | bldr inst | bldr := (inst := self new) openInterface: #windowSpec. inst builder: bldr. inst classNameList selection: aClass fullyQualifiedReference. (bldr window) application: inst; sendWindowEvents: #(#close #release)
</methods> <methods> Tools.ExternalInterfaceFinder class <category>statistics</category>
recentlyVisitedClasses "Answer a copy of the collection of recently visited interface classes." ^RecentlyVisitedClasses copy
resetRecentlyVisited "Prompt the user to confirm forgetting all recently visited interface classes. If the result is yes, forget the classes, otherwise do nothing. Answer the receiver." (Dialog confirm: (#reallyForgetWhichClasses << #dllcc >> 'Really forget which classes<n>have recently been visited?') expandMacros) ifTrue: [RecentlyVisitedClasses := OrderedCollection new. self changed: #recentlyVisited with: (Array with: nil)]
visited: class "Used to collect an impression of what classes the user has been working with." | clName | clName := class fullyQualifiedReference. (RecentlyVisitedClasses includes: clName) ifTrue: [RecentlyVisitedClasses remove: clName]. RecentlyVisitedClasses addFirst: clName. RecentlyVisitedClasses size > 10 ifTrue: [RecentlyVisitedClasses removeLast]. self changed: #recentlyVisited with: (Array with: class)
</methods> <methods> Tools.ExternalInterfaceFinder class <category>class initialization</category>
initialize "ExternalInterfaceFinder initialize" | showMenu | RecentlyVisitedClasses isNil ifTrue: [RecentlyVisitedClasses := OrderedCollection new] ifFalse: [RecentlyVisitedClasses removeAllSuchThat: [:cl | true]]. self changed: #recentlyVisited with: (Array with: nil). self computeExternalInterfaceClasses. (showMenu := Menu new) addItem: (MenuItem labeled: #ShowAllClasses << #dllcc >> 'Show All Classes') value: #showAllClasses; addItem: (MenuItem labeled: #ShowRecentlyVisitedClasses << #dllcc >> 'Show Recently Visited Classes') value: #showRecentlyVisitedClasses. ExternalListMenu := Menu new addItem: ((MenuItem labeled: #NewDot << #dllcc >> 'New...') shortcutKeyCharacter: $N) value: #newExternal; addItem: (MenuItem labeled: #Remove << #dllcc >> 'Remove') value: #remove. ClassListMenu := Menu new addItem: ((MenuItem labeled: #Show << #dllcc >> 'Show') submenu: showMenu); addItem: (MenuItem labeled: #Update << #dllcc >> 'Update') value: [:ctrlr | ctrlr performer update]; addItemGroup: (Array with: (MenuItem labeled: #NewDot << #dllcc >> 'New...') with: (MenuItem labeled: #Builder << #dllcc >> 'Builder') with: (MenuItem labeled: #RenameAsDot << #dllcc >> 'Rename As...') with: (MenuItem labeled: #Remove << #dllcc >> 'Remove')) values: #(#newClass #newBuilder #renameClass #removeClass); addItemGroup: (Array with: (MenuItem labeled: #FileOutAsDot << #dllcc >> 'File Out As ...') with: (MenuItem labeled: #ParcelOutAsDot << #dllcc >> 'Parcel Out As ...') with: (MenuItem labeled: #Browse << #dllcc >> 'Browse')) values: #(#fileOutClass #parcelOutClass #browseClass); addItemGroup: (Array with: (MenuItem labeled: #Regenerate << #dllcc >> 'Regenerate')) values: #(#regenerate). MenuBarMenu := Menu new addItem: ((MenuItem labeled: #View << #dllcc >> 'View') submenu: (Menu new addItemGroup: (Array with: ((MenuItem labeled: #ShowAllClasses << #dllcc >> 'Show All Classes') shortcutKeyCharacter: $A) with: (MenuItem labeled: #ShowRecentlyVisitedClasses << #dllcc >> 'Show Recently Visited Classes')) values: #(#showAllClasses #showRecentlyVisitedClasses); addItemGroup: (Array with: (MenuItem labeled: #ForgetRecentlyVisitedClasses << #dllcc >> 'Forget Recently Visited Classes') with: (MenuItem labeled: #Update << #dllcc >> 'Update')) values: #(#forgetRecentlyVisitedClasses #update))); addItem: ((MenuItem labeled: #Class << #dllcc >> 'Class') submenu: (Menu new addItemGroup: (Array with: ((MenuItem labeled: #NewDot << #dllcc >> 'New...') shortcutKeyCharacter: $N) with: (MenuItem labeled: #Builder << #dllcc >> 'Builder') with: ((MenuItem labeled: #RenameAsDot << #dllcc >> 'Rename As...') disable) with: ((MenuItem labeled: #RemoveDot << #dllcc >> 'Remove...') disable)) values: #(#newClass #newBuilder #renameClass #removeClass); addItemGroup: (Array with: ((MenuItem labeled: #FileOutAsDot << #dllcc >> 'File Out As ...') disable) with: ((MenuItem labeled: #ParcelOutAsDot << #dllcc >> 'Parcel Out As ...') disable) with: (((MenuItem labeled: #Browse << #dllcc >> 'Browse') shortcutKeyCharacter: $B) disable)) values: #(#fileOutClass #parcelOutClass #browseClass); addItemGroup: (Array with: ((MenuItem labeled: #Regenerate << #dllcc >> 'Regenerate') disable)) values: #(#regenerate))); addItem: ((MenuItem labeled: #External << #dllcc >> 'External') submenu: (Menu new addItem: ((MenuItem labeled: #NewDot << #dllcc >> 'New...') disable) value: #newExternal; addItem: ((MenuItem labeled: #Remove << #dllcc >> 'Remove') disable) value: #remove)); addItem: ((MenuItem labeled: #Help << #dllcc >> 'Help') submenu: (Menu new addItemGroup: (Array with: (MenuItem labeled: #Contents << #dllcc >> 'Contents')) values: #(#helpContents)))
</methods> <methods> Tools.Trippy.CStructureTypeInspector <category>properties</category>
dragControllerClass ^ReplaceOnlyDragController
</methods> <methods> Tools.Trippy.CStructureTypeInspector <category>private</category>
members | type memberParts | type := object type. type isPointer ifTrue: [type := type referentType]. memberParts := OrderedCollection new. type baseType keysAndValuesDo: [:name :assoc | memberParts add: (TextAttribute label: name text: ('Type: <1s> offset: <2s>' expandMacrosWith: assoc value printString with: assoc key printString))]. ^memberParts
refresh parts := self members. super refresh
</methods> <methods> Tools.Trippy.CStructureTypeInspector <category>decomposing</category>
partAt: index ^parts at: index
partCount ^parts size
</methods> <methods> Tools.Trippy.CStructureTypeInspector class <category>accessing</category>
tabLabel "Answer a String to use as a tab label of a page containing this inspector." ^(#typeInspecLabel << #dllcc >> 'C Type Members') asString
</methods> <methods> Tools.Trippy.CEnumerationTypeInspector <category>private</category>
members | type memberParts | (type := object type) isPointer ifTrue: [type := type referentType]. memberParts := OrderedCollection new. type baseType keysAndValuesDo: [:name :value | memberParts add: (TextAttribute label: name text: (#Type1pValue2p << #dllcc >> 'Type: <1p> value: <2p>' expandMacrosWith: name with: value))]. ^memberParts
</methods> <methods> External.CParser <category>initialize-release</category>
declarations: aDictionary "Initialize the receiver to contain the predefined declarations contained in the argument. The argument is typically an ExternalDictionary containing predefined macros and types. All macro definitions found in the argument are added to the receiver's reserved word list. Answer the receiver." declarations := aDictionary. declarations reverseDo: [:dec | dec class == CMacroDefinition ifTrue: [reservedWords at: dec name put: dec]]
parse: aStringOrStream as: construct notifying: aRequestor "Parse the argument, aStringOrStream, for the construct, aConstruct. The construct can be one of the many declaration constructs found in the receiver's types-syntax and declarations-syntax protocol. It is typically one of #Cfile or #declaration. Answer the receiver." self init: aStringOrStream notifying: aRequestor failBlock: nil; perform: construct. ^self
</methods> <methods> External.CParser <category>private-scanning</category>
peekForType: aType "Test to see if tokenType matches aType. If so, advance to the next token, pushing the old token on the stack" ^tokenType == aType ifTrue: [stack addLast: token. self scanToken. true] ifFalse: [false]
peekForType: aType value: trialValue "Test to see if tokenType matches aType and token equals trialValue. If so, advance to the next token" ^(tokenType == aType and: [token = trialValue]) ifTrue: [self scanToken. true] ifFalse: [false]
peekForTypeNoPush: aType "Test to see if tokenType matches aType. If so, advance to the next token, leaving the stack unchanged" ^tokenType == aType ifTrue: [self scanToken. true] ifFalse: [false]
</methods> <methods> External.CParser <category>backing up</category>
backupDiscard "Discard the backup state on success. Answer true." backupStack removeLast. backupStack removeLast. ^true
backupRestore "Restore the saved state on failure. Answer false." self popStackTo: backupStack removeLast. self sourcePosition: backupStack removeLast. ^false
backupSave "Save the current state for backing up. Answer the receiver." backupStack addLast: self sourcePosition; addLast: stack size
</methods> <methods> External.CParser <category>stack operations</category>
combineStackTo: oldSize "Make the items down to oldSize into an array, and replace them with it." | size | size := stack size. oldSize = size ifTrue: [^stack addLast: #()]. (oldSize > size or: [oldSize < 0]) ifTrue: [self error: #invalidStackSize << #dllcc >> 'Invalid size for combining stack']. stack addLast: (stack removeLast: size - oldSize)
popStackTo: newSize newSize > stack size ifTrue: [^false]. stack size - newSize timesRepeat: [stack removeLast]. "pop and nil elements" ^true
replaceStackTop: anElement "This is only generated in cases where it is known that the stack is not empty." ^stack at: stack size put: anElement
</methods> <methods> External.CParser <category>private</category>
declarationsPut: aDictionary "Force the receiver's declarations to be the argument. Do not place macros contained in the argument into the receiver's reserved word dictionary -- use #declarations: for that purpose." declarations := aDictionary
fastInit stack := OrderedCollection new: 20. backupStack := OrderedCollection new. super fastInit
</methods> <methods> External.CParser <category>accessing</category>
declarations "Answer all declarations found in the parse up to the time this message is sent. The answered object will be an ExternalDictionary containing macro and type entries." ^declarations
result stack isEmpty ifTrue: [^nil]. ^stack first
</methods> <methods> External.CParser <category>error handling</category>
expected: aString "Override CScanner implementation in order to include the header file that contains the error." | __file__ | __file__ := (declarations at: #__FILE__ ifAbsent: [^super expected: aString]) valuePrintString. ^self notify: #syntaxErrorInFileHere << #dllcc >> ('"<1s>:" syntax error ->' expandMacrosWith: __file__) at: mark
</methods> <methods> External.CParser class <category>private-parser compiler</category>
compile: code notifying: requestor ifFail: failBlock "Compile the argument, code, as source code in the context of the receiver and install the result in the receiver's method dictionary. Override the superclass implementation to warn that a special parser is required." #{ParserCompiler} isDefined ifFalse: [^self error: (#CParserRequiresParserCompiler << #dllcc >> 'The CParser class hierarchy requires a specialized ParserCompiler which is in the AT Parser Compiler parcel. Please load the parcel, otherwise contact Cincom Systems, Inc.')]. ^super compile: code notifying: requestor ifFail: failBlock
compilerClass "Answer a compiler class appropriate for source methods of this class." ^#{ParserCompiler} valueOrDo: [super compilerClass]
methodInfo "Override to flush our cached parser." CScanner withAllSubclasses do: [:sc| sc flushCache]. ^CScanner methodInfo
</methods> <methods> External.CParser class <category>flushing</category>
flushCache "Flush any cached information." reservedWords := cachedParser := nil
</methods> <methods> External.CParser class <category>parsing</category>
parseIncludeFiles: fileNames declarations: declarationDictionary includeDirectories: directoryStringArray requestor: aRequestor "Parse the contents of a collection of public include files. Perform preprocessing on the files before the parse. Use the declarationsDictionary argument as the cache of predefined types and defines. Use the argument, directoryStringArray, as an Array of String directory paths to search when include directives are encountered. Notify aRequestor of any syntax errors. Answers an instance of the receiver whose declaration dictionary is loaded." | aStream | aStream := ReadWriteStream on: (String new: 20). aStream nextPut: Character cr. fileNames do: [:aFileName | aStream nextPutAll: '#include "', aFileName, '"'; nextPut: Character cr]. aStream reset. ^self parseWithPreprocess: aStream as: #Cfile declarations: declarationDictionary includeDirectories: directoryStringArray requestor: aRequestor
parseWithNoPreprocess: aStringOrStream as: construct declarations: declarationDictionary requestor: aRequestor "Parse aStringOrStream as a construct in the C language. Do not perform any preprocessing on the argument aStringOrStream before the parse. Use the declarationsDictionary argument as the cache of predefined types and defines. Notify aRequestor of any syntax errors. Answer the new instance of the receiver that performed the parse. You can send #result to obtain the result of the parse or #declarations to extract the updated declaration dictionary." | parser | parser := cachedParser. (parser notNil and: [parser declarations backup = declarationDictionary backup]) ifTrue: [parser fastInit; declarationsPut: declarationDictionary] ifFalse: [parser := cachedParser := self new declarations: declarationDictionary]. ^parser parse: aStringOrStream as: construct notifying: aRequestor
parseWithPreprocess: aStringOrStream as: construct declarations: declarationDictionary includeDirectories: directoryStringArray requestor: aRequestor "Parse aStringOrStream as a construct in the C language. Perform preprocessing on the argument aStringOrStream before the parse. Use the declarationsDictionary argument as the cache of predefined types and defines. Use the String Array, directoryStringArray, as a collection of directory paths to search when include directives are encountered. Notify aRequestor of any syntax errors. Answers an instance of the receiver whose declaration dictionary is loaded." | preprocessedStream | preprocessedStream := self preprocessorClass preprocess: aStringOrStream declarations: declarationDictionary includeDirectories: directoryStringArray. ^self parseWithNoPreprocess: preprocessedStream reset as: construct declarations: declarationDictionary requestor: aRequestor
</methods> <methods> External.CParser class <category>class accessing</category>
preprocessorClass "Answer the class to be used to preprocess the input stream before parsing. Subclasses must override." ^self subclassResponsibility
</methods> <methods> External.CParser class <category>private</category>
reservedWords ^self superclass reservedWords
typeTable ^self superclass typeTable
</methods> <methods> External.CExpressionParser <category>types-actions</category>
checkEnum | anEnum | anEnum := declarations declarationAt: stack removeLast asSymbol ifAbsent: [^false]. (anEnum isKindOf: CEnumerationType) ifFalse: [^false]. stack addLast: anEnum. ^true
embedArray: aBlock size: size ^[:t | aBlock value: (CArrayType defaultPointer referentType: t; numElements: size)]
embedDeclarand: specifiers ofName: name typeBlock: typeBlock "Leaves name and type constructor block on stack." stack removeLast. stack addLast: name. stack addLast: name. ^[:arg | | declarand | declarand := typeBlock value: arg. specifiers do: [:aSpecifier | aSpecifier notNil ifTrue: [declarand := declarand perform: aSpecifier]]. declarand].
embedPointer: realPointer platformQualifiers: platformQualifiers qualifiers: qualifiers ofName: name typeBlock: typeBlock "The argument 'realPointer' indicates if this pointer may accept Smalltalk objects. The argument specifier indicates a type specifier - one of _near, _far, _huge, or _based. The argument argSpecifier is ingored. The argument isConstant is the symbol #const if the pointer is a constant pointer." stack removeLast. stack addLast: name. stack addLast: name. ^[:t | | aType pointerClass | aType := nil. pointerClass := CType defaultPointerTypeClass. (platformQualifiers includes: #beNear) ifTrue: [aType := pointerClass nearPointer]. (platformQualifiers includes: #beFar) ifTrue: [aType := pointerClass farPointer]. aType isNil ifTrue: [aType := pointerClass defaultPointer]. aType referentType: t. platformQualifiers do: [:aQualifier | aType perform: aQualifier]. "Don't bother with the volatile qualifier." (qualifiers includes: #beConstant) ifTrue: [aType := aType beConstant]. realPointer notNil ifTrue: [aType bePointer]. typeBlock value: aType]
embedProcedure: aBlock args: args ^[:t | | cProcedureType | args size == 0 ifTrue: [cProcedureType := CProcedureType resultType: t argumentTypes: Array new argumentNames: nil. cProcedureType beVarArg] ifFalse: [| firstArg | (args size == 1 and: [((firstArg := (args at: 1) value) isKindOf: CType) and: [firstArg isVoid]]) ifTrue: [cProcedureType := CProcedureType resultType: t argumentTypes: Array new argumentNames: nil] ifFalse: [| argumentAssocs procedureArgs isVarArg argNames | isVarArg := false. (args at: args size) value == #varArg ifTrue: [isVarArg := true. argumentAssocs := args copyFrom: 1 to: args size - 1] ifFalse: [argumentAssocs := args]. procedureArgs := argumentAssocs collect: [:theType | | theValue | (theValue := theType value) isVoid ifTrue: [backupStack := OrderedCollection new. self notify: #voidMustBeEntireList << #dllcc >> '''void'' in parameter list must be the entire list']. theValue]. argNames := #(). argumentAssocs detect: [:a | a key notNil] ifNone: [argNames := nil]. argNames isNil ifFalse: [| count | count := 0. argNames := argumentAssocs collect: [:assoc | assoc key isNil ifTrue: [count := count + 1. '_arg', count printString] ifFalse: [assoc key]]]. cProcedureType := CProcedureType resultType: t argumentTypes: procedureArgs argumentNames: argNames. isVarArg ifTrue: [cProcedureType beVarArg]]]. t isPascal ifTrue: [cProcedureType bePascal]. aBlock value: cProcedureType]
embedType: aType "A nameless type was encountered. Answer an array of one association that represents this unamed typed (the key is nil, the value is the type)." ^Array with: nil->aType
embedType: baseType in: firstDecl andList: declList "Answer an Array of CTypes that were formed from the baseType and the declaration blocks." | realBaseType | ^(Array with: (((firstDecl at: 1) -> (realBaseType := (firstDecl at: 2) == nil ifTrue: [baseType] ifFalse: [(firstDecl at: 2) value: baseType])))), (self embedType: realBaseType inList: declList)
embedType: baseType inList: declList ^declList collect: [:decl2 | "name, type block" (decl2 at: 1) -> ((decl2 at: 2) isNil ifTrue: [baseType] ifFalse: [(decl2 at: 2) value: baseType])]
embedTypeName: baseType name: shouldBeNil declarator: declaratorBlock ^[:environment | declaratorBlock value: baseType]
emptyBlock ^[:t | t]
makeCompositeName: aName members: members metaType: metaType "name == nil means an anonymous structure. members == nil means a structure referred to by name only." | aCompositeType name | aName notNil ifTrue: [name := aName asSymbol]. (members isNil and: [name notNil]) ifTrue: [^declarations compoundAt: name ifAbsent: ["Create a dummy structure." declarations declareAt: name put: (CCompositeType new name: name; metaType: metaType)]]. aCompositeType := CCompositeType new name: name; metaType: metaType. members do: [:memberAssoc | memberAssoc key == nil ifFalse: [aCompositeType at: memberAssoc key asSymbol put: 0 -> memberAssoc value]]. aCompositeType align. ^name notNil ifTrue: [declarations declareAt: name put: aCompositeType] ifFalse: [aCompositeType]
makeEnumName: memberName firstMember: firstMember restOfMembers: otherMembers "Answer a new CEnumerationType named aName with the given members. As a side effect, if aName is not nil the enumeration is added to the declarations dictionary." "To allow a trailing comma for the last enumeration, the parser is structured to push the first enumeration constant onto the stack followed by the remaining constants. We combine all those constants into a single array before creating the enumeration object. This is done to simplify the implementation of makeEnumName:members:." ^self makeEnumName: memberName members: (firstMember isNil ifTrue: [#()] ifFalse: [(Array with: firstMember)]) , (otherMembers isNil ifTrue: [#()] ifFalse: [otherMembers])
makeEnumName: aName members: members "Answer a new CEnumerationType named aName with the given members. As a side effect, if aName is not nil the enumeration is added to the declarations dictionary." | value anEnumType name | value := 0. aName notNil ifTrue: [name := aName asSymbol]. anEnumType := CEnumerationType new name: name. (name notNil and: [members isNil or: [members isEmpty]]) ifTrue: [^declarations compoundAt: name ifAbsent: ["Create a dummy structure." declarations declareAt: name put: anEnumType]]. members notNil ifTrue: [members do: [:nameAndOffset | nameAndOffset value notNil ifTrue: [value := nameAndOffset value]. anEnumType at: nameAndOffset key asSymbol put: value. value := value + 1]]. ^name notNil ifTrue: [declarations declareAt: name put: anEnumType] ifFalse: [anEnumType]
makeOopClass: className | oopClass | oopClass := className asQualifiedReference valueOrDo: [self expected: (#SmalltalkClassName << #dllcc >> 'Smalltalk class name')]. ^COopType new referentClass: oopClass
makeStructName: name members: members ^self makeCompositeName: name members: members metaType: #struct
makeUnionName: name members: members ^self makeCompositeName: name members: members metaType: #union
prefixQualifiers: prefixQualifiers forType: aType postfixQualifiers: postfixQualifiers "Answer a CQualifiedType object that qualifies the argument, aType. The qualifications are indicated by the arguments prefixQualifiers and postfixQualifiers. The C language syntax allowse type specifiers to appear before or after the type specification itself. The specifier arguments are arrays of unary symbols that can be send to a qualified type to give itself the desired attribute. If both of the specifier arrays are empty answer aType." | qualifiedType | (prefixQualifiers isEmpty and: [postfixQualifiers isEmpty]) ifTrue: [^aType]. qualifiedType := CQualifiedType new type: aType. prefixQualifiers do: [:aSpecifier | qualifiedType perform: aSpecifier]. postfixQualifiers do: [:aSpecifier | qualifiedType perform: aSpecifier]. ^qualifiedType
typedefName | aDec typeName | tokenType == #word ifFalse: [^false]. typeName := token asSymbol. aDec := declarations declarationAt: typeName ifAbsent: [nil]. aDec class == CTypedefType ifFalse: [^false]. stack addLast: aDec. self scanToken. ^true
</methods> <methods> External.CExpressionParser <category>expressions-syntax</category>
abstractDeclarator = @((#'_pointer' [#bePointer]) | [nil]) (platformSpecifiers | [nil]) #* typeQualifier (abstractDeclarator | [nil] [self emptyBlock]) [embedPointer:platformQualifiers:qualifiers:ofName:typeBlock:] | @(platformSpecifiers | [nil]) [nil] [self emptyBlock] abstractDeclaratorModifier [embedDeclarand:ofName:typeBlock:] | "Following must use @ in case the next thing is actually a procedure argument list" @ $( abstractDeclarator $) abstractDeclaratorModifier*!
abstractDeclaratorModifier = "Following must use @ in case the next thing is a formal parameter list for a procedure definition." @ $( paramList $) [embedProcedure:args:] | $[ (expression | [nil]) $] [embedArray:size:]
exprBlock = "Answer a block which, when evaluated with an environment, produces the value of the expression in that environment." parseCond
expression = "Answer the result of evaluating the block returned by #exprBlock in the current environment." exprBlock [eval:]
macro = (scanString | expression) sourceAtEnd
parseAdd = parseMultiplication ( #+ [x:] parseMultiplication [x:] [exprBinary:op:#+with:] | #- [x:] parseMultiplication [x:] [exprBinary:op:#-with:] )*!
parseAnd = parseBitOr (#&& [x:] parseBitOr [x:] [exprAnd:with:])*!
parseBitAnd = parseEq (#& [x:] parseEq [x:] [exprBinary:op:#bitAnd: with:])*!
parseBitOr = parseBitXor (#| [x:] parseBitXor [x:] [exprBinary:op:#bitOr: with:])*!
parseBitXor = parseBitAnd ($^ [x:] parseBitAnd [x:] [exprBinary:op:#bitXor: with:])*!
parseCast = @$( typeName $) parseCast [x:] [exprCast:expression:] | parseUnary
parseCond = parseOr ($? [x:] parseOr $: [x:] parseCond [x:] [exprCond:ifTrue:ifFalse:] | )
parseEq = parseRel ( #== [x:] parseRel [x:] [exprRelation:op:#=with:] | #!= [x:] parseRel [x:] [exprRelation:op:#~=with:] )*!
parseMultiplication = parseCast ( #* [x:] parseCast [x:] [exprBinary:op:#*with:] | #/ [x:] parseCast [x:] [exprBinary:op:#//with:] | #% [x:] parseCast [x:] [exprBinary:op:#\\with:] )*!
parseOr = parseAnd (#'||' [x:] parseAnd [x:] [exprOr:with:])*!
parsePostfix = parsePrimary ( $[ expression $] [exprArray:index:] | "$( expression \ $, $) [exprProcedureCall:arguments:] |" $. variableName [exprCompositeReference:member:] | #-> variableName [exprCompositeReference:member:] | #++ [exprPostfixIncrement:] | #'--' [exprPostfixDecrement:] )*!
parsePrimary = variableName [exprVariable:] | number [compressNumber:] | character [:asInteger] | scanString | $( expression $)
parseRel = parseShift ( #< [x:] parseShift [x:] [exprRelation:op:#<with:] | #> [x:] parseShift [x:] [exprRelation:op:#>with:] | #<= [x:] parseShift [x:] [exprRelation:op:#<=with:] | #>= [x:] parseShift [x:] [exprRelation:op:#>=with:] )*!
parseShift = parseAdd ( #<< [x:] parseAdd [x:] [exprBinary:op:#bitShift: with:] | #>> [x:] parseAdd [x:] [exprUnary:op:#negated] [exprBinary:op:#bitShift: with:] )*!
parseUnary = #+ parseCast [x:] [exprUnary:op:#yourself] | #- parseCast [x:] [exprUnary:op:#negated] | #! parseCast [x:] [exprNot:] | #~ parseCast [x:] [exprUnary:op:#bitInvert] | #& parseCast [exprReference:] | #* parseCast [exprDereference:] | word=#sizeof ($( typeName $) | parseUnary) [x:] [exprSizeof:] | parsePostfix
scanOneByteString ^tokenType == #string ifTrue: [stack addLast: (token copyFrom: 2 to: token size - 1). self scanToken. true] ifFalse: [false]
scanString ^(tokenType == #word and: [token = 'L']) ifTrue: [self scanTwoByteString] ifFalse: [self scanOneByteString]
scanTwoByteString self scanToken. ^tokenType == #string ifTrue: [stack addLast: (token copyFrom: 2 to: token size - 1) asTwoByteString. self scanToken. true] ifFalse: [false]
sourceAtEnd ^token isNil
</methods> <methods> External.CExpressionParser <category>types-syntax</category>
afterParamGroup ^token = $, or: [token = $)]
declarand = variableName
declarator = "Leaves name and type constructor block on stack" declWithName | @ [nil] [self emptyBlock] declMod*!
declaratorWithName = "Leaves name and type constructor block on the stack." declWithName | "No name, must have declMod." @ [nil] [self emptyBlock] declMod declMod*!
declMod = "Following must use @ in case the next thing is a formal parameter list for a procedure definition." @ $( paramList $) [embedProcedure:args:] | $[ (expression | [nil]) $] [embedArray:size:]
declWithName = "Leaves name and type constructor block on the stack." @((#'_pointer' [#bePointer]) | [nil]) (platformSpecifiers | [nil]) #* typeQualifier declarator [embedPointer:platformQualifiers:qualifiers:ofName:typeBlock:] | @(platformSpecifiers | [nil]) declarand [self emptyBlock] declMod*! [embedDeclarand:ofName:typeBlock:] | "Following must use @ in case the next thing is actually a procedure argument list" @ $( declarator $) declMod*!
emptyType | aDec typeName | tokenType == #word ifFalse: [^false]. typeName := token asSymbol. aDec := declarations declareAt: typeName put: (CTypedefType new name: typeName; type: CPointerType uniqueDefaultPointer). stack addLast: aDec. self scanToken. ^true
guaranteedSpecifierQualifier = "Parse a type specification; a base type specifier and its type qualifiers. Do not allow undeclared types to be automatically declared. Please see the comments in the method #specifierQualifier for futher details." (@typeQualifier typeSpecifier) typeQualifier [prefixQualifiers:forType:postfixQualifiers:]
paramGroup = (#register | ) specifierQualifier [Array] declarator [:with:with:] (@ $, [Array] declaratorWithName [:with:with:] afterParamGroup)* [embedType:in:andList:]
paramList = paramGroup (@ $, (paramGroup | $.$.$. [Array with: nil -> #varArg]) [:,])*! | $.$.$. [Array with: nil -> #varArg] | [#()]
specifierQualifier = "Parse a type specification; a base type specifier and its type qualifiers. Note that the C language syntax allows for type qualifiers to appear before or after the base type specification as in 'const int', or 'int const' or 'const int const' (where the latter is usually a warning). Place on the top of the stack the CType object." "Note the backtracking symbol @ that appears before the specification sequence. This is to allow the object pushed onto the stack by the first typeSpecifier to be popped if baseTypeSpec fails." (@typeQualifier (typeSpecifier | emptyType)) typeQualifier [prefixQualifiers:forType:postfixQualifiers:]
typeName = guaranteedSpecifierQualifier (abstractDeclarator | [nil] [self emptyBlock]) [embedTypeName:name:declarator:]
typeQualifier = "Answer an array of Symbols that indicate the type qualifiers found for the current type specification. If no type qualifiers are found answer an empty array. The elements of the array should be unary message selectors that can be sent to instances of CType to convert them into a type with the indicated qualification attribute." (#pascal [#bePascal] | #const [#beConstant] | #volatile [#beVolatile] ) *
typeSpecifier = "Place on top of the parse stack a type specifier, one of enum, struct, union, typedef, or scalar type. Fail if a valid type specifier is not present on the input token stream." enum | struct | union | #void [CVoidType void] | #float [CLimitedPrecisionRealType float] | #double [CLimitedPrecisionRealType double] | #extended [CLimitedPrecisionRealType extended] | #unsigned ((#char | #'__int8') [CIntegerType unsignedChar] | (#short | #'__int16') ((#int | ) [CIntegerType unsignedShort]) | #long ( #long (#int | ) [CIntegerType unsignedLongLong] | (#int | ) [CIntegerType unsignedLong]) | #'__int64' [CIntegerType unsignedLongLong] | (#int | #'__int32' | ) [CIntegerType unsignedInt]) | #signed ((#char | #'__int8') [CIntegerType signedChar] | (#short | #'__int16') ((#int | ) [CIntegerType signedShort]) | #long (#long (#int | ) [CIntegerType signedLongLong] | (#int | ) [CIntegerType signedLong]) | #'__int64' [CIntegerType signedLongLong] | (#int | #'__int32' | ) [CIntegerType signedInt]) | (#'_bool' | #'__bool') ((#char | #'__int8') [CIntegerType booleanChar] | (#short | #'__int16') ((#int | ) [CIntegerType booleanShort]) | #long (#long [CIntegerType booleanLongLong] | (#int | ) [CIntegerType booleanLong] ) | #'__int64' [CIntegerType booleanLongLong] | (#int | #'__int32' | ) [CIntegerType booleanInt]) | (#'_hresult' | #'__hresult') (#long [CIntegerType hResultLong]) | (#'_syscall' | #'__syscall') (#unsigned #long [CIntegerType syscallLong]) | (#'_wincall' | #'__wincall') (#unsigned #long [CIntegerType wincallLong]) | (#char | #'__int8') [CIntegerType char] | (#short | #'__int16') ((#int | ) [CIntegerType short]) | #long (#unsigned (#double [CLimitedPrecisionRealType longDouble] | #long (#int | ) [CIntegerType unsignedLongLong] | (#int | ) [CIntegerType unsignedLong] ) | (#signed | ) (#double [CLimitedPrecisionRealType longDouble] | #long (#int | ) [CIntegerType signedLongLong] | (#int | ) [CIntegerType signedLong] )) | (#int | #'__int32') [CIntegerType int] | #'__int64' [CIntegerType signedLongLong] | #'_segment' [CIntegerType short] | #'_oop' ( $( word $) | [#Object]) [makeOopClass:] | typedefName
</methods> <methods> External.CExpressionParser <category>types-syntax-basic</category>
compositeSpec = ${ [nil] members $} | word (${ members $} | [nil] )
enum = #enum enumSpec
enumMember = declarand (#= expression | [nil]) [:->]
enumSpec = "Parse an enumeration specification. Answer true if a valid enumeration was encountered, otherwise answer false. If a valid enumeration is found, the top element of the stack is the enumeration object." ${ [nil] enumMember (@$, enumMember)* ($, | ) $} [makeEnumName:firstMember:restOfMembers:] | word ((${ enumMember (@$, enumMember)* ($, | ) $} | [nil] [nil]) [makeEnumName:firstMember:restOfMembers:] | checkEnum)
memberDecl = declaratorWithName ($: expression | [nil]) [stack removeLast: 3] | $: [Array] expression [: with: nil with: nil with:]
memberGroup = (specifierQualifier | emptyType) ($; [embedType:] | (memberDecl \ $,) $; [embedType:inList:])
members = memberGroup (memberGroup [:,])*!
platformSpecifiers = "Parse any platform specific specifiers. If a specifier is found, send a conversion message to the argument on the top of stack informing it of the specifier. Most of the specifiers in this method are parsed but simply ignored in order to avoid syntax errors. Please consult the documentation for a list of supported specifiers." ((#'_near' | #'__near') [#beNear] | (#'_far' | #'_Far16' | #'__far' | #'_huge' | #'__huge') [#beFar] | (#'_based' | #'__based') $( (($( (#'_segment' | #'__segment') $) | ) variableName. | (#'_segname' | #'__segname') $( scanString. $)) $) [#yourself] | (#'_Seg16') [#beSeg16] | (#'_pascal' | #'__pascal' | #'_Pascal') [#bePascal] | (#'_fortran' | #'__fortran') [#beFortran] | (#'_cdecl' | #'__cdecl' | #'_Cdecl' ) [#beCdecl] | (#'_stdcall' | #'__stdcall') [#beStdcall] | (#'_saveregs' | #'__saveregs' | #'_interrupt' | #'__interrupt' | #'_export' | #'__export' | #'_Export' | #'_Inline' | #'_System' | #'_Far32' | #'_loadds' | #'__loadds' | #'_self' | #'__self') [#yourself] | (#'_fastcall' | #'__fascall' | #'_Fastcall' | #'_Optlink') [#yourself] | (#'_nocallback') [#beNoCallback] | (#'_longcomp') [#beLongcomp] | (#'_oopref') [#beOopRef] | (#'_threaded' | #'__threaded') [#beThreaded] | (#'_hresult' | #'__hresult') [#beHResult] | (#'_syscall' | #'__syscall') [#beSyscall] | (#'_wincall' | #'__wincall') [#beWincall])*
struct = #struct compositeSpec [makeStructName:members:]
union = #union compositeSpec [makeUnionName:members:]
</methods> <methods> External.CExpressionParser <category>expressions-actions</category>
compressNumber: aNumber "Answer the compress the argument if it is an integer, otherwise answer the argument." aNumber isInteger ifTrue: [^aNumber compressed]. ^aNumber
eval: exprBlock "Evaluate the exprBlock (a block that accepts one argument) with an environment in which all undefined variables are defined as 0 (the preprocessor has supposedly replaced all defined variables with their values). Answer the argument if it is not a block closure." ^(exprBlock isKindOf: BlockClosure) ifTrue: [exprBlock value: declarations] ifFalse: [exprBlock]
exprAnd: left with: right ^[:envt | (left value: envt) = 0 ifTrue: [0] ifFalse: [right value: envt]]
exprArray: expressionBlock index: indexBlock ^[:environment | (expressionBlock value: environment) at: (indexBlock value: environment)]
exprBinary: left op: selector with: right ^[:envt | (left value: envt) perform: selector with: (right value: envt)]
exprCast: baseType expression: expression ^[:environment | (baseType value: environment) cast: (expression value: environment)]
exprCompositeReference: compositeBlock member: member ^[:environment | (compositeBlock value: environment) memberAt: (environment at: member asSymbol)]
exprCond: cond ifTrue: expr1 ifFalse: expr2 ^[:envt | (cond value: envt) ~= 0 ifTrue: [expr1 value: envt] ifFalse: [expr2 value: envt]]
exprDereference: expressionBlock ^[:environment | (expressionBlock value: environment) contents]
exprNot: operand ^[:envt | (operand value: envt) = 0 ifTrue: [1] ifFalse: [0]]
exprOr: left with: right ^[:envt | (left value: envt) ~= 0 ifTrue: [1] ifFalse: [right value: envt]]
exprPostfixDecrement: expressionBlock ^[:environment | |expression | expression := expressionBlock value: environment. (expression isKindOf: Number) ifTrue: [expression - 1] ifFalse: [expression decrement]]
exprPostfixIncrement: expressionBlock ^[:environment | |expression | expression := expressionBlock value: environment. (expression isKindOf: Number) ifTrue: [expression + 1] ifFalse: [expression increment]]
exprProcedureCall: procedureBlock arguments: argumentsBlock ^[:environment | (procedureBlock value: environment) callWith: (argumentsBlock value: environment)]
exprReference: expressionBlock "The following is not correct. The value of expression will need to be an object that knows how to answer the reference of the expression is contains. For example, the address of a structure member obtained from an expression of the form '&aStruct->member' should answer a pointer to the member (i.e. aStruct refMemberAt: #member)." ^[:environment | | expression | expression := expressionBlock value: environment]
exprRelation: left op: selector with: right ^[:envt | ((left value: envt) perform: selector with: (right value: envt)) ifTrue: [1] ifFalse: [0]]
exprSizeof: typeBlock ^[:environment | | type | type := typeBlock value: environment. (type isKindOf: CType) ifFalse: [type := type baseCType]. type sizeof]
exprUnary: left op: selector ^[:envt | (left value: envt) perform: selector]
exprVariable: varName "Answer a block that when evaulated will answer the value of the argument, varName, within the environment passed as an argument to the block. The block's argument will be an ExternalDictionary. If the variable is not declared the default is to answer zero." ^ [:environment | | defn | defn := environment at: varName asSymbol ifAbsent: [0]. ((defn isKindOf: CMacroDefinition) and: [defn name == varName asSymbol]) ifTrue: [0] ifFalse: [defn value]]
variableName | aDec | tokenType == #word ifFalse: [^false]. aDec := declarations declarationAt: token asSymbol ifAbsent: [nil]. (aDec notNil and: [aDec class == CTypedefType]) ifTrue: [^false]. stack addLast: token. self scanToken. ^true
x: top "Coerce a value to a block if necessary." ^((top isKindOf: Number) or: [top isString]) ifTrue: [[:envt | top]] ifFalse: [top]
</methods> <methods> External.CExpressionParser class <category>class accessing</category>
preprocessorClass "Answer the class to be used to preprocess the input stream before parsing. Subclasses must override." ^CPreprocessor
</methods> <methods> Tools.Trippy.CStructureInspector <category>decomposing</category>
partAt: index ^parts at: index
partCount ^parts size
</methods> <methods> Tools.Trippy.CStructureInspector <category>private</category>
members | type memberParts | type := object type. type isPointer ifTrue: [type := type referentType]. memberParts := OrderedCollection new. type baseType keysAndValuesDo: [:name :assoc | memberParts add: (CStructMember of: object at: name)]. ^memberParts
refresh parts := object inspectorExtraAttributes, self members. super refresh
</methods> <methods> Tools.Trippy.CStructureInspector <category>properties</category>
dragControllerClass ^ReplaceOnlyDragController
</methods> <methods> Tools.Trippy.CStructureInspector class <category>accessing</category>
tabLabel "Answer a String to use as a tab label of a page containing this inspector." ^(#structInspecLabel << #dllcc >> 'C Struct') asString
</methods> <methods> Tools.ExternalInterfaceClassFinder <category>private</category>
createAttributesArray | oc | oc := OrderedCollection new. oc add: #(#includeFiles #()). oc add: #(#includeFiles #()). oc add: #(#includeDirectories #()). oc add: #(#libraryFiles #()). oc add: #(#libraryDirectories #()). oc add: (Array with: #beVirtual with: self isVirtual value). oc add: (Array with: #optimizationLevel with: self optimizationLevel). ^oc asArray
optimizationLevel ^self isOptimized value ifTrue: [#full] ifFalse: [#debug]
</methods> <methods> Tools.ExternalInterfaceClassFinder <category>aspects</category>
isOptimized "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^isOptimized isNil ifTrue: [isOptimized := false asValue] ifFalse: [isOptimized]
isVirtual "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^isVirtual isNil ifTrue: [isVirtual := false asValue] ifFalse: [isVirtual]
</methods> <methods> Tools.ExternalInterfaceClassFinder <category>interface opening</category>
postBuildWith: aBuilder self setSuperclassTypes: #(#{ExternalInterface}). self isOptimized value: true. classCategory value: 'ExternalInterface-New'. normalSuperclass value: #{ExternalInterface}
</methods> <methods> Tools.ExternalInterfaceClassFinder <category>finding</category>
createClass | ns cls | (self requestedSuperclass value includesBehavior: ExternalInterface) ifFalse: [^Dialog warn: #mustBeExternalInterfaceSubclass << #dllcc >> 'The superclass must be a subclass of ExternalInterface.' for: self builder window]. ns := self currentNameSpace. cls := ns defineClass: self localClassName value superclass: self requestedSuperclass indexedType: #none private: false instanceVariableNames: '' classInstanceVariableNames: '' imports: '' category: self classCategory value attributes: self createAttributesArray. cls asNameSpace addImport: cls poolImportDefinition. candidateClassName value: cls fullName
</methods> <methods> External.CPreprocessor <category>#directives-syntax</category>
directive "Handling of directives depends on skip level." ^skipLevel > 1 ifTrue: [self directive2] ifFalse: [skipLevel = 1 ifTrue: [self directive1] ifFalse: [self directive0]]
directive0 = "When skipLevel=0, pay attention to all directives." word=#if expression [if:]. | word=#else [self enterSkip]. | word=#elif [self enterSkip]. | word=#pragma [self skipDirective]. | word=#error [self preprocessorError]. | word=#line [self skipDirective]. | word=#indent [self skipDirective]. | word=#assert assertDirective | word=#unassert unassertDirective | $# [self skipDirective]. | word=#endif [directiveTakenStack last ifFalse: [self exitSkip]. directiveTakenStack removeLast. self skipDirective]. | [self saveReservedWords]. word=#undef [self restoreReservedWords]. word [undef:]. | word=#ifdef [self restoreReservedWords]. word [defined:] [if:]. | word=#ifndef [self restoreReservedWords]. word [defined:] [ifnot:]. | [dontStepPastEnd := true]. word=#define defineExpression [dontStepPastEnd := false]. | [dontStepPastEnd := false]. [self restoreReservedWords]. word=#include [self include] | [self skipDirective].
directive1 = "When skipLevel=1, pay attention to all conditional directives." word=#else [directiveTakenStack last ifFalse: [directiveTakenStack removeLast; addLast: true. self exitSkip]]. | word=#elif [self exitSkip]. expression [elif:]. | directive2
directive2 = "When skipLevel > 1, only pay attention to if and endif." [self saveReservedWords]. (word=#if | word=#ifdef | word=#ifndef) [directiveTakenStack addLast: false. self enterSkip]. [self restoreReservedWords]. | [self restoreReservedWords]. word=#endif [directiveTakenStack removeLast. self exitSkip. self skipDirective].
macroArg = "Handle a macro argument. Remember the current state of the input stream by pushing the look-ahead character, the current source stream, and the current index within the stream. Parse the argument, then construct the argument as a String and push it onto the stack." [self source] << ($( (nestedMacroArg | $,)*! $) | notArgEnd)*! [self pushMacroArg]
macroArgList = "To avoid premature lookahead, we don't recognize the final ), but leave that to the caller." $( macroArg ($, macroArg )*!
macroArguments: numArgs "Collect and return the arguments for a preprocessor macro. Answer an empty array if the argument, numArgs, is nil (i.e. don't bother scanning for arguments). Answer nil if the argument numArgs is greater than 0 but the next token is not an open parenthesis. Otherwise, scan the stream for the macro arguments and answer an array of those arguments." | depth args | numArgs isNil ifTrue: [^#()]. "no args" depth := stack size. self beginDirective. typeTable := ATypeTable. "cr is whitespace" self backupSave. self scanToken. (numArgs > 0 and: [tokenType ~~ #leftParenthesis]) ifTrue: [self backupRestore. self endDirective. ^nil]. self backupDiscard. self macroArgList ifFalse: [self error: (#InvalidMacroCall << #dllcc >> 'Invalid macro call.')]. token == $) ifFalse: [self error: (#InvalidMacroCall << #dllcc >> 'Invalid macro call.')]. args := stack removeLast: stack size - depth. ((numArgs = 0 and: [args size = 0 or: [args size = 1 and: [(args at: 1) isEmpty]]]) or: [args size = numArgs]) ifFalse: [self error: (#WrongOfArgsForMacro << #dllcc >> 'Wrong # of args for macro.')]. self endDirective. ^args
nestedMacroArg = "Handle a nested macro argument." $( (nestedMacroArg | $,)*! $) | notArgEnd
</methods> <methods> External.CPreprocessor <category>#directives-actions</category>
define: aName argNames: argNames "Define a macro named aName with argument names argNames." | defn dict start positions index end body name | name := aName asSymbol. defn := CMacroDefinition new name: name argNames: argNames. dict := Dictionary new: 10. argNames ~~ nil ifTrue: [1 to: argNames size do: [:i | dict at: (argNames at: i) put: i]]. "Scan the definition, noting positions of arguments. The continuation count must be reset since the definition will be rescanned." continuationCount := 0. start := mark. positions := (Array new: 20) writeStream. [tokenType == #cr or: [hereChar == nil and: [token == nil]]] whileFalse: [(tokenType == #word and: [(index := dict at: token ifAbsent: [nil]) notNil]) ifTrue: [sourceUsesCRLF ifTrue: [positions nextPut: mark - continuationCount - start -> index] ifFalse: [positions nextPut: mark - start -> index]]. self scanToken]. "Back up and copy the entire definition." hereChar == nil ifTrue: [token ~~ Character cr ifTrue: [end := source position + 1] ifFalse: [end := prevEnd + 1]] ifFalse: [end := prevEnd + 1]. "1-origin, and 1 char too far back" source position: start - 1. "1-origin" body := source next: ((end - start) < 0 ifTrue: [0] ifFalse: [sourceUsesCRLF ifTrue: [end - continuationCount - start] ifFalse: [end - start]]). source position: (source atEnd ifTrue:[mark - 1 "at end of file and no cr"] ifFalse:[mark "skip over cr"]). "Now the definition has been read its ok to step past the end (i.e. pop the include stack if required)" dontStepPastEnd := false. self step. defn definition: body substitutions: positions contents. declarations at: name put: defn. self restoreReservedWords. lastDefine := defn. reservedWords at: name put: defn
defineAssert: predicate value: tokenSequence "An assertion with predicate and tokenSequence was parsed. Register this assertion." | previousPredicate predicateSymbol | predicateSymbol := predicate asSymbol. previousPredicate := assertDefines at: predicateSymbol ifAbsent: [nil]. previousPredicate == nil ifTrue: [assertDefines at: predicateSymbol put: (OrderedCollection with: tokenSequence)] ifFalse: [(previousPredicate includes: tokenSequence) ifFalse: [previousPredicate add: tokenSequence]]
defined: key "Answer 1 if the argument is already defined, otherwise answer 0." | definition | definition := declarations at: key asSymbol ifAbsent: [nil]. ^(definition notNil and: [definition class == CMacroDefinition]) ifTrue: [1] ifFalse: [0]
elif: condition "If the argument is false (0), enter directive skip." condition = 0 ifTrue: [self enterSkip] ifFalse: [directiveTakenStack removeLast; addLast: true]
enterSkip skipLevel := skipLevel + 1
exitSkip skipLevel > 0 ifTrue: [skipLevel := skipLevel - 1]
if: condition "If the argument is false (0), enter directive skip." condition = 0 ifTrue: [self enterSkip. directiveTakenStack addLast: false] ifFalse: [directiveTakenStack addLast: true]
ifnot: condition condition = 0 ifTrue: [directiveTakenStack addLast: true] ifFalse: [self enterSkip. directiveTakenStack addLast: false]
include "Handle an include directive." | fileName local file | token == #< ifTrue: [| fstr | fstr := (String new: 40) writeStream. [hereChar = $>] whileFalse: [(hereChar = Character cr or: [hereChar == nil]) ifTrue: [^false]. fstr nextPut: hereChar. self step]. self step. fileName := fstr contents. local := false] ifFalse: [tokenType == #string ifTrue: [fileName := String new. [tokenType ~~ #cr and: [token ~~ nil and: [tokenType == #string]]] whileTrue: [fileName := fileName, (token copyFrom: 2 to: token size -1). self scanToken]. local := true] ifFalse: [^false]]. "Skip to the end of the line." [tokenType == #cr or: [token == nil]] whileFalse: [self scanToken]. file := local ifTrue: [self read: fileName localOrInDirectories: includeDirectories] ifFalse: [self read: fileName inDirectories: includeDirectories]. file lineEndAuto. "The following should really create a new CPreprocessor and stack it rather than changing the current one to parse the new header file." self pushIncludeStack. self endDirective. "restore scanner tables to normal state" self on: file. tokenType := nil. hereChar := source next. ^true
preprocessorError "A #error preprocessor error was encountered. Scan to the end-of-line and display the error message in the transcript." Transcript show: self scanErrorString; cr
pushMacroArg "Answer a string representing the currently parsed macro argument. The top stack entry is the start index for the macro argument string, the second stack entry is the stream associated with startIndex, the third stack entry is the look-ahead character for the stream that was pushed onto the stack just prior." | startIndex aStream oldPosition aMacroArg argLen | startIndex := stack removeLast. aStream := stack removeLast. oldPosition := aStream position. argLen := oldPosition - 1 - startIndex. hereChar isNil ifTrue: [argLen := argLen+1]. (hereChar == Character cr and: [self streamUsesCRLF: aStream]) ifTrue: [argLen := argLen - 1]. aStream position: startIndex - 1. aMacroArg := (aStream next: argLen) replaceAll: Character cr with: $ . aStream position: oldPosition. ^aMacroArg
restoreReservedWords "Restore the current reserved word dictionary." saveReservedWords == nil ifFalse: [reservedWords := saveReservedWords. saveReservedWords := nil]
saveReservedWords "Save the current reserved word dictionary and reset it to an empty dictionary." saveReservedWords := reservedWords. reservedWords := Dictionary new.
scanErrorString "Answer a string consisting of the tokens following an #error directive, up to the end-of-line marker." | cr errorStream | cr := Character cr. errorStream := WriteStream on: String new. token isString ifTrue: [errorStream nextPutAll: token; nextPut: Character space] ifFalse: [errorStream print: token]. [hereChar == nil or: [hereChar == cr]] whileFalse: [ errorStream nextPut: hereChar. hereChar := source next]. hereChar == nil ifFalse: [hereChar := source next]. tokenType := nil. ^errorStream contents
source "Answer the current parser's source stream." ^source
undef: key "Handle the #undef directive. Undefine the argument." | rwords name | name := key asSymbol. declarations removeKey: name ifAbsent: [nil]. "If the macro shadowed a reserved word, undo this now." rwords := self class reservedWords. (rwords includesKey: name) ifTrue: [reservedWords at: name put: true] ifFalse: [reservedWords removeKey: name ifAbsent: []]
undefineAssert: predicate value: tokenSequence "An unassertion with predicate and tokenSequence was parsed. Undefiner this assertion." | predicateSymbol | predicateSymbol := predicate asSymbol. tokenSequence isEmpty ifTrue: [assertDefines removeKey: predicateSymbol ifAbsent: [nil]] ifFalse: [| previousPredicate | previousPredicate := assertDefines at: predicateSymbol ifAbsent: [nil]. previousPredicate == nil ifFalse: [previousPredicate remove: tokenSequence]]
</methods> <methods> External.CPreprocessor <category>preprocessing</category>
outputToken: aToken type: aTokenType lastWasString: lastWasString on: aStream "Place the argument, aToken, of type aTokenType (a Symbol indicating the type of token) on the argument aStream. Answer true if the last token placed on the stream was a String so the appropriate space can be added, otherwise answer false." (aToken isKindOf: Character) ifTrue: [aStream nextPut: aToken. ^false]. (lastWasString and: [(aTokenType == #binary) not]) ifTrue: [aStream nextPut: $ ]. (aToken isKindOf: String) ifTrue: [aStream nextPutAll: aToken] ifFalse: [aToken class == LargePositiveInteger ifTrue: [self printHexNumber: aToken on: aStream] ifFalse: [aStream nextPutAll: aToken printString. "We don't use isKindOf: for speed." (aToken class == Float) ifTrue: [aStream nextPut: $f]]]. ^(aTokenType == #binary) not
preprocess "Answer a string representing aStream with all pre-processing directives stripped and evaluated." | lastTokenWasStringy | lastTokenWasStringy := false. [stack isEmpty ifFalse: [stack removeLast]. token == nil ifTrue: [true] ifFalse: ["Inlined for speed." "lastTokenWasStringy := self outputToken: token type: tokenType lastWasString: lastTokenWasStringy on: outputStream." (token isKindOf: Character) ifTrue: [lastTokenWasStringy := false. outputStream nextPut: token] ifFalse: [(lastTokenWasStringy and: [(tokenType == #binary) not]) ifTrue: [outputStream nextPut: $ ]. (token isKindOf: String) ifTrue: [outputStream nextPutAll: token] ifFalse: [token class == LargePositiveInteger ifTrue: [self printHexNumber: token on: outputStream] ifFalse: [outputStream nextPutAll: token printString. "We don't use isKindOf: for speed." (token class == Float) ifTrue: [outputStream nextPut: $f]]]. lastTokenWasStringy := (tokenType == #binary) not]. self scanToken == nil and: [includeStack isEmpty]]] whileFalse. ^outputStream
</methods> <methods> External.CPreprocessor <category>private-scanning</category>
scanToken "Scan the input stream for a single token." | skipped isWideLiteral | isWideLiteral := tokenType == #word and: [token = 'L' and: [hereChar == $' or: [hereChar == $"]]]. [skipped := 0. [hereChar == nil ifTrue: "end of input" ["skipLevel > 0 ifTrue: [self offEnd: 'Unterminated conditional']." prevEnd := source position. mark := prevEnd + 1. tokenType := #doIt. ^token := nil]. (tokenType := typeTable at: hereChar asInteger) == #xDelimiter] whileTrue: "Skip delimiters fast, there almost always is one." [skipped := skipped + 1. "open code step for speed" [hereChar := source next. hereChar == nil ifTrue: [self stepPastEnd]. hereChar == $\ and: [source peekFor: Character cr]] whileTrue: [skipped := skipped + 1. continuationCount := continuationCount + 1]]. mark := source position. "The following is a hack for platforms that support CRLF - the mark should be adjusted." (hereChar == Character cr and: [sourceUsesCRLF]) ifTrue: [mark := mark - 1]. prevEnd := mark - skipped - 1. tokenType isSymbol ifTrue: "single-character token" [token := hereChar. self step] ifFalse: [buffer reset. [tokenType isSymbol] whileFalse: [buffer nextPut: hereChar. self step. tokenType := tokenType value at: hereChar ifAbsent: [tokenType key]]. (tokenType at: 1) == $x ifTrue: [self perform: tokenType] ifFalse: [token := buffer contents]]. tokenType isNil or: [skipLevel > ignoreSkipLevel]] whileTrue. "loop until we have a real token" (isWideLiteral and: [token isString]) ifTrue: [token := token asTwoByteString]. ^token
step "Override the super class implementation handle line-splicing with \, and to handle #includes and macros. If the end of an include file is encountered, we step back one level to the previous include file before continuing." | aChar | [aChar := hereChar. hereChar := source next. hereChar == nil ifTrue: [self stepPastEnd]. hereChar == $\ and: [source peekFor: Character cr]] whileTrue: [continuationCount := continuationCount + 1]. ^aChar
stepPastEnd "We just ran off the end of the source, while attempting to refill hereChar. If we are in an #include or a macro, pop the stack. " [includeStack isEmpty] whileFalse: [dontStepPastEnd ifTrue: [^self] ifFalse: [self popIncludeStack. hereChar := source next. hereChar notNil ifTrue: [^self]]]. "No more input." hereChar := nil
xCR "We just saw a CR. Look ahead for a preprocessor directive." [self skipWhitespace. (hereChar == $# or: [token == $#]) ifFalse: [tokenType := nil. ^self]. hereChar == $# ifTrue: [self step]. [self beginDirective. self scanToken. self directive] ensure: [self endDirective]] repeat
xWord "Handle a word, may be reserved or a macro." | defn args currentMacroScan macroExpansion tokenSymbolOrNil | token := buffer contents. (inMacroScan or: [skipLevel > 0 or: [(tokenSymbolOrNil := Symbol findInterned: token) == nil or: [(defn := reservedWords at: tokenSymbolOrNil ifAbsent: [nil]) == nil]]]) ifTrue: [tokenType := #word. ^self]. defn == true ifTrue: [tokenType := tokenSymbolOrNil. ^self]. "reserved word" "Token is a preprocessor macro. Expand it." currentMacroScan := inMacroScan. inMacroScan := true. args := self macroArguments: defn numArgs. args == nil ifTrue: [inMacroScan := currentMacroScan. token := tokenSymbolOrNil asString. tokenType := #word. ^self]. macroExpansion := defn expandWithArguments: args. macroExpansion = '' ifTrue: [inMacroScan := currentMacroScan. token := ''. tokenType := #word. ^self]. macroExpansion asSymbol == defn name ifTrue: [inMacroScan := currentMacroScan. token := macroExpansion. tokenType := #word. ^self]. "The following should really create a new CPreprocessor and stack it rather than changing the current one." self pushIncludeStack. self on: macroExpansion readStream. inMacroScan := currentMacroScan. tokenType := nil. hereChar := source next
</methods> <methods> External.CPreprocessor <category>initialize-release</category>
predefine: aName as: aString "Define the argument, aName, to be the string, aString. Disallow redefinition of already declared names." | defn name | name := aName asSymbol. (declarations includesKey: aName) ifFalse: [defn := CMacroDefinition new. defn name: name argNames: nil. defn definition: aString substitutions: #(). declarations at: name put: defn. reservedWords at: name put: defn]
preprocess: stringOrStream declarations: predefinedDeclarations includeDirectories: directoryArray ^self preprocess: stringOrStream declarations: predefinedDeclarations includeDirectories: directoryArray outputStream: (ReadWriteStream on: String new)
preprocess: stringOrStream declarations: predefinedDeclarations includeDirectories: directoryArray outputStream: aStream self declarations: predefinedDeclarations. self predefineNames. self includeDirectories: directoryArray. self init: stringOrStream notifying: nil failBlock: nil. self outputStream: aStream. ^self preprocess
</methods> <methods> External.CPreprocessor <category>private</category>
fastInit inMacroScan := false. skipLevel := ignoreSkipLevel := 0. includeStack := OrderedCollection new. directiveTakenStack := OrderedCollection new. lastDefine := nil. dontStepPastEnd := false. saveDefines := IdentityDictionary new. assertDefines := IdentityDictionary new. continuationCount := 0. super fastInit
includeDirectories: anOrderedCollection includeDirectories := anOrderedCollection
popIncludeStack "The current source stream was just exhausted. Pop the topmost stream information set off the include stack." | sourcePosition | source close. mark := includeStack removeFirst. sourcePosition := includeStack removeFirst. self source: includeStack removeFirst. source position: sourcePosition.
predefineNames "Predefine all the ANSI preprocessor identifiers. We do not guard against them being undefined or redefined. Answer the receiver." self predefine: #'__LINE__' as: '0'; predefine: #'__FILE__' as: ''; predefine: #'__DATE__' as: '"', Date today printString, '"'; predefine: #'__TIME__' as: '"', Time now printString, '"'; predefine: #'__STDC__' as: '1'
pushIncludeStack "Place on the include stack all the stream information required to parse a new source stream and when complete, re-install the current stream for further processing." hereChar notNil ifTrue: [source skip: -1]. "back up 1 char" includeStack addFirst: source. includeStack addFirst: source position. includeStack addFirst: mark
read: aFileTail inDirectories: aDirectoryNames "Look for file in directories and return a ReadStream if found." | filename | filename := nil. aDirectoryNames detect: [:eachDir | filename := eachDir asFilename construct: aFileTail. filename exists and: [filename isReadable]] ifNone: [self error: (#CantFindFile1s << #dllcc >> 'Can''t find file: <1s>' expandMacrosWith: aFileTail)]. declarations removeKey: #__FILE__ ifAbsent: []. "we have to remove it so we can predefine it" self predefine: #__FILE__ as: filename asResolvedString. ^filename readStream
read: aFileTail localOrInDirectories: aDirectoryNames "Look for file in local directory and directories and return a ReadStream if found." ^self read: aFileTail inDirectories: #('.') , aDirectoryNames
</methods> <methods> External.CPreprocessor <category>#directives-parsing</category>
assertDirective = "A #assert directive was encountered. Parse the remainder of the assertion. An assertion takes the following form: #assert predicate(tokenSequence) | #assert predicate Assertion predicates are in a different namespace than macros." word ($( notRightParenthesisWithPush* $) | [#()]) [defineAssert:value:]
beginDirective typeTable := DTypeTable. "cr is now a real token" ignoreSkipLevel := SmallInteger maxVal. "don't skip tokens" continuationCount := 0 "starting a new directive resets the continuationCount"
defineExpression = "Answer a define expression." word (@ noSpace $( word \ $, $) | @ noSpace $( $) [#()] | [nil]) [define:argNames:].
endDirective "A directive has been successfully parsed. Cleanup the effects of #beginDirective." typeTable := self class typeTable. ignoreSkipLevel := 0
hashToken ^token = #'#' and: [self scanToken. true]
noSpace "Test whether the current token immediately followed the previous one." ^mark = (prevEnd + 1)
notArgEnd "Answer true if the end of a macro argument is reached, false otherwise." ^(token == $, or: [token == $) or: [token == nil]]) ifTrue: [false] ifFalse: [self scanToken. true]
notRightParenthesisWithPush "Consume a token if a right brace is not encountered and push the token on the stack" ^(token == $) or: [token == nil]) ifTrue: [false] ifFalse: [stack addLast: token. self scanToken. true]
skipDirective "Skip the rest of an unrecognized directive." [(hereChar == nil) not and: [token ~= Character cr or: [token == $\]]] whileTrue: [self scanToken]
unassertDirective = "A #unassert directive was encountered. Parse the remainder of the unassertion. An unassertion takes the following form: #unassert predicate(tokenSequence) | #unassert predicate Assertion/unassertion predicates are in a different namespace than macros." word ($( notRightParenthesisWithPush* $) | [#()]) [undefineAssert:value:]
</methods> <methods> External.CPreprocessor <category>expressions-actions</category>
exprAssert: key value: tokenSequenceArray "Answer a block accepting a single argument, the current declaration environment, that when evaluated will answer 1 if the assertion key with arguments tokenSequenceArray is asserted." ^[:environment | | tokenCollection | tokenCollection := assertDefines at: key asSymbol ifAbsent: [nil]. tokenCollection == nil ifTrue: [0] ifFalse: [(tokenCollection detect: [:tokenSequence | tokenSequence = tokenSequenceArray] ifNone: [nil]) == nil ifTrue: [0] ifFalse: [1]]]
</methods> <methods> External.CPreprocessor <category>accessing</category>
defineOrSingleDeclaration "The single define was parsed and created during the initial scan of the input stream so simply answer the receiver." ^self
lastDefine "Answer the last macro definition encountered in the current parse." ^lastDefine
outputStream: aStream "Set the stream the receiver is to place all preprocessing output into. Answer the receiver." outputStream := aStream
</methods> <methods> External.CPreprocessor <category>expressions-syntax</category>
parsePrimary = [self saveReservedWords]. word=#defined (( $( variableName [self restoreReservedWords]. $) ) | variableName [self restoreReservedWords]. ) [defined:] | hashToken word $( notRightParenthesisWithPush + $) [self restoreReservedWords]. [exprAssert:value:] | [self restoreReservedWords]. variableName [exprVariable:] | number [compressNumber:] | character [:asInteger] | scanString | $( expression $)
</methods> <methods> External.CPreprocessor class <category>private</category>
computeTables: aTypeTable "Compute the cached type tables used during preprocessing. Please see the class comments for more details. Answers the receiver." | newTypeTable | newTypeTable := aTypeTable copy. newTypeTable at: Character cr asInteger put: #cr. "cr is a token within directives" DTypeTable := newTypeTable. newTypeTable := newTypeTable copy. newTypeTable at: Character cr asInteger put: #xDelimiter. "cr is whitespace in macro arguments" ATypeTable := newTypeTable
typeTable "Answer the type table for the receiver. We currently share the same type table with the superclass CScanner. If this type table has changed, recompute the cached preprocessing type tables, otherwise simply answer the old table." | aTypeTable | aTypeTable := superclass typeTable. (aTypeTable == typeTable and: [ATypeTable notNil and: [DTypeTable notNil]]) ifTrue: [^typeTable] ifFalse: [self computeTables: aTypeTable. ^typeTable := aTypeTable]
</methods> <methods> External.CPreprocessor class <category>preprocessing</category>
preprocess: stringOrStream "Preprocess the data contained in the argument. The argument can be a String object, in which case the String is preprocessed. The argument can also be a Stream, in which case the contents of the stream are preprocessed. This method uses an empty symbol environment dictionary. Use the method #preprocess:declarations: if you need to supply your own pre-declared symbols. Answers a Stream containing the preprocessed source with the stream set to the end." ^self preprocess: stringOrStream declarations: ExternalDictionary new
preprocess: stringOrStream declarations: declarationDictionary "Preprocess the data contained in the argument. The argument can be a String object, in which case the String is preprocessed. The argument can also be a Stream, in which case the contents of the stream are preprocessed. This method uses the environment dictionary indicated by the argument declarationDictionary which should be an ExternalDictionary. Use the method #preprocess: if you do not need to supply your own pre-declared symbols. Answers a Stream containing the preprocessed source with the stream set to the end." ^self preprocess: stringOrStream declarations: declarationDictionary includeDirectories: #()
preprocess: stringOrStream declarations: declarationDictionary includeDirectories: includeDirectoriesStringArray "Preprocess the data contained in the argument stringOrStream. The argument can be a String object, in which case the String is preprocessed. The argument can also be a Stream, in which case the contents of the stream are preprocessed. This method uses the environment dictionary indicated by the argument declarationDictionary which should be an ExternalDictionary. Include file directives found in the input source will be searched in the directories indicated by the argument, includeDirectoriesStringArray. It is an Array of String objects, each String specifying a directory path. Answers a Stream containing the preprocessed source with the stream set to the end." ^self new preprocess: stringOrStream declarations: declarationDictionary includeDirectories: includeDirectoriesStringArray
preprocess: stringOrStream includeDirectories: includeDirectoriesStringArray "Preprocess the data contained in the argument stringOrStream. The argument can be a String object, in which case the String is preprocessed. The argument can also be a Stream, in which case the contents of the stream are preprocessed. This method uses an empty environment dictionary. Include file directives found in the input source will be searched in the directories indicated by the argument, includeDirectoriesStringArray. It is an Array of String objects, each String specifying a directory path. Answers a Stream containing the preprocessed source with the stream set to the end." ^self preprocess: stringOrStream declarations: ExternalDictionary new includeDirectories: includeDirectoriesStringArray
</methods> <methods> Tools.CStructureInspector <category>private-menu messages</category>
inspectField ( self separatorFields includes: field ) ifTrue: [ ^self ]. " ignore double-click inspect of separator items " super inspectField
</methods> <methods> Tools.CStructureInspector <category>field list</category>
fieldIndex "Answer the offset corresponding to the currently selected field." ^self fieldList indexOf: field
fieldList "Answer a collection of the keys of the inspected dictionary." ^#( 'self' ), self basicMemberNames, (Array with: (#hyphenBytes << #dllcc >> '--bytes--') with: 'bytes' with: (#members << #dllcc >> '--members--')), self memberNames
fieldMenu "Answer a Menu of operations on variables that is to be displayed when the operate menu button is pressed." ( self separatorFields includes: field ) ifTrue: [ ^nil ]. ^super fieldMenu
fieldValue "Answer the value of the currently selected variable." field = 'self' ifTrue: [^object]. field = 'theDatum' ifTrue: [ ^self getDatum ]. field = 'type' ifTrue: [ ^self getType ]. field = 'bytes' ifTrue: [ ^self getBytes ]. ^object memberAt: field asSymbol
</methods> <methods> Tools.CStructureInspector <category>private-acessing</category>
basicMemberNames ^#( 'theDatum' 'type' )
getBytes "^object asByteArray" "####CLONED FROM ExternalStructure ####" " Observe also that this would be easier if CDatum supported polymorphic #contents protocol across local and external structures. This could use some work. " ^( object isPointer ifTrue: [ object contents ] ifFalse: [ object ] ) datum asByteArray
getDatum ^object datum
getType ^object type
memberNames ^properties at: #memberNames ifAbsentPut: [self computeMemberNames]
separatorFields ^(Array with: (#hyphenBytes << #dllcc >> '--bytes--') with: (#members << #dllcc >> '--members--'))
setBytes: aByteArray | nBytes | aByteArray class == ByteArray ifFalse: [ self error: (#mustBeAByteArray << #dllcc >> 'must be a byte array') ]. nBytes := self getBytes size. aByteArray size = nBytes ifFalse: [ self error: (#sizeMismatch << #dllcc >> 'size mismatch') ]. object isPointer ifTrue: [ object copyAt: 0 from: aByteArray size: nBytes startingAt: 1 ] ifFalse: [ object datum replaceBytesFrom: 1 to: nBytes with: aByteArray startingAt: 1 ].
</methods> <methods> Tools.CStructureInspector <category>private-operation</category>
applyValue: newValue " Private " field = 'bytes' ifTrue: [ ^self setBytes: newValue ]. field = 'theDatum' ifTrue: [ ^object datum: newValue ]. field = 'type' ifTrue: [ ^object type: newValue ]. object memberAt: field asSymbol put: newValue.
computeMemberNames | aType names | aType := object type. aType isPointer ifTrue: [ aType := aType referentType ]. names := OrderedCollection new. aType baseType keysAndValuesDo: [ :aName :anAssoc | names add: aName ]. ^names asArray
textAcceptAllowed: aController ( self separatorFields includes: field ) ifTrue: [aController view flash. ^false]. ^super textAcceptAllowed: aController
</methods> <methods> Tools.CStructureInspector <category>doIt/accept/explain</category>
acceptText: aText from: aController "Text has been changed. Store or compile the text, depending on the current mode of the receiver." | newValue | field == nil ifTrue: [ ^false ]. newValue := self evaluateText: aText string from: aController ifFail: [ ^false ]. self applyValue: newValue. self resetText. ^true
</methods> <methods> Tools.CStructureInspector <category>text</category>
text "Answer the text displayed by the receiver." ( self separatorFields includes: field ) ifTrue: [ ^Text new ]. ^super text
</methods> <methods> Tools.CCompositeTypeInspector <category>initialize-release</category>
inspect: anObject "Set anObject to be the object inspected by the receiver." super inspect: anObject. self initializeMemberInfo. self resetFields
</methods> <methods> Tools.CCompositeTypeInspector <category>private-accessing</category>
memberNames ^properties at: #memberNames ifAbsent: [self initializeMemberInfo. properties at: #memberNames]
separatorFields ^(Array with: (#members << #dllcc >> '--members--'))
</methods> <methods> Tools.CCompositeTypeInspector <category>private-menu messages</category>
inspectField ( self separatorFields includes: field ) ifTrue: [ ^self ]. " ignore double-click inspect of separator items " super inspectField
</methods> <methods> Tools.CCompositeTypeInspector <category>field list</category>
fieldIndex "Answer the offset corresponding to the currently selected field." ^(self fieldList indexOf: field) - 1
fieldList "Answer a collection of the keys of the inspected dictionary." ^#( 'self' ), object class allInstVarNames, (Array with: (#members << #dllcc >> '--members--')), self memberNames
fieldMenu "Answer a Menu of operations on variables that is to be displayed when the operate menu button is pressed." ( self separatorFields includes: field ) ifTrue: [ ^nil ]. ^super fieldMenu
fieldValue "Answer the value of the currently selected variable." ^(properties at: #memberInfoMap ifAbsent: [^super fieldValue]) at: field asSymbol ifAbsent: [super fieldValue]
</methods> <methods> Tools.CCompositeTypeInspector <category>private-operation</category>
applyValue: newValue " Private " object memberAt: field asSymbol put: newValue.
textAcceptAllowed: aController ( self separatorFields includes: field ) ifTrue: [aController view flash. ^false]. ^super textAcceptAllowed: aController
</methods> <methods> Tools.CCompositeTypeInspector <category>private-initializing</category>
initializeMemberInfo " Private - initialize the receiver's information about the type. " | memberSlotsStartIndex memberNames memberInfoMap | memberNames := properties at: #memberNames put: OrderedCollection new. memberInfoMap := properties at: #memberInfoMap put: IdentityDictionary new. " member names are symbols " memberSlotsStartIndex := 1. object keysAndValuesDo: [ :aName :anAssoc | " assoc is: <offset> -> <type> " memberNames add: aName. memberInfoMap at: aName put: ( Array with: anAssoc "with: anAssoc key" " offset " "with: anAssoc value" " type " with: ( Array with: ( object basicAt: memberSlotsStartIndex + 3 ) " member kind " with: ( object basicAt: memberSlotsStartIndex + 4 ) " member datum class " "BUG: ( object memberDatumClassAt: memberNames size )" ) ). memberSlotsStartIndex:= memberSlotsStartIndex + object slotsPerMember ]. memberNames := memberNames asArray.
</methods> <methods> Tools.CCompositeTypeInspector <category>text</category>
text "Answer the text displayed by the receiver." ( self separatorFields includes: field ) ifTrue: [ ^Text new ]. ^super text
</methods> <methods> Tools.CCompositeTypeInspector <category>doIt/accept/explain</category>
acceptText: aText from: aController "Text has been changed. Store or compile the text, depending on the current mode of the receiver." | newValue | field == nil ifTrue: [ ^false ]. ( self memberNames includes: field asSymbol ) ifTrue: [Dialog warn: (#updateMemberDefinitions << #dllcc >> 'updating member definitions not supported in this inspector'). ^false]. newValue := self evaluateText: aText string from: aController ifFail: [ ^false ]. self applyValue: newValue. self resetText. ^true
</methods> <methods> Tools.Trippy.CStructMember <category>accessing</category>
value ^object memberAt: key
value: anObject ^object memberAt: key put: anObject
</methods> <methods> External.ExternalInterfaceHolder <category>accessing</category>
defines "Answer a list of all #define externals held by the receiver." | aList | aList := SortedCollection sortBlock: [:x :y | x name <= y name]. externalDictionary ownDo: [:anExternal | ((anExternal isKindOf: CMacroDefinition) and: [anExternal numArgs isNil or: [anExternal numArgs == 0]]) ifTrue: [aList add: anExternal]]. ^List withAll: aList
enums "Answer a list of all enumeration type externals held by the receiver." | aList | aList := SortedCollection sortBlock: [:x :y | x name <= y name]. externalDictionary ownDo: [:anExternal | (anExternal isKindOf: CEnumerationType) ifTrue: [aList add: anExternal]]. ^List withAll: aList
externalDictionary "Answer the ExternalDictionary held by the receiver." ^externalDictionary
externalInterface "Answer the ExternalInterface held by the receiver." ^externalInterface
externalInterface: anExternalInterface "Set what external interface the receiver holds." externalInterface := anExternalInterface
externalsAtCategory: category "Answer a List of externals that conform to a particular category defined by the argument. The current list of categories are: #(procedures variables typedefs structs unions enums defines macros #'include files' #'include directories')." | categorySymbol | categorySymbol := category asSymbol. categorySymbol == #procedures ifTrue: [^self procedures]. categorySymbol == #variables ifTrue: [^self variables]. categorySymbol == #typedefs ifTrue: [^self typedefs]. categorySymbol == #structs ifTrue: [^self structs]. categorySymbol == #unions ifTrue: [^self unions]. categorySymbol == #enums ifTrue: [^self enums]. categorySymbol == #defines ifTrue: [^self defines]. categorySymbol == #macros ifTrue: [^self macros]. categorySymbol == #'include files' ifTrue: [^self includeFiles]. categorySymbol == #'include directories' ifTrue: [^self includeDirectories]. categorySymbol == #'library files' ifTrue: [^self libraryFiles]. categorySymbol == #'library directories' ifTrue: [^self libraryDirectories]. ^List new
includeDirectories "Answer a list of all include directories held by the receiver." ^externalInterface isNil ifTrue: [^nil] ifFalse: [^externalInterface includeDirectories]
includeFiles "Answer a list of all include files held by the receiver." ^externalInterface isNil ifTrue: [^nil] ifFalse: [^externalInterface includeFiles]
libraryDirectories "Answer a list of all library directories held by the receiver." ^externalInterface isNil ifTrue: [^nil] ifFalse: [^externalInterface libraryDirectories copy]
libraryFiles "Answer a list of all library files held by the receiver." ^externalInterface isNil ifTrue: [^nil] ifFalse: [^externalInterface libraryFiles collect: [:aFile | aFile name]]
macros "Answer a list of all #define macro externals held by the receiver." | aList | aList := SortedCollection sortBlock: [:x :y | x name <= y name]. externalDictionary ownDo: [:anExternal | ((anExternal isKindOf: CMacroDefinition) and: [anExternal numArgs notNil and: [anExternal numArgs > 0]]) ifTrue: [aList add: anExternal]]. ^List withAll: aList
procedures "Answer a list of all procedure externals held by the receiver. If the receiver holds onto an optimized interface, scan the interface's methods to extract the procedure prototype from the source code -- answer a String as opposed to a procedure external in this case." | aList | aList := SortedCollection sortBlock: [:x :y | (x isCharacters ifTrue: [x] ifFalse: [x name]) <= (y isCharacters ifTrue: [y] ifFalse: [y name])]. externalDictionary ownDo: [:anExternal | (anExternal isKindOf: ExternalProcedure) ifTrue: [aList add: anExternal]]. (externalInterface notNil and: [ externalInterface externals == externalDictionary and: [ externalInterface optimizationLevel == #full]]) ifTrue: [ externalInterface selectorsAndMethodsDo: [:selector :method | | source range | ((method isKindOf: ExternalMethod) and: [method primitiveNumber notNil]) ifTrue: [ source := externalInterface sourceCodeForMethod: method at: selector. range := source findString: '*<C:*>' startingAt: 1 ignoreCase: false useWildcards: true. (range first = 0 and: [range last = 0]) ifFalse: [| prototype index length | prototype := ((source copyFrom: range first + 3 to: range last - 1) copyWithout: Character tab) copyWithout: Character cr. length := prototype size. index := 1. [index <= length and: [(prototype at: index) isSeparator]] whileTrue: [index := index + 1]. aList add: (prototype copyFrom: index to: length)]]]]. ^List withAll: aList
structs "Answer a list of all structure type externals held by the receiver." | aList | aList := SortedCollection sortBlock: [:x :y | x name <= y name]. externalDictionary ownDo: [:anExternal | ((anExternal isKindOf: CCompositeType) and: [anExternal isStructure]) ifTrue: [aList add: anExternal]]. ^List withAll: aList
typedefs "Answer a list of all typedef type externals held by the receiver." | aList | aList := SortedCollection sortBlock: [:x :y | x name <= y name]. externalDictionary ownDo: [:anExternal | (anExternal isKindOf: CTypedefType) ifTrue: [aList add: anExternal]]. ^List withAll: aList
unions "Answer a list of all union type externals held by the receiver." | aList | aList := SortedCollection sortBlock: [:x :y | x name <= y name]. externalDictionary ownDo: [:anExternal | ((anExternal isKindOf: CCompositeType) and: [anExternal isUnion]) ifTrue: [aList add: anExternal]]. ^List withAll: aList
variables "Answer a list of all variable externals held by the receiver." | aList | aList := SortedCollection sortBlock: [:x :y | x name <= y name]. externalDictionary ownDo: [:anExternal | (anExternal isKindOf: ExternalVariable) ifTrue: [aList add: anExternal]]. ^List withAll: aList
</methods> <methods> External.ExternalInterfaceHolder <category>initialize-release</category>
on: anExternalInterface "Initialize the receiver to hold the argument. If the argument is an interface class, initialize the receiver's external dictionary based on the argument's external dictionary. If the argument is an external dictionary, simply remember that dictionary but do not disturb the interface class." (anExternalInterface isKindOf: ExternalInterface class) ifTrue: [externalInterface := anExternalInterface. externalDictionary := externalInterface externals. ^self]. (anExternalInterface isKindOf: ExternalDictionary) ifTrue: [externalDictionary := anExternalInterface. ^self]. ^self error: (#canOnlyHoldExternals << #dllcc >> '<1p> can only hold ExternalInterface or ExternalDictionary objects' expandMacrosWith: self class).
</methods> <methods> External.ExternalInterfaceHolder class <category>instance creation</category>
on: anExternalDictionary "Answer a new instance of the receiver holding onto the argument." ^self new on: anExternalDictionary
</methods> <methods> External.CDeclarationParser <category>declarations-syntax</category>
Cfile = "Parse an entire C file." declaration*!
compoundTypeOnStack "Answer true if there is a compound C type on the stack, otherwise answer false. We allow allow structs, unions and enums to appear. In addition, the compound type may appear without a name. Clients should be prepared to handle these nameless objects." "We reference the C compound type class directly rather than adding a new method (isCompoundType) to the CType hierarchy." ^stack last isKindOf: CCompoundType
declaration = "Parse a single declaration." (typedef | @typeStorageSpec declList [declare:list:]).
declList = (initDecl \ $, | . compoundTypeOnStack [#()]) $;
initDecl = [Array] declaratorWithName (initializer | [nil]) [:with:with:with:]
initializer = "If the top object on the stack is a BlockClosure that creates a procedure type, parse an initializer as an inline function definition. The inline function defintion has the form: <procedureDeclaration> ::= <returnType> <procedureName> (<arguments>) = { <number>* } | <number> Otherwise, skip the initializer list (we do not support aggregate initialization)." [self isPossibleInlineProcedure] ? (#= (${ (number \ $,) $} | number) | [nil]) | #= (${ skipList $} | expression.) [nil]
singleTypedef = #typedef ( @ specifierQualifier initTypeDecl [defineType:declarator:] | @ emptyType initTypeDecl [defineType:declarator:] | [CIntegerType int] initTypeDecl [defineType:declarator:])
skipList = "Skip over an arbitrary list of tokens enclosed in (balanced) {}s. We have already read the initial {." ( ${ skipList $} | notRightBrace )*!
storageSpec = #auto [#auto] | #static [#static] | #extern [#extern] | #register [#register]
typedef = "Push a CTypedefType object onto the stack if a typedef declaration appears next in the input stream and answer true, otherwise answer false." #typedef (specifierQualifier | [CIntegerType int]) typeDeclList [defineType:list:]
typeStorageSpec = specifierQualifier (storageSpec . | ) | storageSpec . (specifierQualifier | [CIntegerType int]) | [CIntegerType int]
</methods> <methods> External.CDeclarationParser <category>method-syntax</category>
closeBracket token == #> ifTrue: [source position: mark. ^true]. ^false
defineOrSingleDeclaration = (singleTypedef | (@ word #= | [nil]) (typeStorageSpec (@initDecl [declare:declarator:] | compoundTypeOnStack)) [:->] ) closeBracket
singleDeclaration = typeStorageSpec (@ initDecl [declare:declarator:] |)
</methods> <methods> External.CDeclarationParser <category>declarations-actions</category>
declare: aType declarator: aDeclarator "Declare a new ExternalObject from the base type, aType. Register the new type in the declarations dictionary. The argument, aDeclarator, is an array of three elements. The first element is a String or Symbol indicating the name of the type and it will be used to key the new type into the declarations dictionary. The second element is a BlockClosure accepting one argument that will construct the new type based on the the base type, aType. The third element is the type's initializer. Answer the new external." | key type external | key := aDeclarator at: 1. type := (aDeclarator at: 2) value: aType. key isNil ifTrue: [^type]. key := key asSymbol. external := type external: key. external initializer: (aDeclarator at: 3). ^declarations declareAt: key put: external
declare: aType list: declList "Answer a collection of associations. Each association's key is the name of the declaration. Each association's value is another association whose key is the declaration's type and whose value is an optional initializer. The initializer is type specific. Examples include an Integer or Integer Array for inline code procedure types and nil for most other types. A side effect of this method is to add each declaration into the receiver's declarations dictionary." | list | list := self embedInitializerType: aType inList: declList. list do: [:nameAndTypeAndInitializer | | name type initializer external | name := nameAndTypeAndInitializer key. type := nameAndTypeAndInitializer value key. initializer := nameAndTypeAndInitializer value value. name notNil ifTrue: [name := name asSymbol. (external := type external: name) notNil ifTrue: [external initializer: initializer. declarations declareAt: name put: external]]]. ^list
defineType: aType declarator: declarator "A typedef declaration was parsed. The argument aType is the base type of the type declaration. The argument declarator is an array of two elements. The first element is a String or Symbol indicating the name of the typedef; the second element is a BlockClosure accepting one argument that is used to build the type from the base type, aType. Answer a new typedef type built from the elements in declarator." | key type external | key := declarator at: 1. key isNil ifTrue: [^aType]. key := key asSymbol. type := (declarator at: 2) value: aType. external := CTypedefType new name: key; type: type. ^declarations declareAt: key put: external
defineType: aType list: declList "A type declaration was parsed. The argument aType is the base type of the type declaration and declList is a list of objects defined to be the type aType. Answer a list of associations whose key is the type name and whose value is the object's type." | list key type external | list := self embedType: aType inList: declList. list do: [:nameType | nameType key notNil ifTrue: [key := nameType key asSymbol. type := nameType value. external := CTypedefType new name: key; type: type. declarations declareAt: key put: external]]. ^list
isPossibleInlineProcedure "Answer true if the top stack object is a BlockClosure that creates a procedure type. We need to check this in order that inline procedure initialization code is parsed only when defining a procedure." ^([stack last value: CIntegerType int] on: Object errorSignal do: [:ex | nil]) isKindOf: CProcedureType
notRightBrace "Consume tokens until a right brace is encountered." ^(token == $} or: [token == nil]) ifTrue: [false] ifFalse: [self scanToken. true]
</methods> <methods> External.CDeclarationParser <category>types-syntax</category>
initTypeDecl = [Array] typeDeclaratorWithName (initializer | [nil]) [:with:with:with:]
typeDeclarand tokenType == #word ifFalse: [^false]. stack addLast: token. self scanToken. ^true
typeDeclarator = "Leaves name and type constructor block on stack" typeDeclWithName | @ [nil] [self emptyBlock] declMod*!
typeDeclaratorWithName = "Leaves name and type constructor block on the stack." typeDeclWithName | "No name, must have declMod." @ [nil] [self emptyBlock] declMod declMod*!
typeDeclList = "Parse a type declaration list and place the declarations on the stack. Answer true if the declaration was parsed, otherwise answer false." (initTypeDecl \ $, | . compoundTypeOnStack [#()]) $;
typeDeclWithName = "Leaves name and type constructor block on the stack." @((#'_pointer' [#bePointer]) | [nil]) (platformSpecifiers | [nil]) #* typeQualifier typeDeclarator [embedPointer:platformQualifiers:qualifiers:ofName:typeBlock:] | @(platformSpecifiers | [nil]) typeDeclarand [self emptyBlock] declMod*! [embedDeclarand:ofName:typeBlock:] | "Following must use @ in case the next thing is actually a procedure argument list" @ $( typeDeclarator $) declMod*!
</methods> <methods> External.CDeclarationParser <category>types-actions</category>
embedInitializerType: baseType inList: declList "Answer a collection of associations. Each association's key is the name of the declaration. Each association's value is another association whose key is the declaration's type and whose value is an optional initializer. The initializer is type specific. Examples include an Integer or Integer Array for inline code procedure types and nil for most other types." ^declList collect: [:decl3 | "name, type block, initializer" (decl3 at: 1) -> ((decl3 at: 2) isNil ifTrue: [baseType -> (decl3 at: 3)] ifFalse: [((decl3 at: 2) value: baseType) -> (decl3 at: 3)])]
</methods> <methods> External.ExternalProcedure <category>code generating</category>
callStreamArgs: argNames assign: assignee interface: aClass "Answer a stream containing expressions used to evaluate the receiver within the interface aClass." aClass isVirtual ifTrue: [virtuals := #()]. self owner: aClass. ^aClass procedureCallStream: self args: argNames assign: assignee
methodClassIn: anInterfaceClass "Answer the class used to create methods when compiling the receiver in the given class." ^anInterfaceClass externalMethodClass
</methods> <methods> External.ExternalObject <category>code generating</category>
methodClassIn: anInterfaceClass "Answer the class used to create methods when compiling the receiver in the given class." ^CompiledMethod
</methods> <methods> External.ExternalObject <category>compiling</category>
notifyCompilationOfTypeDefinition ^self
</methods> <methods> External.ExternalInterface class <category>compiling</category>
compile: code notifying: requestor attributes: attributes selectorBlock: selBlock ifFail: failBlock | needsRecompilation answer | needsRecompilation := false. answer := [ super compile: code notifying: requestor attributes: attributes selectorBlock: selBlock ifFail: failBlock ] on: ExternalInterfaceTypeDefinitionCompiled do: [:ex | needsRecompilation := true. ex resume ]. needsRecompilation ifTrue: [self recompileAfterTypeDefinitionCompiled]. ^answer
</methods> <methods> External.ExternalInterface class <category>private-code generating</category>
errorCodeVariableName "Answer a string that represents the name of the error code variable used when generating interface methods." ^'_errorCode'
</methods> <methods> External.ExternalInterface class <category>public develop</category>
generateMethodsFrom: newExternals "Generate an accessing method for each new external object whose name matches the name of a current external object" self updateExternalsWith: newExternals. self externals do: [:ext | (ext isKindOf: ExternalObject) ifTrue: [ext owner: self]]. self generateMethods
</methods> <methods> External.ExternalInterface class <category>private-code generating</category>
macroCallStream: macro args: args assign: assignee "Answer a stream containing expressions used to evaluate the receiver within the interface aClass." | callStream numArgs macroNumArgs | numArgs := args size. (macroNumArgs := macro numArgs) == nil ifTrue: [macroNumArgs := 0]. numArgs ~= macroNumArgs ifTrue: [self error: 'wrong number of arguments']. callStream := ReadWriteStream on: String new. numArgs = 0 ifTrue: [[macro valueIn: self tempExternals args: nil] on: Object errorSignal do: [:ex | ]. ^callStream nextPutAll: '^', macro name, ' value'; reset]. callStream nextPutAll: '| __args | __args := Array new: ', numArgs printString, '. '. 1 to: numArgs do: [:i | callStream nextPutAll: '__args at: ', i printString, ' put: ', (args at: i), '. ']. callStream nextPutAll: '^[', macro name, ' valueIn: self externals args: __args] on: Object errorSignal do: [:ex| ex return: ex]'. ^callStream reset
methodPrimitiveCallNumber "Answer the primitive number used to compile fully optimized external procedure methods." ^self externalMethodClass methodPrimitiveCallNumber
</methods> <methods> External.ExternalInterface class <category>binary storage</category>
parcelClasses: aClassCollection toParcel: aParcel "Add the classes in aClassCollection to aParcel. Use the current interface version identifier as the Parcel's version." "| parcel | parcel := Parcel name: 'SomeName'. SomeInterfaceClass parcelClasses: SomeInterfaceClass withAllSubclasses toParcel: parcel. parcel saveParcelDialogFor: nil" aClassCollection do: [:aClass | (aClass isKindOf: ExternalInterface class) ifTrue: [aClass flushAllCaches]]. aClassCollection do: [:aClass| aParcel addClassAndAllSelectors: aClass]. aParcel propertyAt: #version put: self version
</methods> <methods> External.ExternalInterface class <category>private-code generating</category>
procedureAtomicCallStream: procedure args: argNames "Answer a stream containing expressions for optimized invocation of an external procedure within the receiver." | nrArgs type | type := procedure type. nrArgs := type argumentTypes size. (type argumentNames size ~= nrArgs and: [argNames size ~= nrArgs]) ifTrue: [self error: 'wrong number of arguments']. ^ReadStream on: '<primitive: ', self methodPrimitiveCallNumber printString, ' errorCode: ', self errorCodeVariableName, '>'
procedureCallStream: procedure args: argNames assign: assignee "Answer a stream containing expressions used to invoke the external function <procedure> within the receiver. " ((procedure type isVarArg and: [argNames size > 0]) or: [assignee notNil or: [procedure type argumentNames notNil and: [argNames ~= procedure type argumentNames]]]) ifTrue: [^self procedureComplexCallStream: procedure args: argNames assign: assignee] ifFalse: [self optimizationLevel = self fullOptimizationLevel ifTrue: [^self procedureAtomicCallStream: procedure args: argNames] ifFalse: [^self procedureComplexCallStream: procedure args: argNames assign: assignee]]
procedureComplexCallStream: procedure args: argNames assign: assignee "Answer a stream containing expressions for debug-mode invocation of an external procedure within the receiver." | callStream nrArgs args type errorCodeName | type := procedure type. nrArgs := type isVarArg ifTrue: [argNames size min: 1] ifFalse: [type argumentTypes size]. type argumentNames size = nrArgs ifTrue: [args := type argumentNames] ifFalse: [argNames size ~= nrArgs ifTrue: [self error: 'wrong number of arguments']. args := argNames]. callStream := ReadWriteStream on: String new. callStream nextPutAll: '| '; nextPutAll: (errorCodeName := self errorCodeVariableName); nextPutAll: ' | self '; nextPutAll: #externalAccessFailedSignal; cr; nextPutAll: 'handle: [:ex | '; nextPutAll: errorCodeName; nextPutAll: ' := ex parameter. ex returnWith: '; nextPutAll: errorCodeName; nextPutAll: '] do: ['. type isVarArg ifTrue: [callStream nextPut: $^. assignee isNil ifTrue: [callStream nextPut: $(] ifFalse: [callStream nextPutAll: assignee; nextPutAll: ' := (']. callStream nextPutAll: procedure name; nextPutAll: ') callFrom: self withArguments:'; nextPutAll: (argNames size = 1 ifTrue: [(argNames at: 1)] ifFalse: ['#()']); nextPutAll: ']. '] ifFalse: [callStream nextPutAll: ' | __args | __args := Array new: '; print: nrArgs; nextPutAll: '. '. 1 to: nrArgs do: [:i | callStream nextPutAll: '__args at: '; print: i; nextPutAll: ' put: '; nextPutAll: ((args at: i) isEmpty ifTrue: [argNames at: i] ifFalse: [args at: i]); nextPutAll: '. ']. callStream nextPut: $^. assignee isNil ifTrue: [callStream nextPut: $(] ifFalse: [callStream nextPutAll: assignee; nextPutAll: ' := (']. callStream nextPutAll: procedure name; nextPutAll: ') callFrom: self withArguments: __args]. ']. ^callStream reset
</methods> <methods> External.ExternalInterface class <category>compiling</category>
recompileAfterTypeDefinitionCompiled "Detection of dependencies on type definitions requires parsing the C pragma. Simply recompile everything thus avoiding the need to spend energies determining what to compile and what to leave alone" self withAllSubclasses do: [:each | each recompileMethods]
</methods> <methods> External.ExternalInterface class <category>public develop</category>
regenerateMethods "Parse my includeFiles, then regenerate my current accessing methods." | newExternals | "Parse includeFiles" newExternals := self externals: self newExternals includeFiles: includeFiles includeDirectories: includeDirectories. ObjectMemory garbageCollect. "To finalize externals of removed methods" self generateMethodsFrom: newExternals
</methods> <methods> External.ExternalInterface class <category>generating methods</category>
tempExternals | tempExternals | tempExternals := ExternalDictionary new addBackup: self externals. self allSharedPools do: [:pool | (pool isKindOf: ExternalDictionary) ifTrue: [tempExternals addBackup: pool]]. ^tempExternals
</methods> <methods> External.ExternalInterface class <category>private-code generating</category>
typeCallStream: type args: argNames assign: assignee "Answer a stream containing expressions used to evaluate the receiver within the interface aClass." "This method should actually only be used with type arguments that are instances of CType subclasses that maintain a notion of a 'name'. For now we provide a default implementation of 'name' in CType to answer nil (which results in an error)." | callStream | argNames isEmpty ifFalse: [self error: 'wrong number of arguments']. type name isNil ifTrue: [self error: 'Unnamed types not supported']. callStream := ReadWriteStream on: String new. callStream nextPutAll: '^', type name. ^callStream reset
</methods> <methods> External.ExternalInterface class <category>generating methods</category>
updateExternalsWith: newExternals "Modify the receiver's external dictionary with elements from the argument, newExternals. Answer the receiver." | myExternals selections | myExternals := self externals. selections := IdentitySet new. newExternals ownKeysAndValuesDo: [:key :ext | (myExternals ownDetect: [:myExt | myExt name = ext name] ifNone: [nil]) notNil ifTrue: [selections add: ext. "Also add types, that ext transitively depends on" (ext respondsTo: #type) ifTrue: [selections addAll: ext type namedTypes]]]. selections do: [:sel | myExternals installAt: sel name asSymbol put: sel]
</methods> <methods> External.ExternalInterface class <category>private-code generating</category>
variableCallStream: variable args: argNames assign: assignee "Answer a stream containing expressions used to evaluate the receiver within the interface aClass." | callStream | argNames size > 1 ifTrue: [self error: 'wrong number of arguments']. callStream := ReadWriteStream on: String new. callStream nextPut: $^. assignee isNil ifFalse: [callStream nextPutAll: assignee; nextPutAll: ' := ']. callStream nextPut: $(; nextPutAll: variable accessString; nextPutAll: ') contents'. argNames size = 1 ifTrue: [callStream nextPutAll: ': '; nextPutAll: argNames first]. ^callStream reset
</methods> <methods> Core.UndefinedObject <category>compiling</category>
notifyCompilationOfTypeDefinition ^self
</methods> <methods> External.CType <category>code generating</category>
callStreamArgs: argNames assign: assignee interface: aClass "Answer a stream containing expressions used to evaluate the receiver within the interface aClass." ^aClass typeCallStream: self args: argNames assign: assignee
methodClassIn: targetClass "Answer the class used to create methods of the receiver's type." ^CompiledMethod
</methods> <methods> External.CType <category>compiling</category>
notifyCompilationOfTypeDefinition ^ExternalInterfaceTypeDefinitionCompiled raiseRequest
</methods> <methods> External.ExternalMethod class <category>private-code generating</category>
methodPrimitiveCallNumber "Answer the primitive number used to compile fully optimized external methods." ^395
</methods> <methods> External.ExternalMethod <category>initialize-release</category>
for: anExternalAssociation selector: aSelector "Initialize the receiver to be a method for the given external and the given method selector. Answer the receiver." self for: anExternalAssociation. methodSelector := aSelector. ^self
</methods> <methods> External.CCompoundType <category>user interface</category>
inspectorClass ^CCompositeTypeInspector
inspectorClasses ^Array with: Tools.Trippy.CStructureTypeInspector with: Tools.Trippy.BasicInspector
</methods> <methods> External.CEnumerationType <category>user interface</category>
inspectorClasses ^Array with: Tools.Trippy.CEnumerationTypeInspector with: Tools.Trippy.BasicInspector
</methods> <methods> External.CCompositePointer <category>user interface</category>
inspectorClass ^CStructureInspector
inspectorClasses ^Array with: Tools.Trippy.CStructureInspector with: Tools.Trippy.BasicInspector
inspectorExtraAttributes ^Array with: (Tools.Trippy.DerivedAttribute label: (#bytes << #dllcc >> 'bytes') valueBlock: [self contents datum asByteArray])
</methods> <methods> External.CMacroDefinition <category>code generating</category>
callStreamArgs: args assign: assignee interface: aClass "Answer a stream containing expressions used to evaluate the receiver within the interface aClass." ^aClass macroCallStream: self args: args assign: assignee
methodClassIn: targetClass "Answer the class used to create methods of the receiver's type." ^CompiledMethod
</methods> <methods> External.CMacroDefinition <category>compiling</category>
notifyCompilationOfTypeDefinition ^self
</methods> <methods> External.ExternalVariable <category>code generating</category>
accessString "Answer a String that is used to access the receiver in a compiled method." ^self isVirtual ifTrue: [name, ' asPointer: self class'] ifFalse: [name]
callStreamArgs: argNames assign: assignee interface: aClass "Answer a stream containing expressions used to evaluate the receiver within the interface aClass." aClass isVirtual ifTrue: [virtuals := #()]. self owner: aClass. ^aClass variableCallStream: self args: argNames assign: assignee
</methods> <methods> External.CComposite <category>user interface</category>
inspectorClass ^CStructureInspector
inspectorClasses ^Array with: Tools.Trippy.CStructureInspector with: Tools.Trippy.BasicInspector
inspectorExtraAttributes ^Array with: (Tools.Trippy.DerivedAttribute label: (#bytes << #dllcc >> 'bytes') valueBlock: [self datum asByteArray])
</methods> <methods> Tools.ExternalInterfaceBuilder class <category>interface specs</category>
externalMultiSelectionSubCanvas "UIPainter new openOnClass: self andSelector: #externalMultiSelectionSubCanvas" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{Kernel.UserMessage} #key: #UnlabeledCanvas #defaultString: 'Unlabeled Canvas' #catalogID: #dllcc) #min: #(#Point 50 50 ) #bounds: #(#Rectangle 251 196 451 396 ) ) #component: #(#SpecCollection #collection: #(#(#SequenceViewSpec #layout: #(#LayoutFrame 0 0 0 0 0 1 0 1 ) #name: #ExternalMultiSelectionList #flags: 15 #model: #externalMultiSelectionList #multipleSelections: true ) ) ) )
externalSingleSelectionSubCanvas "UIPainter new openOnClass: self andSelector: #externalSingleSelectionSubCanvas" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#{Kernel.UserMessage} #key: #UnlabeledCanvas #defaultString: 'Unlabeled Canvas' #catalogID: #dllcc) #min: #(#Point 50 50 ) #bounds: #(#Rectangle 243 192 443 392 ) ) #component: #(#SpecCollection #collection: #(#(#SequenceViewSpec #layout: #(#LayoutFrame 0 0 0 0 0 1 0 1 ) #name: #ExternalSingleSelectionList #flags: 15 #model: #externalSingleSelectionList ) ) ) )
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: #(#UserMessage #key: #builderLabel #defaultString: 'External Interface Builder' #catalogID: #dllcc) #min: #(#Point 20 20 ) #bounds: #(#Rectangle 475 163 987 434 ) #flags: 4 #menu: #menuBar ) #component: #(#SpecCollection #collection: #( #(#SequenceViewSpec #layout: #(#LayoutFrame 4 0 28 0 -2 0.333333 -40 1 ) #model: #categoryList ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 26 0 0 1 ) #label: #(#UserMessage #key: #Category #defaultString: 'Category' #catalogID: #dllcc) ) #(#LabelSpec #layout: #(#AlignmentOrigin 6 0.333333 26 0 0 1 ) #name: #ExternalListLabel #label: #(#UserMessage #key: #Externals #defaultString: 'Externals' #catalogID: #dllcc) ) #(#SubCanvasSpec #layout: #(#LayoutFrame 2 0.333333 28 0 -4 1 -40 1 ) #name: #ExternalSubCanvas #flags: 0 #majorKey: #ExternalInterfaceBuilder #minorKey: #externalSingleSelectionSubCanvas ) #(#ActionButtonSpec #layout: #(#LayoutFrame 2 0 -35 1 -1 0.23 -5 1 ) #name: #parseButton #model: #parse #label: #(#UserMessage #key: #ParseFiles #defaultString: 'Parse Files' #catalogID: #dllcc) #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 1 0.23 -35 1 -1 0.48 -5 1 ) #name: #addMethodsButton #model: #addMethods #label: #(#UserMessage #key: #AddMethods #defaultString: 'Add Methods' #catalogID: #dllcc) #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 1 0.48 -35 1 -1 0.72 -5 1 ) #name: #defineButton #model: #defineClass #label: #(#UserMessage #key: #DefineClass #defaultString: 'Define Class' #catalogID: #dllcc) #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 1 0.72 -35 1 -1 0.83 -5 1 ) #name: #addButton #model: #add #label: #(#UserMessage #key: #Add #defaultString: 'Add' #catalogID: #dllcc) #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 1 0.83 -35 1 -3 1 -5 1 ) #name: #removeButton #model: #remove #label: #(#UserMessage #key: #Remove #defaultString: 'Remove' #catalogID: #dllcc) #defaultable: true ) ) ) )
</methods> <methods> Tools.ExternalInterfaceFinder class <category>interface specs</category>
defineMethodCreationDialog "UIPainter new openOnClass: self andSelector: #defineMethodCreationDialog" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: ' ' #min: #(#Point 288 134 ) #max: #(#Point 640 134 ) #bounds: #(#Rectangle 771 376 1080 510 ) ) #component: #(#SpecCollection #collection: #( #(#LabelSpec #layout: #(#AlignmentOrigin 0 0.5 3 0 0.5 0 ) #label: #(#{Kernel.UserMessage} #key: #NewDefine #defaultString: 'New Define' #catalogID: #dllcc) ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 54 0 0 1 ) #label: #(#{Kernel.UserMessage} #key: #Name #defaultString: 'Name:' #catalogID: #dllcc) ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 83 0 0 1 ) #name: #typeLabel #label: #(#{Kernel.UserMessage} #key: #Value #defaultString: 'Value:' #catalogID: #dllcc) ) #(#InputFieldSpec #layout: #(#LayoutFrame 74 0 32 0 -10 1 56 0 ) #name: #externalNameField #model: #externalName #type: #string ) #(#InputFieldSpec #layout: #(#LayoutFrame 74 0 61 0 -10 1 85 0 ) #model: #macroValue #type: #string ) #(#ActionButtonSpec #layout: #(#LayoutFrame -136 0.5 -35 1 -70 0.5 -5 1 ) #model: #doOK #label: #(#{Kernel.UserMessage} #key: #OK #defaultString: 'OK' #catalogID: #dllcc) #isDefault: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -62 0.5 -35 1 62 0.5 -5 1 ) #model: #doBrowse #label: #(#{Kernel.UserMessage} #key: #OK_Browse #defaultString: 'OK & Browse' #catalogID: #dllcc) #isDefault: false #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 70 0.5 -35 1 136 0.5 -5 1 ) #model: #doAbort #label: #(#{Kernel.UserMessage} #key: #Cancel #defaultString: 'Cancel' #catalogID: #dllcc) #isDefault: false #defaultable: true ) ) ) )
macroMethodCreationDialog "UIPainter new openOnClass: self andSelector: #macroMethodCreationDialog" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: ' ' #min: #(#Point 282 134 ) #max: #(#Point 640 134 ) #bounds: #(#Rectangle 330 393 640 527 ) ) #component: #(#SpecCollection #collection: #( #(#LabelSpec #layout: #(#AlignmentOrigin 0 0.5 3 0 0.5 0 ) #label: #(#{Kernel.UserMessage} #key: #NewMacro #defaultString: 'New Macro' #catalogID: #dllcc) ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 54 0 0 1 ) #label: #(#{Kernel.UserMessage} #key: #Name #defaultString: 'Name:' #catalogID: #dllcc) ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 83 0 0 1 ) #name: #typeLabel #label: #(#{Kernel.UserMessage} #key: #Value #defaultString: 'Value:' #catalogID: #dllcc) ) #(#InputFieldSpec #layout: #(#LayoutFrame 74 0 32 0 -10 1 56 0 ) #name: #externalNameField #model: #externalName #type: #string ) #(#InputFieldSpec #layout: #(#LayoutFrame 74 0 61 0 -10 1 85 0 ) #model: #macroValue #type: #string ) #(#ActionButtonSpec #layout: #(#LayoutFrame -136 0.5 -35 1 -70 0.5 -5 1 ) #model: #doOK #label: #(#{Kernel.UserMessage} #key: #OK #defaultString: 'OK' #catalogID: #dllcc) #isDefault: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -62 0.5 -35 1 62 0.5 -5 1 ) #model: #doBrowse #label: #(#{Kernel.UserMessage} #key: #OK_Browse #defaultString: 'OK & Browse' #catalogID: #dllcc) #isDefault: false #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 70 0.5 -35 1 136 0.5 -5 1 ) #model: #doAbort #label: #(#{Kernel.UserMessage} #key: #Cancel #defaultString: 'Cancel' #catalogID: #dllcc) #isDefault: false #defaultable: true ) ) ) )
procMethodCreationDialog "UIPainter new openOnClass: self andSelector: #procMethodCreationDialog" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: ' ' #min: #(#Point 20 20 ) #bounds: #(#Rectangle 532 237 850 539 ) ) #component: #(#SpecCollection #collection: #( #(#GroupBoxSpec #layout: #(#LayoutFrame 10 0 86 0 -10 1 -79 1 ) #label: #(#{Kernel.UserMessage} #key: #ArgumentTypes #defaultString: 'Argument Types: ' #catalogID: #dllcc) ) #(#LabelSpec #layout: #(#AlignmentOrigin 0 0.5 3 0 0.5 0 ) #label: #(#{Kernel.UserMessage} #key: #NewProcedure #defaultString: 'New Procedure' #catalogID: #dllcc) ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 58 0 0 1 ) #label: #(#{Kernel.UserMessage} #key: #Name #defaultString: 'Name:' #catalogID: #dllcc) ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 86 0 0 1 ) #name: #typeLabel #label: #(#{Kernel.UserMessage} #key: #ReturnType #defaultString: 'Return Type:' #catalogID: #dllcc) ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 -46 1 0 1 ) #label: #(#{Kernel.UserMessage} #key: #CallingConvention #defaultString: 'Calling convention:' #catalogID: #dllcc) ) #(#InputFieldSpec #layout: #(#LayoutFrame 74 0 32 0 -10 1 56 0 ) #name: #externalNameField #model: #externalName #type: #string ) #(#ComboBoxSpec #layout: #(#LayoutFrame 147 0 60 0 -10 1 84 0 ) #name: #returnTypeField #model: #returnTypeString #isReadOnly: false #comboList: #typeMenu ) #(#SequenceViewSpec #layout: #(#LayoutFrame 20 0 114 0 -15 0.5 -89 1 ) #model: #argumentNamesList ) #(#ComboBoxSpec #layout: #(#LayoutFrame -5 0.5 114 0 -18 1 138 0 ) #name: #argumentTypeField #model: #argumentTypeString #isReadOnly: false #comboList: #typeMenu ) #(#ComboBoxSpec #layout: #(#LayoutFrame 186 0 -72 1 -10 1 -48 1 ) #model: #callingConvention #comboList: #callingConventionMenu ) #(#ActionButtonSpec #layout: #(#LayoutFrame -136 0.5 -35 1 -70 0.5 -5 1 ) #model: #doOK #label: #(#{Kernel.UserMessage} #key: #OK #defaultString: 'OK' #catalogID: #dllcc) #isDefault: true #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -62 0.5 -35 1 62 0.5 -5 1 ) #model: #doBrowse #label: #(#{Kernel.UserMessage} #key: #OK_Browse #defaultString: 'OK & Browse' #catalogID: #dllcc) #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 70 0.5 -35 1 136 0.5 -5 1 ) #model: #doAbort #label: #(#{Kernel.UserMessage} #key: #Cancel #defaultString: 'Cancel' #catalogID: #dllcc) #defaultable: true ) ) ) )
typedefMethodCreationDialog "UIPainter new openOnClass: self andSelector: #typedefMethodCreationDialog" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: ' ' #min: #(#Point 279 135 ) #max: #(#Point 640 135 ) #bounds: #(#Rectangle 20 244 328 379 ) ) #component: #(#SpecCollection #collection: #( #(#LabelSpec #layout: #(#LayoutOrigin 107 0 0 0 ) #label: #(#{Kernel.UserMessage} #key: #NewTypedef #defaultString: 'New Typedef' #catalogID: #dllcc) ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 59 0 0 1 ) #label: #(#{Kernel.UserMessage} #key: #Name #defaultString: 'Name:' #catalogID: #dllcc) ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 87 0 0 1 ) #name: #typeLabel #label: #(#{Kernel.UserMessage} #key: #Type #defaultString: 'Type:' #catalogID: #dllcc) ) #(#InputFieldSpec #layout: #(#LayoutFrame 74 0 32 0 -10 1 57 0 ) #name: #externalNameField #model: #externalName #type: #string ) #(#ComboBoxSpec #layout: #(#Rectangle 74 61 224 85 ) #name: #typeField #model: #typeString #isReadOnly: false #comboList: #typeMenu ) #(#ActionButtonSpec #layout: #(#LayoutFrame -136 0.5 -35 1 -70 0.5 -5 1 ) #model: #doOK #label: #(#{Kernel.UserMessage} #key: #OK #defaultString: 'OK' #catalogID: #dllcc) #isDefault: true #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -62 0.5 -35 1 62 0.5 -5 1 ) #model: #doBrowse #label: #(#{Kernel.UserMessage} #key: #OK_Browse #defaultString: 'OK & Browse' #catalogID: #dllcc) #isDefault: false #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 70 0.5 -35 1 136 0.5 -5 1 ) #model: #doAbort #label: #(#{Kernel.UserMessage} #key: #Cancel #defaultString: 'Cancel' #catalogID: #dllcc) #isDefault: false #defaultable: true ) ) ) )
varMethodCreationDialog "UIPainter new openOnClass: self andSelector: #varMethodCreationDialog" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: ' ' #min: #(#Point 273 134 ) #max: #(#Point 640 134 ) #bounds: #(#Rectangle 25 431 332 565 ) ) #component: #(#SpecCollection #collection: #( #(#LabelSpec #layout: #(#Point 107 0 ) #label: #(#{Kernel.UserMessage} #key: #NewVariable #defaultString: 'New Variable' #catalogID: #dllcc) ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 59 0 0 1 ) #label: #(#{Kernel.UserMessage} #key: #Name #defaultString: 'Name:' #catalogID: #dllcc) ) #(#LabelSpec #layout: #(#AlignmentOrigin 10 0 87 0 0 1 ) #name: #typeLabel #label: #(#{Kernel.UserMessage} #key: #Type #defaultString: 'Type:' #catalogID: #dllcc) ) #(#InputFieldSpec #layout: #(#LayoutFrame 74 0 32 0 -10 1 57 0 ) #name: #externalNameField #model: #externalName #type: #string ) #(#ComboBoxSpec #layout: #(#Rectangle 74 61 224 85 ) #name: #typeField #model: #typeString #isReadOnly: false #comboList: #typeMenu ) #(#ActionButtonSpec #layout: #(#LayoutFrame -136 0.5 -35 1 -70 0.5 -5 1 ) #model: #doOK #label: #(#{Kernel.UserMessage} #key: #OK #defaultString: 'OK' #catalogID: #dllcc) #isDefault: true #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -62 0.5 -35 1 62 0.5 -5 1 ) #model: #doBrowse #label: #(#{Kernel.UserMessage} #key: #OK_Browse #defaultString: 'OK & Browse' #catalogID: #dllcc) #isDefault: false #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 70 0.5 -35 1 136 0.5 -5 1 ) #model: #doAbort #label: #(#{Kernel.UserMessage} #key: #Cancel #defaultString: 'Cancel' #catalogID: #dllcc) #isDefault: false #defaultable: true ) ) ) )
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #(#UserMessage #key: #finderLabel #defaultString: 'External Interface Finder' #catalogID: #dllcc) #min: #(#{Core.Point} 20 20 ) #bounds: #(#{Graphics.Rectangle} 583 472 989 710 ) #flags: 4 #menu: #menuBar ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{UI.AlignmentOrigin} 10 0.3 58 0 0 1 ) #label: #(#UserMessage #key: #Category #defaultString: 'Category' #catalogID: #dllcc) ) #(#{UI.LabelSpec} #layout: #(#{UI.AlignmentOrigin} 0 0.6 58 0 0 1 ) #name: #ExternalListLabel #label: #(#UserMessage #key: #Externals #defaultString: 'Externals' #catalogID: #dllcc) ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 10 0 56 0 5 0.3 -10 1 ) #name: #ClassNameList #model: #classNameList #menu: #classNameListMenu ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 10 0.3 56 0 -5 0.6 -10 1 ) #name: #CategoryList #model: #categoryList ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.6 56 0 -10 1 -10 1 ) #name: #ExternalList #flags: 15 #model: #externalList #menu: #externalListMenu ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0 0 0 0 0.25 32 0 ) #name: #browseButton #model: #browseSelection #label: #(#UserMessage #key: #Browse #defaultString: 'Browse' #catalogID: #dllcc) ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.25 0 0 0 0.5 32 0 ) #name: #regenerateButton #model: #regenerate #label: #(#UserMessage #key: #Regenerate #defaultString: 'Regenerate' #catalogID: #dllcc) ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.5 0 0 0 0.75 32 0 ) #name: #newButton #model: #newInterface #label: #(#UserMessage #key: #New #defaultString: 'New' #catalogID: #dllcc) ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} 0 0.75 0 0 0 1 32 0 ) #name: #removeButton #model: #remove #label: #(#UserMessage #key: #Remove #defaultString: 'Remove' #catalogID: #dllcc) ) #(#{UI.LabelSpec} #layout: #(#{UI.AlignmentOrigin} 10 0 58 0 0 1 ) #name: #ClassNameListLabel #label: #(#UserMessage #key: #Class #defaultString: 'Class' #catalogID: #dllcc) ) ) ) )
</methods> <methods> Tools.ExternalInterfaceClassFinder class <category>interface specs</category>
createSpec "UIPainter new openOnClass: self andSelector: #createSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: #(#{Kernel.UserMessage} #key: #UnlabeledCanvas #defaultString: 'Unlabeled Canvas' #catalogID: #dllcc) #bounds: #(#{Graphics.Rectangle} 654 356 1074 636 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 4 0 40 0 -2 0.4 -4 1 ) #name: #nameSpaces #model: #nameSpaces #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #doubleClickSelector: #expandCollapse ) #useModifierKeys: true #selectionType: #normalSelection ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 12 6 ) #label: #(#{Kernel.UserMessage} #key: #Location #defaultString: 'Location' #catalogID: #dllcc) ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 100 0.4 40 0 -4 1 70 0 ) #model: #localClassName ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 100 0.4 75 0 -4 1 105 0 ) #model: #classCategory ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 8 0.4 120 0 ) #label: #(#{Kernel.UserMessage} #key: #Superclass #defaultString: 'Superclass:' #catalogID: #dllcc) ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 8 0.4 42 0 ) #label: #(#{Kernel.UserMessage} #key: #Name #defaultString: 'Name:' #catalogID: #dllcc) ) #(#{UI.LabelSpec} #layout: #(#{Graphics.LayoutOrigin} 8 0.4 77 0 ) #label: #(#{Kernel.UserMessage} #key: #CategoryC #defaultString: 'Category:' #catalogID: #dllcc) ) #(#{UI.MenuButtonSpec} #layout: #(#{Graphics.LayoutFrame} 40 0.4 155 0 -4 1 185 0 ) #model: #normalSuperclass #menu: #superclassOptions ) #(#{UI.SubCanvasSpec} #layout: #(#{Graphics.LayoutFrame} 40 0.4 190 0 -4 1 220 0 ) #name: #superclassID #flags: 0 #minorKey: #nameOnlySpec #clientKey: #superclassID ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 205 234 ) #model: #isVirtual #label: #(#{Kernel.UserMessage} #key: #Virtual #defaultString: 'Virtual' #catalogID: #dllcc) ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 297 234 ) #model: #isOptimized #label: #(#{Kernel.UserMessage} #key: #Optimized #defaultString: 'Optimized' #catalogID: #dllcc) ) ) ) )
</methods> <methods> Tools.VisualLauncher class <category>resources</category>
BWExtFinder24 "UIMaskEditor new openOnClass: self andSelector: #BWExtFinder24" <resource: #image> ^CachedImage on: (Image extent: 24@24 depth: 1 bitsPerPixel: 1 palette: CoveragePalette monoMaskPalette usingBits: #[255 255 255 0 128 0 1 0 191 255 253 0 148 42 21 0 159 255 253 0 152 0 5 0 144 15 5 0 146 31 133 0 146 25 133 0 146 24 5 0 146 24 5 0 146 24 5 0 146 24 5 0 158 25 133 0 154 31 133 0 154 15 5 0 254 0 5 0 211 255 197 0 240 0 29 0 144 0 1 0 159 255 253 0 128 0 1 0 255 255 255 0 0 0 0 0 ])
BWExtFinder32 "UIMaskEditor new openOnClass: self andSelector: #BWExtFinder32" <resource: #image> ^CachedImage on: (Image extent: 32@32 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: #[0 0 0 0 63 255 255 254 95 255 255 254 111 255 255 254 112 0 0 6 117 245 87 214 112 0 0 6 115 255 255 246 119 255 255 246 119 126 3 246 119 124 1 246 119 124 1 246 119 124 113 246 119 124 127 246 119 124 127 246 119 124 127 246 119 124 127 246 119 124 113 246 116 124 1 246 117 124 1 246 117 126 3 246 68 127 255 246 87 127 255 246 87 0 1 246 71 255 255 134 119 255 255 254 119 255 255 254 112 0 0 6 127 255 255 250 127 255 255 252 0 0 0 0 255 255 255 255 ])
CGExtFinder24 "UIMaskEditor new openOnClass: self andSelector: #CGExtFinder24" <resource: #image> ^CachedImage on: (Image extent: 24@24 depth: 4 bitsPerPixel: 4 palette: (MappedPalette withColors: ((Array new: 9) at: 1 put: ColorValue black; at: 2 put: (ColorValue scaledRed: 3276 scaledGreen: 3276 scaledBlue: 3276); at: 3 put: ColorValue white; at: 4 put: (ColorValue scaledRed: 4112 scaledGreen: 4112 scaledBlue: 4112); at: 5 put: ColorValue cyan; at: 6 put: ColorValue lightGray; at: 7 put: ColorValue yellow; at: 8 put: (ColorValue scaledRed: 0 scaledGreen: 0 scaledBlue: 4112); at: 9 put: ColorValue red; yourself)) usingBits: (ByteArray fromPackedString: '@@@@@@@@@@@@@@@@ADQDQDQDQDQDQDQ@@0@@@@@@@@@@@@A@@2@ H"HB@ H"HBA@@2@@@@@@@@@@@@A@AR@FI"X&I"X&I"A@@2@RX&I"]7]"X&A@@2@3@RX'']7]6I"A@AR@2@!I''\&]2X&A@@2@2@2D'']"X&I"A@@2@2@#HW\&I"X&A@AR@2@2T'']"X&I"A@@2@2@#H7\&I"X&A@@2@@@2L''\R]6I"A@AR@H@#H7]7]2X&A@@2@H@2L#]7\&I"A@@@@@@#H2L%HRX&A@@H@Q@@@@@@@@I"A@@@@2DQDQDQDQD@A@@Q@5L3L3L3L3L3Q@@2@@@@@@@@@@@@A@@3DQDQDQDQDQDQE@@@@@@@@@@@@@@@@@L3L3L3L3L3L3L3L3'))
CGExtFinder32 "UIMaskEditor new openOnClass: self andSelector: #CGExtFinder32" <resource: #image> ^CachedImage on: (Image extent: 32@32 depth: 4 bitsPerPixel: 4 palette: (MappedPalette withColors: ((Array new: 9) at: 1 put: ColorValue black; at: 2 put: (ColorValue scaledRed: 3276 scaledGreen: 3276 scaledBlue: 3276); at: 3 put: ColorValue white; at: 4 put: (ColorValue scaledRed: 4112 scaledGreen: 4112 scaledBlue: 4112); at: 5 put: ColorValue cyan; at: 6 put: ColorValue lightGray; at: 7 put: ColorValue yellow; at: 8 put: (ColorValue scaledRed: 0 scaledGreen: 0 scaledBlue: 4112); at: 9 put: ColorValue red; yourself)) usingBits: (ByteArray fromPackedString: '@@@@@@@@@@@@@@@@@@@@@@ADQDQDQDQDQDQDQDQDQD@CADQDQDQDQDQDQDQDQDQ@@3ADQDQDQDQDQDQDQDQDP@L2@@@@@@@@@@@@@@@@AD@CL HBH"HB@ HB@"H"@ Q@@3H@@@@@@@@@@@@@@@@DP@T2@FI"X&I"X&I"X&I"AD@CL HVI"X&I"X&I"X&I Q@@3HBL0E"X&]7]7]&X&HDP@L2@#HCE"Y7]7]7]"X&AD@EL H2@#E"]7]7]7I"X Q@@3HBL L#E'']6I'']6I"XDP@L2@#HBL#E7\&I"X&I"AD@CL H2@2L#]7X&I"X&I Q@ASHBL H2T'']2X&I"X&XDP@L2@#HCH2M7]"X&I"X&AD@CL H2@#H2]7E"]7I"X Q@@3HB@@L#H7]7]7]6I"XDP@T2@ BT#I7]7]7\&I"AD@CL HH@2L#I7]7]2X&I Q@@0@B@@H2T#H2L#E"X&HDP@LH@!DCH2L%H2T#E"X&AD@CB@H2@@@@@@@@@@I"X Q@@0@BL1DQDQDQDQDQD@@DP@LQ@#L1DQDQDQDQDQDTQD@CL H5L3L3L3L3L3L1DTQ@@3H@@@@@@@@@@@@@@@@DP@L3DQDQDQDQDQDQDQDQDD@CMSL3L3L3L3L3L3L3L3L@@@@@@@@@@@@@@@@@@@@@@EUUUUUUUUUUUUUUUUUUUUTb'))
</methods> <methods> Tools.VisualLauncher <category>actions</category>
openExternalFinder <menuItem: #(#BrowseExternals #dllcc 'Browse Externals') icon: #extFinderIcon nameKey: nil menu: #(#launcherToolBar) position: 20.04 helpText: #(#DLLAndCConnect #dllcc 'DLL and C Connect')> self openApplicationForClassNamed: #{ExternalInterfaceFinder}
</methods> <initialize> External.CScanner </initialize> <initialize> Tools.ExternalInterfaceBuilder </initialize> <initialize> Tools.ExternalInterfaceFinder </initialize> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>ApplicationModel</name> <environment>UI</environment> <super>UI.Model</super> <private>false</private> none builder uiSession eventHandlers savedWindowInformation <imports></imports> <category>UIBuilder-Framework</category> <attributes> <package>UIBuilder-Framework</package> </attributes> </class> <class> <name>VisualLauncher</name> <environment>Tools</environment> <super>UI.ApplicationModel</super> <private>false</private> none menuBar toolBar textCollector toolDock <imports></imports> <category>Tools-Misc</category> <attributes> <package>Tools-Misc</package> </attributes> </class> <class> <name>ExternalObject</name> <environment>External</environment> <super>Core.Object</super> <private>false</private> none name ordinal handle type virtuals owner <imports></imports> <category>External-Interface</category> <attributes> <package>External-Interface</package> </attributes> </class> <class> <name>UndefinedObject</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>Scanner</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none source mark prevEnd hereChar token tokenType saveComments currentComment buffer typeTable <imports></imports> <category>System-Compiler-Public Access</category> <attributes> <package>System-Compiler-Public Access</package> </attributes> </class> <class> <name>CMacroDefinition</name> <environment>External</environment> <super>Core.Object</super> <private>false</private> none name argNames fragments cachedValue <imports></imports> <category>External-Types</category> <attributes> <package>External-Types</package> </attributes> </class> <class> <name>CComposite</name> <environment>External</environment> <super>External.CDatum</super> <private>false</private> none <imports></imports> <category>External-Data</category> <attributes> <package>External-Data</package> </attributes> </class> <class> <name>CType</name> <environment>External</environment> <super>Core.Object</super> <private>false</private> none specifierFlags <imports></imports> <category>External-Types</category> <attributes> <package>External-Types</package> </attributes> </class> <class> <name>CCompoundType</name> <environment>External</environment> <super>External.CType</super> <private>false</private> objects name <imports></imports> <category>External-Types</category> <attributes> <package>External-Types</package> </attributes> </class> <class> <name>CEnumerationType</name> <environment>External</environment> <super>External.CCompoundType</super> <private>false</private> objects <imports></imports> <category>External-Types</category> <attributes> <package>External-Types</package> </attributes> </class> <class> <name>Inspector</name> <environment>Tools</environment> <super>UI.ApplicationModel</super> <private>false</private> none object field fieldList properties history showAllFields <imports></imports> <category>Tools-Inspector</category> <attributes> <package>Tools-Inspector</package> </attributes> </class> <class> <name>Compiler</name> <environment>Kernel</environment> <super>Kernel.SmalltalkCompiler</super> <private>false</private> none <imports></imports> <category>System-Compiler-Public Access</category> <attributes> <package>System-Compiler-Public Access</package> </attributes> </class> <class> <name>PartListAbstractInspector</name> <environment>Tools.Trippy</environment> <super>Tools.Trippy.Inspector</super> <private>false</private> none driver segmentListHolder fieldListHolder textHolder dragController undoHistory <imports></imports> <category>Tools-Trippy</category> <attributes> <package>Tools-Trippy</package> </attributes> </class> <class> <name>Parser</name> <environment>Kernel</environment> <super>Kernel.Scanner</super> <private>false</private> none builder requestor oldLanguage newLanguage extendedLanguage parseNode failBlock endTemps targetClass environment topEnvironment bindingRefs <imports></imports> <category>System-Compiler-Public Access</category> <attributes> <package>System-Compiler-Public Access</package> </attributes> </class> <class> <name>ClassFinder</name> <environment>Tools</environment> <super>UI.ApplicationModel</super> <private>false</private> none class className candidateClassName pages nameSpaces realNameSpaces classNames classPattern finished localClassName classCategory normalSuperclass superclassOptions superclassID dialog clientData canBeFutureClass <imports></imports> <category>Tools-Misc</category> <attributes> <package>Tools-Misc</package> </attributes> </class> <class> <name>KeyedElement</name> <environment>Tools.Trippy</environment> <super>Tools.Trippy.Part</super> <private>false</private> none key <imports></imports> <category>Tools-Trippy</category> <attributes> <package>Tools-Trippy</package> </attributes> </class> <class> <name>CCompositePointer</name> <environment>External</environment> <super>External.CPointer</super> <private>false</private> none <imports></imports> <category>External-Data</category> <attributes> <package>External-Data</package> </attributes> </class> <class> <name>ExternalVariable</name> <environment>External</environment> <super>External.ExternalObject</super> <private>false</private> none <imports></imports> <category>External-Interface</category> <attributes> <package>External-Interface</package> </attributes> </class> <class> <name>ExternalProcedure</name> <environment>External</environment> <super>External.ExternalObject</super> <private>false</private> none <imports></imports> <category>External-Interface</category> <attributes> <package>External-Interface</package> </attributes> </class> <class> <name>ExternalMethod</name> <environment>External</environment> <super>Kernel.CompiledMethod</super> <private>false</private> objects handle specifierFlags argumentKinds structArgSize structReturnSize datumClass resultType virtuals methodSelector external <imports></imports> <category>External-Interface</category> <attributes> <package>External-Interface</package> </attributes> </class> <class> <name>Notification</name> <environment>Core</environment> <super>Core.Exception</super> <private>false</private> none <imports></imports> <category>Kernel-Exception Handling</category> <attributes> <package>Kernel-Exception Handling</package> </attributes> </class>