[Vm-dev] VM Maker: VMMaker.oscog-eem.1701.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Feb 25 21:45:23 UTC 2016
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1701.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1701
Author: eem
Time: 25 February 2016, 1:43:31.008874 pm
UUID: cc23c8bd-4264-4514-baa0-e0c9f5996c5f
Ancestors: VMMaker.oscog-eem.1700
Fix casts of functions obtained form the SecurityPlugin which, you guessed it, should be typed using sqInt, not int.
=============== Diff against VMMaker.oscog-eem.1700 ===============
Item was changed:
----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallIntegersIn:andScratch:scratch: (in category 'compile abstract instructions') -----
genJumpNotSmallIntegersIn: aRegister andScratch: scratchA scratch: scratchB
"Generate a compare and branch to test if aRegister and scratchA contains other than SmallIntegers,
i.e. don't branch if both aRegister and scratchA contain SmallIntegers.
Answer the jump. Destroy scratchA and scratchB if required."
<returnTypeC: #'AbstractInstruction *'>
+ "Straight-forward approach. Map SmallIntegers to 0 in scratchA & scratchB, add and jump non-zero."
+ cogit backEnd hasThreeAddressArithmetic
+ ifFalse:
+ [^cogit
+ MoveR: aRegister R: scratchB;
+ SubCq: objectMemory smallIntegerTag R: scratchA;
+ SubCq: objectMemory smallIntegerTag R: scratchB;
+ AndCq: objectMemory tagMask R: scratchA;
+ AndCq: objectMemory tagMask R: scratchB;
+ AddR: scratchA R: scratchB;
+ JumpNonZero: 0]
+ "Better approach; iff 3 address arithmetic. Because tag pattern 7 is unused the following selects only two SmallIntegers
+ | pairs |
+ pairs := OrderedCollection new.
+ 0 to: 7 do: [:r| 0 to: 7 do: [:a| pairs addLast: {r. a}]].
+ pairs select: [:p| ([:r :a| (a - r bitAnd: 7) + a] valueWithArguments: p) = 1]
+ => an OrderedCollection(#(1 1) #(7 0))
+ But if there is no three address arithmetic this also generates 7 instructions."
+ ifTrue:
+ [^cogit
+ AndCq: objectMemory tagMask R: scratchA R: scratchB;
+ SubR: aRegister R: scratchA;
+ AndCq: objectMemory tagMask R: scratchA;
+ AddCq: objectMemory smallIntegerTag negated R: scratchB R: scratchA;
+ JumpNonZero: 0]!
- "Map SmallIntegers to 0 in scratchA & scratchB, add and jump non-zero."
- ^cogit
- MoveR: aRegister R: scratchB;
- SubCq: objectMemory smallIntegerTag R: scratchA;
- SubCq: objectMemory smallIntegerTag R: scratchB;
- AndCq: objectMemory tagMask R: scratchA;
- AndCq: objectMemory tagMask R: scratchB;
- AddR: scratchA R: scratchB;
- JumpNonZero: 0!
Item was changed:
----- Method: SocketPlugin>>primitiveDisableSocketAccess (in category 'security primitives') -----
primitiveDisableSocketAccess
<export: true>
"If the security plugin can be loaded, use it to turn off socket access
If not, assume it's ok"
sDSAfn ~= 0 ifTrue:
+ [self cCode: '((sqInt (*) (void)) sDSAfn)()']!
- [self cCode: '((int (*) (void)) sDSAfn)()']!
Item was changed:
----- Method: SocketPlugin>>primitiveHasSocketAccess (in category 'security primitives') -----
primitiveHasSocketAccess
| hasAccess |
<export: true>
"If the security plugin can be loaded, use it to check .
If not, assume it's ok"
hasAccess := sHSAfn = 0
+ or: [self cCode: ' ((sqInt (*) (void)) sHSAfn)()' inSmalltalk:[true]].
- or: [self cCode: ' ((int (*) (void)) sHSAfn)()' inSmalltalk:[true]].
interpreterProxy pop: 1.
interpreterProxy pushBool: hasAccess!
Item was changed:
----- Method: SocketPlugin>>primitiveSocket:connectTo:port: (in category 'primitives') -----
primitiveSocket: socket connectTo: address port: port
| addr s okToConnect |
<var: #s type: 'SocketPtr'>
self primitive: 'primitiveSocketConnectToPort' parameters: #(#Oop #ByteArray #SmallInteger ).
addr := self netAddressToInt: (self cCoerce: address to: 'unsigned char *').
"If the security plugin can be loaded, use it to check for permission.
If not, assume it's ok"
+ sCCTPfn ~= 0 ifTrue:
+ [okToConnect := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCTPfn)(addr, port)'.
+ okToConnect ifFalse:
+ [^ interpreterProxy primitiveFail]].
- sCCTPfn ~= 0
- ifTrue: [okToConnect := self cCode: ' ((int (*) (int, int)) sCCTPfn)(addr, port)'.
- okToConnect
- ifFalse: [^ interpreterProxy primitiveFail]].
s := self socketValueOf: socket.
+ interpreterProxy failed ifFalse:
+ [self sqSocket: s ConnectTo: addr Port: port]!
- interpreterProxy failed
- ifFalse: [self
- sqSocket: s
- ConnectTo: addr
- Port: port]!
Item was changed:
----- Method: SocketPlugin>>primitiveSocket:listenOnPort: (in category 'primitives') -----
primitiveSocket: socket listenOnPort: port
"one part of the wierdass dual prim primitiveSocketListenOnPort which
was warped by some demented evil person determined to twist the very
nature of reality"
| s okToListen |
<var: #s type: 'SocketPtr '>
self primitive: 'primitiveSocketListenOnPort' parameters: #(#Oop #SmallInteger ).
s := self socketValueOf: socket.
"If the security plugin can be loaded, use it to check for permission.
If not, assume it's ok"
+ sCCLOPfn ~= 0 ifTrue:
+ [okToListen := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCLOPfn)((sqInt)s, port)'.
+ okToListen ifFalse:
+ [^ interpreterProxy primitiveFail]].
+ interpreterProxy failed ifFalse:
+ [self sqSocket: s ListenOnPort: port]!
- sCCLOPfn ~= 0
- ifTrue: [okToListen := self cCode: ' ((int (*) (SocketPtr, int)) sCCLOPfn)(s, port)'.
- okToListen
- ifFalse: [^ interpreterProxy primitiveFail]].
- interpreterProxy failed ifFalse:[self sqSocket: s ListenOnPort: port]!
Item was changed:
----- Method: SocketPlugin>>primitiveSocket:listenOnPort:backlogSize: (in category 'primitives') -----
primitiveSocket: socket listenOnPort: port backlogSize: backlog
"second part of the wierdass dual prim primitiveSocketListenOnPort
which was warped by some demented evil person determined to twist the
very nature of reality"
| s okToListen |
<var: #s type: 'SocketPtr'>
self primitive: 'primitiveSocketListenOnPortBacklog' parameters: #(#Oop #SmallInteger #SmallInteger ).
s := self socketValueOf: socket.
"If the security plugin can be loaded, use it to check for permission.
If not, assume it's ok"
+ sCCLOPfn ~= 0 ifTrue:
+ [okToListen := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCLOPfn)((sqInt)s, port)'.
+ okToListen ifFalse:
+ [^interpreterProxy primitiveFail]].
+ self sqSocket: s ListenOnPort: port BacklogSize: backlog!
- sCCLOPfn ~= 0
- ifTrue: [okToListen := self cCode: ' ((int (*) (SocketPtr, int)) sCCLOPfn)(s, port)'.
- okToListen
- ifFalse: [^ interpreterProxy primitiveFail]].
- self
- sqSocket: s
- ListenOnPort: port
- BacklogSize: backlog!
Item was changed:
----- Method: SocketPlugin>>primitiveSocket:listenOnPort:backlogSize:interface: (in category 'primitives') -----
primitiveSocket: socket listenOnPort: port backlogSize: backlog interface: ifAddr
"Bind a socket to the given port and interface address with no more than backlog pending connections. The socket can be UDP, in which case the backlog should be specified as zero."
| s okToListen addr |
<var: #s type: 'SocketPtr'>
self primitive: 'primitiveSocketListenOnPortBacklogInterface' parameters: #(#Oop #SmallInteger #SmallInteger #ByteArray).
s := self socketValueOf: socket.
"If the security plugin can be loaded, use it to check for permission.
If not, assume it's ok"
+ sCCLOPfn ~= 0 ifTrue:
+ [okToListen := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCLOPfn)((sqInt)s, port)'.
+ okToListen ifFalse:
+ [^ interpreterProxy primitiveFail]].
- sCCLOPfn ~= 0
- ifTrue: [okToListen := self cCode: ' ((int (*) (SocketPtr, int)) sCCLOPfn)(s, port)'.
- okToListen
- ifFalse: [^ interpreterProxy primitiveFail]].
addr := self netAddressToInt: (self cCoerce: ifAddr to: 'unsigned char *').
+ self sqSocket: s ListenOnPort: port BacklogSize: backlog Interface: addr!
- self
- sqSocket: s
- ListenOnPort: port
- BacklogSize: backlog
- Interface: addr!
Item was changed:
----- Method: SocketPlugin>>primitiveSocketCreateNetwork:type:receiveBufferSize:sendBufSize:semaIndex: (in category 'primitives') -----
primitiveSocketCreateNetwork: netType type: socketType receiveBufferSize: recvBufSize sendBufSize: sendBufSize semaIndex: semaIndex
| socketOop s okToCreate |
<var: #s type: 'SocketPtr '>
self primitive: 'primitiveSocketCreate' parameters: #(#SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger ).
"If the security plugin can be loaded, use it to check for permission.
If not, assume it's ok"
+ sCCSOTfn ~= 0 ifTrue:
+ [okToCreate := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCSOTfn)(netType, socketType)'.
+ okToCreate ifFalse:
+ [^ interpreterProxy primitiveFail]].
- sCCSOTfn ~= 0
- ifTrue: [okToCreate := self cCode: ' ((int (*) (int, int)) sCCSOTfn)(netType, socketType)'.
- okToCreate
- ifFalse: [^ interpreterProxy primitiveFail]].
socketOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self socketRecordSize.
s := self socketValueOf: socketOop.
+ interpreterProxy failed ifFalse:
+ [self
+ sqSocket: s
+ CreateNetType: netType
+ SocketType: socketType
+ RecvBytes: recvBufSize
+ SendBytes: sendBufSize
+ SemaID: semaIndex].
+ ^socketOop!
- self
- sqSocket: s
- CreateNetType: netType
- SocketType: socketType
- RecvBytes: recvBufSize
- SendBytes: sendBufSize
- SemaID: semaIndex.
- ^ socketOop!
Item was changed:
----- Method: SocketPlugin>>primitiveSocketCreateNetwork:type:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex: (in category 'primitives') -----
primitiveSocketCreateNetwork: netType type: socketType receiveBufferSize: recvBufSize sendBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema
| socketOop s okToCreate |
<var: #s type: 'SocketPtr '>
self primitive: 'primitiveSocketCreate3Semaphores' parameters: #(#SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger ).
"If the security plugin can be loaded, use it to check for permission.
If not, assume it's ok"
+ sCCSOTfn ~= 0 ifTrue:
+ [okToCreate := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCSOTfn)(netType, socketType)'.
+ okToCreate ifFalse:
+ [^ interpreterProxy primitiveFail]].
- sCCSOTfn ~= 0
- ifTrue: [okToCreate := self cCode: ' ((int (*) (int, int)) sCCSOTfn)(netType, socketType)'.
- okToCreate
- ifFalse: [^ interpreterProxy primitiveFail]].
socketOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self socketRecordSize.
s := self socketValueOf: socketOop.
+ interpreterProxy failed ifFalse:
+ [self
+ sqSocket: s
+ CreateNetType: netType
+ SocketType: socketType
+ RecvBytes: recvBufSize
+ SendBytes: sendBufSize
+ SemaID: semaIndex
+ ReadSemaID: aReadSema
+ WriteSemaID: aWriteSema].
+ ^socketOop!
- self
- sqSocket: s
- CreateNetType: netType
- SocketType: socketType
- RecvBytes: recvBufSize
- SendBytes: sendBufSize
- SemaID: semaIndex
- ReadSemaID: aReadSema
- WriteSemaID: aWriteSema.
- ^ socketOop!
Item was changed:
----- Method: SocketPlugin>>primitiveSocketCreateRaw:type:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex: (in category 'primitives') -----
primitiveSocketCreateRaw: netType type: protoType receiveBufferSize: recvBufSize sendBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema
| socketOop s okToCreate |
<var: #s type: 'SocketPtr '>
self primitive: 'primitiveSocketCreateRAW' parameters: #(#SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger ).
"If the security plugin can be loaded, use it to check for permission.
If not, assume it's ok"
+ sCCSOTfn ~= 0 ifTrue:
+ [okToCreate := self cCode: ' ((sqInt (*) (sqInt, sqInt)) sCCSOTfn)(netType, protoType)'.
+ okToCreate ifFalse:
+ [^ interpreterProxy primitiveFail]].
- sCCSOTfn ~= 0
- ifTrue: [okToCreate := self cCode: ' ((int (*) (int, int)) sCCSOTfn)(netType, protoType)'.
- okToCreate
- ifFalse: [^ interpreterProxy primitiveFail]].
socketOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self socketRecordSize.
s := self socketValueOf: socketOop.
+ interpreterProxy failed ifFalse:
+ [self
+ sqSocket: s
+ CreateRaw: netType
+ ProtoType: protoType
+ RecvBytes: recvBufSize
+ SendBytes: sendBufSize
+ SemaID: semaIndex
+ ReadSemaID: aReadSema
+ WriteSemaID: aWriteSema].
- self
- sqSocket: s
- CreateRaw: netType
- ProtoType: protoType
- RecvBytes: recvBufSize
- SendBytes: sendBufSize
- SemaID: semaIndex
- ReadSemaID: aReadSema
- WriteSemaID: aWriteSema.
^ socketOop!
Item was changed:
----- Method: TMethod>>emitCCodeOn:generator: (in category 'C code generation') -----
emitCCodeOn: aStream generator: aCodeGen
"Emit C code for this method onto the given stream.
All calls to inlined methods should already have been expanded."
| conditional |
aCodeGen currentMethod: self.
self emitCCommentOn: aStream. "place method comment and method name before function."
aStream crtab; nextPutAll: '/* '; nextPutAll: self definingClass name; nextPutAll: '>>#'; nextPutAll: self smalltalkSelector; nextPutAll: ' */'.
aStream cr.
conditional := self emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: false.
aStream cr; nextPut: ${.
self emitCLocalsOn: aStream generator: aCodeGen.
aCodeGen
pushScope: declarations
while: [parseTree emitCCodeOn: aStream level: 1 generator: aCodeGen].
+ (returnType = #void or: [parseTree endsWithReturn]) ifFalse:
+ [aStream tab; nextPutAll: 'return 0;'; cr].
aStream nextPut: $}; cr.
conditional ifTrue:
[self terminateConditionalDefineFor: self compileTimeOptionPragmas on: aStream]!
More information about the Vm-dev
mailing list