[Vm-dev] VM Maker: VMMaker.oscog-eem.495.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Nov 2 19:55:47 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.495.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.495
Author: eem
Time: 2 November 2013, 12:06:02.903 pm
UUID: 860b7241-00b7-446d-bb17-e217178e55c8
Ancestors: VMMaker.oscog-eem.494
Rescue plugin generation by removing final ^self & computing ret
type in VMPluginCodeGenerator>>compileToTMethodSelector:in:.
Also, checkedDeclarationAt:put:in: needs to look at definingClass's
inst vars for translated plugins.
Move harmonizeReturnTypesIn: from TMethod to CCodeGenerator so
VMPluginCodeGenerator can override to map #void, #sqInt to #void.
Eliminate several extraneous variable declarations in plugins.
=============== Diff against VMMaker.oscog-eem.494 ===============
Item was added:
+ ----- Method: CCodeGenerator>>harmonizeReturnTypesIn: (in category 'type inference') -----
+ harmonizeReturnTypesIn: aSetOfTypes
+ "Eliminate signed/unsigned conflicts in aSetOfTypes"
+ | sqs usqs |
+ #(char short int #'unsigned char' #'unsigned short' #'unsigned int')
+ with: #(sqInt sqInt sqInt #usqInt #usqInt #usqInt)
+ do: [:type :replacement|
+ (aSetOfTypes includes: type) ifTrue:
+ [aSetOfTypes remove: type; add: replacement]].
+ sqs := aSetOfTypes select: [:t| t beginsWith: 'sq'].
+ usqs := aSetOfTypes select: [:t| t beginsWith: 'usq'].
+ ^(sqs size + usqs size = aSetOfTypes size
+ and: [sqs notEmpty
+ and: [sqs allSatisfy: [:t| usqs includes: 'u', t]]])
+ ifTrue: [sqs]
+ ifFalse: [aSetOfTypes]!
Item was changed:
----- Method: CroquetPlugin>>primitiveAdj3 (in category 'transforms') -----
primitiveAdj3
"Computes the adjoint of the Matrix4x4 receiver,
placing the results the the Matrix4x4 argument,
"
|
argc
srcOop src
dstOop dst
m11 m12 m13 m21 m22 m23 m31 m32 m33
c11 c12 c13 c21 c22 c23 c31 c32 c33
|
<export: true>
<inline: true>
<var: #c11 declareC: 'const int c11 = 0'>
<var: #c12 declareC: 'const int c12 = 1'>
<var: #c13 declareC: 'const int c13 = 2'>
+ "<var: #c14 declareC: 'const int c14 = 3'>"
- <var: #c14 declareC: 'const int c14 = 3'>
<var: #c21 declareC: 'const int c21 = 4'>
<var: #c22 declareC: 'const int c22 = 5'>
<var: #c23 declareC: 'const int c23 = 6'>
+ "<var: #c24 declareC: 'const int c24 = 7'>"
- <var: #c24 declareC: 'const int c24 = 7'>
<var: #c31 declareC: 'const int c31 = 8'>
<var: #c32 declareC: 'const int c32 = 9'>
<var: #c33 declareC: 'const int c33 = 10'>
+ "<var: #c34 declareC: 'const int c34 = 11'>"
- <var: #c34 declareC: 'const int c34 = 11'>
<var: #src type: 'float *'>
<var: #dst type: 'float *'>
<var: #m11 type: 'double'>
<var: #m12 type: 'double'>
<var: #m13 type: 'double'>
<var: #m21 type: 'double'>
<var: #m22 type: 'double'>
<var: #m23 type: 'double'>
<var: #m31 type: 'double'>
<var: #m32 type: 'double'>
<var: #m33 type: 'double'>
"then we need the following no-op to make Smalltalk shut up about vars not being initted."
self cCode: '' inSmalltalk: [
c11 := 0.
c12 := 1.
c13 := 2.
"c14 := 3."
c21 := 4.
c22 := 5.
c23 := 6.
"c24 := 7."
c31 := 8.
c32 := 9.
c33 := 10.
"c34 := 11."
].
"NOTE: the bottom row of a OpenGL-ordered matrix is always 0 0 0 1,
so we don't need consts here for those elements."
"do the dance to get our receiver and argument"
argc := interpreterProxy methodArgumentCount.
argc = 1
ifFalse:[^interpreterProxy primitiveFail].
"stackArgvObject is something I added to Interpreter, but since it's not in there yet,
this won't compile - use it when it's there. Yes, it would be nice if Smalltalk had #ifdefs..."
self flag: #stackArgv.
"
srcOop := interpreterProxy stackArgvObject: 0.
src := interpreterProxy firstIndexableField: srcOop.
dstOop := interpreterProxy stackArgvObject: 1.
dst := interpreterProxy firstIndexableField: dstOop.
"
srcOop := interpreterProxy stackObjectValue: argc.
src := interpreterProxy firstIndexableField: srcOop.
dstOop := interpreterProxy stackObjectValue: (argc - 1).
dst := interpreterProxy firstIndexableField: dstOop.
"read in the source matrix 3x3, which contains the encoded rotation and scale factors"
m11 := src at: c11.
m12 := src at: c12.
m13 := src at: c13.
m21 := src at: c21.
m22 := src at: c22.
m23 := src at: c23.
m31 := src at: c31.
m32 := src at: c32.
m33 := src at: c33.
"do the actual work"
"compute our cofactors and transpose. adj = transpose of cofactors"
dst at: c11 put: ((m22 * m33) - (m23 * m32)) .
dst at: c21 put: (0.0 - ((m21 * m33) - (m23 * m31))).
dst at: c31 put: ((m21 * m32) - (m22 * m31)).
dst at: c12 put: (0.0 - ((m12 * m33) - (m13 * m32))).
dst at: c22 put: ((m11 * m33) - (m13 * m31)).
dst at: c32 put: (0.0 - ((m11 * m32) - (m12 * m31))).
dst at: c13 put: ((m12 * m23) - (m13 * m22)).
dst at: c23 put: (0.0 - ((m11 * m23) - (m13 * m21))).
dst at: c33 put: ((m11 * m22) - (m12 * m21)).
+ interpreterProxy pop: argc + 1 thenPush: dstOop
- interpreterProxy pop: argc + 1.
- ^interpreterProxy push: dstOop.
!
Item was changed:
----- Method: DeflatePlugin>>primitiveUpdateGZipCrc32 (in category 'primitives') -----
primitiveUpdateGZipCrc32
"Primitive. Update a 32bit CRC value."
| collection stopIndex startIndex crc length bytePtr |
<export: true>
+ <var: #bytePtr type: #'unsigned char *'>
- <var: #crc type:'unsigned int '>
- <var: #bytePtr type:'unsigned char *'>
- <var: #crcTable type:'unsigned int *'>
interpreterProxy methodArgumentCount = 4
ifFalse:[^interpreterProxy primitiveFail].
collection := interpreterProxy stackObjectValue: 0.
stopIndex := interpreterProxy stackIntegerValue: 1.
startIndex := interpreterProxy stackIntegerValue: 2.
crc := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 3).
+ interpreterProxy failed ifTrue: [^self].
- interpreterProxy failed ifTrue:[^0].
((interpreterProxy isBytes: collection) and:[stopIndex >= startIndex and:[startIndex > 0]])
ifFalse:[^interpreterProxy primitiveFail].
length := interpreterProxy byteSizeOf: collection.
(stopIndex <= length) ifFalse:[^interpreterProxy primitiveFail].
bytePtr := interpreterProxy firstIndexableField: collection.
self cCode:'' inSmalltalk:[zipCrcTable := CArrayAccessor on: GZipWriteStream crcTable].
startIndex := startIndex - 1.
stopIndex := stopIndex - 1.
+ startIndex to: stopIndex do:
+ [:i|
+ crc := (zipCrcTable at: ((crc bitXor: (bytePtr at: i)) bitAnd: 255)) bitXor: (crc >> 8)].
+ interpreterProxy
+ pop: 5 "args + rcvr"
+ thenPush: (interpreterProxy positive32BitIntegerFor: crc)!
- startIndex to: stopIndex do:[:i|
- crc := (zipCrcTable at: ((crc bitXor: (bytePtr at: i)) bitAnd: 255)) bitXor: (crc >> 8).
- ].
- interpreterProxy pop: 5. "args + rcvr"
- interpreterProxy push: (interpreterProxy positive32BitIntegerFor: crc).!
Item was changed:
----- Method: FilePlugin>>primitiveFileWrite (in category 'file primitives') -----
primitiveFileWrite
| count startIndex array file elementSize bytesWritten |
<var: 'file' type: 'SQFile *'>
- <var: 'arrayIndex' type: 'char *'>
<var: 'count' type: 'size_t'>
<var: 'startIndex' type: 'size_t'>
<var: 'elementSize' type: 'size_t'>
<export: true>
count := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
startIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1).
array := interpreterProxy stackValue: 2.
file := self fileValueOf: (interpreterProxy stackValue: 3).
(interpreterProxy failed
"buffer can be any indexable words or bytes object except CompiledMethod"
or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
elementSize := (interpreterProxy isWords: array) ifTrue: [4] ifFalse: [1].
(startIndex >= 1
and: [(startIndex + count - 1) <= (interpreterProxy slotSizeOf: array)]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
"Note: adjust startIndex for zero-origin indexing"
bytesWritten := self
sqFile: file
Write: count * elementSize
From: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
At: startIndex - 1 * elementSize.
interpreterProxy failed ifFalse:
[interpreterProxy pop: 5 thenPush: (interpreterProxy integerObjectOf: bytesWritten // elementSize)]!
Item was changed:
----- Method: IA32ABIPlugin>>primMalloc (in category 'primitives-memory management') -----
primMalloc
"Malloc arg bytes."
"primMalloc: byteSize <Integer> <^Integer>
<primitive: 'primMalloc' error: errorCode module: 'IA32ABI'>"
| byteSize addr |
<export: true>
- <var: #ptr type: 'long *'>
<var: #byteSize type: 'long'>
byteSize := interpreterProxy stackIntegerValue: 0.
(interpreterProxy failed
or: [byteSize <= 0 "some mallocs can't deal with malloc(0) bytes"]) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ addr := self cCode: [self malloc: byteSize] inSmalltalk: [Alien Cmalloc: byteSize].
- self cCode: 'addr = (sqInt)malloc(byteSize)'
- inSmalltalk: [addr := self Cmalloc: byteSize].
addr = 0 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoCMemory].
+ interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: addr asUnsignedInteger)!
- interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: addr)!
Item was changed:
----- Method: InternetConfigPlugin>>primitiveGetMacintoshFileTypeAndCreatorFrom: (in category 'system primitives') -----
primitiveGetMacintoshFileTypeAndCreatorFrom: aFileName
| oop ptr keyLength creator |
- <var: #aFile declareC: 'char aFile[256]'>
<var: #creator declareC: 'char creator[8]'>
<var: #ptr type: 'char *'>
self primitive: 'primitiveGetMacintoshFileTypeAndCreatorFrom'
parameters: #(String).
keyLength := interpreterProxy byteSizeOf: aFileName cPtrAsOop.
self sqInternetGetMacintoshFileTypeAndCreatorFrom: aFileName keySize: keyLength into: creator.
oop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: 8.
ptr := interpreterProxy firstIndexableField: oop.
0 to: 7 do:[:i|
ptr at: i put: (creator at: i)].
^oop.
!
Item was changed:
----- Method: LargeIntegersPlugin>>digitMontgomery:times:modulo:mInvModB: (in category 'oop functions') -----
digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv
| firstLen secondLen thirdLen prod |
- <var: #over type: 'unsigned char '>
firstLen := self byteSizeOfBytes: firstLarge.
secondLen := self byteSizeOfBytes: secondLarge.
thirdLen := self byteSizeOfBytes: thirdLarge.
firstLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail].
secondLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail].
(mInv >= 0 and: [mInv <= 255]) ifFalse: [^interpreterProxy primitiveFail].
self remapOop: #(firstLarge secondLarge thirdLarge) in: [prod := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: thirdLen].
self
cdigitMontgomery: (interpreterProxy firstIndexableField: firstLarge)
len: firstLen
times: (interpreterProxy firstIndexableField: secondLarge)
len: secondLen
modulo: (interpreterProxy firstIndexableField: thirdLarge)
len: thirdLen
mInvModB: mInv
into: (interpreterProxy firstIndexableField: prod).
^self normalizePositive: prod!
Item was changed:
----- Method: LargeIntegersPlugin>>primGetModuleName (in category 'control & support primitives') -----
primGetModuleName
"If calling this primitive fails, then C module does not exist."
| strLen strOop strPtr |
- <var: #cString type: 'char *'>
<var: #strPtr type: 'char *'>
self debugCode: [self msg: 'primGetModuleName'].
self
primitive: 'primGetModuleName'
parameters: #()
receiver: #Oop.
strLen := self strlen: self getModuleName.
strOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: strLen.
strPtr := interpreterProxy firstIndexableField: strOop.
0 to: strLen - 1 do: [:i | strPtr at: i put: (self getModuleName at: i)].
+ ^strOop!
- ^ strOop!
Item was changed:
----- Method: MacMenubarPlugin>>primitiveGetItemCmd:item: (in category 'system primitives') -----
primitiveGetItemCmd: menuHandleOop item: anInteger
| menuHandle aCharacter |
<var: 'menuHandle' type: 'MenuHandle'>
+ <var: #aCharacter type: 'CharParameter'>
- <var: #aCharacter type: 'CharParameter '>
- <var: #ptr type: 'char *'>
self primitive: 'primitiveGetItemCmd'
parameters: #(Oop SmallInteger).
menuHandle := self cCoerce: (interpreterProxy positive32BitValueOf: menuHandleOop) to: 'MenuHandle'.
(self ioCheckMenuHandle: menuHandle) ifFalse: [^interpreterProxy success: false].
aCharacter := 0.
self cCode: 'GetItemCmd(menuHandle,anInteger,&aCharacter)' inSmalltalk:[menuHandle].
^aCharacter asSmallIntegerObj
!
Item was changed:
----- Method: MacMenubarPlugin>>primitiveGetItemMark:item: (in category 'system primitives') -----
primitiveGetItemMark: menuHandleOop item: anInteger
| menuHandle aCharacter |
<var: 'menuHandle' type: 'MenuHandle'>
+ <var: #aCharacter type: 'CharParameter'>
- <var: #aCharacter type: 'CharParameter '>
- <var: #ptr type: 'char *'>
self primitive: 'primitiveGetItemMark'
parameters: #(Oop SmallInteger).
menuHandle := self cCoerce: (interpreterProxy positive32BitValueOf: menuHandleOop) to: 'MenuHandle'.
(self ioCheckMenuHandle: menuHandle) ifFalse: [^interpreterProxy success: false].
aCharacter := 0.
self cCode: 'GetItemMark(menuHandle,anInteger,&aCharacter)' inSmalltalk:[menuHandle].
^aCharacter asSmallIntegerObj
!
Item was changed:
----- Method: NewsqueakIA32ABIPlugin>>primMalloc (in category 'primitives-memory management') -----
primMalloc
"Malloc arg bytes."
"primMalloc: byteSize <Integer> <^Integer>
<primitive: 'primMalloc' error: errorCode module: 'IA32ABI'>"
| byteSize addr |
<export: true>
<var: #ptr type: 'long *'>
<var: #byteSize type: 'long'>
byteSize := interpreterProxy stackIntegerValue: 0.
(interpreterProxy failed
or: [byteSize <= 0 "some mallocs can't deal with malloc(0) bytes"]) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ addr := self cCode: [self malloc: byteSize] inSmalltalk: [Alien Cmalloc: byteSize].
- self cCode: 'addr = (sqInt)malloc(byteSize)'
- inSmalltalk: [addr := self Cmalloc: byteSize].
addr = 0 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoCMemory].
+ interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: addr asUnsignedInteger)!
- interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: addr)!
Item was changed:
----- Method: TMethod>>addTypesFor:to:in: (in category 'type inference') -----
addTypesFor: node to: typeSet in: aCodeGen
| expr |
expr := node.
[expr isAssignment or: [expr isStmtList]] whileTrue:
[expr isAssignment ifTrue:
[expr := expr variable].
expr isStmtList ifTrue:
[expr := expr statements last]].
expr isSend ifTrue:
[(#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: expr selector) ifTrue:
[^expr args do:
[:block|
self addTypesFor: block to: typeSet in: aCodeGen]].
(#(= ~= == ~~ < > <= >= anyMask: noMask:) includes: expr selector) ifTrue:
[^typeSet add: #sqInt].
(#(+ - * / // \\ mod: quo: bitAnd: bitClear: bitOr: bitXor: bitShift:) includes: expr selector) ifTrue:
[| types |
types := Set new.
self addTypesFor: expr receiver to: types in: aCodeGen.
(types size = 1 and: [types anyOne last = $*]) ifTrue: "pointer arithmetic"
[^typeSet add: types anyOne].
self addTypesFor: expr args first to: types in: aCodeGen.
+ types := aCodeGen harmonizeReturnTypesIn: types.
- types := self harmonizeSignedAndUnsignedTypesIn: types.
types size = 2 ifTrue:
[(types includes: #double) ifTrue:
[^typeSet add: #double].
(types includes: #float) ifTrue:
[^typeSet add: #float].
^self]. "don't know; leave unspecified."
^types notEmpty ifTrue:
[typeSet add: types anyOne]].
^(aCodeGen returnTypeForSend: expr) ifNotNil:
[:type| typeSet add: type]].
expr isVariable ifTrue:
[(aCodeGen typeOfVariable: expr name)
ifNotNil: [:type| typeSet add: type]
ifNil: [typeSet add: (expr name = 'self'
ifTrue: [#void]
ifFalse: [#sqInt])]].
expr isConstant ifTrue:
[| val |
val := expr value.
val isInteger ifTrue:
[typeSet add: ((val >= 0 ifTrue: [val] ifFalse: [-1 - val]) highBit <= 32
ifTrue: [#sqInt]
ifFalse: [#sqLong])].
(#(nil true false) includes: val) ifTrue:
[typeSet add: #sqInt].
val isFloat ifTrue:
[typeSet add: #float]]!
Item was changed:
----- Method: TMethod>>checkedDeclarationAt:put:in: (in category 'accessing') -----
checkedDeclarationAt: aVariableName put: aDeclaration in: aCCodeGen
+ ((args includes: aVariableName)
+ or: [(locals includes: aVariableName)
+ or: [(definingClass instVarIndexFor: aVariableName asString ifAbsent: nil) notNil]]) ifFalse:
- ((args includes: aVariableName) or: [locals includes: aVariableName]) ifFalse:
[| msg |
msg := definingClass name, '>>', selector, ' contains declaration for non-existent variable ', aVariableName.
aCCodeGen
ifNotNil: [aCCodeGen logger show: msg; cr]
ifNil: [self error: msg]].
^self declarationAt: aVariableName "<String>" put: aDeclaration!
Item was changed:
----- Method: TMethod>>inferReturnTypeFromReturnsIn: (in category 'type inference') -----
inferReturnTypeFromReturnsIn: aCodeGen
"Attempt to infer the return type of the receiver from returns in the parse tree."
returnType ifNil: "the initial default"
[aCodeGen
pushScope: declarations
while:
[| hasReturn returnTypes |
hasReturn := false.
returnTypes := Set new.
parseTree nodesDo:
[:node|
node isReturn ifTrue:
[hasReturn := true.
self addTypesFor: node expression to: returnTypes in: aCodeGen]].
returnTypes remove: #implicit ifAbsent: [].
+ returnTypes := aCodeGen harmonizeReturnTypesIn: returnTypes.
- returnTypes := self harmonizeSignedAndUnsignedTypesIn: returnTypes.
hasReturn
ifTrue:
[returnTypes size > 1 ifTrue:
[aCodeGen logger show:
(String streamContents:
[:s|
s nextPutAll: 'conflicting return types '.
returnTypes
do: [:t| s nextPutAll: t]
separatedBy: [s nextPutAll: ', '].
s nextPutAll: ' in '; nextPutAll: selector; cr])].
returnTypes size = 1 ifTrue:
[self returnType: returnTypes anyOne]]
ifFalse:
[self returnType: (aCodeGen implicitReturnTypeFor: selector)]]]!
Item was changed:
----- Method: VMPluginCodeGenerator>>compileToTMethodSelector:in: (in category 'utilities') -----
compileToTMethodSelector: selector in: aClass
+ "Compile a method to a TMethod. Override to eagerly record declarations etc
+ that happen in a later phase in the main VM's CCodeGenerator."
- "Compile a method to a TMethod"
| m |
m := (Compiler new
parse: (aClass sourceCodeAt: selector)
in: aClass
notifying: nil)
asTranslationMethodOfClass: self translationMethodClass.
+ m removeFinalSelfReturnIn: self.
+ m recordDeclarationsIn: self.
m inferReturnTypeIn: self.
m returnType ifNil:
[m returnType: (self implicitReturnTypeFor: selector)].
^m!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>harmonizeReturnTypesIn: (in category 'type inference') -----
+ harmonizeReturnTypesIn: aSetOfTypes
+ "Eliminate signed/unsigned conflicts in aSetOfTypes. Override to
+ default to void if any one return type is void."
+ ^(aSetOfTypes includes: #void)
+ ifTrue: [Set with: #void]
+ ifFalse: [super harmonizeReturnTypesIn: aSetOfTypes]!
Item was changed:
----- Method: VMProfileLinuxSupportPlugin>>primitiveExecutableModules (in category 'primitives') -----
primitiveExecutableModules
"Answer an Array of pairs of strings for executable modules (the VM executable and loaded libraries).
The first element in each pair is the filename of the module. The second element is either nil or
the symlink's target, if the filename is a symlink."
<export: true>
- <var: #name type: 'const char *'>
- <var: #nameObjData type: #'char *'>
| resultObj |
numModules := 0.
self cCode: 'dl_iterate_phdr(countnummodules,0)' inSmalltalk: [0].
resultObj := interpreterProxy
instantiateClass: interpreterProxy classArray
indexableSize: numModules - 1 * 2. "skip the fake linux-gate.so.1"
resultObj = 0 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
interpreterProxy pushRemappableOop: resultObj.
primErr := numModules := 0.
self cCode: 'dl_iterate_phdr(reapmodulesymlinks,0)' inSmalltalk: [0].
resultObj := interpreterProxy popRemappableOop.
primErr ~= 0 ifTrue:
[^interpreterProxy primitiveFailFor: primErr].
^interpreterProxy methodReturnValue: resultObj!
More information about the Vm-dev
mailing list