[Vm-dev] VM Maker: FileAttributesPlugin.oscog-AlistairGrant.41.mcz

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


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

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

Name: FileAttributesPlugin.oscog-AlistairGrant.41
Author: AlistairGrant
Time: 19 October 2018, 8:51:24.040838 am
UUID: d2d6702b-d756-4a5f-a516-ca0959a63ef3
Ancestors: FileAttributesPlugin.oscog-AlistairGrant.40

FileAttributesPlugin 2.0.3

Adds partial support for running in the VM simulator.

This is a work-in-progress, the simulation currently fails in #primitiveFailForOSError: and when writing file names with unicode characters that are multibyte in UTF8.

=============== Diff against FileAttributesPlugin.oscog-AlistairGrant.40 ===============

Item was added:
+ ----- Method: FileAttributesPlugin class>>moduleName (in category 'translation') -----
+ moduleName
+ 
+ 	^ 'FileAttributesPlugin'!

Item was added:
+ ----- Method: FileAttributesPlugin class>>shouldBeTranslated (in category 'translation') -----
+ shouldBeTranslated
+ 	^true!

Item was added:
+ ----- Method: FileAttributesPlugin class>>simulatorClass (in category 'simulation') -----
+ simulatorClass
+ 	^FileAttributesPluginSimulator!

Item was changed:
  ----- Method: FileAttributesPlugin>>fileToAttributeArray:mask:array: (in category 'private - file') -----
  fileToAttributeArray: faPath mask: attributeMask array: attributeArray
  	"Answer a file attribute array from pathNameOop."
  
  	| getStats useLstat getAccess statArray accessArray combinedArray status fileNameOop statBuf  |
  	<returnTypeC: #'int'>
  	<var: 'faPath' type: #'fapath *'>
  	<var: 'attributeArray' type: #'sqInt *'>
  	<var: 'statBuf' type: #'faStatStruct'>
  
  	"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"
  		^self invalidArguments].
  	getStats ifTrue: 
  		[
  		useLstat := attributeMask anyMask: 4.
  		statArray := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 12.
  		statArray ifNil:
  			[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
+ 		self cCode: '' inSmalltalk: [
+ 			statBuf := ValueHolder new. "ByteArray new: 1024"
+ 			fileNameOop := ValueHolder new].
  		status := useLstat ifFalse:
  					[ self faStat: faPath _: (self addressOf: statBuf ) _: (self addressOf: fileNameOop) ]
  				ifTrue:
  					[ self faLinkStat: faPath _: (self addressOf: statBuf ) _: (self addressOf: fileNameOop) ].
  		status ~= 0 ifTrue: [^status].
  		status := self statArrayFor: faPath toArray: statArray from: (self addressOf: statBuf) fileName: fileNameOop.
  		status ~= 0 ifTrue: [^status].
  		"Set attributeArray in case only stat() attributes have been requested"
  		attributeArray at: 0 put: statArray
  		].
  	getAccess ifTrue: 
  		[
  		accessArray := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 3.
  		accessArray ifNil:
  			[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  		self faAccessAttributes: faPath _: accessArray _: 0.
  		"Set attributeArray in case only access() attributes have been requested"
  		attributeArray at: 0 put: accessArray
  		].
+ 	(getStats and: [getAccess]) ifTrue: 
- 	[getStats and: [getAccess]] ifTrue: 
  		[
  		combinedArray := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
  		combinedArray ifNil:
  			[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  		attributeArray at: 0 put: combinedArray.
  		interpreterProxy
  			storePointer: 0 ofObject: combinedArray withValue: statArray;
  			storePointer: 1 ofObject: combinedArray withValue: accessArray
  		].
  
  	^0!

Item was changed:
  ----- Method: FileAttributesPlugin>>posixFileTimesFrom:to: (in category 'private - posix') -----
  posixFileTimesFrom: statBufPointer to: attributeArray
  	"Populate attributeArray with the file times from statBufPointer"
  
  	| attributeDate |
  
  	<var: 'statBufPointer' type: #'faStatStruct *'>
  	<var: 'attributeDate' type: #'sqLong'>
  
  	self cppIf: #_WIN32 defined ifTrue: [] ifFalse: [
+ 	attributeDate := self faConvertUnixToLongSqueakTime: (self
+ 		cCode: 'statBufPointer->st_atime'
+ 		inSmalltalk: [statBufPointer contents at: 9]).
- 	attributeDate := self faConvertUnixToLongSqueakTime: (self cCode: 'statBufPointer->st_atime').
  	interpreterProxy
  		storePointer: 8
  			ofObject: attributeArray
  				withValue: (interpreterProxy signed64BitIntegerFor: attributeDate).
+ 	attributeDate := self faConvertUnixToLongSqueakTime: (self
+ 		cCode: 'statBufPointer->st_mtime'
+ 		inSmalltalk: [statBufPointer contents at: 10]).
- 	attributeDate := self faConvertUnixToLongSqueakTime: (self cCode: 'statBufPointer->st_mtime').
  	interpreterProxy
  		storePointer: 9
  			ofObject: attributeArray
  				withValue: (interpreterProxy signed64BitIntegerFor: attributeDate).
+ 	attributeDate := self faConvertUnixToLongSqueakTime: (self
+ 		cCode: 'statBufPointer->st_ctime'
+ 		inSmalltalk: [statBufPointer contents at: 11]).
- 	attributeDate := self faConvertUnixToLongSqueakTime: (self cCode: 'statBufPointer->st_ctime').
  	interpreterProxy
  		storePointer: 10
  			ofObject: attributeArray
  				withValue: (interpreterProxy signed64BitIntegerFor: attributeDate);
  		storePointer: 11
  			ofObject: attributeArray
  				withValue: interpreterProxy nilObject ].
  	^0!

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 faPath result |
  	<export: true>
  	<var: 'fapath' type: #'faPath *'>
  
  	dirPointerOop := interpreterProxy stackValue: 0.
  	faPath := self pointerFrom: dirPointerOop.
  	faPath ifNil:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  
  	result := self faCloseDirectory: faPath.
  	result = 0 ifFalse:
  		[^interpreterProxy primitiveFailForOSError: result].
  	self free: faPath.
  	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 *'>
  
  	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].
  
+ 	faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'
+ 				inSmalltalk: [self simulatedFaPath].
- 	faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'.
  	faPath = nil ifTrue: [^interpreterProxy primitiveFailForOSError: self cantAllocateMemory].
  	self faSetStPathOop: faPath _: fileName.
  	interpreterProxy failed ifTrue: [
  		self free: faPath.
  		^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 attributeArray faPath status |
  	<export: true>
  	<var: 'faPath' type: #'fapath *'>
  
  	fileName := interpreterProxy stackObjectValue: 1.
  	attributeMask := interpreterProxy stackIntegerValue: 0.
  	(interpreterProxy failed
  	or: [(interpreterProxy isBytes: fileName) not]) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  
+ 	faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'
+ 				inSmalltalk: [self simulatedFaPath].
- 	faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'.
  	faPath = nil ifTrue: [^interpreterProxy primitiveFailForOSError: self cantAllocateMemory].
+ 	self faSetStPathOop: faPath _: fileName.
- 	self faSet: faPath StPathOop: fileName.
  	interpreterProxy failed ifTrue: [
  		self free: faPath.
  		^interpreterProxy primitiveFailureCode].
  
  	status := self fileToAttributeArray: faPath
  					mask: attributeMask 
  					array: (self addressOf: attributeArray put: [:val| attributeArray := val]).
  	self free: faPath.
  	status ~= 0
  		ifTrue: [interpreterProxy primitiveFailForOSError: status]
  		ifFalse: [interpreterProxy methodReturnValue: attributeArray]!

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 *'>
  
  	fileNameOop := interpreterProxy stackObjectValue: 0.
  	(interpreterProxy isBytes: fileNameOop) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  
+ 	faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'
+ 				inSmalltalk: [self simulatedFaPath].
- 	faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'.
  	faPath = nil ifTrue: [^interpreterProxy primitiveFailForOSError: self cantAllocateMemory].
  	self faSetStPathOop: faPath _: fileNameOop.
  	interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailureCode].
  
  	resultOop := self faExists: faPath.
  	self free: faPath.
  	^interpreterProxy methodReturnValue: resultOop.
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveFileMasks (in category 'file primitives') -----
  primitiveFileMasks
  	"Answer an array of well known file masks"
  
  	| masks |
  	<export: true>
  	masks := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 8.
  	masks ifNil: [^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	interpreterProxy
  		storePointer: 0
  		ofObject: masks
+ 		withValue: (interpreterProxy positive32BitIntegerFor: (self cCode: [#S_IFMT] inSmalltalk: [16rF000])).
- 		withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFMT').
  	self cppIf: #_WIN32 defined not
+ 		ifTrue: [
+ 			interpreterProxy
- 		ifTrue:
- 			[interpreterProxy
  				storePointer: 1
  				ofObject: masks
+ 				withValue: (interpreterProxy positive32BitIntegerFor: (self cCode: [#S_IFSOCK] inSmalltalk: [16rC000])).
- 				withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFSOCK').
  			interpreterProxy
  				storePointer: 2
  				ofObject: masks
+ 				withValue: (interpreterProxy positive32BitIntegerFor: (self cCode: [#S_IFLNK] inSmalltalk: [16rA000]))].
- 				withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFLNK')].
  	interpreterProxy
  		storePointer: 3
  		ofObject: masks
+ 		withValue: (interpreterProxy positive32BitIntegerFor: (self cCode: [#S_IFREG] inSmalltalk: [16r8000])).
- 		withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFREG').
  	interpreterProxy
  		storePointer: 4
  		ofObject: masks
+ 		withValue: (interpreterProxy positive32BitIntegerFor: (self cCode: [#S_IFBLK] inSmalltalk: [16r6000])).
- 		withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFBLK').
  	interpreterProxy
  		storePointer: 5
  		ofObject: masks
+ 		withValue: (interpreterProxy positive32BitIntegerFor: (self cCode: [#S_IFDIR] inSmalltalk: [16r4000])).
- 		withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFDIR').
  	interpreterProxy
  		storePointer: 6
  		ofObject: masks
+ 		withValue: (interpreterProxy positive32BitIntegerFor: (self cCode: [#S_IFCHR] inSmalltalk: [16r2000])).
- 		withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFCHR').
  	interpreterProxy
  		storePointer: 7
  		ofObject: masks
+ 		withValue: (interpreterProxy positive32BitIntegerFor: (self cCode: [#S_IFIFO] inSmalltalk: [16r1000])).
- 		withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFIFO').
  	interpreterProxy pop: 1 thenPush: masks!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveOpendir (in category 'file primitives') -----
  primitiveOpendir
  
  	"self primOpendir: '/etc'"
  
  	| dirName faPath dirOop status resultOop |
  	<export: true>
  	<var: 'faPath' type: #'fapath *'>
  
  	dirName := interpreterProxy stackObjectValue: 0.
  	(interpreterProxy isBytes: dirName) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  
+ 	faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'
+ 				inSmalltalk: [self simulatedFaPath].
- 	faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'.
  	faPath = nil ifTrue: [^interpreterProxy primitiveFailForOSError: self cantAllocateMemory].
+ 	self faSetStDirOop: faPath _: dirName.
+ 	interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailureCode].
- 	self faSet: faPath StDirOop: dirName.
  
  	(self canOpenDirectoryStreamFor: (self faGetStPath: faPath) length: (self faGetStPathLen: faPath)) ifFalse: [
  		self free: faPath.
  		^interpreterProxy primitiveFailForOSError: self cantOpenDir].
  
  	status := self faOpenDirectory: faPath.
  	status = self noMoreData ifTrue: [
  		self free: faPath.
  		^interpreterProxy pop: 2 thenPush: interpreterProxy nilObject].
  	status < 0 ifTrue: [
  		self free: faPath.
  		^interpreterProxy primitiveFailForOSError: status].
  	resultOop := self processDirectory: faPath.
  	interpreterProxy failed ifTrue: [
  		self free: faPath.
  		^interpreterProxy primitiveFailureCode ].
  
  	self remapOop: resultOop in:
  		[ dirOop := self addressObjectFor: faPath ].
  	^interpreterProxy 
  		storePointer: 2 ofObject: resultOop withValue: dirOop;
  		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 faPath resultArray status |
  	<export: true>
  	<var: 'faPath' type: #'fapath *'>
  
  	dirPointerOop := interpreterProxy stackValue: 0.
  	faPath := self pointerFrom: dirPointerOop.
  	faPath ifNil:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  
  	status := self faReadDirectory: faPath.
  	status = self noMoreData ifTrue:
  		[^interpreterProxy pop: 2 thenPush: interpreterProxy nilObject].
  	status < 0 ifTrue:
  		[^interpreterProxy primitiveFailForOSError: status].
  	resultArray := self processDirectory: faPath.
  	interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailureCode].
  
  	interpreterProxy
  		pop: 2 thenPush: resultArray!

Item was changed:
  ----- Method: FileAttributesPlugin>>processDirectory: (in category 'private') -----
  processDirectory: faPath
  	"The supplied faPath contains the full path to the current entry while iterating over a directory.
  	Convert the file name to an object, get the attributes and answer the resulting array."
  
  	| status entryName attributeArray resultArray |
  	<var: 'faPath' type: #'fapath *'>
  
+ 	status := self faCharToByteArray: (self faGetStFile: faPath) 
+ 				_: (self addressOf: entryName put: [:val | entryName := val]).
- 	status := self faChar: (self faGetStFile: faPath) 
- 				ToByteArray: (self addressOf: entryName put: [:val | entryName := val]).
  	status ~= 0 ifTrue:
  		[ ^interpreterProxy primitiveFailForOSError: status].
  
  	status := self fileToAttributeArray: faPath mask: 1 array: (self addressOf: attributeArray put: [:val| attributeArray := val]).
  	"If the stat() fails, still return the filename, just no attributes"
  	status ~= 0 ifTrue: [attributeArray := interpreterProxy nilObject].
  
  	"resultArray: entryName, attributeArray, dirPtrOop"
  	self remapOop: #(entryName attributeArray)
  		in: [resultArray := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 3].
  	resultArray ifNil:
  		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	interpreterProxy
  		storePointer: 0 ofObject: resultArray withValue: entryName;
  		storePointer: 1 ofObject: resultArray withValue: attributeArray.
  	^resultArray!

Item was changed:
  ----- Method: FileAttributesPlugin>>statArrayFor:toArray:from:fileName: (in category 'private - file') -----
  statArrayFor: faPath toArray: attributeArray from: statBufPointer fileName: fileNameOop
  	"Answer a file entry array from the supplied statBufPointer"
  
+ 	| sizeIfFile status isDir |
- 	| sizeIfFile status |
  	<var: 'faPath' type: #'fapath *'>
  	<var: 'statBufPointer' type: #'faStatStruct *'>
  
+ 	isDir := self
+ 		cCode: 'S_ISDIR(statBufPointer->st_mode)'
+ 		inSmalltalk: [
+ 			((statBufPointer contents at: 2) bitAnd: self s_IFMT) = self s_IFDIR
+ 				ifTrue: [1]
+ 				ifFalse: [0]].
+ 	sizeIfFile := isDir = 0
+ 					ifTrue: [self cCode: 'statBufPointer->st_size'
+ 								inSmalltalk: [self
+ 									cCode: 'statBufPointer->st_size'
+ 									inSmalltalk: [statBufPointer contents at: 8]]]
- 	sizeIfFile := (self cCode: 'S_ISDIR(statBufPointer->st_mode)') = 0
- 					ifTrue: [self cCode: 'statBufPointer->st_size']
  					ifFalse: [0].
  	interpreterProxy
  		storePointer: 0
  			ofObject: attributeArray
+ 				withValue: (self cCode: 'fileNameOop' inSmalltalk: [self toOop: fileNameOop contents]);
- 				withValue: fileNameOop;
  		storePointer: 1
  			ofObject: attributeArray
+ 				withValue: (interpreterProxy positive64BitIntegerFor: (self
+ 					cCode: 'statBufPointer->st_mode'
+ 					inSmalltalk: [statBufPointer contents at: 2]));
- 				withValue: (interpreterProxy positive64BitIntegerFor: (self cCode: 'statBufPointer->st_mode'));
  		storePointer: 2
  			ofObject: attributeArray
+ 				withValue: (interpreterProxy positive64BitIntegerFor: (self
+ 					cCode: 'statBufPointer->st_ino'
+ 					inSmalltalk: [statBufPointer contents at: 3]));
- 				withValue: (interpreterProxy positive64BitIntegerFor: (self cCode: 'statBufPointer->st_ino'));
  		storePointer: 3
  			ofObject: attributeArray
+ 				withValue: (interpreterProxy positive64BitIntegerFor: (self
+ 					cCode: 'statBufPointer->st_dev'
+ 					inSmalltalk: [statBufPointer contents at: 4]));
- 				withValue: (interpreterProxy positive64BitIntegerFor: (self cCode: 'statBufPointer->st_dev'));
  		storePointer: 4
  			ofObject: attributeArray
+ 				withValue: (interpreterProxy positive64BitIntegerFor: (self
+ 					cCode: 'statBufPointer->st_nlink'
+ 					inSmalltalk: [statBufPointer contents at: 5]));
- 				withValue: (interpreterProxy positive64BitIntegerFor: (self cCode: 'statBufPointer->st_nlink'));
  		storePointer: 5
  			ofObject: attributeArray
+ 				withValue: (interpreterProxy positive64BitIntegerFor: (self
+ 					cCode: 'statBufPointer->st_uid'
+ 					inSmalltalk: [statBufPointer contents at: 6]));
- 				withValue: (interpreterProxy positive64BitIntegerFor: (self cCode: 'statBufPointer->st_uid'));
  		storePointer: 6
  			ofObject: attributeArray
+ 				withValue: (interpreterProxy positive64BitIntegerFor: (self
+ 					cCode: 'statBufPointer->st_gid'
+ 					inSmalltalk: [statBufPointer contents at: 7]));
- 				withValue: (interpreterProxy positive64BitIntegerFor: (self cCode: 'statBufPointer->st_gid'));
  		storePointer: 7
  			ofObject: attributeArray
  				withValue: (interpreterProxy positive64BitIntegerFor: sizeIfFile).
  
  	self cppIf: #_WIN32 defined
  		ifTrue: [ status := self winFileTimesFor: faPath to: attributeArray ]
  		ifFalse: [ status := self posixFileTimesFrom: statBufPointer to: attributeArray ].
  
  	^status
  !

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.3'!
- 	^'2.0.2'!

Item was added:
+ FileAttributesPlugin subclass: #FileAttributesPluginSimulator
+ 	instanceVariableNames: 'maxPathLen'
+ 	classVariableNames: 'S_IFBLK S_IFCHR S_IFDIR S_IFIFO S_IFLNK S_IFMT S_IFREG S_IFSOCK'
+ 	poolDictionaries: ''
+ 	category: 'FileAttributesPlugin'!
+ 
+ !FileAttributesPluginSimulator commentStamp: 'AlistairGrant 10/12/2018 16:08' prior: 0!
+ FileAttributesPluginSimulator provides support functions to allow the FilePluginsAttribute to run in the VM simulator.
+ 
+ faPath is opaque to the VM, but normally stores:
+ 
+ 1. The file path being interagated in the format provided by the image (precomposed UTF8).
+ 2. The file path in platform specific format, e.g. wide strings for Windows, decomposed UTF8 for Mac.
+ 3. Platform specific directory iteration information when required, e.g. primOpendir.
+ 
+ The simulator stores an Array with:
+ 
+ 1. The input path in precomposed UTF8.
+ 2. The file name when iterating over directories.
+ 3. The pointer to the real faPath used by the plugin.
+ 
+ Instance Variables
+ !

Item was added:
+ ----- Method: FileAttributesPluginSimulator class>>shouldBeTranslated (in category 'translation') -----
+ shouldBeTranslated
+ "This class should not be translated"
+ 	^false!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>addressObjectFor: (in category 'simulation support') -----
+ addressObjectFor: aByteArray
+ 	"The simulation passes around ByteArrays in place of malloc'd memory.
+ 	Copy the supplied ByteArray to the simulations memory and answer the address."
+ 
+ 	^self toOop: aByteArray!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>arrayFromOop: (in category 'simulation support') -----
+ arrayFromOop: anOop
+ 	"Answer a copy of the supplied array Oop"
+ 
+ 	| sz array |
+ 
+ 	sz := interpreterProxy stSizeOf: anOop.
+ 	array := Array new: sz.
+ 	1 to: sz do: [ :i |
+ 		array at: i put: (self fromOop: (interpreterProxy fetchPointer: i-1 ofObject: anOop))].
+ 	^array!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>byteArrayFromOop: (in category 'simulation support') -----
+ byteArrayFromOop: anOop
+ 	"Answer a copy of the supplied byte array Oop"
+ 
+ 	| sz array ptr |
+ 
+ 	sz := interpreterProxy stSizeOf: anOop.
+ 	ptr := interpreterProxy arrayValueOf: anOop.
+ 	array := ByteArray new: sz.
+ 	1 to: sz do: [ :i |
+ 		array at: i put: (interpreterProxy byteAt: ptr+i-1)].
+ 	^array!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>classOf: (in category 'simulation support') -----
+ classOf: anOop
+ 
+ 	| clsOop |
+ 	
+ 	clsOop := interpreterProxy fetchClassOf: anOop.
+ 	clsOop = interpreterProxy nilObject ifTrue: [^UndefinedObject].
+ 	clsOop = interpreterProxy classArray ifTrue: [^Array].
+ 	clsOop = interpreterProxy classByteArray ifTrue: [^ByteArray].
+ 	self error: 'unknown class'!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faCharToByteArray:_: (in category 'simulation') -----
+ faCharToByteArray: filePtr _: byteArrayPtr
+ 	"Copy the supplied file name to the simulation and set the pointer"
+ 
+ 	byteArrayPtr at: 0 put: (self toOop: filePtr).
+ 	^0!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faCloseDirectory: (in category 'simulation') -----
+ faCloseDirectory: faPath
+ 	"Simulate the the call by actually calling the primitive and discarding the stat information (which will be retrieved again later in the simulation)."
+ 
+ 	| result status |
+ 
+ 	result := self primClosedir: (self faPathPtr: faPath).
+ 	result ifNotNil: [
+ 		faPath at: 3 put: nil.
+ 		status := 0 ]
+ 	ifNil: [status := self unexpectedError].
+ 	^status
+ !

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faConvertUnixToLongSqueakTime: (in category 'simulation') -----
+ faConvertUnixToLongSqueakTime: anInteger
+ 	"In the simulation the primitive returns the value already converted, so this is a no-op"
+ 
+ 	^anInteger!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faExists: (in category 'simulation') -----
+ faExists: faPath
+ 	"Simulate the the call by actually calling the primitive."
+ 
+ 	^(self primExists: faPath first)
+ 		ifTrue: [interpreterProxy trueObject]
+ 		ifFalse: [interpreterProxy falseObject].
+ !

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faFileAttribute:_: (in category 'simulation') -----
+ faFileAttribute: faPath _: attributeNumber
+ 	"Simulate the the call by actually calling the primitive."
+ 
+ 	^self toOop: (self primFileAttribute: faPath first number: attributeNumber)!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faGetStFile: (in category 'simulation') -----
+ faGetStFile: faPath
+ 	"Answer the basename of the path.
+ 	The simulated faPath contains the basename as the second entry in the Array."
+ 
+ 	^faPath at: 2!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faGetStPath: (in category 'simulation') -----
+ faGetStPath: faPath
+ 	"Answer the St format of the path."
+ 
+ 	| path |
+ 
+ 	path := faPath first.
+ 	faPath second ifNotNil: [
+ 		path := path, faPath second].
+ 	^path!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faGetStPathLen: (in category 'simulation') -----
+ faGetStPathLen: faPath
+ 	"Answer the length of the path."
+ 
+ 	^faPath first size
+ !

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faOpenDirectory: (in category 'simulation') -----
+ faOpenDirectory: faPath
+ 	"Simulate the the call by actually calling the primitive and discarding the stat information (which will be retrieved again later in the simulation)."
+ 
+ 	| result status |
+ 
+ 	result := self primOpendir: faPath first.
+ 	result ifNotNil: [
+ 		faPath 
+ 			at: 2 put: (result at: 1);
+ 			at: 3 put: (result at: 3).
+ 		status := 0 ]
+ 	ifNil: [status := self noMoreData].
+ 	^status
+ !

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faPathPtr: (in category 'simulation') -----
+ faPathPtr: faPathSimulation
+ 	"Given the simulation faPath, answer the ByteArray pointing to the actual faPath"
+ 
+ 	^faPathSimulation at: 3!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faReadDirectory: (in category 'simulation') -----
+ faReadDirectory: faPath
+ 	"Simulate the the call by actually calling the primitive and discarding the stat information (which will be retrieved again later in the simulation)."
+ 
+ 	| result status |
+ 
+ 	result := self primReaddir: (self faPathPtr: faPath).
+ 	result ifNotNil: [
+ 		faPath at: 2 put: (result at: 1).
+ 		status := 0 ]
+ 	ifNil: [status := self noMoreData].
+ 	^status
+ !

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faSetStDirOop:_: (in category 'simulation') -----
+ faSetStDirOop: faPath _: dirOop
+ 	"Simulate setting the dir name in the supplied faPath."
+ 
+ 	self faSetStPathOop: faPath _: dirOop.
+ 	faPath first last = FileDirectory pathNameDelimiter asciiValue ifFalse:
+ 		[faPath at: 1 put: (faPath first copyWith: FileDirectory pathNameDelimiter asciiValue)]!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faSetStPathOop:_: (in category 'simulation') -----
+ faSetStPathOop: faPath _: fileNameOop
+ 	"Simulate setting the file name in the supplied faPath.
+ 	The simulated faPath is simply the file name as a C string (null-terminated)."
+ 
+ 	| fileNameBytes len path |
+ 
+ 	fileNameBytes := interpreterProxy arrayValueOf: fileNameOop.
+ 	self assert: faPath class == Array.
+ 	len := self strlen: fileNameBytes.
+ 	path := ByteArray new: len.
+ 	self strncpy: path _: fileNameBytes _: len.
+ 	faPath at: 1 put: path.!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faStat:_:_: (in category 'simulation') -----
+ faStat: faPath _: statBuf _: fileNameOop
+ 	"Simulate the call to faStat().
+ 	The simulator uses a dictionary with keys named after the stat structure members."
+ 
+ 	| path primArray |
+ 
+ 	path := self faGetStPath: faPath.
+ 	primArray := self primFileAttributes: path mask: 1.
+ 	primArray isNumber ifTrue: [^primArray].
+ 	"First entry is fileName: **TODO**"
+ 	statBuf contents: primArray.
+ 	^0!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>fromOop: (in category 'simulation support') -----
+ fromOop: anOop
+ 
+ 	| cls |
+ 
+ 	cls := self classOf: anOop.
+ 	cls = UndefinedObject ifTrue: [^nil].
+ 	cls = Array ifTrue: [^self arrayFromOop: anOop].
+ 	cls = ByteArray ifTrue: [^self byteArrayFromOop: anOop].
+ 	self error: 'Unknown class'.!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>initialize (in category 'initialize-release') -----
+ initialize
+ 	"Initialise the receiver for the current platform"
+ 
+ 	| masks |
+ 
+ 	masks := self primFileMasks.
+ 	S_IFMT := masks at: 1.
+ 	S_IFSOCK := masks at: 2.
+ 	S_IFLNK := masks at: 3.
+ 	S_IFREG := masks at: 4.
+ 	S_IFBLK := masks at: 5.
+ 	S_IFDIR := masks at: 6.
+ 	S_IFCHR := masks at: 7.
+ 	S_IFIFO := masks at: 8.
+ !

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>maxPathLen (in category 'simulation support') -----
+ maxPathLen
+ 	"Answer the maximum supported path length for the current platform"
+ 
+ 	^maxPathLen ifNil: [maxPathLen := self primPathMax]!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>pointerFrom: (in category 'simulation support') -----
+ pointerFrom: arrayOop
+ 	"For the simulation, convert the supplied address to a ByteArray"
+ 
+ 	^self fromOop: arrayOop!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>primClosedir: (in category 'primitives') -----
+ primClosedir: directoryPointerBytes
+ 	"Close the directory stream associated with directoryPointerBytes.
+ 	Caution: do not call this twice on the same externalAddress."
+ 
+ 	"self primClosedir: (self primOpendir: '/etc')"
+ 	"self primClosedir: (self primOpendir: '/no/such/directory')"
+ 
+ 	<primitive: 'primitiveClosedir' module: 'FileAttributesPlugin' error: error>
+ 	^self signalError: error for: 'primClosedir'!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>primExists: (in category 'primitives') -----
+ primExists: aByteArray
+ 	"Answer a boolean indicating whether the supplied file exists."
+ 
+ 	<primitive: 'primitiveFileExists' module: 'FileAttributesPlugin' error: error>
+ 	^self signalError: error for: aByteArray.
+ !

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>primFileAttribute:number: (in category 'primitives') -----
+ primFileAttribute: aByteArray number: attributeNumber
+ 	"Answer a single attribute for the supplied file.
+ 	For backward compatibility (on Unix) with FileReference if the file doesn't exist, and the specified path is a (broken) symbolic link, answer the requested attribute for the symbolic link.
+ 
+ stat() information:
+ 	
+ 	1: name
+ 	2: mode
+ 	3: ino
+ 	4: dev
+ 	5: nlink
+ 	6: uid
+ 	7: gid
+ 	8: size
+ 	9: accessDate
+ 	10: modifiedDate
+ 	11: changeDate
+ 	12: creationDate
+ 
+ access() information
+ 
+ 	13: is readable
+ 	14: is writeable
+ 	15: is executable
+ 
+ symbolic link information
+ 
+ 	16: is symbolic link
+ 	"
+ 	<primitive: 'primitiveFileAttribute' module: 'FileAttributesPlugin' error: error>
+ 	"FilePlugin>>primitiveDirectoryEntry would return the symbolic link attributes if the symbolic link was broken.  This was due to the incorrect implementation of attempting to retrieve symbolic link information.
+ 	If the old behaviour is required, the logic is:
+ 	
+ 		(error isPrimitiveError and: [attributeNumber ~= 16 and: [error errorCode = self cantStatPath and: [
+ 					self platformSupportsSymbolicLinksEgUnix]]]) ifTrue:
+ 						[DiskSymlinkDirectoryEntry fileSystem: DiskStore currentFileSystem path: aString asPath]"
+ 	error isPrimitiveError ifTrue: [ 
+ 		(attributeNumber = 16 and: [ error errorCode = self unsupportedOperation ]) ifTrue: 
+ 			"If symlinks aren't supported, answer false"
+ 			[ ^false ]].
+ 	^self signalError: error for: aByteArray
+ !

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>primFileAttributes:mask: (in category 'primitives') -----
+ primFileAttributes: aByteArray mask: attributeMask
+ 	"Answer an array of attributes for the supplied file.  The size and contents of the array are determined by the attributeMask:
+ 
+ Bit 0: stat() information
+ Bit 1: access() information
+ Bit 2: use lstat() (instead of stat())
+ 
+ On error, answer an error code (Integer).
+ 
+ stat() information:
+ 	
+ 	1: name
+ 	2: mode
+ 	3: ino
+ 	4: dev
+ 	5: nlink
+ 	6: uid
+ 	7: gid
+ 	8: size
+ 	9: accessDate
+ 	10: modifiedDate
+ 	11: creationDate
+ 
+ access() information
+ 
+ 	1: is readable
+ 	2: is writeable
+ 	3: is executable
+ 	"
+ 	<primitive: 'primitiveFileAttributes' module: 'FileAttributesPlugin' error: error>
+ 	^self signalError: error for: aByteArray
+ !

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>primFileMasks (in category 'primitives') -----
+ primFileMasks
+ 	"Answer an array of well known masks:
+ 	
+ 	1: S_IFMT
+ 	2: S_IFSOCK
+ 	3: S_IFLNK
+ 	4: S_IFREG
+ 	5: S_IFBLK
+ 	6: S_IFDIR
+ 	7: S_IFCHR
+ 	8: S_IFIFO
+ 
+ 	For more information, see: http://man7.org/linux/man-pages/man2/stat.2.html
+ 	"
+ 	<primitive: 'primitiveFileMasks' module: 'FileAttributesPlugin' error: error>
+ 	^self signalError: error for: 'primFileMasks'!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>primOpendir: (in category 'primitives') -----
+ primOpendir: pathString
+ 	"Answer an ExternalAddress for a directory stream on pathString, or nil if
+ 	the directory cannot be opened"
+ 
+ 	"self primOpendir: '/etc'"
+ 	"self primOpendir: '.'"
+ 	"self primOpendir: '/no/such/directory'"
+ 
+ 	<primitive: 'primitiveOpendir' module: 'FileAttributesPlugin' error: error>
+ 	^self signalError: error for: pathString!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>primPathMax (in category 'primitives') -----
+ primPathMax
+ 	"Answer the VMs FA_PATH_MAX value"
+ 
+ 	<primitive: 'primitivePathMax' module: 'FileAttributesPlugin' error: error>
+ 	^self signalError: error for: 'primPathMax'!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>primReaddir: (in category 'primitives') -----
+ primReaddir: directoryPointerBytes
+ 	"Read the next directory entry from the directory stream associated with
+ 	directoryPointerBytes. Answer the name of the entry, ornil for end of directory stream."
+ 
+ 	"self primReaddir: (self primOpendir: '/etc')"
+ 	"self primReaddir: (self primOpendir: '/no/such/directory')"
+ 
+ 	<primitive: 'primitiveReaddir' module: 'FileAttributesPlugin' error: error>
+ 	^self signalError: error for: 'primReaddir:'!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>s_IFDIR (in category 'simulation support') -----
+ s_IFDIR
+ 
+ 	^S_IFDIR!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>s_IFMT (in category 'simulation support') -----
+ s_IFMT
+ 
+ 	^S_IFMT!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>signalError:for: (in category 'primitives') -----
+ signalError: error for: aByteArray
+ 	"In the simulation, just return the error code"
+ 
+ 	error ifNil: [ ^self primitiveFailed ].
+ 	error isSymbol ifTrue: [ ^self primitiveFailed: error ].
+ 	error isPrimitiveError ifFalse: [ 
+ 		"We shouldn't ever get here"
+ 		^self primitiveFailed. ].
+ 
+ 	^error errorCode.
+ !

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>simulatedFaPath (in category 'simulation support') -----
+ simulatedFaPath
+ 	"Answer the simulated faPath.
+ 	See class comments for details."
+ 
+ 	^Array new: 3.!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>toOop: (in category 'simulation support') -----
+ toOop: anObject
+ 	"Convert the supplied simulation object to an object in the simulated image (oop).
+ 	Use a horrible series of class comparisons to keep it all local for now"
+ 
+ 	| resultOop resultBytes |
+ 
+ 	anObject class == Array ifTrue: [
+ 		resultOop := interpreterProxy
+ 						instantiateClass: (interpreterProxy classArray)
+ 						indexableSize: anObject size.
+ 		1 to: anObject size do: [ :i |
+ 			interpreterProxy
+ 				storePointer: i-1
+ 				ofObject: resultOop
+ 				withValue: (self toOop: (anObject at: i))].
+ 		^resultOop].
+ 	anObject class == ByteArray ifTrue: [
+ 		resultOop := interpreterProxy
+ 						instantiateClass: (interpreterProxy classByteArray)
+ 						indexableSize: anObject size.
+ 		resultBytes := interpreterProxy arrayValueOf: resultOop.
+ 		1 to: anObject size do: [ :i |
+ 			interpreterProxy byteAt: resultBytes+i-1 put: (anObject at: i)].
+ 		^resultOop].
+ 	(anObject isKindOf: Boolean) ifTrue: [
+ 		self halt.
+ 		^anObject
+ 			ifTrue: [interpreterProxy trueObject]
+ 			ifFalse: [interpreterProxy falseObject].
+ 		].
+ 	anObject isInteger ifTrue: [
+ 		(anObject between: -2147483648 and: 2147483648) ifTrue:
+ 			[^interpreterProxy signed32BitIntegerFor: anObject].
+ 		^anObject > 0
+ 			ifTrue: [interpreterProxy positive64BitIntegerFor: anObject]
+ 			ifFalse: [interpreterProxy signed64BitIntegerFor: anObject]].
+ 	anObject == nil ifTrue:
+ 		[^interpreterProxy nilObject].
+ 	self error: 'unknown object type'.!




More information about the Vm-dev mailing list