'From Squeak2.9alpha of 13 June 2000 [latest update: #3399] on 3 February 2001 at 6:57:45 pm'! "Change Set: TranslatorFixes-ar Date: 3 February 2001 Author: Andreas Raab These changes modify the code translator to more easily integrate translated primitives (e.g., those without a specific plugin class). With these changes it's possible to make a stub class of InterpreterPlugin containing a single method for generating the code from an automatically translated primitive."! Object subclass: #TMethod instanceVariableNames: 'selector returnType args locals declarations primitive parseTree labels possibleSideEffectsCache complete export static comment definingClass ' classVariableNames: 'CaseStatements ' poolDictionaries: '' category: 'VMConstruction-Translation to C'! !CCodeGenerator methodsFor: 'public' stamp: 'ar 2/3/2001 17:55'! addMethodsForPrimitives: classAndSelectorList | sel aClass source verbose meth | classAndSelectorList do: [:classAndSelector | aClass _ Smalltalk at: (classAndSelector at: 1). self addAllClassVarsFor: aClass. "TPR - should pool vars also be added here?" "find the method in either the class or the metaclass" sel _ classAndSelector at: 2. (aClass includesSelector: sel) ifTrue: [source _ aClass sourceCodeAt: sel] ifFalse: [source _ aClass class sourceCodeAt: sel]. "compile the method source and convert to a suitable translation method " meth _ (Compiler new parse: source in: aClass notifying: nil) asTranslationMethodOfClass: self translationMethodClass. (aClass includesSelector: sel) ifTrue: [meth definingClass: aClass] ifFalse: [meth definingClass: aClass class]. meth primitive > 0 ifTrue:[meth preparePrimitiveName]. "for old-style array accessing: meth covertToZeroBasedArrayReferences." meth replaceSizeMessages. self addMethod: meth]. "method preparation" verbose _ false. self prepareMethods. verbose ifTrue: [self printUnboundCallWarnings. self printUnboundVariableReferenceWarnings. Transcript cr]. "code generation" self doInlining: true. methods do:[:m| "if this method is supposed to be a primitive (rather than a helper routine), add assorted prolog and epilog items" m primitive > 0 ifTrue: [m preparePrimitivePrologue]].! ! !CCodeGenerator methodsFor: 'public' stamp: 'ar 2/3/2001 18:10'! codeStringForPrimitives: classAndSelectorList self addMethodsForPrimitives: classAndSelectorList. ^self generateCodeStringForPrimitives! ! !CCodeGenerator methodsFor: 'public' stamp: 'ar 2/3/2001 17:04'! generateCodeStringForPrimitives | s methodList | s _ ReadWriteStream on: (String new: 1000). methodList _ methods asSortedCollection: [:m1 :m2 | m1 selector < m2 selector]. self emitCHeaderForPrimitivesOn: s. self emitCVariablesOn: s. self emitCFunctionPrototypes: methodList on: s. methodList do: [:m | m emitCCodeOn: s generator: self]. ^ s contents ! ! !CCodeGenerator methodsFor: 'inlining' stamp: 'ar 2/3/2001 17:08'! pruneMethods: selectorList "Explicitly prune some methods" selectorList do:[:sel| methods removeKey: sel ifAbsent:[]].! ! !InterpreterPlugin class methodsFor: 'translation' stamp: 'ar 2/3/2001 16:56'! storeString: s onFileNamed: fileName "Store the given string in a file of the given name." | f | f _ CrLfFileStream newFileNamed: fileName. f nextPutAll: s. f close.! ! !InterpreterPlugin class methodsFor: 'translation' stamp: 'ar 2/3/2001 15:44'! translate: fileName doInlining: inlineFlag locally: localFlag "Time millisecondsToRun: [ FloatArrayPlugin translate: 'SqFloatArray.c' doInlining: true. Smalltalk beep]" | cg fullName fd | fullName _ self baseDirectoryName. fd _ FileDirectory on: fullName. localFlag ifFalse:[ (fd directoryExists: self moduleName) ifFalse:[fd createDirectory: self moduleName]. fd _ fd on: (fd fullNameFor: self moduleName)]. fullName _ fd fullNameFor: fileName. self initialize. self headerFile ifNotNil:[ (CrLfFileStream newFileNamed: (fd fullNameFor: self moduleName,'.h')) nextPutAll: self headerFile; close]. cg _ self codeGeneratorClass new initialize. localFlag ifTrue:[cg pluginPrefix: self moduleName]. "Add an extra declaration for module name" cg declareModuleName: self moduleNameAndVersion local: localFlag. self translateOn: cg inlining: inlineFlag to: fullName local: localFlag. ^cg! ! !InterpreterPlugin class methodsFor: 'translation' stamp: 'ar 2/3/2001 15:44'! translateOn: cg inlining: inlineFlag to: fullName local: localFlag "do the actual translation" | theClass | theClass _ self. [theClass == Object] whileFalse:[ cg addClass: theClass. theClass declareCVarsIn: cg. theClass _ theClass superclass]. cg storeCodeOnFile: fullName doInlining: inlineFlag. ! ! !B3DEnginePlugin class methodsFor: 'translation' stamp: 'ar 2/3/2001 15:44'! translateOn: cg inlining: inlineFlag to: fullName local: localFlag "do the actual translation" {InterpreterPlugin. B3DEnginePlugin. B3DTransformerPlugin. B3DVertexBufferPlugin. B3DShaderPlugin. B3DClipperPlugin. B3DPickerPlugin. B3DRasterizerPlugin} do: [:theClass | theClass initialize. cg addClass: theClass. theClass declareCVarsIn: cg]. cg storeCodeOnFile: fullName doInlining: inlineFlag. B3DRasterizerPlugin writeSupportCode: true. ! ! !PluggableCodeGenerator methodsFor: 'C code generator' stamp: 'ar 2/3/2001 18:36'! emitCHeaderForPrimitivesOn: aStream "Write a C file header for compiled primitives onto the given stream." aStream nextPutAll: '/* Automatically generated from Squeak on '. aStream nextPutAll: Time dateAndTimeNow printString. aStream nextPutAll: ' */'; cr; cr. aStream nextPutAll: '#include #include #include #include #include /* Default EXPORT macro that does nothing (see comment in sq.h): */ #define EXPORT(returnType) returnType /* Do not include the entire sq.h file but just those parts needed. */ /* The virtual machine proxy definition */ #include "sqVirtualMachine.h" /* Configuration options */ #include "sqConfig.h" /* Platform specific definitions */ #include "sqPlatformSpecific.h" #define true 1 #define false 0 #define null 0 /* using ''null'' because nil is predefined in Think C */ '; cr; cr. "Additional header files" headerFiles do:[:hdr| aStream nextPutAll:'#include '; nextPutAll: hdr; cr]. aStream nextPutAll: ' /* Memory Access Macros */ #define byteAt(i) (*((unsigned char *) (i))) #define byteAtput(i, val) (*((unsigned char *) (i)) = val) #define longAt(i) (*((int *) (i))) #define longAtput(i, val) (*((int *) (i)) = val) /*** Proxy Functions ***/ #define stackValue(i) (interpreterProxy->stackValue(i)) #define stackIntegerValue(i) (interpreterProxy->stackIntegerValue(i)) #define successFlag (!!interpreterProxy->failed()) #define success(bool) (interpreterProxy->success(bool)) #define arrayValueOf(oop) (interpreterProxy->arrayValueOf(oop)) #define checkedIntegerValueOf(oop) (interpreterProxy->checkedIntegerValueOf(oop)) #define fetchArrayofObject(idx,oop) (interpreterProxy->fetchArrayofObject(idx,oop)) #define fetchFloatofObject(idx,oop) (interpreterProxy->fetchFloatofObject(idx,oop)) #define fetchIntegerofObject(idx,oop) (interpreterProxy->fetchIntegerofObject(idx,oop)) #define floatValueOf(oop) (interpreterProxy->floatValueOf(oop)) #define pop(n) (interpreterProxy->pop(n)) #define pushInteger(n) (interpreterProxy->pushInteger(n)) #define sizeOfSTArrayFromCPrimitive(cPtr) (interpreterProxy->sizeOfSTArrayFromCPrimitive(cPtr)) #define storeIntegerofObjectwithValue(idx,oop,value) (interpreterProxy->storeIntegerofObjectwithValue(idx,oop,value)) /* allows accessing Strings in both C and Smalltalk */ #define asciiValue(c) c '. aStream cr.! ! !PluggableCodeGenerator methodsFor: 'public' stamp: 'ar 2/3/2001 18:29'! codeStringForPrimitives: classAndSelectorList self addClass: InterpreterPlugin. InterpreterPlugin declareCVarsIn: self. ^super codeStringForPrimitives: classAndSelectorList ! ! !SurfacePlugin class methodsFor: 'translation' stamp: 'ar 2/3/2001 16:44'! translateOn: cg inlining: inlineFlag to: fullName local: localFlag "do the actual translation" | theClass fd | theClass _ self. [theClass == Object] whileFalse:[ cg addClass: theClass. theClass declareCVarsIn: cg. theClass _ theClass superclass]. "cg storeCodeOnFile: fullName doInlining: inlineFlag." fd _ FileDirectory on: (FileDirectory dirPathFor: fullName). (CrLfFileStream newFileNamed: (fd fullNameFor: self moduleName,'.c')) nextPutAll: (self sourceCode copyReplaceAll:'$$SURFACE_PLUGIN_STANDALONE$$' with: (localFlag ifTrue:['0'] ifFalse:['1'])); close. ! ! !TMethod methodsFor: 'accessing' stamp: 'ar 2/3/2001 17:29'! definingClass ^definingClass! ! !TMethod methodsFor: 'accessing' stamp: 'ar 2/3/2001 17:29'! definingClass: aClass definingClass _ aClass.! ! !TMethod methodsFor: 'primitive compilation' stamp: 'ar 2/3/2001 17:33'! preparePrimitiveName "Prepare the selector for this method in translation" | aClass | aClass _ definingClass. primitive = 117 ifTrue:[selector _ ((aClass includesSelector: selector) ifTrue: [aClass compiledMethodAt: selector] ifFalse: [aClass class compiledMethodAt: selector]) literals first at: 2. export _ true] ifFalse:[selector _ 'prim', aClass name, selector]. ! ! !TMethod methodsFor: 'primitive compilation' stamp: 'ar 2/3/2001 17:36'! preparePrimitivePrologue "Add a prolog and postlog to a primitive method. The prolog copies any instance variables referenced by this primitive method into local variables. The postlog copies values of assigned-to variables back into the instance. The names of the new locals are added to the local variables list. The declarations dictionary defines the types of any non-integer variables (locals, arguments, or instance variables). In particular, it may specify the types: int * -- an array of 32-bit values (e.g., a BitMap) short * -- an array of 16-bit values (e.g., a SoundBuffer) char * -- an array of unsigned bytes (e.g., a String) double -- a double precision floating point number (e.g., 3.14159) Undeclared variables are taken to be integers and will be converted from Smalltalk to C ints." "Current restrictions: o method must not contain message sends o method must not allocate objects o method must not manipulate raw oops o method cannot access class variables o method can only return an integer" | prolog postlog instVarsUsed varsAssignedTo instVarList primArgCount varName endsWithReturn aClass | selector == #setInterpreter: ifTrue:[self halt]. aClass _ definingClass. prolog _ OrderedCollection new. postlog _ OrderedCollection new. instVarsUsed _ self freeVariableReferences asSet. varsAssignedTo _ self variablesAssignedTo asSet. instVarList _ aClass allInstVarNames. primArgCount _ args size. "add receiver fetch and arg conversions to prolog" prolog addAll: self fetchRcvrExpr. 1 to: args size do: [:argIndex | varName _ args at: argIndex. prolog addAll: (self argConversionExprFor: varName stackIndex: args size - argIndex)]. "add success check to postlog" postlog addAll: self checkSuccessExpr. "add instance variable fetches to prolog and instance variable stores to postlog" 1 to: instVarList size do: [:varIndex | varName _ instVarList at: varIndex. (instVarsUsed includes: varName) ifTrue: [ locals add: varName. prolog addAll: (self instVarGetExprFor: varName offset: varIndex - 1). (varsAssignedTo includes: varName) ifTrue: [ postlog addAll: (self instVarPutExprFor: varName offset: varIndex - 1)]]]. prolog addAll: self checkSuccessExpr. locals addAllFirst: args. locals addFirst: 'rcvr'. args _ args class new. locals asSet size = locals size ifFalse: [self error: 'local name conflicts with instance variable name']. endsWithReturn _ self endsWithReturn. self fixUpReturns: primArgCount postlog: postlog. endsWithReturn ifTrue: [parseTree setStatements: prolog, parseTree statements] ifFalse: [ postlog addAll: (self popArgsExpr: primArgCount). parseTree setStatements: prolog, parseTree statements, postlog]. ! ! TMethod removeSelector: #preparePrimitiveInClass:! SurfacePlugin class removeSelector: #translate:doInlining:locally:! SurfacePlugin class removeSelector: #translateOn:inlining:to:! PluggableCodeGenerator removeSelector: #addMethodsForPrimitives:! B3DEnginePlugin class removeSelector: #translate:doInlining:locally:! B3DEnginePlugin class removeSelector: #translateOn:inlining:to:! InterpreterPlugin class removeSelector: #translateOn:inlining:to:! CCodeGenerator removeSelector: #codeStringForPrimitives! CCodeGenerator removeSelector: #generateCodeStringForPrimitives:!