*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Tue, 20 Jun 2000 20:20:02 +0200
changeset 5405 f07c8045ab4e
parent 5404 633f3ccac244
child 5406 4a6995b61c0e
*** empty log message ***
Method.st
--- 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!