[Vm-dev] VM Maker: FileAttributesPlugin.oscog-akg.47.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Nov 29 20:20:38 UTC 2019


Eliot Miranda uploaded a new version of FileAttributesPlugin to project VM Maker:
http://source.squeak.org/VMMaker/FileAttributesPlugin.oscog-akg.47.mcz

==================== Summary ====================

Name: FileAttributesPlugin.oscog-akg.47
Author: akg
Time: 19 December 2018, 8:21:00.365149 am
UUID: 352a23fa-7521-49aa-8801-e32b80394b9d
Ancestors: FileAttributesPlugin.oscog-akg.46

FileAttributesPlugin 2.0.7

Move some allocations from the heap to the stack.

These allocations where never used outside the context of the allocating routine, so can be on the stack instead.

=============== Diff against FileAttributesPlugin.oscog-akg.46 ===============

Item was changed:
+ ----- Method: FileAttributesPlugin>>attributeArray:for:mask: (in category 'private') -----
- ----- Method: FileAttributesPlugin>>attributeArray:for:mask: (in category 'file primitives') -----
  attributeArray: attributeArrayPtr for: faPath mask: attributeMask
  	"Create the attributes array for the specified file (faPath) and set attributeArrayPtr.
  	Which attributes are retrieved are specified in attributeMask.
  	On error, set the error in interpreterProxy and answer the appropriate status (some callers check the status, others interpreterProxy)"
  
  	| status getAccess getStats getLinkStats attributeArray accessArray resultOop  |
  	<var: 'faPath' type: #'fapath *'>
  	<var: 'attributeArrayPtr' type: #'sqInt *'>
  
  	"Determine which attributes to retrieve"
  	getStats := attributeMask anyMask: 1.
  	getAccess := attributeMask anyMask: 2.
  	(getStats or: [getAccess]) ifFalse:
  		["No information has been requested, which doesn't make sense"
  		interpreterProxy primitiveFailForOSError: self invalidArguments.
  		^self invalidArguments].
  	getLinkStats := attributeMask anyMask: 4.
  
  	getStats ifTrue:
  		[ attributeArray := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 13.
  		attributeArray ifNil:
  			[interpreterProxy primitiveFailFor: PrimErrNoMemory.
  			^self interpreterError].
  		self remapOop: attributeArray in:
  			[status := self faFileStatAttributes: faPath _: getLinkStats _: attributeArray].
  		status ~= 0 ifTrue:
  			[^status].
  		"Set resultOop in case only stat attributes have been requested"
  		resultOop := attributeArray ].
  
  	getAccess ifTrue:
  		[self remapOop: attributeArray in:
  			[accessArray := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 3].
  		accessArray ifNil:
  			[interpreterProxy primitiveFailFor: PrimErrNoMemory.
  			self interpreterError].
  		self faAccessAttributes: faPath _: accessArray _: 0.
  		interpreterProxy failed ifTrue: 
  			[^self interpreterError].
  		"Set resultOop in case only access attributes have been requested"
  		resultOop := accessArray ].
  
  	(getStats and: [getAccess]) ifTrue: 
  		[self remapOop: #(attributeArray accessArray) in:
  			[resultOop := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2].
  		resultOop ifNil:
  			[interpreterProxy primitiveFailFor: PrimErrNoMemory.
  			self interpreterError].
  		interpreterProxy
  			storePointer: 0 ofObject: resultOop withValue: attributeArray;
  			storePointer: 1 ofObject: resultOop withValue: accessArray
  		].
  
  	attributeArrayPtr at: 0 put: resultOop.
  	^self faSuccess!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveChangeMode (in category 'file primitives') -----
  primitiveChangeMode
  	"Set the mode of the supplied file using chmod()."
  
  	| fileNameOop newMode status faPath |
  	<export: true>
  	<var: 'newMode' type: #'sqInt'>
+ 	<var: 'faPath' type: #'fapath'>
- 	<var: 'faPath' type: #'fapath *'>
  
  	fileNameOop := interpreterProxy stackObjectValue: 1.
  	newMode := interpreterProxy stackIntegerValue: 0.
  	(interpreterProxy failed
  		or: [(interpreterProxy isBytes: fileNameOop) not]) ifTrue:
  			[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	self cppIf: #HAVE_CHMOD ifTrue: [
+ 		self faSetStPathOop: (self addressOf: faPath) _: fileNameOop.
+ 		interpreterProxy failed ifTrue:
+ 			[^interpreterProxy primitiveFailureCode].
- 		faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'
- 						inSmalltalk: [self simulatedFaPath].
- 		faPath = nil ifTrue: [^interpreterProxy primitiveFailForOSError: self cantAllocateMemory].
- 		self faSetStPathOop: faPath _: fileNameOop.
- 		interpreterProxy failed ifTrue: [
- 			self free: faPath.
- 			^interpreterProxy primitiveFailureCode].
  
+ 		status := self chmod: (self faGetPlatPath: (self addressOf: faPath)) _: newMode.
+ 		status ~= 0 ifTrue: 
+ 			[^interpreterProxy primitiveFailForOSError: (self cCode: 'errno')].
- 		status := self chmod: (self faGetPlatPath: faPath) _: newMode.
- 		self free: faPath.
- 		status ~= 0 ifTrue: [
- 			^interpreterProxy primitiveFailForOSError: (self cCode: 'errno')].
  		^interpreterProxy methodReturnValue: interpreterProxy nilObject.
  		].
  	^interpreterProxy primitiveFailForOSError: self unsupportedOperation.
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveChangeOwner (in category 'file primitives') -----
  primitiveChangeOwner
  	"Set the owner of the supplied file using chown()."
  
  	| fileNameOop ownerId groupId faPath status |
  	<export: true>
+ 	<var: 'faPath' type: #'fapath'>
- 	<var: 'faPath' type: #'fapath *'>
  
  	fileNameOop := interpreterProxy stackObjectValue: 2.
  	ownerId := interpreterProxy stackIntegerValue: 1.
  	groupId := interpreterProxy stackIntegerValue: 0.
  	(interpreterProxy failed
  		or: [(interpreterProxy isBytes: fileNameOop) not]) ifTrue:
  			[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	self cppIf: #HAVE_CHOWN ifTrue: [
+ 		self faSetStPathOop: (self addressOf: faPath) _: fileNameOop.
+ 		interpreterProxy failed ifTrue: 
+ 			[^interpreterProxy primitiveFailureCode].
- 		faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'
- 						inSmalltalk: [self simulatedFaPath].
- 		faPath = nil ifTrue: [^interpreterProxy primitiveFailForOSError: self cantAllocateMemory].
- 		self faSetStPathOop: faPath _: fileNameOop.
- 		interpreterProxy failed ifTrue: [
- 			self free: faPath.
- 			^interpreterProxy primitiveFailureCode].
  
+ 		status := self chown: (self faGetPlatPath: (self addressOf: faPath)) _: ownerId _: groupId.
+ 		status ~= 0 ifTrue: 
+ 			[^interpreterProxy primitiveFailForOSError: (self cCode: 'errno')].
- 		status := self chown: (self faGetPlatPath: faPath) _: ownerId _: groupId.
- 		self free: faPath.
- 		status ~= 0 ifTrue: [
- 			^interpreterProxy primitiveFailForOSError: (self cCode: 'errno')].
  		^interpreterProxy methodReturnValue: interpreterProxy nilObject.
  		].
  	^interpreterProxy primitiveFailForOSError: self unsupportedOperation.
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveClosedir (in category 'file primitives') -----
  primitiveClosedir
  	"Close the directory stream for dirPointerOop. Answer dirPointerOop on success.
  	Raise PrimErrBadArgument if the parameter is not a ByteArray length size(void *).
  	If closedir() returns an error raise PrimitiveOSError."
  
  	| dirPointerOop faPathPtr faPath result |
  	<export: true>
  	<var: 'faPath' type: #'fapath *'>
  	<var: 'faPathPtr' type: #'fapathptr *'>
  
  	dirPointerOop := interpreterProxy stackValue: 0.
+ 	faPathPtr := self structFromObject: dirPointerOop 
+ 		size: (self cCode: 'sizeof(fapathptr)').
- 	faPathPtr := self cCode: '(fapathptr *)structFromObjectsize(dirPointerOop, sizeof(fapathptr))'
- 		inSmalltalk: [self structFromObject: dirPointerOop size: self sizeOfFaPathPtr].
  	faPathPtr = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self faValidateSessionId: (self cCode: 'faPathPtr->sessionId' inSmalltalk: [faPathPtr first])) ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- 		[self free: faPathPtr.
- 		^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	faPath := self cCode: 'faPathPtr->faPath' inSmalltalk: [faPathPtr second].
  
  	result := self faCloseDirectory: faPath.
  	self faInvalidateSessionId: (self cCode: '&faPathPtr->sessionId' inSmalltalk: [faPathPtr]).
  	result = 0 ifFalse:
  		[^interpreterProxy primitiveFailForOSError: result].
- 	self free: faPathPtr.
  	self free: faPath.
+ 	interpreterProxy methodReturnValue: dirPointerOop!
- 	interpreterProxy pop: 2 thenPush: dirPointerOop!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveFileAttribute (in category 'file primitives') -----
  primitiveFileAttribute
  	"Answer a single file attribute.
  	primFileAttributes: aString attributeNumber: attributeNumber
  	aString is the path to the file
  	attributeNumber identifies which attribute to return:
  	1 - 12: stat(): name, mode, ino, dev, nlink, uid, gid, size, accessDate, modifiedDate, changeDate, creationDate
  	13 - 15: access(): R_OK, W_OK, X_OK
  	16: isSymlink
  	On error, answer a single element array containing the appropriate error code."
  
  	| fileName attributeNumber resultOop faPath |
  	<export: true>
+ 	<var: 'faPath' type: #'fapath'>
- 	<var: 'faPath' type: #'fapath *'>
  
  	fileName := interpreterProxy stackObjectValue: 1.
  	attributeNumber := interpreterProxy stackIntegerValue: 0.
  	(interpreterProxy failed
  		or: [(attributeNumber between: 1 and: 16) not
  		or: [(interpreterProxy isBytes: fileName) not]]) ifTrue:
  			[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  
+ 	self faSetStPathOop: (self addressOf: faPath) _: fileName.
+ 	interpreterProxy failed ifTrue: 
+ 		[^interpreterProxy primitiveFailureCode].
- 	faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'
- 				inSmalltalk: [self simulatedFaPath].
- 	faPath = nil ifTrue: [^interpreterProxy primitiveFailForOSError: self cantAllocateMemory].
- 	self faSetStPathOop: faPath _: fileName.
- 	interpreterProxy failed ifTrue: [
- 		self free: faPath.
- 		^interpreterProxy primitiveFailureCode].
  
+ 	resultOop := self faFileAttribute: (self addressOf: faPath) _: attributeNumber.
+ 	interpreterProxy failed ifTrue: 
+ 		[^interpreterProxy primitiveFailureCode].
- 	resultOop := self faFileAttribute: faPath _: attributeNumber.
- 	self free: faPath.
- 	interpreterProxy failed ifTrue: [
- 		^interpreterProxy primitiveFailureCode].
  
  	resultOop = 0
  		ifTrue: ["It shouldn't be possible to get here"
  			interpreterProxy primitiveFailForOSError: self unexpectedError]
  		ifFalse: [interpreterProxy methodReturnValue: resultOop]!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveFileAttributes (in category 'file primitives') -----
  primitiveFileAttributes
  	"Answer an array of file attributes.
  	primFileAttributes: aString mask: attributeMask
  	aString is the path to the file
  	attributeMask indicates which attributes to retrieve:
  	bit 0 - get stat() attributes
  	bit 1 - get access() attributes
  	bit 2 - use lstat() instead of stat()
  	On error answer the appropriate error code (Integer)"
  
  	| fileName attributeMask faPath status resultOop  |
  	<export: true>
+ 	<var: 'faPath' type: #'fapath'>
- 	<var: 'faPath' type: #'fapath *'>
  
  	fileName := interpreterProxy stackObjectValue: 1.
  	attributeMask := interpreterProxy stackIntegerValue: 0.
  	(interpreterProxy failed
  	or: [(interpreterProxy isBytes: fileName) not]) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  
+ 	self faSetStPathOop: (self addressOf: faPath) _: fileName.
+ 	interpreterProxy failed ifTrue: 
+ 		[^interpreterProxy primitiveFailureCode].
- 	faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'
- 				inSmalltalk: [self simulatedFaPath].
- 	faPath = nil ifTrue: [^interpreterProxy primitiveFailForOSError: self cantAllocateMemory].
- 	self faSetStPathOop: faPath _: fileName.
- 	interpreterProxy failed ifTrue: [
- 		self free: faPath.
- 		^interpreterProxy primitiveFailureCode].
  
+ 	status := self attributeArray: (self addressOf: resultOop put: [ :val | resultOop := val]) 
+ 					for: (self addressOf: faPath) 
+ 					mask: attributeMask.
- 	status := self attributeArray: (self addressOf: resultOop put: [ :val | resultOop := val]) for: faPath mask: attributeMask.
- 	self free: faPath.
  	status ~= 0 ifTrue:
  		[^interpreterProxy primitiveFailForOSError: status].
  	^interpreterProxy methodReturnValue: resultOop!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveFileExists (in category 'file primitives') -----
  primitiveFileExists
  	"Check for existence of a file with a call to access()."
  
  	| fileNameOop faPath resultOop |
  	<export: true>
+ 	<var: 'faPath'type: #'fapath'>
- 	<var: 'faPath'type: #'fapath *'>
  
  	fileNameOop := interpreterProxy stackObjectValue: 0.
  	(interpreterProxy isBytes: fileNameOop) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  
+ 	self faSetStPathOop: (self addressOf: faPath) _: fileNameOop.
- 	faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'
- 				inSmalltalk: [self simulatedFaPath].
- 	faPath = nil ifTrue: [^interpreterProxy primitiveFailForOSError: self cantAllocateMemory].
- 	self faSetStPathOop: faPath _: fileNameOop.
  	interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailureCode].
  
+ 	resultOop := self faExists: (self addressOf: faPath).
- 	resultOop := self faExists: faPath.
- 	self free: faPath.
  	^interpreterProxy methodReturnValue: resultOop.
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>primitivePlatToStPath (in category 'file primitives') -----
  primitivePlatToStPath
  	"Convert the supplied file name (platform encoded) to the St UTF8 encoded byte array"
  
  	| fileName faPath resultOop byteArrayPtr |
  	<export: true>
+ 	<var: 'faPath' type: #'fapath'>
- 	<var: 'faPath' type: #'fapath *'>
  	<var: 'byteArrayPtr' type: #'unsigned char *'>
  
  	fileName := interpreterProxy stackObjectValue: 0.
  	(interpreterProxy failed
  		or: [(interpreterProxy isBytes: fileName) not]) ifTrue:
  			[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  
+ 	self faSetPlatPathOop: (self addressOf: faPath) _: fileName.
+ 	interpreterProxy failed ifTrue: 
+ 		[^interpreterProxy primitiveFailureCode].
- 	faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'
- 				inSmalltalk: [self simulatedFaPath].
- 	faPath = nil ifTrue: [^interpreterProxy primitiveFailForOSError: self cantAllocateMemory].
- 	self faSetPlatPathOop: faPath _: fileName.
- 	interpreterProxy failed ifTrue: [
- 		self free: faPath.
- 		^interpreterProxy primitiveFailureCode].
  
  	resultOop := interpreterProxy
  		instantiateClass: interpreterProxy classByteArray
+ 		indexableSize: (self faGetStPathLen: (self addressOf: faPath)).
+ 	resultOop ifNil: [^interpreterProxy primitiveFailFor: PrimErrNoMemory].
- 		indexableSize: (self faGetStPathLen: faPath).
- 	resultOop ifNil: [
- 		self free: faPath.
- 		^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	byteArrayPtr := interpreterProxy arrayValueOf: resultOop.
+ 	self memcpy: byteArrayPtr 
+ 		_: (self faGetStPath: (self addressOf: faPath)) 
+ 		_: (self faGetStPathLen: (self addressOf: faPath)).
- 	self memcpy: byteArrayPtr _: (self faGetStPath: faPath) _: (self faGetStPathLen: faPath).
- 	self free: faPath.
  
  	^interpreterProxy methodReturnValue: resultOop.
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveReaddir (in category 'file primitives') -----
  primitiveReaddir
  	"Get the next entry in the directory stream. Answer the name of the entry, or
  	nil for the end of the directory stream.
  	Arguments:
  	- directoryPointer (ByteArray)"
  
  	| dirPointerOop faPathPtr faPath resultArray status |
  	<export: true>
  	<var: 'faPath' type: #'fapath *'>
  	<var: 'faPathPtr' type: #'fapathptr *'>
  
  	dirPointerOop := interpreterProxy stackValue: 0.
+ 	faPathPtr := self structFromObject: dirPointerOop 
+ 		size: (self cCode: 'sizeof(fapathptr)').
- 	faPathPtr := self cCode: '(fapathptr *)structFromObjectsize(dirPointerOop, sizeof(fapathptr))'
- 		inSmalltalk: [self structFromObject: dirPointerOop size: self sizeOfFaPathPtr].
  	faPathPtr = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self faValidateSessionId: (self cCode: 'faPathPtr->sessionId' inSmalltalk: [faPathPtr first])) ifFalse:
+ 		[^interpreterProxy primitiveFailForOSError: self badSessionId].
- 		[self free: faPathPtr.
- 		^interpreterProxy primitiveFailForOSError: self badSessionId].
  	faPath := self cCode: 'faPathPtr->faPath' inSmalltalk: [faPathPtr second].
  
  	status := self faReadDirectory: faPath.
  	status = self noMoreData ifTrue:
+ 		[^interpreterProxy methodReturnValue: interpreterProxy nilObject].
- 		[self free: faPathPtr.
- 		^interpreterProxy pop: 2 thenPush: interpreterProxy nilObject].
  	status < 0 ifTrue:
+ 		[^interpreterProxy primitiveFailForOSError: status].
- 		[self free: faPathPtr.
- 		^interpreterProxy primitiveFailForOSError: status].
  	resultArray := self processDirectory: faPath.
+ 	"no need to check the status of #processDirectory: as it will have flagged an error with interpreterProxy"
- 	self free: faPathPtr.
- 	interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailureCode].
- 
  	^interpreterProxy methodReturnValue: resultArray.
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveRewinddir (in category 'file primitives') -----
  primitiveRewinddir
  	"Set directoryStream to first entry. Answer dirPointerOop."
  
  	| dirPointerOop faPathPtr faPath status resultOop |
  	<export: true>
  	<var: 'faPath' type: #'fapath *'>
  	<var: 'faPathPtr' type: #'fapathptr *'>
  
  	dirPointerOop := interpreterProxy stackValue: 0.
+ 	faPathPtr := self structFromObject: dirPointerOop 
+ 		size: (self cCode: 'sizeof(fapathptr)').
- 	faPathPtr := self cCode: '(fapathptr *)structFromObjectsize(dirPointerOop, sizeof(fapathptr))'
- 		inSmalltalk: [self structFromObject: dirPointerOop size: self sizeOfFaPathPtr].
  	faPathPtr = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self faValidateSessionId: (self cCode: 'faPathPtr->sessionId' inSmalltalk: [faPathPtr first])) ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- 		[self free: faPathPtr.
- 		^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	faPath := self cCode: 'faPathPtr->faPath' inSmalltalk: [faPathPtr second].
  
  	status := self faRewindDirectory: faPath.
  	status < 0 ifTrue: 
+ 		[^interpreterProxy primitiveFailForOSError: status].
- 		[self free: faPathPtr.
- 		^interpreterProxy primitiveFailForOSError: status].
  	resultOop := self processDirectory: faPath.
+ 	"no need to check the status of #processDirectory: as it will have flagged an error with interpreterProxy"
- 	self free: faPathPtr.
- 	interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailureCode ].
  	^interpreterProxy methodReturnValue: resultOop.!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveStToPlatPath (in category 'file primitives') -----
  primitiveStToPlatPath
  	"Convert the supplied file name (UTF8 encoded) to the platform encoded byte array"
  
  	| fileName faPath resultOop byteArrayPtr |
  	<export: true>
+ 	<var: 'faPath' type: #'fapath'>
- 	<var: 'faPath' type: #'fapath *'>
  	<var: 'byteArrayPtr' type: #'unsigned char *'>
  
  	fileName := interpreterProxy stackObjectValue: 0.
  	(interpreterProxy failed
  		or: [(interpreterProxy isBytes: fileName) not]) ifTrue:
  			[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  
+ 	self faSetStPathOop: (self addressOf: faPath) _: fileName.
+ 	interpreterProxy failed ifTrue: 
+ 		[^interpreterProxy primitiveFailureCode].
- 	faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'
- 				inSmalltalk: [self simulatedFaPath].
- 	faPath = nil ifTrue: [^interpreterProxy primitiveFailForOSError: self cantAllocateMemory].
- 	self faSetStPathOop: faPath _: fileName.
- 	interpreterProxy failed ifTrue: [
- 		self free: faPath.
- 		^interpreterProxy primitiveFailureCode].
  
  	resultOop := interpreterProxy
  		instantiateClass: interpreterProxy classByteArray
+ 		indexableSize: (self faGetPlatPathByteCount: (self addressOf: faPath)).
+ 	resultOop ifNil: [^interpreterProxy primitiveFailFor: PrimErrNoMemory].
- 		indexableSize: (self faGetPlatPathByteCount: faPath).
- 	resultOop ifNil: [
- 		self free: faPath.
- 		^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	byteArrayPtr := interpreterProxy arrayValueOf: resultOop.
+ 	self memcpy: byteArrayPtr 
+ 		_: (self faGetPlatPath: (self addressOf: faPath)) 
+ 		_: (self faGetPlatPathByteCount: (self addressOf: faPath)).
- 	self memcpy: byteArrayPtr _: (self faGetPlatPath: faPath) _: (self faGetPlatPathByteCount: faPath).
- 	self free: faPath.
  
  	^interpreterProxy methodReturnValue: resultOop.
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveSymlinkChangeOwner (in category 'file primitives') -----
  primitiveSymlinkChangeOwner
  	"Set the owner of the supplied file using chown()."
  
  	| fileNameOop ownerId groupId faPath status |
  	<export: true>
+ 	<var: 'faPath' type: #'fapath'>
- 	<var: 'faPath' type: #'fapath *'>
  
  	fileNameOop := interpreterProxy stackObjectValue: 2.
  	ownerId := interpreterProxy stackIntegerValue: 1.
  	groupId := interpreterProxy stackIntegerValue: 0.
  	(interpreterProxy failed
  		or: [(interpreterProxy isBytes: fileNameOop) not]) ifTrue:
  			[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	self cppIf: #HAVE_CHOWN ifTrue: [
+ 		self faSetStPathOop: (self addressOf: faPath) _: fileNameOop.
+ 		interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailureCode].
- 		faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'
- 						inSmalltalk: [self simulatedFaPath].
- 		faPath = nil ifTrue: [^interpreterProxy primitiveFailForOSError: self cantAllocateMemory].
- 		self faSetStPathOop: faPath _: fileNameOop.
- 		interpreterProxy failed ifTrue: [
- 			self free: faPath.
- 			^interpreterProxy primitiveFailureCode].
  
+ 		status := self lchown: (self faGetPlatPath: (self addressOf: faPath)) _: ownerId _: groupId.
- 		status := self lchown: (self faGetPlatPath: faPath) _: ownerId _: groupId.
- 		self free: faPath.
  		status ~= 0 ifTrue:
  			[^interpreterProxy primitiveFailForOSError: (self cCode: 'errno')].
  		^interpreterProxy methodReturnValue: interpreterProxy nilObject.
  		].
  	^interpreterProxy primitiveFailForOSError: self unsupportedOperation.
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>structFromObject:size: (in category 'private - directory') -----
  structFromObject: anObject size: structSize
  	"Allocate memory of the requiested size and copy the contents of anObject in to it.
  	anObject is expected to be bytes, e.g. ByteArray or String.
+ 	The structure is allocated on the stack using alloca(), thus this method must always be inlined so that the memory is valid in the calling method."
- 	The sender is responsible for freeing the memory."
  
  	| buffer |
+ 	<inline: #always>
  	<returnTypeC: #'void *'>
  	<var: 'buffer' type: #'void *'>
  
- 	buffer := 0.
  	(interpreterProxy stSizeOf: anObject) = structSize ifFalse:
  		[interpreterProxy primitiveFailFor: PrimErrBadArgument.
+ 		^0].
+ 	buffer := self alloca: structSize.
- 		^buffer].
- 	buffer := self malloc: structSize.
  	buffer = 0 ifTrue:
+ 		[interpreterProxy primitiveFailFor: PrimErrNoCMemory]
+ 	ifFalse:
+ 		[self memcpy: buffer
- 		[interpreterProxy primitiveFailFor: PrimErrNoCMemory.
- 		^buffer].
- 	self memcpy: buffer
  			_: (interpreterProxy arrayValueOf: anObject)
+ 			_: structSize].
- 			_: structSize.
  	^buffer!

Item was changed:
  ----- Method: FileAttributesPlugin>>versionString (in category 'version string') -----
  versionString
  	"Answer a string containing the version string for this plugin."
  	<inline: #always>
+ 	^'2.0.7'!
- 	^'2.0.6'!



More information about the Vm-dev mailing list