--- a/ByteCodeCompiler.st Tue Mar 28 19:45:42 2006 +0200
+++ b/ByteCodeCompiler.st Wed Mar 29 14:06:27 2006 +0200
@@ -2845,7 +2845,7 @@
ifFail:[ #Error ]
!
-compile:aStringArg forClass:aClassArg inCategory:cat notifying:requestor
+compile:sourceCodeStringArg forClass:aClassArg inCategory:cat notifying:requestor
install:install skipIfSame:skipIfSame silent:silent foldConstants:fold
ifFail:failBlock
@@ -2864,12 +2864,12 @@
|newMethod tree symbolicCodeArray oldMethod lazy silencio
sourceFile sourceStream newSource primNr pos keptOldCode answer
- pkg aClass aString errorOccurred oldCategory newCategory|
+ aClass sourceCodeString hasErrorInMethodHeader oldCategory newCategory oldPackage newPackage|
aClass := aClassArg.
- aString := aStringArg.
-
- aString isNil ifTrue:[^ nil].
+ sourceCodeString := sourceCodeStringArg.
+
+ sourceCodeString isNil ifTrue:[^ nil].
silencio := silent
or:[Smalltalk silentLoading == true
or:[ListCompiledMethods == false]].
@@ -2882,7 +2882,7 @@
RestartCompilationSignal handle:[:ex |
"/ class could have changed ...
aClass := self classToCompileFor.
- aString := self correctedSource ? aStringArg.
+ sourceCodeString := self correctedSource ? sourceCodeStringArg.
methodArgs := methodArgNames := methodVars := methodVarNames := nil.
usedInstVars := usedClassVars := usedVars := nil.
modifiedInstVars := modifiedClassVars := modifiedGlobals := nil.
@@ -2891,7 +2891,7 @@
] do:[
"create a compiler, let it parse and create the parsetree"
- self source:(ReadStream on:aString string).
+ self source:(ReadStream on:sourceCodeString string).
self nextToken.
self setClassToCompileFor:aClass.
@@ -2905,7 +2905,8 @@
self warnUndeclared:false.
].
- (errorOccurred := (self parseMethodSpec == #Error)) ifTrue:[
+ hasErrorInMethodHeader := (self parseMethodSpec == #Error).
+ hasErrorInMethodHeader ifTrue:[
self parseError:'syntax error in method specification'.
tree := #Error.
] ifFalse:[
@@ -2915,83 +2916,94 @@
].
].
+ hasErrorInMethodHeader ifTrue:[
+ self showErrorMessageForClass:aClass.
+ ^ failBlock value.
+ ].
+
(aClass notNil and:[selector notNil]) ifTrue:[
oldMethod := aClass compiledMethodAt:selector.
oldMethod notNil ifTrue:[
oldCategory := oldMethod category.
+ oldPackage := oldMethod package.
].
].
+
+ (aClass notNil and:[aClass owningClass notNil
+ and:[parserFlags allowExtensionsToPrivateClasses not]]) ifTrue:[
+ "inherit private classe's package from owning class"
+ newPackage := aClass owningClass package
+ ] ifFalse:[
+ (requestor respondsTo:#packageToInstall) ifTrue:[
+ "if there is an requestor who knows about the package, use it"
+ newPackage := requestor packageToInstall
+ ] ifFalse:[
+ "if noone answers our package query, do not use the default
+ but use an existing method's package instead"
+ (oldPackage isNil or:[Class packageQuerySignal isHandled]) ifTrue:[
+ newPackage := Class packageQuerySignal query.
+ ] ifFalse:[
+ newPackage := oldPackage.
+ ].
+ ].
+ ].
+
newCategory := cat.
newCategory isNil ifTrue:[
newCategory := oldCategory ? '* As yet uncategorized *'.
].
- errorOccurred ifFalse:[
- (aClass isNil or:[parserFlags allowExtensionsToPrivateClasses or:[aClass owningClass isNil]]) ifTrue:[
- (requestor respondsTo:#packageToInstall) ifFalse:[
- pkg := Class packageQuerySignal query.
- ] ifTrue:[
- pkg := requestor packageToInstall
- ].
- ] ifFalse:[
- pkg := aClass owningClass package
+ lazy ifTrue:[
+ "/
+ "/ that one method IS required
+ "/
+ (aClass isMeta and:[selector == #version]) ifTrue:[
+ lazy := false
].
-
- lazy ifTrue:[
- "/
- "/ that one method IS required
- "/
- (aClass isMeta and:[selector == #version]) ifTrue:[
- lazy := false
- ].
- "/
- "/ primitives also
- "/
- (self hasNonOptionalPrimitiveCode
- or:[self hasPrimitiveCode and:[self class canCreateMachineCode]])
- ifTrue:[
- lazy := false
- ].
+ "/
+ "/ primitives also
+ "/
+ (self hasNonOptionalPrimitiveCode
+ or:[self hasPrimitiveCode and:[self class canCreateMachineCode]])
+ ifTrue:[
+ lazy := false
].
-
- lazy ifFalse:[
- "check if same source"
- skipIfSame ifTrue:[
- oldMethod notNil ifTrue:[
- oldMethod source = aString ifTrue:[
- oldMethod isInvalid ifFalse:[
- silencio ifFalse:[
- Transcript showCR:(' unchanged: ',aClass name,' ',selector)
- ].
- "
- same. however, category may be different
- "
- (newCategory ~= oldCategory) ifTrue:[
- oldMethod category:newCategory.
+ ].
+
+ lazy ifFalse:[
+ "check if same source"
+ (skipIfSame and:[oldMethod notNil and:[oldMethod source = sourceCodeString]]) ifTrue:[
+ oldMethod isInvalid ifFalse:[
+ silencio ifFalse:[
+ Transcript showCR:(' unchanged: ',aClass name,' ',selector)
+ ].
+ "
+ same. however, category may be different
+ "
+ (newCategory ~= oldCategory) ifTrue:[
+ oldMethod category:newCategory.
"/ aClass updateRevisionString.
- aClass addChangeRecordForMethodCategory:oldMethod category:newCategory.
- silencio ifFalse:[
- Transcript showCR:(' (category change only)')
- ].
- ].
- "
- and package may be too.
- "
- (pkg notNil and:[pkg ~~ oldMethod package]) ifTrue:[
- oldMethod package:pkg.
- silencio ifFalse:[
- Transcript showCR:(' (package-id change only)')
- ].
- ].
- ^ oldMethod
- ]
- ]
- ]
- ].
- ]
+ aClass addChangeRecordForMethodCategory:oldMethod category:newCategory.
+ silencio ifFalse:[
+ Transcript showCR:(' (category change only)')
+ ].
+ ].
+ "
+ and package may be too.
+ "
+ (newPackage notNil and:[newPackage ~~ oldPackage]) ifTrue:[
+ oldMethod package:newPackage.
+ silencio ifFalse:[
+ Transcript showCR:(' (package-id change only)')
+ ].
+ ].
+ ^ oldMethod
+ ]
+ ].
].
(self errorFlag or:[tree == #Error]) ifTrue:[
+ "error in method body"
self showErrorMessageForClass:aClass.
^ failBlock value
].
@@ -3006,10 +3018,10 @@
freak-out support for inline C-code...
"
((self hasNonOptionalPrimitiveCode
- or:[(self hasPrimitiveCode and:[self class canCreateMachineCode])
- or:[ParserFlags stcCompilation == #always and:[selector ~~ #doIt]]])
- and:[(ParserFlags stcCompilation ~~ #never)
- and:[NewPrimitives ~~ true]]) ifTrue:[
+ or:[(self hasPrimitiveCode and:[self class canCreateMachineCode])
+ or:[ParserFlags stcCompilation == #always and:[selector ~~ #doIt]]])
+ and:[(ParserFlags stcCompilation ~~ #never)
+ and:[NewPrimitives ~~ true]]) ifTrue:[
Parser::ParseError handle:[:ex |
self parseError:(ex description) position:1.
newMethod := #Error.
@@ -3018,7 +3030,7 @@
(STCCompilerInterface new
originator:self;
parserFlags:parserFlags)
- compileToMachineCode:aString
+ compileToMachineCode:sourceCodeString
forClass:aClass
selector:selector
inCategory:cat
@@ -3034,17 +3046,14 @@
].
(newMethod == #CannotLoad) ifTrue:[
- newMethod := self trappingStubMethodFor:aString inCategory:newCategory.
- newMethod setPackage:pkg.
+ newMethod := self trappingStubMethodFor:sourceCodeString inCategory:newCategory.
+ newMethod setPackage:newPackage.
keptOldCode := false.
install ifTrue:[
"/
"/ be very careful with existing methods
"/ (otherwise, you could easily make your system unusable in systems which cannot load)
"/
- selector notNil ifTrue:[
- oldMethod := aClass compiledMethodAt:selector
- ].
(oldMethod notNil and:[oldMethod code ~= newMethod code]) ifTrue:[
answer := Dialog
confirm:
@@ -3083,8 +3092,8 @@
"/
"/ generate a trapping method, if primitive code is present
"/
- NewPrimitives ~~ true ifTrue:[
- newMethod := self trappingStubMethodFor:aString inCategory:newCategory.
+ NewPrimitives ifFalse:[
+ newMethod := self trappingStubMethodFor:sourceCodeString inCategory:newCategory.
install ifTrue:[
aClass addSelector:selector withMethod:newMethod.
].
@@ -3107,32 +3116,23 @@
]
].
sourceStream isNil ifTrue:[
- newMethod source:aString string.
+ newMethod source:sourceCodeString string.
] ifFalse:[
sourceStream setToEnd.
pos := sourceStream position1Based.
- sourceStream nextChunkPut:aString.
+ sourceStream nextChunkPut:sourceCodeString.
sourceStream close.
newMethod sourceFilename:sourceFile position:pos.
].
newMethod setCategory:newCategory.
-pkg := aClass package.
-"/ aClass owningClass isNil ifTrue:[
-"/ pkg := Class packageQuerySignal query.
-"/ ] ifFalse:[
-"/ pkg := aClass owningClass package
-"/ ].
- newMethod setPackage:pkg.
-"/ Project notNil ifTrue:[
-"/ newMethod package:(Project currentPackageName)
-"/ ].
+ newMethod setPackage:newPackage.
newMethod numberOfArgs:selector numArgs.
aClass addSelector:selector withLazyMethod:newMethod.
^ newMethod
].
primNr := self primitiveNumber.
- ((NewPrimitives == true) or:[primNr isNil]) ifTrue:[
+ (NewPrimitives or:[primNr isNil]) ifTrue:[
"
produce symbolic code first
"
@@ -3157,7 +3157,7 @@
finally create the new method-object
"
newMethod := self createMethod.
- NewPrimitives == true ifTrue:[
+ NewPrimitives ifTrue:[
newMethod byteCode:(self code).
primNr isNil ifTrue:[
self hasNonOptionalPrimitiveCode ifTrue:[
@@ -3179,7 +3179,7 @@
if there where any corrections, install the updated source
"
(newSource := self correctedSource) isNil ifTrue:[
- newSource := aString string.
+ newSource := sourceCodeString string.
].
(newSource includes:Character return) ifTrue:[
"/ see if it contains crlf's or only cr's
@@ -3187,20 +3187,8 @@
].
newMethod source:newSource.
newMethod setCategory:newCategory.
-
- aClass notNil ifTrue:[
- (install not
- and:[(oldMethod := aClass compiledMethodAt:selector) notNil]) ifTrue:[
- pkg := oldMethod package
- ] ifFalse:[
- (parserFlags allowExtensionsToPrivateClasses or:[aClass owningClass isNil]) ifTrue:[
- pkg := Class packageQuerySignal query.
- ] ifFalse:[
- pkg := aClass owningClass package
- ].
- ].
- newMethod setPackage:pkg.
- ].
+ newMethod setPackage:newPackage.
+
(self contextMustBeReturnable) ifTrue:[
newMethod contextMustBeReturnable:true
].
@@ -3266,7 +3254,7 @@
!ByteCodeCompiler class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.234 2006-02-08 18:28:26 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.235 2006-03-29 12:06:27 stefan Exp $'
! !
ByteCodeCompiler initialize!