--- a/Method.st Tue Jun 20 12:50:48 2000 +0200
+++ b/Method.st Tue Jun 20 20:20:02 2000 +0200
@@ -991,6 +991,37 @@
"Modified: 5.1.1997 / 01:01:53 / cg"
!
+asByteCodeMethodWithSource:newSource
+ "if the receiver has no bytecodes, create & return a method having
+ the same semantics as the receiver, but uses interpreted bytecodes.
+ Otherwise, return the receiver. The new method is not installed in
+ the methodDictionary of any class - just returned.
+ If the method contains primitive code, this may return a method
+ without bytecode.
+ Can be used to obtain a bytecode version of a machine-code method,
+ for binary storage or dynamic recompilation (which is not yet finished)
+ or to compile lazy methods down to executable ones."
+
+ |doMachineCode mthd|
+
+ byteCode notNil ifTrue:[
+ "
+ is already a bytecoded method
+ "
+ ^ self
+ ].
+ doMachineCode := Compiler stcCompilation:#never.
+ [
+ mthd := self asExecutableMethodWithSource:newSource.
+ ] valueNowOrOnUnwindDo:[
+ Compiler stcCompilation:doMachineCode.
+ ].
+ ^ mthd
+
+ "Created: 24.10.1995 / 14:02:32 / cg"
+ "Modified: 5.1.1997 / 01:01:53 / cg"
+!
+
asExecutableMethod
"if the receiver has neither bytecodes nor machinecode, create & return a
method having semantics as the receivers source. This may be machine code,
@@ -1088,6 +1119,80 @@
"Modified: 10.1.1997 / 17:55:33 / cg"
!
+asExecutableMethodWithSource:newSource
+ |temporaryMethod cls silent lazy|
+
+ cls := self containingClass.
+ cls isNil ifTrue:[
+ 'Method [warning]: cannot generate bytecode (no class for compilation)' errorPrintCR.
+ ^ nil
+ ].
+
+ "we have to sequentialize this using a lock-semaphore,
+ to make sure only one method is compiled at a time.
+ Otherwise, we might get into trouble, if (due to a timeout)
+ another recompile is forced while compiling this one ...
+ (happened when autoloading animation demos)
+ "
+ CompilationLock critical:[
+ "
+ dont want this to go into the changes file,
+ dont want output on Transcript and definitely
+ dont want a lazy method ...
+ "
+ Class withoutUpdatingChangesDo:[
+ silent := Smalltalk silentLoading:true.
+ lazy := Compiler compileLazy:false.
+
+ [
+ |compiler|
+
+ Class nameSpaceQuerySignal answer:(cls nameSpace)
+ do:[
+ compiler := cls compilerClass.
+
+ "/
+ "/ kludge - have to make ST/X's compiler protocol
+ "/ be compatible to ST-80's
+ "/
+ (compiler respondsTo:#compile:forClass:inCategory:notifying:install:)
+ ifTrue:[
+ temporaryMethod := compiler
+ compile:newSource
+ forClass:cls
+ inCategory:(self category)
+ notifying:nil
+ install:false.
+ ] ifFalse:[
+ temporaryMethod := compiler new
+ compile:newSource
+ in:cls
+ notifying:nil
+ ifFail:nil
+ ].
+ ].
+ ] valueNowOrOnUnwindDo:[
+ Compiler compileLazy:lazy.
+ Smalltalk silentLoading:silent.
+ ]
+ ].
+ ].
+ (temporaryMethod isNil or:[temporaryMethod == #Error]) ifTrue:[
+ 'Method [warning]: cannot generate bytecode (contains primitive code or error)' errorPrintCR.
+ ^ nil.
+ ].
+ "/
+ "/ try to save a bit of memory, by sharing the source (whatever it is)
+ "/
+ temporaryMethod source:newSource.
+ "/
+ "/ dont forget the methods class & package ...
+ "/
+ temporaryMethod setPackage:package.
+ temporaryMethod mclass:mclass.
+ ^ temporaryMethod
+!
+
readBinaryContentsFrom: stream manager: manager
self hasCode ifTrue:[
"built-in method - already complete"
@@ -1759,6 +1864,49 @@
!Method methodsFor:'private-compiler interface'!
+primitiveNumber
+ "for stx rel >= 5.x only:
+ return the primitive number."
+
+%{ /* NOCONTEXT */
+
+#ifdef F_PRIMITIVE
+ INT f = __intVal(__INST(flags));
+ INT nr = nil;
+
+ if (f & F_PRIMITIVE) {
+ nr = __INST(code_);
+ }
+ RETURN (nr);
+#endif
+%}.
+ self primitiveFailed
+
+
+
+!
+
+setPrimitiveNumber:aNumber
+ "for stx rel >= 5.x only:
+ mark the method as having primitive code."
+
+%{ /* NOCONTEXT */
+
+#ifdef F_PRIMITIVE
+ INT f = __intVal(__INST(flags));
+
+ f |= F_PRIMITIVE;
+ __INST(flags) = __MKSMALLINT(f);
+ __INST(code_) = aNumber;
+ RETURN (self);
+#endif
+%}.
+ self primitiveFailed
+
+
+
+!
+
setResourceFlag
"mark the method as having a <resource> definition in its
source.
@@ -2558,6 +2706,6 @@
!Method class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.192 2000-06-17 15:43:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.193 2000-06-20 18:20:02 cg Exp $'
! !
Method initialize!