2219 ]. |
2219 ]. |
2220 |
2220 |
2221 self startCodeGenerationHookOn:codeStream. |
2221 self startCodeGenerationHookOn:codeStream. |
2222 self generateVariables:methodVars on:codeStream. |
2222 self generateVariables:methodVars on:codeStream. |
2223 |
2223 |
2224 thisStatement := tree. |
2224 (tree isKindOf:MethodNode) ifTrue:[ |
2225 [thisStatement notNil] whileTrue:[ |
2225 "kludge for VW compat." |
2226 lastStatement := thisStatement. |
2226 tree codeForSideEffectOn:codeStream inBlock:nil for:self. |
2227 thisStatement codeForSideEffectOn:codeStream inBlock:nil for:self. |
2227 lastStatement := tree statements last. |
2228 thisStatement := thisStatement nextStatement |
2228 ] ifFalse:[ |
|
2229 thisStatement := tree. |
|
2230 [thisStatement notNil] whileTrue:[ |
|
2231 lastStatement := thisStatement. |
|
2232 thisStatement codeForSideEffectOn:codeStream inBlock:nil for:self. |
|
2233 thisStatement := thisStatement nextStatement |
|
2234 ]. |
2229 ]. |
2235 ]. |
2230 |
2236 |
2231 (lastStatement isNil or:[lastStatement isReturnNode not]) |
2237 (lastStatement isNil or:[lastStatement isReturnNode not]) |
2232 ifTrue:[ |
2238 ifTrue:[ |
2233 "not a return - add retSelf" |
2239 "not a return - add retSelf" |
2246 ]. |
2252 ]. |
2247 codeStream nextPut:#retSelf |
2253 codeStream nextPut:#retSelf |
2248 ]. |
2254 ]. |
2249 ^ codeStream contents |
2255 ^ codeStream contents |
2250 |
2256 |
2251 "Modified: 15.8.1996 / 17:35:02 / stefan" |
2257 "Modified: / 15-08-1996 / 17:35:02 / stefan" |
|
2258 "Modified: / 06-08-2006 / 15:03:14 / cg" |
2252 ! |
2259 ! |
2253 |
2260 |
2254 generateVariables:varCollection on:codeStream |
2261 generateVariables:varCollection on:codeStream |
2255 varCollection isNil ifTrue:[^ self]. |
2262 varCollection isNil ifTrue:[^ self]. |
2256 |
2263 |
2696 If skipIsSame is true, and the source is the same as an existing |
2703 If skipIsSame is true, and the source is the same as an existing |
2697 methods source, this is a noop (for fast fileIn). |
2704 methods source, this is a noop (for fast fileIn). |
2698 The argument, silent controls if errors are to be reported. |
2705 The argument, silent controls if errors are to be reported. |
2699 Returns the method, #Error or nil." |
2706 Returns the method, #Error or nil." |
2700 |
2707 |
2701 |newMethod tree symbolicCodeArray oldMethod lazy silencio |
2708 |newMethod tree symbolicCodeArray oldMethod silencio |
2702 sourceFile sourceStream newSource primNr pos keptOldCode answer |
2709 sourceFile sourceStream newSource primNr pos keptOldCode answer |
2703 aClass sourceCodeString hasErrorInMethodHeader oldCategory newCategory oldPackage newPackage| |
2710 aClass sourceCodeString hasErrorInMethodHeader oldCategory newCategory oldPackage newPackage| |
2704 |
2711 |
2705 aClass := aClassArg. |
2712 aClass := aClassArg. |
2706 sourceCodeString := sourceCodeStringArg. |
2713 sourceCodeString := sourceCodeStringArg. |
2707 |
2714 |
2708 sourceCodeString isNil ifTrue:[^ nil]. |
2715 sourceCodeString isNil ifTrue:[^ nil]. |
2709 silencio := silent |
2716 silencio := silent |
2710 or:[Smalltalk silentLoading == true |
2717 or:[Smalltalk silentLoading == true |
2711 or:[ListCompiledMethods == false]]. |
2718 or:[ListCompiledMethods == false]]. |
2712 |
|
2713 "lazy compilation is EXPERIMENTAL" |
|
2714 lazy := (LazyCompilation == true) and:[install]. |
|
2715 "/ no longer ... |
|
2716 lazy := false. |
|
2717 |
2719 |
2718 RestartCompilationSignal handle:[:ex | |
2720 RestartCompilationSignal handle:[:ex | |
2719 "/ class could have changed ... |
2721 "/ class could have changed ... |
2720 aClass := self classToCompileFor. |
2722 aClass := self classToCompileFor. |
2721 sourceCodeString := self correctedSource ? sourceCodeStringArg. |
2723 sourceCodeString := self correctedSource ? sourceCodeStringArg. |
2787 newCategory := cat. |
2789 newCategory := cat. |
2788 newCategory isNil ifTrue:[ |
2790 newCategory isNil ifTrue:[ |
2789 newCategory := oldCategory ? '* As yet uncategorized *'. |
2791 newCategory := oldCategory ? '* As yet uncategorized *'. |
2790 ]. |
2792 ]. |
2791 |
2793 |
2792 lazy ifTrue:[ |
2794 "check if same source" |
2793 "/ |
2795 (skipIfSame and:[oldMethod notNil and:[oldMethod source = sourceCodeString]]) ifTrue:[ |
2794 "/ that one method IS required |
2796 oldMethod isInvalid ifFalse:[ |
2795 "/ |
2797 silencio ifFalse:[ |
2796 (aClass isMeta and:[selector == #version]) ifTrue:[ |
2798 Transcript showCR:(' unchanged: ',aClass name,' ',selector) |
2797 lazy := false |
2799 ]. |
2798 ]. |
2800 " |
2799 "/ |
2801 same. however, category may be different |
2800 "/ primitives also |
2802 " |
2801 "/ |
2803 (newCategory ~= oldCategory) ifTrue:[ |
2802 (self hasNonOptionalPrimitiveCode |
2804 oldMethod category:newCategory. |
2803 or:[self hasPrimitiveCode and:[self class canCreateMachineCode]]) |
2805 "/ aClass updateRevisionString. |
2804 ifTrue:[ |
2806 aClass addChangeRecordForMethodCategory:oldMethod category:newCategory. |
2805 lazy := false |
|
2806 ]. |
|
2807 ]. |
|
2808 |
|
2809 lazy ifFalse:[ |
|
2810 "check if same source" |
|
2811 (skipIfSame and:[oldMethod notNil and:[oldMethod source = sourceCodeString]]) ifTrue:[ |
|
2812 oldMethod isInvalid ifFalse:[ |
|
2813 silencio ifFalse:[ |
2807 silencio ifFalse:[ |
2814 Transcript showCR:(' unchanged: ',aClass name,' ',selector) |
2808 Transcript showCR:(' (category change only)') |
2815 ]. |
2809 ]. |
2816 " |
2810 ]. |
2817 same. however, category may be different |
2811 " |
2818 " |
2812 and package may be too. |
2819 (newCategory ~= oldCategory) ifTrue:[ |
2813 " |
2820 oldMethod category:newCategory. |
2814 (newPackage notNil and:[newPackage ~~ oldPackage]) ifTrue:[ |
2821 "/ aClass updateRevisionString. |
2815 oldMethod package:newPackage. |
2822 aClass addChangeRecordForMethodCategory:oldMethod category:newCategory. |
2816 silencio ifFalse:[ |
2823 silencio ifFalse:[ |
2817 Transcript showCR:(' (package-id change only)') |
2824 Transcript showCR:(' (category change only)') |
|
2825 ]. |
|
2826 ]. |
2818 ]. |
2827 " |
2819 ]. |
2828 and package may be too. |
2820 ^ oldMethod |
2829 " |
2821 ] |
2830 (newPackage notNil and:[newPackage ~~ oldPackage]) ifTrue:[ |
|
2831 oldMethod package:newPackage. |
|
2832 silencio ifFalse:[ |
|
2833 Transcript showCR:(' (package-id change only)') |
|
2834 ]. |
|
2835 ]. |
|
2836 ^ oldMethod |
|
2837 ] |
|
2838 ]. |
|
2839 ]. |
2822 ]. |
2840 |
2823 |
2841 (self errorFlag or:[tree == #Error]) ifTrue:[ |
2824 (self errorFlag or:[tree == #Error]) ifTrue:[ |
2842 "error in method body" |
2825 "error in method body" |
2843 self showErrorMessageForClass:aClass. |
2826 self showErrorMessageForClass:aClass. |
2936 self showErrorNotification:'not compiled to machine code - created a stub instead.'. |
2919 self showErrorNotification:'not compiled to machine code - created a stub instead.'. |
2937 ^ newMethod |
2920 ^ newMethod |
2938 ]. |
2921 ]. |
2939 ]. |
2922 ]. |
2940 |
2923 |
2941 " |
|
2942 EXPERIMENTAL: quick loading |
|
2943 only create a lazyMethod, which has no byteCode and will |
|
2944 compile itself when first called. |
|
2945 " |
|
2946 lazy ifTrue:[ |
|
2947 newMethod := LazyMethod new. |
|
2948 (ClassCategoryReader sourceMode == #sourceReference) ifTrue:[ |
|
2949 sourceFile := ObjectMemory nameForSources. |
|
2950 sourceFile notNil ifTrue:[ |
|
2951 sourceStream := sourceFile asFilename appendingWriteStream. |
|
2952 ] |
|
2953 ]. |
|
2954 sourceStream isNil ifTrue:[ |
|
2955 newMethod source:sourceCodeString string. |
|
2956 ] ifFalse:[ |
|
2957 sourceStream setToEnd. |
|
2958 pos := sourceStream position1Based. |
|
2959 sourceStream nextChunkPut:sourceCodeString. |
|
2960 sourceStream close. |
|
2961 newMethod sourceFilename:sourceFile position:pos. |
|
2962 ]. |
|
2963 newMethod setCategory:newCategory. |
|
2964 newMethod setPackage:newPackage. |
|
2965 newMethod numberOfArgs:selector numArgs. |
|
2966 aClass addSelector:selector withLazyMethod:newMethod. |
|
2967 ^ newMethod |
|
2968 ]. |
|
2969 |
|
2970 primNr := self primitiveNumber. |
2924 primNr := self primitiveNumber. |
2971 (NewPrimitives or:[primNr isNil]) ifTrue:[ |
2925 (NewPrimitives or:[primNr isNil]) ifTrue:[ |
2972 " |
2926 " |
2973 produce symbolic code first |
2927 produce symbolic code first |
2974 " |
2928 " |
3035 Transcript showCR:(' compiled: ', aClass name,' ', selector) |
2989 Transcript showCR:(' compiled: ', aClass name,' ', selector) |
3036 ]. |
2990 ]. |
3037 |
2991 |
3038 ^ newMethod |
2992 ^ newMethod |
3039 |
2993 |
3040 "Created: / 29.10.1995 / 19:59:36 / cg" |
2994 "Created: / 29-10-1995 / 19:59:36 / cg" |
3041 "Modified: / 19.3.1999 / 08:31:09 / stefan" |
2995 "Modified: / 19-03-1999 / 08:31:09 / stefan" |
3042 "Modified: / 17.11.2001 / 21:27:08 / cg" |
2996 "Modified: / 03-08-2006 / 15:35:45 / cg" |
3043 ! |
2997 ! |
3044 |
2998 |
3045 compile:methodText forClass:aBehavior install:doInstall |
2999 compile:methodText forClass:aBehavior install:doInstall |
3046 "compile a source-string for a method in classToCompileFor. |
3000 "compile a source-string for a method in classToCompileFor. |
3047 The install-argument controls if the method is to be installed into the |
3001 The install-argument controls if the method is to be installed into the |
3058 silent:false |
3012 silent:false |
3059 foldConstants:true |
3013 foldConstants:true |
3060 ifFail:[ #Error ] |
3014 ifFail:[ #Error ] |
3061 |
3015 |
3062 "Created: / 17-07-2006 / 18:44:53 / cg" |
3016 "Created: / 17-07-2006 / 18:44:53 / cg" |
|
3017 ! |
|
3018 |
|
3019 compileTree:aTree forClass:aClassArg |
|
3020 |newMethod symbolicCodeArray oldMethod silencio |
|
3021 sourceFile sourceStream newSource primNr pos keptOldCode answer |
|
3022 aClass sourceCodeString hasErrorInMethodHeader oldCategory newCategory oldPackage newPackage| |
|
3023 |
|
3024 aClass := aClassArg. |
|
3025 |
|
3026 self tree:aTree. |
|
3027 |
|
3028 newMethod := self createMethod. |
|
3029 newMethod byteCode:(self code). |
|
3030 |
|
3031 (self contextMustBeReturnable) ifTrue:[ |
|
3032 newMethod contextMustBeReturnable:true |
|
3033 ]. |
|
3034 |
|
3035 ^ newMethod |
|
3036 |
|
3037 "Modified: / 19-03-1999 / 08:31:09 / stefan" |
|
3038 "Created: / 06-08-2006 / 03:25:39 / cg" |
|
3039 ! |
|
3040 |
|
3041 compileTree:aMethodNode forClass:aClassArg ifFail:failBlock |
|
3042 |newMethod symbolicCodeArray aClass prev| |
|
3043 |
|
3044 aClass := aClassArg. |
|
3045 |
|
3046 self tree:aMethodNode. |
|
3047 |
|
3048 selector := aMethodNode selector. |
|
3049 methodArgs := aMethodNode arguments ? #(). |
|
3050 methodArgNames := methodArgs collect:[:eachVar | eachVar name]. |
|
3051 methodVars := aMethodNode locals ? #(). |
|
3052 methodVarNames := methodVars collect:[:eachVar | eachVar name]. |
|
3053 |
|
3054 " |
|
3055 produce symbolic code first |
|
3056 " |
|
3057 symbolicCodeArray := self genSymbolicCode. |
|
3058 (symbolicCodeArray == #Error) ifTrue:[ |
|
3059 self showErrorNotification:'translation error'. |
|
3060 ^ failBlock value |
|
3061 ]. |
|
3062 |
|
3063 " |
|
3064 take this, producing bytecode |
|
3065 (someone willin' to make machine code :-) |
|
3066 " |
|
3067 ((self genByteCodeFrom:symbolicCodeArray) == #Error) ifTrue:[ |
|
3068 self showErrorNotification:'relocation error - code must be simplified'. |
|
3069 ^ failBlock value |
|
3070 ]. |
|
3071 |
|
3072 newMethod := self createMethod. |
|
3073 newMethod byteCode:(self code). |
|
3074 |
|
3075 (self contextMustBeReturnable) ifTrue:[ |
|
3076 newMethod contextMustBeReturnable:true |
|
3077 ]. |
|
3078 |
|
3079 ^ newMethod |
|
3080 |
|
3081 "Modified: / 19-03-1999 / 08:31:09 / stefan" |
|
3082 "Created: / 06-08-2006 / 03:26:27 / cg" |
|
3083 "Modified: / 06-08-2006 / 15:14:26 / cg" |
3063 ! |
3084 ! |
3064 |
3085 |
3065 showErrorNotification:message |
3086 showErrorNotification:message |
3066 Transcript show:'***'. |
3087 Transcript show:'***'. |
3067 selector notNil ifTrue:[ |
3088 selector notNil ifTrue:[ |