[View] [Edit] [Lock] [References] [Attachments] [History] [Home] [Changes] [Search] [Help]
sample[VSE] hReader
The hReader framework is a tool used for parsing C header files and produce intermediate code to bind windows DLL to VSE.
Code
"
__________________________________________________
@Alejandro F. Reimondo 04/20/07
This proyect sources are property of : Alejandro F. Reimondo
Its use is NOT legal without written rights.
Amenabar 3476 Piso: 2 Dto: B.
Ciudad de Buenos Aires.
Argentina.
Tel: (54)-1-703-5586.
__________________________________________________
"!
ARObject subclass: #CSourceObject
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: '' !
CSourceObject subclass: #CEvaluator
instanceVariableNames:
' dictionary failBlock status stream plurals inRange divZero overflow complex current '
classVariableNames: ''
poolDictionaries:
' CharacterConstants ' !
CSourceObject subclass: #CScanner
instanceVariableNames:
' stream lastComment monitor intervals '
classVariableNames: ''
poolDictionaries:
' CharacterConstants ' !
CSourceObject subclass: #CSourceFile
instanceVariableNames:
' pathName constants includes types variables monitored '
classVariableNames:
' Libraries '
poolDictionaries: '' !
CSourceFile subclass: #CppSourceFile
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: '' !
CppSourceFile subclass: #IDLSourceFile
instanceVariableNames:
' interfaces '
classVariableNames: ''
poolDictionaries: '' !
CSourceObject subclass: #CTypeDefinition
instanceVariableNames:
' name types comment attributes '
classVariableNames: ''
poolDictionaries: '' !
CTypeDefinition subclass: #CppClassDefinition
instanceVariableNames:
' parent contents '
classVariableNames: ''
poolDictionaries: '' !
CppClassDefinition subclass: #IDLInterfaceDefinition
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: '' !
CTypeDefinition subclass: #CVariableDefinition
instanceVariableNames:
' parameters '
classVariableNames: ''
poolDictionaries: '' !
!CSourceObject class methods !
objectFiler
" Private - Returns then ObjectFiler. "
^Smalltalk at: #ObjectFiler ifAbsent: [
self checkBound: 'voflr31w'.
Smalltalk at: #ObjectFiler
ifAbsent: [ self error: 'Component ObjectFiler is needed for loading pre-compiled libraries.' ]
]! !
!CEvaluator class methods !
maxExpo
" Returns the maximum aceptable exponent. "
^709 "exp(709) = 8.21840746e307"!
maxReal
" Returns the maximum aceptable exponent. "
^1.7e308! !
!CEvaluator methods !
checkOverflowBetween: value and: valueHold for: operator
"Private - Check for an overflow condition and sets the overflow flag properly"
operator = $* ifTrue: [
value abs > 1.0 ifTrue: [overflow := self class maxReal / value abs < valueHold abs ].
^self
].
operator = $/ ifTrue: [
overflow := valueHold asFloat = 0.0
or: [
value abs > 1.0 and: [ (1 / valueHold) abs > (self class maxReal / value abs) ]
].
^self
].
operator = $+ ifTrue: [
overflow := valueHold > 0
ifTrue: [self class maxReal - valueHold < value]
ifFalse: [ value < (self class maxReal negated - valueHold) ].
^self
].
operator = $- ifTrue: [
overflow := valueHold < 0
ifTrue: [value > self class maxReal + valueHold]
ifFalse: [ value < (self class maxReal negated + valueHold) ].
^self
].
self error: 'Invalid Operation'!
define: aKey as: aValue
"Define a new key name as aValue.
if aValue is aString it will be evaluated.
aKey must be stored as uppercase"
| eval value |
aValue isString
ifTrue: [
eval := self copy.
value := eval evaluate: aValue
value isNil
ifTrue: [ ^self error: eval status ]
]
ifFalse: [value := aValue].
dictionary at: aKey asUpperCase put: value!
eoln
"Private - Returns the End Of Line character"
^Cr!
errorString
"Returns the current error string"
| errors |
status isNil ifTrue: [^nil].
errors := #(
'Caracter ilegal.'
'Sintaxis incorrecta.'
'Parentesis desequilibrados.'
'Formato real incorrecto.'
'Funcion nlegal o variable desconocida.'
'Resultado indefinido.'
'Resultado muy grande.'
'Resultado complejo.'
'Division por cero.'
'Error en Macro.'
'Variable mal definida.'
'Variable perdida.'
).
(status between: 1 and: errors size)
ifFalse: [^'Undefined error condition'].
^errors at: status!
evaluate: aString
"Evaluates a string and returns it's value (aNumber) or nil if failed."
| result |
stream := ReadStream on: aString asUpperCase.
status := nil.
self initBooleans.
self getNext.
current = Cr ifTrue: [self setError: 2. ^nil].
result := self expression.
inRange ifFalse: [self setError: 6.^nil].
overflow ifTrue: [self setError: 7.^nil].
complex ifTrue: [self setError: 8.^nil].
divZero ifTrue: [self setError: 9.^nil].
self hasError ifTrue: [^nil].
^result!
expression
"Private - Solves the next expresion in the receiver's stream"
| nested opr e eHold sign |
self ok ifFalse: [^nil].
nested := false.
sign := current = $-.
('+-' includes: current) ifTrue: [ self getNext ].
e := self simpleExpression.
(e notNil and: [sign]) ifTrue: [e := e negated].
[ '+-' includes: current ] whileTrue: [
self ok ifFalse: [^nil].
opr := current.
self getNext.
eHold := self simpleExpression.
self ok ifFalse: [^nil].
opr = $+ ifTrue: [
self checkOverflowBetween: e and: eHold for: $+.
overflow ifFalse: [e := e + eHold] ifTrue: [e := nil]
].
opr = $- ifTrue: [
self checkOverflowBetween: e and: eHold for: $-.
overflow ifFalse: [e := e - eHold] ifTrue: [e := nil]
].
].
^e!
factor
"Private - Solves the next factor in the receiver's stream"
| f |
self ok ifFalse: [^nil].
(current isDigit or: ['.' includes: current])
ifTrue: [ ^self getNumber ]
ifFalse: [ "not a digit..."
"subexpression..."
(self isLeftPar: current)
ifTrue: [
self getNext.
f := self expression.
self ok ifFalse: [^nil].
(self isRightPar: current)
ifTrue: [
self getNext.
( ('+-*/^!!' includes: current)
or: [current = self eoln
or: [ (self isRightPar: current)
or: [self isLeftPar: current]]])
ifFalse: [ current := $* ].
stream position: stream position - 1
]
ifFalse: [
current ~= self eoln
ifTrue: [ self setError: 3. ^nil ]
]
]
ifFalse: [ "it must be a function call..."
(f := self functionCall) notNil
ifTrue: [
self getNext.
current = $!! ifTrue: [ f := f factorial. self getNext ].
]
]
].
f isNil
ifTrue: [
(self isAlpha: current)
ifTrue: [ self setError: 5 ]
ifFalse: [ self setError: 2 ].
].
^f!
fnAbs
"Private - Returns the value for the standard function"
^self factor abs!
fnCos
"Private - Returns the value for the standard function"
^self factor cos!
fnDefined
"Private - Returns true when value is not null"
^self factor ~= 0!
fnFact
"Private - Returns the value for the standard function"
^self factor asInteger factorial!
fnLn
"Private - Returns the value for the standard function"
^self factor ln!
fnLog
"Private - Returns the value for the standard function"
^self factor log: 10!
fnLog10
"Private - Returns the value for the standard function"
^self factor log: 10!
fnPi
"Private - Returns the value for the function named Pi"
^Float pi!
fnSin
"Private - Returns the value for the standard function"
^self factor sin!
fnSqr
"Private - Returns the value for the standard function"
| param |
param := self factor.
param isNil ifTrue: [^nil].
param > self class maxReal sqrt
ifTrue: [overflow := true.^nil].
^param squared!
fnSqrt
"Private - Returns the value for the standard function"
| param |
param := self factor.
param isNil ifTrue: [^nil].
param < 0
ifTrue: [complex := true.^nil].
^param sqrt!
fnTan
"Private - Returns the value for the standard function"
^self factor tan!
functionCall
"Private - Solves the next function call in the receiver's stream"
| result start name message |
self ok ifFalse: [^nil].
(self isAlpha: current) ifFalse: [^nil].
start := self position.
name := WriteStream on: String new.
[ (current isDigit or: [self isAlpha: current])
ifTrue: [name nextPut: current. true]
ifFalse: [false]
] whileTrue: [
current := stream atEnd
ifTrue: [self eoln]
ifFalse: [stream next]
].
name := name contents.
name isEmpty ifTrue: [^nil].
stream atEnd ifFalse: [ stream position: stream position - 1 ].
(result := failBlock value: name) notNil
ifTrue: [^result].
result := self valueForKey: name.
result notNil ifTrue: [^result ].
message := name asLowerCase.
message at: 1 put: message first asUpperCase.
message := ('fn',message) asSymbol.
(self respondsTo: message)
ifTrue: [^self perform: message].
self setError: 5.
^nil!
getNext
"Private - Returns the next character in the receiver or Cr"
| char |
[
stream atEnd ifTrue: [^current := self eoln].
char := stream next.
char isSeparator ] whileTrue: [].
(self isValid: char) ifFalse: [self setError: 2].
^current := char!
getNumber
"Private - Returns the next numeric value in the receiver or nil if failed"
| v digits getHexa index getChar |
self ok ifFalse: [^nil].
getChar := [
current := stream atEnd
ifTrue: [self eoln]
ifFalse: [stream next]
].
getHexa := [
v := 0.
[ getChar value.
(index := '0123456789ABCDEF' indexOf: current) > 0
] whileTrue: [ v := v * 16 + index - 1 ].
('LU' includes: current) ifTrue: [ self getNext ].
v
].
digits := WriteStream on: String new.
current = $0
ifTrue: [
getChar value.
current = $X
ifTrue: [^getHexa value].
digits nextPut: $0.
].
[ digits nextPut: current.
getChar value.
current isDigit or: ['.E-+' includes: current]
] whileTrue: [].
digits := digits contents.
current isSeparator ifTrue: [self getNext].
((digits includes: $.)
or: [digits includes: $E])
ifTrue: [^digits asFloat]
ifFalse: [^digits asInteger]!
hasError
"Private - True if the receiver has registered an error"
^status notNil!
ifFailed: aBlock
"Sets the block to ve evaluated when a constant can't be solved.
aBlock must be a block and must returns
a proper value for the next token in the receiver's stream or nil.
aBlock must advance the receiver's stream"
failBlock := aBlock!
initBooleans
"Private - Initialize boolean flags"
inRange := true. "es arg . valido xEjm: fact(-1.3) "
divZero := "division por cero xEjm: 1/sen(2 - 2)"
overflow := "xEjm fact(100)"
complex := false. "xEjm sqrt(-1)"!
initialize
"Private - Initialize the receiver."
dictionary := Dictionary new.
failBlock := [:var| nil ]. "no search alternative"
plurals := true. "consider plural xejm: 5 dolars = 5 * dolar "!
isAlpha: aCharacter
"Private - Returns true if aCharacter is isAlphanumeric"
^aCharacter isAlphaNumeric or: [aCharacter = $_]!
isLeftPar: aCharacter
"Private - Returns true if aCharacter is a left parentesis"
^#($( $[ ${) includes: aCharacter!
isRightPar: aCharacter
"Private - Returns true if aCharacter is a right parentesis"
^#($) $] $}) includes: aCharacter!
isValid: aCharacter
"Private - Returns true if aCharacter is valid"
aCharacter isAlphaNumeric ifTrue: [^true].
(self isRightPar: aCharacter) ifTrue: [^true].
(self isLeftPar: aCharacter) ifTrue: [^true].
^#($- $+ $* $/ $^ $_) includes: aCharacter!
ok
"Private - True if the receiver's status is Ok & Booleans ok"
^self hasError not and: [ inRange & complex not & divZero not & overflow not ]!
position
"Returns th ereceivers current position.
If an error has been ocurred it's at position"
^stream position!
setError: aNumber
"Private - Set the current error in the receiver"
status := aNumber.
" self error: 'Debuggin Error:', aNumber asString "!
signedFactor
"Private - Solves the next single factor in the rceiver's stream"
^current = $-
ifTrue: [ (self getNext;factor) negated]
ifFalse: [ self factor ]!
simpleExpression
"Private - Solves the next simple expresion in the receiver's stream"
| s sHold opr |
self ok ifFalse: [^nil].
s := self term.
[
"Check for missing * and insertIt"
(self ok and: [
(self isLeftPar: current)
or: [(self isAlpha: current)
or: [ current isDigit or: ['.' includes: current] ] ] ])
ifTrue: [ current := $*. stream position: stream position - 1 ].
'*/' includes: current
] whileTrue: [
self ok ifFalse: [^nil].
opr := current.
self getNext.
(opr = $= and: [current = $=]) ifTrue: [ self getNext ].
((self isLeftPar: opr)
or: [(self isAlpha: opr)
or: [ opr isDigit or: ['.' includes: opr] ] ])
ifTrue: [ opr := $*. current := $( ].
sHold := self term.
self ok ifFalse: [^nil].
$* = opr ifTrue: [
self checkOverflowBetween: s and: sHold for: $*.
overflow ifFalse: [s := s * sHold]
].
$= = opr ifTrue: [
s = sHold ifTrue: [s := 1] ifFalse: [s := 0]
].
$/ = opr ifTrue: [
(divZero := sHold = 0)
ifFalse: [
self checkOverflowBetween: s and: sHold for: $/.
overflow ifFalse: [ s := s / sHold ]
]
].
].
^s!
status
"Returns the receiver's status"
^status!
stream
"Private - Returns the receiver's source stream"
^stream!
term
"Private - Solves the next term in the rceiver's stream"
| t tHold opr |
self ok ifFalse: [^nil].
t := self signedFactor.
[ $^ = current ] whileTrue: [
self ok ifFalse: [^nil].
self getNext.
tHold := self signedFactor: current.
"Check for illegal power..."
(t < 0 and: [ tHold - tHold truncated ~= 0 ])
ifTrue: [complex := true.^nil].
t < 0
ifTrue: [
self checkOverflowBetween: t negated ln and: tHold for: $*.
self ok ifFalse: [^nil].
t negated ln * tHold > self class maxExpo
ifTrue: [overflow := true.^nil].
tHold abs truncated \\ 2 = 0
ifTrue: [t := (t negated ln * tHold) exp ]
ifFalse: [t := (t negated ln * tHold) exp negated ].
]
ifFalse: [ " t >= 0 "
self checkOverflowBetween: t ln and: tHold for: $*.
self ok ifFalse: [^nil].
t ln * tHold > self class maxExpo
ifTrue: [overflow := true.^nil].
t := (t ln * tHold) exp
].
].
^t!
valueForKey: name
"Private - Returns the value for key name or nil"
| singular |
(dictionary includesKey: name)
ifTrue: [^dictionary at: name].
(plurals and: [
name size > 1 and: [name last = $S]])
ifTrue: [
singular := name copyFrom: 1 to: name size - 1.
(dictionary includesKey: singular)
ifTrue: [^dictionary at: singular].
(singular size > 1 and: [singular last = $E]) "caso dolarES"
ifTrue: [
singular := singular copyFrom: 1 to: singular size - 1.
(dictionary includesKey: singular)
ifTrue: [^dictionary at: singular]
].
].
^nil! !
!CScanner class methods !
on: aStream
"Returns an instance of the receiver on aStream"
^self new
stream: aStream;
yourself! !
!CScanner methods !
addComment: aString
" Private - Add aString to the receiver comment. "
self lastComment: self lastComment ,'\'withCrs ,aString "trimBlanks"!
atEnd
"True if the receiver is at end"
stream isNil ifTrue: [^true].
self skipBlanks.
^stream atEnd!
clearComment
"Set the instance var of the receiver."
lastComment := nil.!
getComment
" Returns the last comment unStupidized (stupid banners removed). "
| result |
result := self lastComment.
self clearComment.
^self unStupidize: result!
initializeLastComment
" Private - Initializes the receiver's lastComment"
lastComment := String new.!
isAlpha: aCharacter
"Private - Returns true if aCharacter is isAlphanumeric"
^aCharacter isAlphaNumeric or: [aCharacter = $_]!
isNewLineSeparator: aCharacter
"Private - True if aCharacter is a newLine separator"
^aCharacter == Lf
or: [aCharacter == Cr]!
isSeparator: aCharacter
"Private - True if aCharacter is a separator"
^aCharacter == Space
or: [aCharacter == Tab]!
lastComment
"Returns the instance var of the receiver
for external manipulation"
lastComment isNil ifTrue: [ self initializeLastComment ].
^lastComment!
lastComment: anObject
"Sets the instance var of the receiver
with anObject. (No checking is done)"
lastComment := anObject!
next
"Peek the next character in the receiver"
self skipBlanks isNil ifTrue: [^nil].
^stream next!
nextBasicToken
" Private - Returns the next token in the receiver"
| token char |
"
[stream atEnd or: [(char := stream peek) isSeparator]]
whileTrue: [ stream next ].
"
self skipBlanks isNil ifTrue: [^nil].
token := WriteStream on: String new.
token nextPut: (char := stream next).
(('#' includes: char) or: [self isAlpha: char])
ifFalse: [^String with: char].
[
stream atEnd ifTrue: [^token contents].
self isAlpha: stream peek
] whileTrue: [ token nextPut: stream next ].
^token contents!
nextLine
"Returns the next line in the receiver"
| line scanner result |
[ [self isSeparator: stream peek] whileTrue: [ stream next ].
(self isNewLineSeparator: stream peek) ifTrue: [
^stream nextLine
].
self skipComment ] whileTrue: [].
line := String with: $\.
[ line notEmpty and: [line last = $\] ] whileTrue: [
line := (line copyFrom: 1 to: line size - 1) , stream nextLine
].
result := WriteStream on: String new.
scanner := self class new stream: (ReadStream on: line).
[scanner stream atEnd] whileFalse: [
scanner stream peek isSeparator ifTrue: [result nextPut: scanner stream peek].
scanner atEnd ifFalse: [ result nextPut: scanner next ]
].
^result contents!
nextName
"Returns the next name in the receiver"
| name |
self skipBlanks isNil ifTrue: [^nil].
name := WriteStream on: String new.
[stream atEnd not and: [self isAlpha: stream peek]]
whileTrue: [ name nextPut: stream next ].
^name contents!
nextString
" Returns the next C string in the receiver. "
self skipBlanks isNil ifTrue: [^nil].
self peek = $" ifFalse: [ ^self error: 'Must be a string'. ].
^self next; upTo: $"!
nextToken
"Returns the next token in the receiver"
| token |
token := self nextBasicToken.
self position: self position.
^token!
openMonitor
" Private - Open monitor window on the receiver's stream."
| position |
(stream isKindOf: FileStream) ifFalse: [ ^self ].
position := stream position.
monitor := TextWindow
windowLabeled: 'C Source scanner on ',stream printString
frame: (0@0 extent: Display extent * (1@2 / 3)) truncated.
intervals := OrderedCollection new.
stream position: 0.
[stream atEnd] whileFalse: [
intervals add: stream position.
stream nextLine.
].
intervals add: stream position.
monitor contents: stream contents.
self position: position.!
peek
"Peek the next character in the receiver"
self skipBlanks isNil ifTrue: [^nil].
^stream peek!
peekToken
"Returns the next token in the receiver but not advance it"
| pos token |
pos := self position.
token := self nextToken.
self position: pos.
^token!
position
"Returns the position of the receiver"
^stream position!
position: aNumber
" Sets the position of the receiver. "
| start end index |
stream position: aNumber.
monitor notNil ifTrue: [
index := 1.
end := stream position.
[index < intervals size and: [(intervals at: index + 1) < end]]
whileTrue: [ index := index + 1 ].
start := intervals at: index.
Notifier isControlKeyDown ifFalse: [ monitor pane selectFrom: start to: end ]
].!
skipBasicBlanks
" Private - Skip blanks & comments.
Must returns nil if the stream is at end..."
| skip char |
skip := [
[ stream atEnd ifTrue: [^nil].
char := stream peek.
(char isSeparator or: [ self isSeparator: char ])
] whileTrue: [stream next]
].
skip value.
[self skipComment] whileTrue: [ skip value ].
stream atEnd ifTrue: [^nil].!
skipBlanks
" Skip blanks & comments.
Must returns nil if the stream is at end..."
| result |
result := self skipBasicBlanks.
self position: self position.
^result!
skipComment
"Private - Skip next comment.
Must return true if a comment has been skipped."
| savedPosition start |
stream peek = $/ ifFalse: [^false].
savedPosition := stream position.
stream next.
stream peek = $/ ifTrue: [
stream next.
self addComment: stream nextLine.
^true
].
stream peek = $*
ifTrue: [
start := stream position.
[
stream
skipTo: $/;
position: stream position - 2.
stream next = $*
] whileFalse: [ stream next;next ].
self addComment: (stream copyFrom: start + 2 to: stream position - 1).
stream next.
^true
].
stream position: savedPosition.
^false!
stream
"Returns the stream of the receiver"
^stream!
stream: aStream
"Private - Set the working stream"
stream := aStream!
unStupidize: aString
" Private - Returns and unStupidized version of aString (stupid banners removed). "
| line aStream output isStupid mustJoin |
isStupid := [:string|
(string reject: [:c| '*/-_=#\' includes: c ]) size < 3
].
aStream := ReadStream on: (aString trimBlanks replaceAll: ' ' with: (String with: 9 asCharacter)).
output := WriteStream on: (String new: aString size).
mustJoin := true.
[aStream atEnd] whileFalse: [
line := aStream nextLine reject: [:c| '"' includes: c ].
mustJoin
ifFalse: [ output cr ]
ifTrue: [ line := ' ',line trimBlanks ].
line := ((isStupid value: line) ifTrue: [ String new ] ifFalse: [ line ]).
(line notEmpty and: [line first = $* and: [ line last = $*]])
ifTrue: [ line := (line reject: [:c| c = $* ]) trimBlanks ,' - ' ].
output nextPutAll: line.
mustJoin := line notEmpty and: [ (line last = $.) not ].
].
line := output contents.
line size > 1 ifTrue: [
line at: 1 put: line first asUppercase.
line last = $. ifFalse: [ line := line,'.' ].
].
^line trimBlanks!
upTo: aCharacter
" Returns the next contents in the receiver upTo aCharacter. "
^stream upTo: aCharacter! !
!CSourceFile class methods !
@ aPathName
" Returns an instance of the receiver parsing the file at pathName. "
^self pathName: aPathName!
fileExtension
" Private - Returns the file extension for precompiled files."
^'.CSF' "for C source files"!
initializeLibraries
" Private - Initialize the cached libraries. "
Libraries := Dictionary new!
keyForLibraryNamed: aName
" Private - Returns the key to search for library named aName. "
^aName asLowercase!
libraries
" Private - Returns the cached libraries. "
Libraries isNil ifTrue: [ self initializeLibraries ].
^Libraries!
libraryNamed: aName ifAbsent: aBlock
" Private - Returns the library named aLibrary in the cached libraries or the result of evaluating aBlock. "
^self libraries
at: (self keyForLibraryNamed: aName)
ifAbsent: aBlock!
loadFrom: pathName
"Returns an instance of the receiver read from pathName.
WARNING: file with pathName MUST contain an instance of the receiver."
^self objectFiler loadFromPathName: pathName!
open
"Private - User selected Open... for scanning a file.
CSourceFile open inspect
"
| dialog file |
( dialog := FileDialog new openFile ) isNil ifTrue: [ ^nil ].
( file := dialog file ) isNil ifTrue: [ ^nil ].
^self pathName: file!
pathName: aString
"Returns an instance of the receiver with aSTring as file pathname"
^self new
pathName: aString;
yourself!
purgeGlobals
" Private - Purge the receive's gloabls. "
Libraries := nil.!
registerLibrary: aLibrary as: aName
" Private - Register a library as cached library named aName. "
^self libraries
at: (self keyForLibraryNamed: aName)
put: aLibrary! !
!CSourceFile methods !
allIncludes
" Returns a set with all includes removing duplicates. "
| all |
all := Dictionary new.
self includes do: [:each|
all at: each name put: each.
each allIncludes do: [:one|
all at: one name ifAbsentPut: [ one ]
].
].
^all values asSet!
apiCalls
"Returns the api calls defined in teh receiver."
| result |
self ensureScanned.
result := Dictionary new.
variables keys do: [:key|
(variables at: key) isApi ifTrue: [
result at: key put: (variables at: key)
]
].
^result!
apiSourcesFor: aClassName
" Returns the sourceCode for api calls implemented by a class named aClassName. "
| sources apiCalls |
sources := WriteStream on: String new.
apiCalls := self apiCalls.
apiCalls keys asSortedCollection do: [:key|
sources
cr;nextPut: $!!;
space;nextPutAll: aClassName;
space;nextPutAll: 'methods !!';cr;
nextChunkPut: ((apiCalls at: key) sourceStringIn: self);
nextPutAll: ' !!';cr;
yourself.
].
^sources contents!
attributesFrom: aScanner
" Private - Returns the attributes read from aScanner. "
^( (aScanner upTo: $])
asArrayOfSubstringsSeparatedBy: $,
) collect: [:each| each trimBlanks ]!
constants
"Private - Returns the receiver's constants dictionary.
Scan the receiver if not scanned yet. "
constants isNil ifTrue: [ self scan ].
^constants!
define: aScanner
"Private - Gets the next define expression."
| name line value |
name := aScanner nextName.
line := aScanner nextLine trimBlanks.
line isEmpty
ifTrue: [ value := 1 ]
ifFalse: [
"Try as a type expression"
(self isTypeDef: line)
ifTrue: [
types at: name put: line.
^self
].
value := self valueOf: line.
].
"Register as a constant value"
value notNil
ifTrue: [ self constants at: name put: value ].!
defineType: typeNames as: aType
"Private - Initialize the receiver's types named in typeNames with aType."
typeNames isString "names can be holded in a string"
ifTrue: [^self defineType: typeNames asArrayOfSubstrings as: aType ].
typeNames do: [:each|
types at: each put: aType
].
^aType!
defineTypes: typeNames as: aType
"Private - Initialize the receiver's types named in typeNames with aType."
^self defineType: typeNames as: aType!
defineVariable: varNames as: aVariable
"Private - Initialize the receiver's Variable(s) named in varNames with aVariable."
varNames isString "names can be holded in a string"
ifTrue: [ ^self defineVariable: varNames asArrayOfSubstrings as: aVariable ].
varNames do: [:each|
variables at: each put: aVariable
].
^aVariable!
ensureScanned
" Ensure the receiver has been already scanned. "
self constants.!
enum: aScanner
"Private - Gets the next enum expression."
| token current mask |
mask := aScanner peekToken.
mask = '{' ifFalse: [ aScanner nextToken ].
aScanner peekToken = '{' ifFalse: [
^self error: 'Missing {'
].
aScanner nextToken.
current := 0.
[ aScanner peekToken = '}' ] whileFalse: [
current := (self nextEnum: aScanner value: current) + 1.
].
aScanner nextToken.!
fieldsForStructure: aStructure
" Private - Returns the fields array for aStructure. "
| records fieldName selector |
fieldName := [:aName|
selector := self stName: aName.
selector first isUpperCase ifTrue: [
selector at: 1 put: selector first asLowercase
].
selector asSymbol
].
records := aStructure value.
^records collect: [:each|
(Array
with: (fieldName value: each name)
), (each fieldSpecificationIn: self)
]!
fieldSpecificationIn: aSourceFile
" Returns the receiver's field specification array. "
| stream result current |
stream := ReadStream on: types asArray.
result := stream next.
[stream atEnd] whileFalse: [
current := stream next.
current isSymbol
ifTrue: [ self halt ]
ifFalse: [
current isNumber | current isString
ifTrue: [ result := current ]
ifFalse: [ self halt.
].
].
].
^Array with: result!
fileOutPoolDictionaryNamed: aName
"Extracted pool dictionary Smalltalk source code into a file named aName.Pol ."
(File newFile: aName,'.pol')
nextPutAll: (self poolDictionarySourceNamed: aName);
close.!
fileOutSources
" FileOut the Smalltalk source code built for the receiver. "
^self fileOutSourcesFor: self name!
fileOutSourcesFor: aClass
" FileOut the Smalltalk source code built for class aClass. "
^self
fileOutSourcesFor: aClass
intoFileNamed: aClass asString,' source.st'!
fileOutSourcesFor: aClass intoFileNamed: aPathName
" FileOut the Smalltalk source code into a file named aPathName. "
| file |
file := File newFile: aPathName.
[ file nextPutAll: (self sourcesForClass: aClass)
] ensure: [ file close ].!
getVariable: aScanner with: aType
"Private - Gets the next variable or function definition."
| var |
var := CVariableDefinition for: self using: aScanner ofType: aType.
var notNil ifTrue: [ self defineVariable: var name as: var ].!
hasBeenScanned
" True if the receiver has been scanned yet. "
^constants notNil!
hasTypeNamed: aTypeName
" Returns true if the receiver knowns a type named aName. "
self typeNamed: aTypeName ifAbsent: [ ^false ].
^true!
hasValidComments
" Returns true if the receiver scan valuable/valid comments.
Default return value is true.
This method can be refined for no comment output. "
^true!
if: aScanner
"Private - Conditional Scan the source."
^self ifdef: aScanner!
ifdef: aScanner
"Private - Conditional Scan the source."
| value token nextLine |
nextLine := aScanner nextLine.
value := self valueOf: nextLine.
(value notNil and: [value ~= 0])
ifTrue: [
token := self scanWith: aScanner upTo: #('#else' '#endif').
token = '#else' ifFalse: [ ^self ]
]
ifFalse: [
token := self copy scanWith: aScanner upTo: #('#else' '#endif').
token = '#else' ifFalse: [ ^self ]
].
self copy scanWith: aScanner upTo: '#endif'!
ifndef: aScanner
"Private - Conditional Scan the source."
| value token |
value := self valueOf: aScanner nextLine.
(value isNil or: [value = 0])
ifTrue: [
token := self scanWith: aScanner upTo: #('#else' '#endif').
token = '#else' ifFalse: [ ^self ]
]
ifFalse: [
token := self copy scanWith: aScanner upTo: #('#else' '#endif').
token = '#else' ifFalse: [ ^self ]
].
self copy scanWith: aScanner upTo: '#endif'!
include: aScanner
"Private - Include aditional code source."
| token name isStandard include |
aScanner clearComment.
name := aScanner nextLine trimBlanks.
('"<' includes: name first) ifFalse: [ ^self error: ' Include file name spected.' ].
isStandard := name first = '<'.
name := name copyFrom: 2 to: name size - 1.
isStandard ifTrue: [
includes add: (self standardLibraryNamed: name).
^self
].
include := self libraryNamed: name.
include hasBeenScanned ifFalse: [
include scan; save.
].
includes add: include!
includes
"Returns the instance var of the receiver
for external manipulation"
^includes!
initialize
"Private - Initialize the receiver."
super initialize.
constants := nil. "not scanned yet..."
includes := OrderedCollection new.
self
initializeTypes;
initializeVariables.!
initializeMonitored
" Private - Initializes the receiver's monitored"
monitored := false!
initializeTypes
"Private - Initialize the receiver's types."
types := Dictionary new.
self
defineType: #('FAR PASCAL' 'far' 'WINAPI' '__stdcall') as: #api; "api: stdcall: c: pascal16: c16:"
defineType: '* LPSTR LPBYTE LPDWORD PBYTE LPWORD LPVOID' as: #address;
defineType: 'LONG DWORD long' as: #long;
defineType: 'HANDLE HWND Handle' as: #handle;
defineType: 'char byte unsigned BYTE' as: #byte;
defineType: 'INT short UINT WORD word' as: #short;
defineType: 'BOOL' as: #ulong;
defineType: 'VOID void const' as: #none;
yourself.!
initializeVariables
"Private - Initialize the receiver's variables."
variables := Dictionary new.!
isTypeDef: aString
" Private - Returns true if aString is a type expression. "
| stream |
(types includesKey: aString) ifTrue: [^true].
includes do: [:each|
(each isTypeDef: aString) ifTrue: [ ^true ].
].
stream := ReadStream on: aString trimBlanks.
stream atEnd ifTrue: [^false].
[stream atEnd] whileFalse: [
(types includesKey: stream nextWord)
ifFalse: [^false].
].
self halt.
^true!
libraryNamed: aName
" Private - Returns the library named aName. "
| result aPathName |
result := self class libraryNamed: aName ifAbsent: [].
result notNil ifTrue: [ ^result ].
aPathName := File
findFileName: aName
on: self pathName fileNamePath.
aPathName isNil ifTrue: [
aPathName := File findFileName: aName
].
result := self
libraryNamed: aName
in: aPathName.
result isNil ifTrue: [
^self error: 'Library not found ',aName
] ifFalse: [ self class registerLibrary: result as: aName ].
^result!
libraryNamed: name in: fullPathName
"Private - Try to find pre-compiled file for name,
if can't be found try to scan source file in pathName."
| precompiled |
precompiled := (fullPathName upTo: $.),self class fileExtension.
precompiled := File findFileName: precompiled.
precompiled notNil ifTrue: [
^self class loadFrom: precompiled
].
fullPathName notNil ifTrue: [
^self class pathName: fullPathName
].
^nil!
monitored
"Returns the instance var of the receiver
for external manipulation"
monitored isNil ifTrue: [ self initializeMonitored ].
^monitored!
monitored: anObject
"Sets the instance var of the receiver
with anObject. (No checking is done)"
monitored := anObject!
mustBeTypeDef: aString
" Private - Ensure aString is a type expression. "
| chooser |
(self isTypeDef: aString) ifTrue: [ ^self ].
(MessageBox confirm: 'Missing type "',aString,'".\Do you want to define it ?'withCrs)
ifTrue: [
chooser := ListChooser
openOn: types keys asSortedCollection asArray , #( struct ulong long short )
initialSelection: 'void'
prompt: 'Type equivalence for ',aString.
chooser selection notNil ifTrue: [
Transcript cr;nextPutAll: aString,' ',chooser selection.
^self defineType: aString as: chooser selection.
].
].
^self error: 'Missing type ',aString!
name
" Returns the name of the receiver. "
^self stName: self pathName fileName fileNameLessPath
!
nameForStructure: aStructure
" Private - Returns the name of structure aStructure. "
^"self stName: "aStructure key!
nextAttributesFrom: aScanner
" Private - Returns the next attributes in aScanner (or an empty collection). "
| result |
result := Array new.
[ aScanner peekToken = '['
] whileTrue: [
aScanner nextToken.
result := result , (self attributesFrom: aScanner)
].
^result!
nextEnum: aScanner value: default
"Private - Gets the next enum expression with default value. "
| aName expression value lineScanner |
aName := aScanner nextName.
lineScanner := aScanner species on: aScanner nextLine trimBlanks asStream.
lineScanner skipBlanks.
lineScanner peekToken = '=' ifTrue: [ lineScanner nextToken ].
expression := lineScanner nextLine.
(expression notEmpty and: [ expression last = $, ])
ifTrue: [ expression := expression copyFrom: 1 to: expression size - 1 ].
value := expression notEmpty ifTrue: [
self valueOf: expression
].
value isNil ifTrue: [ value := default ].
self constants at: aName put: value.
^value!
nextVarDef: aScanner
" Private - Returns the next variable definition. "
| var |
var := CTypeDefinition for: self using: aScanner.
aScanner peek = $; ifTrue: [ aScanner next ].
^var!
nextVarDef: aScanner startingWith: aToken
" Private - Returns the next variable definition. "
| var |
var := CTypeDefinition for: self using: aScanner with: aToken.
aScanner peek = $; ifTrue: [ aScanner next ].
^var!
oleType: aType
" Private - Returns the ole equivalence for aType. "
(aType isKindOf: Collection) ifTrue: [
^self oleType: aType last
].
^aType oleType: self reversed: false!
pathName
"Returns the receiver's file path name"
^pathName!
pathName: aString
"Set the instance var of the receiver"
pathName := aString!
poolDictionary
"Returns the extracted pool dictionary"
| pool name |
pool := Dictionary new.
self constants keysDo: [:key|
name := self stName: key.
name size = 0 ifFalse: [ pool at: name put: (self constants at: key) ]
].
^pool!
poolDictionarySourceNamed: aName
"Returns the extracted pool dictionary Smalltalk source code for
a pool dictionary named aName..."
| stream tab dict |
dict := self poolDictionary.
dict isEmpty ifTrue: [ ^String new ].
tab := ' '.
stream := WriteStream on: (String new: 5120).
stream
nextPutAll: aName,' := Dictionary new.';cr;
nextPutAll: aName;cr.
dict keys asSortedCollection do: [:key|
stream nextPutAll: tab,'at: ',key printString,' put: ',(dict at: key) printString,';';cr
].
stream nextChunkPut: tab,'yourself.'.
^stream contents!
printOn: aStream
" Append the ASCII representation of the receiver to aStream. "
super printOn: aStream.
aStream nextPutAll: ' [',self name,'] '.!
privateValueFor: aString
" Private - Returns the value of the variable named aString or nil.
Query the included source files. "
| value alternative |
value := self constants at: aString ifAbsent: [
includes detect: [:each| (alternative := each valueOf: aString) notNil ] ifNone: [alternative := nil].
alternative
].
value isContext ifTrue: [^value value]. "block to be evaluated..."
^value!
process: aToken with: aScanner
"Private - Process aToken found in aScanner"
"Debuggin directives..."
aToken = '#halt' ifTrue: [^self halt].
aToken = ';' ifTrue: [^self "ignore empty sentences"].
aToken = '#inspect' ifTrue: [^self inspect].
aToken = '#smalltalk' ifTrue: [ ^self processChunk: aScanner ].
aToken isEmpty ifTrue: [^self].
aToken = '#define' ifTrue: [^self define: aScanner].
aToken = '#undef' ifTrue: [^self undef: aScanner].
aToken = 'typedef' ifTrue: [^self typedef: aScanner].
aToken = 'enum' ifTrue: [
self enum: aScanner.
aScanner nextToken = ';' ifFalse: [ self error: 'Missing ;' ].
^self
].
aToken = 'struct' ifTrue: [^self struct: aScanner].
aToken = '#include' ifTrue: [^self include: aScanner].
aToken = '#if' ifTrue: [^self if: aScanner].
aToken = '#ifdef' ifTrue: [^self ifdef: aScanner].
aToken = '#ifndef' ifTrue: [^self ifndef: aScanner].
(#('#endif' '#pragma' '#else') includes: aToken)
ifTrue: [ aScanner nextLine.^self ]. "ignored"
(self isTypeDef: aToken) ifTrue: [^self getVariable: aScanner with: aToken ].
(MessageBox confirm: aToken , ' Not Implemented Yet.\ Abort ?' withCrs)
ifTrue: [ ^self error: aToken , ' Not Implemented Yet.' ].
^nil!
processChunk: aScanner
" Private - Process the next chuk in aScanner. "
| chunk |
[ chunk := aScanner upTo: $!!.
aScanner peekToken = '!!' ] whileTrue: [
chunk := chunk , aScanner nextToken.
].
CompilerInterface
evaluate: chunk in: self class
to: self notifying: CompilerInterface
ifFail: [ self error: 'Compilation error' ]!
save
" Dump receiver's contents as a precompiled header file in file near pathName. "
| fileName |
self ensureScanned.
fileName := (pathName upTo: $.),self class fileExtension.
self class objectFiler dump: self newFile: fileName!
scan
"Perform scanning of the receiver's source file"
| scanner |
scanner := self scanner.
[ self scanWith: scanner upTo: nil
] ensure: [ scanner stream close ].
^self!
scanner
" Private - Returns a new scanner for the receiver's source."
| scanner |
scanner := self scannerSupport on: self sourceFile.
self monitored ifTrue: [ scanner openMonitor ].
^scanner!
scannerSupport
" Private - Returns the scanner support for the receiver's source. "
^CScanner!
scanWith: aScanner upTo: aToken
"Perform scanning of the receiver's source file"
| token |
constants isNil ifTrue: [ constants := Dictionary new ].
token := #unKnown.
[aScanner atEnd or: [token = aToken
or: [ aToken notNil and: [ aToken isString not
and: [(aToken includes: token) not ]]]]]
whileFalse: [
self process: (token := aScanner nextToken trimBlanks) with: aScanner
].
^token!
sizeInBytesFor: aTypeRef
" Private - Returns the size determined by aTypeRef. "
| aType |
aTypeRef isSymbol ifTrue: [
^SelfDefinedStructure sizeInBytesFor: aTypeRef
].
aTypeRef isString ifTrue: [
aTypeRef first = $* ifTrue: [ ^self sizeInBytesFor: #ulong ].
aType := self typeNamed: aTypeRef.
^self sizeInBytesFor: aType
].
aTypeRef isNumber ifTrue: [ ^aTypeRef ].
^aTypeRef sizeInBytesIn: self!
sourceFile
"Private - Returns a file for reading source."
^File pathNameReadOnly: pathName!
sourcesForClass: aClass
" Return the sources for aClass. "
^self sourcesForClassNamed: aClass asString!
sourcesForClassNamed: aClassName
" Return the sources for a class named aClassName. "
| sources |
sources := WriteStream on: String new.
sources
cr;nextPutAll: (self poolDictionarySourceNamed: aClassName,'Constants');
cr;nextPutAll: (self structSourcesFor: aClassName);
cr;nextPutAll: (self apiSourcesFor: aClassName);
yourself.
^sources contents!
sourcesForStructure: aStructure
" Private - Returns the sourceCode expression for aStructure. "
^'registerType: '
, (self nameForStructure: aStructure) printString
,'
as: #(', ((self fieldsForStructure: aStructure)
inject: String new into: [ :total :each|
total,'
',each asString
]),')'!
standardLibraryNamed: aName
"Private - Returns an instance of the receiver with standard definitions."
^self class loadFrom: ('Standard\',aName,self class fileExtension)!
stName: aName
" Private - Returns aName formated as a Smalltalk name. "
| current last stream result |
stream := ReadStream on: aName.
result := WriteStream on: String new.
last := $_.
[stream atEnd] whileFalse: [
current := stream next "asLowerCase".
last = $_ ifTrue: [ current := current asUpperCase ].
current isAlphaNumeric ifTrue: [ result nextPut: current ].
last := current.
].
^result contents!
struct: aScanner
"Private - Gets the next struct expression."
| tag name fields var |
fields := OrderedCollection new.
tag := aScanner nextToken.
tag = '{' ifTrue: [ tag := nil ].
aScanner peekToken = '{'
ifTrue: [ aScanner nextToken ].
[ aScanner peekToken = '}' ] whileFalse: [
var := self nextVarDef: aScanner.
var notNil ifTrue: [ fields add: var ].
].
aScanner nextToken = '}' ifFalse: [ ^self error: '} spected in struct' ].
name := aScanner nextToken.
aScanner peekToken = ';' ifTrue: [aScanner nextToken].
tag isNil ifTrue: [tag := name].
^types at: name put: (Array with: tag with: fields asArray)!
structSourcesFor: aClassName
" Private - Returns the sourceCode for structures implemented in class named aClassName. "
| structures sources |
structures := self structuresDefinedIn: types.
structures size = 0 ifTrue: [ ^String new ].
sources := WriteStream on: String new.
sources
cr;nextPut: $!!;
space;nextPutAll: aClassName;
space;nextPutAll: 'methods !!';cr;
space;nextPutAll: 'initializeStructures
" Private - Initializes the structures for the receiver. "
self';
yourself.
structures do: [:each|
sources
cr;nextPutAll: ' ';
nextPutAll: (self sourcesForStructure: each);
nextPut: $;
].
sources
nextChunkPut: '
yourself.';
nextPutAll: ' !!';cr;
yourself.
^sources contents!
structuresDefinedIn: aDictionary
" Private - Returns the structures defined in aDictionary.
aStructure is an association with
key = name of the structure
value = array of field definitions
"
| result |
result := OrderedCollection new.
aDictionary associationsDo: [:assoc|
((assoc value isMemberOf: Array)
and: [ assoc value last isMemberOf: Array ])
ifTrue: [
result add: (Association
key: assoc key
value: assoc value last)
].
].
^result!
stType: aType
" Private - Returns the smalltalk equivalence for aType. "
(aType isKindOf: Collection) ifTrue: [
^self stType: aType last
].
^aType basicType: self reversed: false!
typedef: aScanner
"Private - Gets the next type expression."
| token type |
token := aScanner nextToken.
token = 'enum' ifTrue: [
self enum: aScanner.
self defineType: aScanner nextName as: #ulong.
aScanner nextToken = ';' ifFalse: [
^self error: 'Missing ;'
].
^self
].
token = 'struct' ifTrue: [
type := self struct: aScanner.
token := aScanner peekToken.
type := type first.
[token = ','] whileTrue: [
aScanner nextToken.
type := self nextVarDef: aScanner startingWith: type.
types at: type name put: type.
type := type name.
].
^self
].
[
type := self nextVarDef: aScanner startingWith: token.
types at: type name put: type.
token := aScanner peekToken.
token = ',' ] whileTrue: [
aScanner nextToken.
token := type name.
].!
typeNamed: typeName
" Private - Returns the type named typeName or generates an error. "
^self typeNamed: typeName ifAbsent: [
self error: 'Missing type ',typeName
]!
typeNamed: typeName ifAbsent: aBlock
" Private - Returns the type named typeName or the result of evaluating aBlock. "
| aType |
(typeName isMemberOf: Array) ifTrue: [
^self error: 'invalid type value.', typeName printString
].
^types at: typeName ifAbsent: [
self includes do: [:each|
aType := each typeNamed: typeName ifAbsent: [ ].
aType notNil ifTrue: [ ^aType ].
].
aBlock value
].!
undef: aScanner
"Private - Gets the next #undef expression."
| name |
[ name := aScanner nextName.
self constants at: name put: nil. "marked as undefined"
aScanner peekToken = ',' ]
whileTrue: [ aScanner nextToken ].!
valueOf: aString
"Private - Returns the value in aString."
| evaluator result |
evaluator := CEvaluator new.
evaluator ifFailed: [:var| self privateValueFor: var ].
result := evaluator evaluate: aString.
result isNil
ifTrue: [
(aString notEmpty
and: [ aString first = $" and: [ aString last = $" ]])
ifTrue: [ ^aString copyFrom: 2 to: aString size - 1 ].
result := Prompter
prompt: 'Value for: ',aString,' {',evaluator errorString,'}'
default: aString asString.
result isNil ifTrue: [^nil].
].
^result!
variableNamed: aName
"Private - Returns the variable named aName. "
^variables at: aName!
variableNamed: aName ifAbsent: aBlock
"Private - Returns the variable named aName or the result of evaluating aBlock. "
^variables
at: aName
ifAbsent: [ aBlock value ]! !
!IDLSourceFile class methods !
defaultInterfacesDefinitions
" Private - Returns the definitions for default interfaces. "
^#(
( 'IUnknown' ( '#QueryInterface|AddRef|Release' ) none )
)! !
!IDLSourceFile methods !
forwardInterface: aName with: attributes
" Private - Process the forward definition of an interface. "
self interface: aName with: attributes.!
hasValidComments
" Returns true if the receiver scan valuable/valid comments. "
^false "do not output comments"!
import: aScanner
" Private - Import a library onto the receiver. "
| aName include |
aScanner clearComment.
aName := aScanner nextString.
aScanner nextToken = ';' ifFalse: [
^self error: '; expected.'
].
include := self libraryNamed: aName.
include hasBeenScanned ifFalse: [
include scan; save.
].
includes add: include!
initializeInterfaces
" Private - Initializes the receiver's interfaces"
interfaces := Dictionary new.
self interfacesNamed: self class defaultInterfacesDefinitions.!
initializeTypes
"Private - Initialize the receiver's types."
super initializeTypes.
self
defineType: 'HRESULT' as: #hresult;
defineType: #( 'double' ) as: #double;
defineType: #( 'LPOLESTR' 'LPWSTR' 'LPCWSTR' 'LPUNKNOWN' ) as: #address;
defineType: #( 'DWORD' 'ULONG' ) as: #ulong;
defineType: #( 'WCHAR' 'OLECHAR' ) as: #short;
yourself.!
interface: aName with: attributes
" Private - Returns the a definition of an interface named aName. "
| result interface |
result := self interfaces
at: aName
ifAbsentPut: [
interface := IDLInterfaceDefinition new
name: aName;
yourself.
self defineType: aName as: interface.
interface
].
attributes notNil ifTrue: [
result attributes: attributes
].
^result!
interface: aName with: attributes parent: aParent
" Private - Returns the a definition of an interface named aName. "
| result interface |
result := self interfaces
at: aName
ifAbsentPut: [
interface := IDLInterfaceDefinition new
name: aName;
yourself.
self defineType: aName as: interface.
interface
].
attributes notNil ifTrue: [
result attributes: attributes
].
result parent: (aParent isString
ifTrue: [ self interfaces at: aParent asString ]
ifFalse: [ aParent ]).
^result!
interfaces
"Returns the instance var of the receiver
for external manipulation"
interfaces isNil ifTrue: [ self initializeInterfaces ].
^interfaces!
interfacesNamed: interfaceDeclarations
" Returns the instances known by the receiver with names.
Define new interfaces for interfaceDeclarations if not already defined. "
| aName attributes aParent |
^interfaceDeclarations collect: [:each|
aParent := attributes := nil.
each isString
ifTrue: [ aName := each ]
ifFalse: [ aName := each first. attributes := each at: 2. aParent := each at: 3 ].
aParent = #none ifTrue: [ aParent := nil ].
self interface: aName with: attributes parent: aParent.
]!
process: aToken with: aScanner
"Private - Process aToken found in aScanner"
aToken = 'cpp_quote' ifTrue: [ ^self processQuote: aScanner ].
aToken = 'interface' ifTrue: [ ^self processInterface: aScanner with: nil ].
aToken = '[' ifTrue: [ ^self processAttributes: aScanner ].
aToken = 'import' ifTrue: [ ^self import: aScanner ].
^super process: aToken with: aScanner!
processAttributes: aScanner
" Private - Process the next attributes & interface. "
| attributes aName |
attributes := self attributesFrom: aScanner.
aName := aScanner nextName.
aName = 'interface' ifFalse: [ ^self error: 'Interface expected.' ].
self processInterface: aScanner with: attributes.!
processInterface: aScanner with: attributes
" Private - Process the next interface. "
| aName interface |
aName := aScanner nextName.
aScanner peek = $;
ifTrue: [
self forwardInterface: aName with: attributes.
aScanner next.
^self
]
ifFalse: [
interface := self interface: aName with: attributes.
interface fillUsing: aScanner and: self.
]!
processQuote: aScanner
" Private - Process the next quote expression. "
| quote |
aScanner peek = $( ifFalse: [ ^self error: 'invalid quote'. ].
aScanner clearComment.
aScanner next.
quote := aScanner nextString.
aScanner peek = $) ifFalse: [ ^self error: 'invalid quote'. ].
aScanner next.!
sourcesForClassNamed: aClassName
" Return the sources for a class named aClassName. "
| result elements |
result := super sourcesForClassNamed: aClassName.
elements := self interfaces select: [:each| each notEmpty ].
elements do: [:each|
result := result , (each sourcesForClassDefinitionIn: self)
].
elements do: [:each|
result := result , (each sourcesForContentsIn: self)
].
^result!
sourcesForInterface: anInterface
" Private - Returns the sources for anInterface defined in the receiver. "
^anInterface sourcesIn: self!
variableNamed: aName ifAbsent: aBlock
"Private - Returns the variable named aName. "
| result |
^self interfaces
at: aName ifAbsent: [
includes do: [:each|
result := each variableNamed: aName ifAbsent: [].
result notNil ifTrue: [ ^result ].
].
super
variableNamed: aName
ifAbsent: aBlock
]! !
!CTypeDefinition class methods !
for: aSourceFile using: aScanner
"Returns an instance of the receiver from aScanner in a CSourceFile"
^self new fillUsing: aScanner and: aSourceFile!
for: aSourceFile using: aScanner ofType: aType
"Returns an instance of the receiver from aScanner in a CSourceFile"
^self new
addType: aType;
fillUsing: aScanner and: aSourceFile!
for: aSourceFile using: aScanner with: aToken
"Returns an instance of the receiver from aScanner in a CSourceFile"
^self new
addType: aToken;
fillUsing: aScanner and: aSourceFile! !
!CTypeDefinition methods !
addAttributes: aCollection
"Private - Add attributes in aCollection. "
aCollection size = 0 ifTrue: [ ^self ].
attributes := attributes size = 0
ifTrue: [ aCollection ]
ifFalse: [ attributes , aCollection ].!
addType: aType
"Private - Add a new type to the receiver"
types add: aType.!
attributes
"Returns the instance var of the receiver
for external manipulation"
attributes isNil ifTrue: [ self initializeAttributes ].
^attributes!
attributes: anObject
"Sets the instance var of the receiver
with anObject. (No checking is done)"
attributes := anObject!
basicType: aSourceFile reversed: reversed
" Returns the receiver's type using types in aSourceFile. "
| chain |
chain := reversed ifTrue: [ types reversed ] ifFalse: [ types ].
^self basicTypeOf: chain in: aSourceFile!
basicTypeOf: chain in: aSourceFile
" Private - Returns the type specified by chain. "
| result current |
chain do: [:each|
current := each.
[ current isSymbol ] whileFalse: [
current isNumber ifTrue: [ ^#struct ].
(current isKindOf: Array) ifTrue: [ ^#struct ].
current := current isString
ifTrue: [ aSourceFile typeNamed: current ]
ifFalse: [ #struct ].
].
"falta hacer encapsulamiento de tipos???"
result := current.
].
^result!
comment
"Returns the instance var of the receiver
for external manipulation"
^comment!
comment: anObject
"Sets the instance var of the receiver
with anObject. (No checking is done)"
comment := anObject!
description
" Private - Return the description of the receiver. "
^'Var/Fn'!
endsWith: aCharacter
"Private - Returns the true if aCharacter ends the receiver's expression"
^#( $; $, $) ) includes: aCharacter!
ensureLowercaseName
" Ensure the name of the receiver start with lowercase letter. "
name size > 0 ifTrue: [
name at: 1 put: name first asLowercase
]!
fieldSpecificationIn: aSourceFile
" Returns the receiver's field specification array. "
| stream result current |
stream := ReadStream on: types asArray.
result := stream next.
current := aSourceFile typeNamed: result ifAbsent: [].
result := current isSymbol | current isNumber
ifTrue: [ current ] ifFalse: [ result ].
[stream atEnd] whileFalse: [
current := stream next.
current isNumber ifTrue: [
result := (aSourceFile sizeInBytesFor: result) * current.
current := nil.
].
current = '*' ifTrue: [
(result isString and: [ result includes: $* ])
ifTrue: [ ^#( ulong asExternalAddress ) ]
ifFalse: [ result := current, (result isString
ifTrue: [ result ]
ifFalse: [ result name ]) ].
current := nil.
].
current isSymbol ifTrue: [ self halt ].
current isString ifTrue: [ result := current ]
].
^Array with: result!
fillNameUsing: aScanner and: aSourceFile
"Private - Fill the receiver's name from aScanner in a CSourceFile"
name isNil ifFalse: [ ^self error: 'Duplicated type name.' ].
name := aScanner nextToken.
comment := aScanner getComment.!
fillTypeUsing: aScanner and: aSourceFile
"Private - Fill the receiver's type from aScanner in a CSourceFile"
| token |
token := aScanner peekToken.
types isEmpty ifTrue: [ aSourceFile mustBeTypeDef: token ].
(aSourceFile isTypeDef: token)
ifTrue: [ self addType: aScanner nextToken ]
ifFalse: [^false ].
^true!
fillUsing: aScanner and: aSourceFile
"Private - Fill the receiver from aScanner in a CSourceFile"
| count expression |
attributes := aSourceFile nextAttributesFrom: aScanner.
[self endsWith: aScanner peek]
whileFalse: [
self addAttributes: (aSourceFile nextAttributesFrom: aScanner).
(self fillTypeUsing: aScanner and: aSourceFile)
ifFalse: [
self fillNameUsing: aScanner and: aSourceFile.
aScanner peek = $[
ifTrue: [
expression := (aScanner stream upTo: $]).
count := aSourceFile valueOf: expression.
count isNil ifTrue: [^self error: 'Error en expresion ',expression ].
self addType: count.
].
^self
].
].
"syntetize the name..."
name isNil & types notEmpty ifTrue: [ name := 'a',types first ].
^self!
initialize
"Private - Initialize the receiver."
super initialize.
types := OrderedCollection new.!
initializeAttributes
" Private - Initializes the receiver's attributes"
attributes := Array new!
isIn
" Returns true if the receiver is defined with 'in' attribute. "
^self attributes includes: 'in'!
isOut
" Returns true if the receiver is defined with 'out' attribute. "
^self attributes includes: 'out'!
isVoid
" Returns true if the receiver is void. "
^self name size = 0!
name
" Returns the name of the receiver. "
^name!
nameAndArguments
"Returns the receiver's name and arguments. "
^self name printString!
oleType: aSourceFile reversed: reversed
" Returns the receiver's ole type using types in aSourceFile. "
| result |
result := self basicType: aSourceFile reversed: reversed.
( #( address struct ) includes: result) ifTrue: [
self isOut ifTrue: [ ^#structOut ].
self isIn ifTrue: [ ^#structIn ].
].
^result!
printOn: aStream
" Append the ASCII representation of the receiver to aStream. "
aStream
nextPutAll: self description;
nextPutAll: ': ',self nameAndArguments;
nextPutAll: (self attributes size > 0 ifTrue: [ self attributes asString ] ifFalse: [ String new ]);
nextPutAll: ' >> ',types asArray asString;
yourself.
self comment size > 0 ifTrue: [
aStream cr;nextPutAll: self comment asString.
].!
sizeInBytesIn: aSourceFile
" Returns the receiver's size inbytes as defined by aSourceFile. "
^self notImplementedYet!
targetStructureIn: aSourceFile
" Returns the receiver's target structure type in aSourceFile.
Warning: the receiver MUST be a structure pointer. "
| chain |
chain := ReadStream on: types reversed.
[ chain peek = '*' ] whileTrue: [ chain next ].
^aSourceFile typeNamed: chain next! !
!CppClassDefinition methods !
classVariablesStringIn: aSourceFile
" Private - Returns the sources for the receiver's class variables. "
^String new!
contents
"Returns the instance var of the receiver
for external manipulation"
contents isNil ifTrue: [ self initializeContents ].
^contents!
fileOutContent: anElement index: index in: aSourceFile to: aStream
" Private - Dump sources for anElement onto aStream. "
^self implementedBySubclass!
fillDefinitionFrom: aScanner and: aSourceFile
" Private - Fill the receiver's contents from aScanner in a aSourceFile. "
| type element theAttributes |
aScanner peekToken = '{' ifFalse: [ ^self error: '{ expected.' ].
aScanner nextToken.
[aScanner peekToken = '}'] whileFalse: [
theAttributes := aSourceFile nextAttributesFrom: aScanner.
type := aScanner nextToken.
(aSourceFile isTypeDef: type)
ifFalse: [ self error: 'missing function return type' ]
ifTrue: [
element := CVariableDefinition for: aSourceFile using: aScanner ofType: type.
element notNil ifTrue: [
element addAttributes: theAttributes.
self contents add: element
]
]
].
aScanner nextToken.!
fillParentFrom: aScanner and: aSourceFile
" Private - Fill the receiver's parent from aScanner in a aSourceFile. "
| aName |
aScanner peekToken = ':' ifFalse: [ ^self error: ': expected.' ].
aScanner nextToken.
parent := aSourceFile
variableNamed: aScanner nextName
ifAbsent: [ self error: 'Missing parent' ].!
fillUsing: aScanner and: aSourceFile
" Private - Fill the receiver from aScanner in a CSourceFile. "
comment := aScanner getComment.
self
fillParentFrom: aScanner and: aSourceFile;
fillDefinitionFrom: aScanner and: aSourceFile;
yourself.!
firstIndexIn: aSourceFile
" Private - Returns the index to be used to generate code for first method defined by the receiver. "
| methodsSize |
parent isNil ifTrue: [ ^0 ].
methodsSize := parent contents size.
methodsSize = 0 ifTrue: [
" (#('IPersist' 'IUnknown' 'IDispatch' ) includes: parent name) ifFalse: [ self halt ]. "
methodsSize := parent methodsSizeFromAttributes
].
^(parent firstIndexIn: aSourceFile) + methodsSize!
initializeContents
" Private - Initializes the receiver's contents"
contents := OrderedCollection new.!
instanceVariablesStringIn: aSourceFile
" Private - Returns the sources for the receiver's instance variables. "
^String new!
isEmpty
" Answer true if the receiver does not contain elements, else answer false. "
^contents size = 0!
methodsSizeFromAttributes
" Private - Returns the number of methods of the receiver extracted from attributes. "
self attributes do: [:each|
(each isString and: [ each first = $# ]) ifTrue: [
^(each occurrencesOf: $|) + 1
]
].
^0!
name: anObject
"Sets the instance var of the receiver
with anObject. (No checking is done)"
name := anObject!
notEmpty
" Answer true if the receiver contains one or more elements, else answer false. "
^contents size > 0!
parent
"Returns the instance var of the receiver
for external manipulation"
^parent!
parent: anObject
"Sets the instance var of the receiver
with anObject. (No checking is done)"
parent := anObject!
poolDictionariesStringIn: aSourceFile
" Private - Returns the sources for the receiver's pool dictionaries. "
^String new "we currently do not bind to pools"!
sourcesForClassDefinition: tokens in: aSourceFile
" Private - Returns the sources for the receiver's class definition. "
^tokens first, self parent name, tokens last
,' subclass: #', tokens first, self name ,tokens last ,'
instanceVariableNames: ',(self instanceVariablesStringIn: aSourceFile) printString ,'
classVariableNames: ',(self classVariablesStringIn: aSourceFile) printString ,'
poolDictionaries: ',(self poolDictionariesStringIn: aSourceFile) printString ,'!!
'!
sourcesForClassDefinitionIn: aSourceFile
" Private - Returns the sources for the receiver's class definition. "
^self
sourcesForClassDefinition: (Array with: String new with: String new)
in: aSourceFile!
sourcesForContentsIn: aSourceFile
" Private - Returns the sources for the receiver's contents. "
| sources index |
sources := WriteStream on: String new.
index := self firstIndexIn: aSourceFile.
self contents do: [:each|
self
fileOutContent: each index: index
in: aSourceFile to: sources.
index := index + 1.
].
^sources contents!
sourcesIn: aSourceFile
" Returns the sources of the receiver defined by aSourceFile. "
^(self sourcesForClassDefinitionIn: aSourceFile),'
',(self sourcesForContentsIn: aSourceFile)! !
!IDLInterfaceDefinition methods !
fileOutContent: anElement index: index in: aSourceFile to: aStream
" Private - Dump sources for anElement onto aStream. "
anElement ensureLowercaseArguments.
anElement requiresInvoke
ifTrue: [
aStream
nextPutAll: (self sourceForInvokeMethod: anElement index: index in: aSourceFile);
nextPutAll: (self
sourceForInterfaceMethod: anElement index: index
in: aSourceFile invoked: true);
yourself
] ifFalse: [
aStream
nextPutAll: (self
sourceForInterfaceMethod: anElement index: index
in: aSourceFile invoked: false);
yourself
].
aStream
nextPutAll: (self sourceForMethod: anElement in: aSourceFile);
yourself.!
iid
" Private - Returns the IID of the receiver (or nil). "
attributes do: [:each|
(each indexOfString: 'uuid(') = 1 ifTrue: [
^GUID fromString: '{',(each copyFrom: 6 to: each size - 1),'}'
].
].
^nil!
implementationOf: anIDLMethod in: aSourceFile
" Private - Returns the implementation of normal call to anIDLMethod. "
| definitions prologue call epilogue outs argument resultReference |
outs := anIDLMethod outParameters.
definitions := WriteStream on: String new.
prologue := WriteStream on: String new.
call := WriteStream on: String new.
epilogue := WriteStream on: String new.
definitions cr;nextPutAll: ' | result'.
outs size > 0 ifTrue: [
epilogue cr;nextPutAll: ' result := '.
outs size > 1 ifTrue: [ epilogue nextPutAll: 'Array ' ].
].
outs do: [:parameter|
argument := parameter name ,'Reference'.
definitions space; nextPutAll: argument.
resultReference := self resultReferenceFor: parameter named: argument in: aSourceFile.
prologue cr;nextPutAll: ' ' ,argument ,' := ' ,resultReference first ,'.'.
outs size > 0 ifTrue: [
outs size > 1
ifTrue: [ epilogue cr;nextPutAll: ' with: ' ,resultReference last ]
ifFalse: [ epilogue nextPutAll: resultReference last ]
].
].
outs size > 0 ifTrue: [ epilogue nextPut: $. ].
definitions space;nextPut: $|.
call
cr;nextPutAll: ' result := interface ';
nextPutAll: (anIDLMethod
methodDefinitionIn: aSourceFile lowercase: false
with: nil and: 'Reference' withComment: false);
nextPut: $.;
cr;nextPutAll: ' (HRESULT succeeded: result) ifFalse: [ ^nil ].';
yourself.
^definitions contents
, prologue contents
, call contents
, epilogue contents
, '
^result'!
invokedImplementationOf: anIDLMethod in: aSourceFile
" Private - Returns the implementation of invoke call to anIDLMethod. "
| definitions prologue invoke epilogue outs argument wrapper |
outs := anIDLMethod outParameters.
definitions := WriteStream on: String new.
prologue := WriteStream on: String new.
invoke := WriteStream on: String new.
epilogue := WriteStream on: String new.
definitions cr;nextPutAll: ' | result'.
outs do: [:parameter|
argument := parameter name ,'Value'.
definitions space; nextPutAll: argument.
wrapper := self wrapperFor: parameter named: argument in: aSourceFile.
prologue cr;nextPutAll: ' ' ,argument ,' := ' ,wrapper first ,'.'.
wrapper last isString ifTrue: [
epilogue cr;nextPutAll: ' ' ,parameter name ,'Reference value: ' ,wrapper last ,'.'.
] ifFalse: [
epilogue cr;nextPutAll: ' ',wrapper last first ,' isValid ifTrue: [ '
,parameter name ,'Reference value: ' ,wrapper last last ,' ].'.
]
].
definitions space;nextPut: $|.
invoke
cr;nextPutAll: ' result := self ';
nextPutAll: (self messageCallFor: anIDLMethod with: 'invoke' in: aSourceFile);
nextPut: $.;
yourself.
^definitions contents
, prologue contents
, invoke contents
, epilogue contents
, '
^result'!
messageCallFor: anIDLMethod with: prologue in: aSourceFile
" Private - Returns the sources for definition of anIDLMethod. "
| result |
result := anIDLMethod
methodDefinitionIn: aSourceFile lowercase: false
with: ' asParameter' and: (prologue size > 0 ifTrue: [ "'Reference" 'Value asParameter' ])
withComment: false.
prologue size > 0 ifTrue: [ ^prologue , result ].
^result!
messageDefinitionFor: anIDLMethod with: prologue in: aSourceFile
" Private - Returns the sources for definition of anIDLMethod. "
| result |
result := anIDLMethod
methodDefinitionIn: aSourceFile lowercase: false
with: nil and: (prologue size > 0 ifTrue: [ 'Reference' ])
withComment: true.
(prologue ~= #none and: [ prologue size > 0 ]) ifTrue: [ ^prologue , result ].
^result!
resultReferenceFor: parameter named: argument in: aSourceFile
" Private - Returns the implementation of a value holder for parameter. "
| target tag |
(aSourceFile oleType: parameter) = #structOut ifTrue: [
target := parameter targetStructureIn: aSourceFile.
(target isKindOf: IDLInterfaceDefinition) ifTrue: [
^Array
with: target name ,' new asValueReference'
with: argument,' value'
].
((target isKindOf: CTypeDefinition)
or: [ (target isArray and: [
tag := target first.
tag first = $_ ])
or: [ target = #double ]]) ifTrue: [
^Array
with: 'nil asValueReference'
with: argument,' value'
].
(#( ulong long byte address struct short hresult handle none ) includes: target) ifTrue: [
^Array
with: 'nil asValueReference'
with: argument,' value',(
target = #address
ifTrue: [ ' asExternalAddress' ]
ifFalse: [ String new ])
].
(target isArray and: [
tag := target first isString])
ifTrue: [
^Array
with: 'nil asValueReference'
with: argument,' value'
].
target notImplementedYet.
].
^Array
with: 'nil asValueReference' halt
with: argument,' value'!
sourceFor: tag method: anIDLMethod index: index in: aSourceFile
" Private - Returns the sources for the anIDLMethod definition. "
^self
sourceFor: tag with: anIDLMethod
of: self name,'Pointer'
implementedAs: '
<ole: ' ,index asString
,(anIDLMethod oleArgumentsIn: aSourceFile) ,' >
^self vtableDispatchFailed'
in: aSourceFile!
sourceFor: prologue with: anIDLMethod
of: implementor implementedAs: implementation
in: aSourceFile
" Private - Returns the sources for anIDLMethod source code. "
^self
sourceForMethodDefinedAs:
(self messageDefinitionFor: anIDLMethod with: prologue in: aSourceFile)
, implementation
by: implementor!
sourceForInterfaceMethod: anIDLMethod index: index in: aSourceFile invoked: invoked
" Private - Returns the sources for interface pointer the anIDLMethod definition. "
invoked ifFalse: [ "direct interface, no invoke wrapper"
^self
sourceFor: nil method: anIDLMethod
index: index in: aSourceFile
].
^self
sourceFor: #none with: anIDLMethod
of: self name,'Pointer'
implementedAs: (self
invokedImplementationOf: anIDLMethod
in: aSourceFile)
in: aSourceFile!
sourceForInvokeMethod: anIDLMethod index: index in: aSourceFile
" Private - Returns the sources for the anIDLMethod definition. "
^self
sourceFor: #invoke method: anIDLMethod
index: index in: aSourceFile!
sourceForMethod: anIDLMethod in: aSourceFile
" Private - Returns the source code for the top level interface specified by anElement. "
^self
sourceForMethodDefinedAs:
(anIDLMethod
methodDefinitionIn: aSourceFile lowercase: true
with: nil and: nil withComment: true)
, (self
implementationOf: anIDLMethod
in: aSourceFile)
by: self name!
sourceForMethodDefinedAs: code by: implementor
" Private - Returns the source code for a method defined by code. "
(code indexOfString: 'GENERATED') = 0 ifTrue: [ self halt ].
^'!! ',implementor,' methods !!
',code,'!! !!
'!
sourcesForClassDefinition: tokens in: aSourceFile
" Private - Returns the sources for the receiver's class definition. "
^(super sourcesForClassDefinition: tokens in: aSourceFile)
,(self sourcesForIIDDefinition: tokens in: aSourceFile)!
sourcesForClassDefinitionIn: aSourceFile
" Private - Returns the sources for the receiver's class definition. "
^(super sourcesForClassDefinitionIn: aSourceFile)
, (self
sourcesForClassDefinition: (Array with: String new with: 'Pointer')
in: aSourceFile)!
sourcesForIIDDefinition: tokens in: aSourceFile
" Private - Returns the sources for the receiver's IID definition. "
| iid |
iid := self iid.
iid isNil ifTrue: [ ^String new ].
^self
sourceForMethodDefinedAs: 'defaultIID
" GENERATED, Private - Returns the interface ID GUID of the receiver. "
^GUID fromString: ', iid asString printString
by: tokens first,self name,tokens last,' class'!
wrapperFor: parameter named: argument in: aSourceFile
" Private - Returns the implementation of a value holder for parameter. "
| target tag |
(aSourceFile oleType: parameter) = #structOut ifTrue: [
target := parameter targetStructureIn: aSourceFile.
(target isKindOf: IDLInterfaceDefinition) ifTrue: [
^Array
with: target name ,'Pointer forReturnValue'
with: (Array with: argument) "validated argument"
].
(target isKindOf: CTypeDefinition) ifTrue: [
^Array
with: 'OLEStructure forReturnValue: #',(aSourceFile stName: target name)
with: (Array with: argument) "validated argument"
].
(target isArray and: [
tag := target first.
tag first = $_ ]) ifTrue: [
^Array
with: (self wrapperForReturnValue: (tag copyFrom: 2 to: tag size) in: aSourceFile)
with: argument
].
(#( ulong address struct none ) includes: target) ifTrue: [
^Array
with: 'ExternalLong new'
with: argument,' asUnsignedInteger'
].
(#( long byte short hresult handle ) includes: target) ifTrue: [
^Array
with: 'ExternalLong new'
with: argument,' asInteger'
].
target = #double ifTrue: [
^Array
with: 'Float new'
with: argument
].
(target isArray and: [
tag := target first.
(MessageBox confirm: 'Is structure ',tag,' ?') ]) ifTrue: [
^Array
with: (self wrapperForReturnValue: tag in: aSourceFile)
with: argument
].
target notImplementedYet.
].
^Array
with: 'ExternalLong new' halt
with: argument,' asUnsignedLong'
"
para..... | se usa holder..... |value....
DWORD * | 'ExternalLong new' |argument,' asUnsignedLong'
IID * | 'GUID forReturnValue' |argument
OLEStructureXXX * | 'OLEStructure forReturnValue: #StructureXXX' |argument
LPEnumXXXIID * | 'IEnumPointer forReturnValue: IID_IEnumXXX' |argument
"!
wrapperForReturnValue: structureName in: aSourceFile
" Private - Returns the code for wrapper intantiation of structure. "
| aType |
(Smalltalk includesKey: structureName asSymbol) ifTrue: [
^structureName, ' forReturnValue'
].
^'self returnValueForStructureNamed: ',structureName printString! !
!CVariableDefinition methods !
description
" Private - Return the description of the receiver. "
self isApi ifTrue: [ ^'api' ].
^super description!
ensureLowercaseArguments
" Ensure the arguments defined in the receiver are lowercase. "
parameters size > 0 ifTrue: [
parameters do: [:each| each ensureLowercaseName ]
]!
fillNameUsing: aScanner and: aSourceFile
"Private - Fill the receiver's name from aScanner in a CSourceFile"
super fillNameUsing: aScanner and: aSourceFile.
(aScanner peek = $( or: [
(self basicType: aSourceFile reversed: true) = #api
]) ifTrue: [ self getParamsUsing: aScanner and: aSourceFile ].
aScanner peek = $; ifTrue: [ aScanner next ].!
getParamsUsing: aScanner and: aSourceFile
"Private - Fill the receiver's parameters from aScanner in a CSourceFile"
| token param |
aScanner peek = $( ifFalse: [^self].
parameters := OrderedCollection new.
[ aScanner next.
param := CTypeDefinition for: aSourceFile using: aScanner.
param isVoid ifFalse: [ parameters add: param ].
aScanner peek = $)] whileFalse: [].
aScanner next.
parameters := parameters asArray.!
isApi
" Private - True if the receiver is an API call. "
^parameters notNil!
methodDefinitionIn: aSourceFile lowercase: lowercase
" Private - Return the source code of the receiver's method implementation. "
^self
methodDefinitionIn: aSourceFile
lowercase: lowercase with: nil and: nil
withComment: true!
methodDefinitionIn: aSourceFile lowercase: lowercase
with: inExtent and: outExtent
withComment: withComment
" Private - Return the source code of the receiver's method implementation. "
| keyword sources params argument parameter aComment |
sources := WriteStream on: String new.
keyword := aSourceFile stName: self name.
lowercase ifTrue: [
keyword at: 1 put: keyword first asLowercase
].
sources nextPutAll: keyword.
params := ReadStream on: parameters.
[params atEnd] whileFalse: [
parameter := params next.
sources nextPutAll: ': '.
argument := aSourceFile stName: parameter name.
argument at: 1 put: argument first asLowercase.
sources nextPutAll: argument.
(outExtent size > 0 and: [ parameter isOut ]) ifTrue: [
sources nextPutAll: outExtent
] ifFalse: [
(inExtent size > 0 and: [ parameter isIn ]) ifTrue: [
sources nextPutAll: inExtent
]
].
params atEnd ifFalse: [
sources nextPutAll: ' '.
keyword := aSourceFile stName: params peek name.
keyword at: 1 put: keyword first asLowercase.
sources nextPutAll: keyword.
].
].
withComment ifTrue: [
sources cr.
aComment := aSourceFile hasValidComments ifTrue: [ self comment ].
aComment size > 0 ifTrue: [
sources tab;nextPutAll: '" GENERATED - ',aComment trimBlanks,' "';cr
] ifFalse: [ sources tab;nextPutAll: '" GENERATED - No comment. "';cr ].
].
^sources contents!
nameAndArguments
" Returns the name and arguments of the receiver. "
^super nameAndArguments, ' ', parameters printString!
oleArgumentsIn: aSourceFile
" Private - Return the source code of the receiver's arguments to be passed through OLE interface. "
| keyword sources params argument |
sources := WriteStream on: String new.
params := ReadStream on: parameters.
[params atEnd] whileFalse: [
argument := aSourceFile oleType: params next.
(#( none ) includes: argument) ifTrue: [ argument := #ulong ].
sources space;nextPutAll: argument.
].
argument := aSourceFile stType: self.
(#( ulong struct ) includes: argument) ifTrue: [ argument := #ulongReturn ].
sources space;nextPutAll: argument.
^sources contents!
outParameters
" Retruns the parameters defined with out attribute. "
^parameters select: [:each| each isOut ]!
requiresInvoke
" Returns true if the receiver must be wrapped with an invoke definition. "
| attr |
parameters size = 0 ifTrue: [ ^false ].
parameters detect: [:one| one isOut ] ifNone: [ ^false ].
^true!
sourceStringIn: aSourceFile
" Private - Return the source code of the receiver. "
| sources params argument |
sources := WriteStream on: String new.
sources nextPutAll: (self methodDefinitionIn: aSourceFile lowercase: true).
sources
cr;tab;nextPutAll: '<',self description,':';
space;nextPutAll: self name printString.
params := ReadStream on: parameters.
[params atEnd] whileFalse: [
argument := aSourceFile stType: params next.
(#( none ) includes: argument) ifTrue: [ argument := #ulong ].
sources space;nextPutAll: argument.
].
argument := aSourceFile stType: self.
(#( ulong struct ) includes: argument) ifTrue: [ argument := #ulongReturn ].
sources space;nextPutAll: argument.
sources
nextPut: $>;cr;
tab;nextPutAll: '^self invalidArgument';
yourself.
^sources contents! !