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

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


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

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

Name: FileAttributesPlugin.oscog-AlistairGrant.28
Author: AlistairGrant
Time: 21 February 2018, 9:46:27.211606 am
UUID: fb804aff-1cbd-4ffa-b48a-e3d665d10673
Ancestors: FileAttributesPlugin.oscog-AlistairGrant.27

1.2.6: Clean up Windows specific code, return nil for creationTime on Unix

- Use the option: pragma to make Windows specific methods only compile on Windows.
- Return nil instead of -1 for file creationTime on Unix

=============== Diff against FileAttributesPlugin-nice.15 ===============

Item was changed:
  InterpreterPlugin subclass: #FileAttributesPlugin
+ 	instanceVariableNames: 'hasSecurityPlugin sCOFfn sCLPfn'
- 	instanceVariableNames: 'hasSecurityPlugin smallIntegerMaxVal'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'FileAttributesPlugin'!
  
+ !FileAttributesPlugin commentStamp: 'AlistairGrant 9/3/2017 08:09' prior: 0!
- !FileAttributesPlugin commentStamp: 'AlistairGrant 5/14/2017 11:37' prior: 0!
  FileAttributesPlugin defines the named primitives used by the FileAttributes.
  
  For information on stat(), see http://man7.org/linux/man-pages/man2/stat.2.html
  For information on access(), see http://man7.org/linux/man-pages/man2/access.2.html
  
  For information on design considerations, see FileAttributes class comments.
  
  Public interface:
  
+ The set of primitives available to the image are located in the 'file primitives' protocol.
- - primitiveFileExists - answer a boolean indicating whether the supplied path name string exists
- - primitiveFileAttributes - answer an array containing stat() and/or access() information for the supplied path name string
- - primitiveFileMasks - answer an array of stat.st_mode masks
  
  
  Return codes:
  
+ Methods called within FileAttributesPlugin will return 0 on success, or one of the codes contained in the 'errors' protocol on failure.
+ 
+ Public primitives should never return 0.  See each primitive for the success return types.  Failure codes are returned as an integer, or integer wrapped in an array (see FileAttributes class comments for further discussion).
- 0 - Internal success.  This should never be returned by the public primitives
- 1 - String too long.  A file path name was longer than PATH_MAX.
- 2 - stat() call failed.
  !

Item was changed:
  ----- Method: FileAttributesPlugin class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: cg
  
+ 	self declareC:  #('sCLPfn' 'sCOFfn')
+ 		as: #'void *'
+ 		in: cg.
+ 	"Assume the security plugin can be loaded until proven otherwise"
+ 	cg var: 'hasSecurityPlugin' declareC: 'int hasSecurityPlugin = 1'.
+ 
+ 	cg addHeaderFile: '<limits.h>'.
  	cg addHeaderFile: '<sys/types.h>'.
  	cg addHeaderFile: '<dirent.h>
+ #ifdef _WIN32
- #ifdef WIN32
  #include <windows.h>
  #include <winbase.h>
  #define FAIL() { return -1; }
  #include "sqWin32File.h"
  #endif
  typedef struct dirptrstruct {
      		DIR *dp;
  		int path_len;
      		char *path_file;
     		char path[PATH_MAX+4];
      		} osdir;'.
  	cg addHeaderFile: '<sys/stat.h>
+ #if !!defined(HAVE_LSTAT) && !!defined(_WIN32)
- #if !!defined(HAVE_LSTAT) && !!defined(WIN32)
  #define HAVE_LSTAT 1
  #endif'.
  	cg addHeaderFile: '<unistd.h>
+ /* AKG 2017 - ', self moduleName, '.c translated from class ', self name, ' */'!
- /* AKG 2017 - ', self moduleName, '.c translated from class ', self name, ' */'.
- 	"Assume the security plugin can be loaded until proven otherwise"
- 	cg var: 'hasSecurityPlugin' declareC: 'int hasSecurityPlugin= 1'.
- 	"The maximum value of a SmallInteger is encoded here so that the plugin can
- 	be regenerated and rebuilt correctly even if the Smalltalk word size or object
- 	format changes. -dtl"
- 	cg var: 'smallIntegerMaxVal' declareC: 'int smallIntegerMaxVal= ', SmallInteger maxVal asString.
- 	"Window creationDate declarations"
- !

Item was added:
+ ----- Method: FileAttributesPlugin class>>isStructType: (in category 'translation') -----
+ isStructType: typeName
+ 	^#('struct stat' 'struct dirent' 'osdir') includes: typeName!

Item was changed:
  ----- Method: FileAttributesPlugin>>accessAttributesForFilename:into:startingAt: (in category 'private - file') -----
  accessAttributesForFilename: cPathName into: attributeArray startingAt: offset
  	"Call access() for each access type (R, W, X) on the c string cPathName, storing the results in the st array attributeArray."
  
  	| index boolean |
  	<var: 'cPathName' type: 'char *'>
  	index := offset.
+ 	((self acc: cPathName ess: self fileReadableFlag) = 0)
- 	((self cCode: 'access(cPathName, R_OK)') = 0)
  		ifTrue: [boolean := interpreterProxy trueObject]
  		ifFalse: [boolean := interpreterProxy falseObject].
  	interpreterProxy
  		storePointer: index
  		ofObject: attributeArray
  		withValue: boolean.
  	index := index + 1.
+ 	boolean := ((self acc: cPathName ess: self fileWriteableFlag) = 0)
+ 					ifTrue: [interpreterProxy trueObject]
+ 					ifFalse: [interpreterProxy falseObject].
- 	((self cCode: 'access(cPathName, W_OK)') = 0)
- 		ifTrue: [boolean := interpreterProxy trueObject]
- 		ifFalse: [boolean := interpreterProxy falseObject].
  	interpreterProxy
  		storePointer: index
  		ofObject: attributeArray
  		withValue: boolean.
  	index := index + 1.
+ 	boolean := ((self acc: cPathName ess: self fileExecutableFlag) = 0)
+ 					ifTrue: [interpreterProxy trueObject]
+ 					ifFalse: [interpreterProxy falseObject].
- 	((self cCode: 'access(cPathName, X_OK)') = 0)
- 		ifTrue: [boolean := interpreterProxy trueObject]
- 		ifFalse: [boolean := interpreterProxy falseObject].
  	interpreterProxy
  		storePointer: index
  		ofObject: attributeArray
  		withValue: boolean.
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>addressObjectFor: (in category 'private - directory') -----
  addressObjectFor: aMachineAddress
  	"Answer an ExternalAddress object which represents aMachineAddress"
  
  	| addressOop addressOopArrayPointer addressUnion idx |
  	<var: 'aMachineAddress' type: 'void *'>
  	<var: 'addressUnion' declareC: 'union {void *address; unsigned char bytes[sizeof(void *)];} addressUnion'>
  	<var: 'addressOopArrayPointer' declareC: 'unsigned char *addressOopArrayPointer'>
  	addressOop := interpreterProxy
  		instantiateClass: interpreterProxy classByteArray
  		indexableSize: self sizeOfPointer.
+ 	addressOop ifNil:
+ 		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	addressOopArrayPointer := interpreterProxy arrayValueOf: addressOop.
  	self cCode: 'addressUnion.address = aMachineAddress'.
  	idx := 0.
  	[idx < self sizeOfPointer] whileTrue:
  		[self cCode: 'addressOopArrayPointer[idx] = addressUnion.bytes[idx]'.
  		idx := idx + 1].
  	^ addressOop
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>byteArrayFromCString:to: (in category 'private') -----
  byteArrayFromCString: aCString to: byteArrayOop
  	"Answer a new ByteArray copied from a null-terminated C string.
  	Caution: This may invoke the garbage collector."
  
  	| len newByteArray byteArrayPtr |
  	<var: 'aCString' type: 'const char *'>
  	<var: 'byteArrayPtr' type: 'unsigned char *'>
  	<var: 'byteArrayOop' type: 'sqInt *'>
  	len := self strlen: aCString.
  	"We never return strings longer than PATH_MAX"
+ 	len > #PATH_MAX ifTrue: [^self stringTooLong].
- 	len > (self cCode: 'PATH_MAX') ifTrue: [^self stringTooLong].
  	newByteArray := interpreterProxy
  		instantiateClass: interpreterProxy classByteArray
  		indexableSize: len.
+ 	newByteArray ifNil:
+ 		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	byteArrayPtr := interpreterProxy arrayValueOf: newByteArray.
  	self mem: byteArrayPtr cp: aCString y: len.
+ 	byteArrayOop at: 0 put: newByteArray.
+ 	^0!
- 	self cCode: '*byteArrayOop = newByteArray'.
- 	^0.!

Item was changed:
  ----- Method: FileAttributesPlugin>>canOpenDirectoryStreamFor:length: (in category 'private - directory') -----
  canOpenDirectoryStreamFor: aPathCString length: length
  	"Answer non-zero if security permits the directory to be listed."
  
  	"FIXME: This function has not been tested. -dtl"
  
- 	| sCLPfn |
  	<var: 'aPathCString' type: 'char *'>
- 	<var: 'sCLPfn' type: 'void *'>
  	"If the security plugin can be loaded, use it to check . 
  	If not, assume it's ok"
  	"The hasSecurityPlugin flag is set to 1 by default"
  	(hasSecurityPlugin = 0) ifTrue: [^ true].
- 	sCLPfn := interpreterProxy ioLoadFunction: 'secCanListPathOfSize' From: 'SecurityPlugin'.
  	sCLPfn ~= 0
  		ifTrue:
  			[^ self cCode: ' ((int (*) (char *, int)) sCLPfn)(aPathCString, length)'
  				inSmalltalk: [true]]
  		ifFalse:
  			[hasSecurityPlugin := 0.	"Reset the flag so we do not try again next time"
  			^ true]
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>canStatFilePath:length: (in category 'private - file') -----
  canStatFilePath: aPathCString length: length
  	"Answer non-zero if security permits the a stat() call on the file path. Allow a
  	stat() call only on files which we are permitted to open."
  
  	"FIXME: This function has not been tested. -dtl"
  
- 	| sCOFfn |
  	<var: 'aPathCString' type: 'char *'>
- 	<var: 'sCOFfn' type: 'void *'>
  	"If the security plugin can be loaded, use it to check . 
  	If not, assume it's ok"
  	"The hasSecurityPlugin flag is set to 1 by default"
  	(hasSecurityPlugin = 0) ifTrue: [^ true].
- 	sCOFfn := interpreterProxy ioLoadFunction: 'secCanOpenFileOfSizeWritable' From: 'SecurityPlugin'.
  	sCOFfn ~= 0
  		ifTrue:
  			[^ self cCode: ' ((int (*) (char *, int, int)) sCOFfn)(aPathCString, length, 0)'
  				inSmalltalk: [true]]
  		ifFalse: 
  			[hasSecurityPlugin := 0.	"Reset the flag so we do not try again next time"
  			^ true]
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>cantAllocateMemory (in category 'errors') -----
  cantAllocateMemory
+ 	<inline: #always>
- 
  	^-10!

Item was changed:
  ----- Method: FileAttributesPlugin>>cantOpenDir (in category 'errors') -----
  cantOpenDir
+ 	<inline: #always>
- 
  	^-9!

Item was changed:
  ----- Method: FileAttributesPlugin>>cantReadlink (in category 'errors') -----
  cantReadlink
+ 	<inline: #always>
- 
  	^-8!

Item was changed:
  ----- Method: FileAttributesPlugin>>cantStatPath (in category 'errors') -----
  cantStatPath
  	"SecurityPlugin determined that the requested path cannot be accessed."
+ 	<inline: #always>
  	^-3!

Item was changed:
  ----- Method: FileAttributesPlugin>>checkAccess:mode:to: (in category 'private - file') -----
  checkAccess: pathString mode: mode to: flag
  	"Check access to pathString."
  
  	| cString len sPtr |
  	<export: true>
  	<var: 'cString' declareC: 'char cString[PATH_MAX]'>
  	<var: 'sPtr' declareC: 'char *sPtr'>
  	<var: 'flag' type: 'sqInt *'>
  	len := interpreterProxy stSizeOf: pathString.
  	"Note: The static sized string buffer is faster than using a Smalltalk allocated
  	string as the buffer, and is unlikely to fail in practice. In the event that
  	the buffer turns out to be too small, write an error message to stdout before
  	failing."
+ 	len >= #PATH_MAX ifTrue: [^self stringTooLong].
- 	(len >= (self cCode: 'PATH_MAX')) ifTrue: [^self stringTooLong].
  	"Copy pathString to the new string"
  	sPtr := interpreterProxy arrayValueOf: pathString.
  	((self canStatFilePath: sPtr length: len) = 0) ifTrue: [^self cantStatPath].
  	self mem: cString cp: sPtr y: len.
  	cString at: len put: 0.
+ 	flag at: 0 put: (self acc: cString ess: mode).
- 	self cCode: '*flag = access(cString, mode)'.
  	^0
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>corruptValue (in category 'errors') -----
  corruptValue
+ 	<inline: #always>
- 
  	^-7!

Item was changed:
  ----- Method: FileAttributesPlugin>>fileCreationTimeFor:length:to: (in category 'private - windows') -----
  fileCreationTimeFor: pathString length: pathLength to: creationDate
  	"Get the creationDate for the supplied file.
  	Linux kernel 4.11 should have statx(), so hopefully there will be a cross-platform
  	solution soon.  Just dump the c-code and hope to remove it soon."
+ 	<option: #_WIN32>
+ 	| tm winAttrs win32Path sysTime |
- 
- 	| tm |
  	<var: 'pathString' type: 'char *'>
  	<var: 'creationDate' type: 'time_t *'>
  	<var: 'tm' type: 'struct tm'>
+ 	<var: 'winAttrs' type: 'WIN32_FILE_ATTRIBUTE_DATA'>
+ 	<var: 'win32Path' type: 'WCHAR *'>
+ 	<var: 'sysTime' type: 'SYSTEMTIME'>
+ 	self touch: winAttrs.
+ 	self touch: sysTime.
+ 	self me: (self addressOf: tm) ms: 0 et: tm sizeof.
+ 	"convert the supplied path name into a wide string"
+ 	self ALLOC_: win32Path WIN32_: pathString PATH: pathLength.
+ 	(self cCode: 'GetFileAttributesExW(win32Path, 0, &winAttrs)') = 0 ifTrue:
+  		[^self getAttributesFailed].
+ 	(self cCode: 'FileTimeToSystemTime(&winAttrs.ftCreationTime, &sysTime)') = 0 ifTrue:
+  		[^self timeConversionFailed].
  
  	self cCode: '
+ 	tm.tm_year = sysTime.wYear - 1900;
+ 	tm.tm_mon = sysTime.wMonth - 1;
+ 	tm.tm_mday = sysTime.wDay;
- #ifdef WIN32
-   WIN32_FILE_ATTRIBUTE_DATA winAttrs;
-   WCHAR *win32Path;
-   SYSTEMTIME sysTime;
- #endif
  
+ 	tm.tm_hour = sysTime.wHour;
+ 	tm.tm_min = sysTime.wMinute;
+ 	tm.tm_sec = sysTime.wSecond;
+ 	tm.tm_isdst = 0;
+ 	*creationDate = mktime(&tm)'.
-   memset(&tm, 0, sizeof(tm));
  
+ 	^0!
- #ifdef WIN32
-   /* convert the supplied path name into a wide string */
-   ALLOC_WIN32_PATH(win32Path, pathString, pathLength)'.
- 
-   [(self cCode: 'GetFileAttributesExW(win32Path, 0, &winAttrs)') = 0] ifTrue:
-       [^self getAttributesFailed].
- 
-   [(self cCode: 'FileTimeToSystemTime(&winAttrs.ftCreationTime, &sysTime)') = 0] ifTrue:
-       [^self timeConversionFailed].
- 
-   self cCode: '
-   tm.tm_year = sysTime.wYear - 1900;
-   tm.tm_mon = sysTime.wMonth - 1;
-   tm.tm_mday = sysTime.wDay;
- 
-   tm.tm_hour = sysTime.wHour;
-   tm.tm_min = sysTime.wMinute;
-   tm.tm_sec = sysTime.wSecond;
-   tm.tm_isdst = 0;
- #endif
- 
-   *creationDate = mktime(&tm)'.
- 
- 	^0.
- !

Item was changed:
  ----- Method: FileAttributesPlugin>>fileExecutableFlag (in category 'private - file') -----
  fileExecutableFlag
+ 	<inline: #always>
+ 	^ self cCode: [#X_OK] inSmalltalk: [1]!
- 
- 	^ self cCode: 'X_OK' inSmalltalk: [1]!

Item was changed:
  ----- Method: FileAttributesPlugin>>fileOKFlag (in category 'private - file') -----
  fileOKFlag
+ 	<inline: #always>
+ 	^ self cCode: [#F_OK] inSmalltalk: [0]!
- 
- 	^ self cCode: 'F_OK' inSmalltalk: [0]!

Item was changed:
  ----- Method: FileAttributesPlugin>>fileReadableFlag (in category 'private - file') -----
  fileReadableFlag
+ 	<inline: #always>
+ 	^ self cCode: [#R_OK] inSmalltalk: [4]!
- 
- 	^ self cCode: 'R_OK' inSmalltalk: [4]!

Item was changed:
  ----- Method: FileAttributesPlugin>>fileToAttributeArray:mask:array: (in category 'private - file') -----
  fileToAttributeArray: cPathName mask: attributeMask array: attributeArray
  	"Answer a file attribute array from pathNameOop."
  
+ 	| getStats useLstat getAccess statArray accessArray combinedArray status fileNameOop statBuf  |
- 	| getStats useLstat getAccess statArray accessArray combinedArray status fileNameOop statBuf statBufPointer  |
  	<returnTypeC: 'int'>
  	<var: 'cPathName' type: 'char *'>
  	<var: 'attributeArray' type: 'sqInt *'>
  	<var: 'statBuf' type: 'struct stat'>
- 	<var: 'statBufPointer' type: 'struct stat *'>
  
- 	statBufPointer := self addressOf: statBuf.
  	"Determine which attributes to retrieve"
+ 	getStats := attributeMask anyMask: 1.
+ 	getAccess := attributeMask anyMask: 2.
+ 	(getStats or: [getAccess]) ifFalse:
- 	getStats := (attributeMask bitAnd: 1) = 1.
- 	getAccess := (attributeMask bitAnd: 2) = 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].
+ 		status := useLstat ifFalse:
+ 					[ self putStatFor: cPathName
+ 							intoBuffer: (self addressOf: statBuf)
- 		useLstat := (attributeMask bitAnd: 4) = 4.
- 		statArray := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 12.
- 		useLstat ifFalse:
- 			[ status := self putStatFor: cPathName
- 							intoBuffer: statBufPointer
  							targetName:  (self addressOf: fileNameOop) ]
+ 				ifTrue:
+ 					[ self putLStatFor: cPathName
+ 							intoBuffer: (self addressOf: statBuf)
- 		ifTrue:
- 			[ status := self putLStatFor: cPathName
- 							intoBuffer: statBufPointer
  							targetName:  (self addressOf: fileNameOop) ].
  		status ~= 0 ifTrue: [^status].
+ 		status := self statArrayFor: cPathName toArray: statArray from: (self addressOf: statBuf) fileName: fileNameOop.
- 		status := self statArrayFor: cPathName toArray: statArray from: statBufPointer fileName: fileNameOop.
  		status ~= 0 ifTrue: [^status].
  		"Set attributeArray in case only stat() attributes have been requested"
+ 		attributeArray at: 0 put: statArray
- 		self cCode: '*attributeArray = statArray'.
  		].
  	getAccess ifTrue: 
  		[
+ 		accessArray := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 3.
+ 		accessArray ifNil:
+ 			[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
- 		accessArray := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 3.
  		self accessAttributesForFilename: cPathName into: accessArray startingAt: 0.
  		"Set attributeArray in case only access() attributes have been requested"
+ 		attributeArray at: 0 put: accessArray
- 		self cCode: '*attributeArray = accessArray'.
  		].
  	[getStats and: [getAccess]] ifTrue: 
  		[
+ 		combinedArray := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
+ 		combinedArray ifNil:
+ 			[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
+ 		attributeArray at: 0 put: combinedArray.
- 		combinedArray := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2.
- 		self cCode: '*attributeArray = combinedArray'.
  		interpreterProxy
+ 			storePointer: 0 ofObject: combinedArray withValue: statArray;
+ 			storePointer: 1 ofObject: combinedArray withValue: accessArray
- 			storePointer: 0
- 			ofObject: combinedArray
- 			withValue: statArray.
- 		interpreterProxy
- 			storePointer: 1
- 			ofObject: combinedArray
- 			withValue: accessArray.
  		].
  
  	^0!

Item was changed:
  ----- Method: FileAttributesPlugin>>fileWriteableFlag (in category 'private - file') -----
  fileWriteableFlag
+ 	<inline: #always>
+ 	^ self cCode: [#W_OK] inSmalltalk: [2]!
- 
- 	^ self cCode: 'W_OK' inSmalltalk: [2]!

Item was changed:
  ----- Method: FileAttributesPlugin>>getAttributesFailed (in category 'errors') -----
  getAttributesFailed
+ 	<inline: #always>
- 
  	^-4!

Item was added:
+ ----- Method: FileAttributesPlugin>>initialiseModule (in category 'initialize-release') -----
+ initialiseModule
+ 	<export: true>
+ 
+ 	sCOFfn := interpreterProxy ioLoadFunction: 'secCanOpenFileOfSizeWritable' From: 'SecurityPlugin'.
+ 	sCLPfn := interpreterProxy ioLoadFunction: 'secCanListPathOfSize' From: 'SecurityPlugin'.
+ 	^true!

Item was changed:
  ----- Method: FileAttributesPlugin>>invalidArguments (in category 'errors') -----
  invalidArguments
+ 	<inline: #always>
- 
  	^-6!

Item was changed:
  ----- Method: FileAttributesPlugin>>invalidRequest (in category 'errors') -----
  invalidRequest
+ 	<inline: #always>
- 
  	^-11!

Item was changed:
  ----- Method: FileAttributesPlugin>>isSymlink:boolean: (in category 'private - file') -----
  isSymlink: cPathName boolean: resultOop
  	"Set resultOop to a boolean indicating whether cPathName is a symbolic link.
  	Answer status (0 = success)"
  
  	| status statBuf |
  	<var: 'cPathName' type: 'char *'>
  	<var: 'resultOop' type: 'sqInt *'>
  	<var: 'statBuf' type: 'struct stat'>
+ 	self touch: statBuf.
+ 	self cppIf: #HAVE_LSTAT == 1 ifTrue:
+ 		[status := self lst: cPathName at: (self addressOf: statBuf).
+ 		status ~= 0 ifTrue: [^self cantStatPath].
+ 		(self S_ISLNK: statBuf st_mode) = 0
+ 			ifFalse: [resultOop at: 0 put: interpreterProxy trueObject]
+ 			ifTrue: [resultOop at: 0 put: interpreterProxy falseObject]].
+ 	^0!
- 
- 	self cPreprocessorDirective: '#if (HAVE_LSTAT == 1)'.
- 	status := self cCode: 'lstat(cPathName, &statBuf)'.
- 	(status ~= 0) ifTrue: [^self cantStatPath].
- 	((self cCode: 'S_ISLNK(statBuf.st_mode)') = 0)
- 		ifFalse: [self cCode: '*resultOop = interpreterProxy->trueObject()']
- 		ifTrue: [self cCode: '*resultOop = interpreterProxy->falseObject()'].
- 	self cPreprocessorDirective: '#endif'. "HAVE_LSTAT == 1"
- 	^0
- !

Item was added:
+ ----- Method: FileAttributesPlugin>>offsetStatBufTimesForWIN32: (in category 'private - windows') -----
+ offsetStatBufTimesForWIN32: statBufPointer
+ 	"Adjust the statBuffer to UTC, see https://msdn.microsoft.com/en-us/library/windows/desktop/ms725481(v=vs.85).aspx"
+ 	<option: #_WIN32>
+ 	<var: 'statBufPointer' type: 'struct stat *'>
+ 	| status  dtzi offset |
+ 	<var: 'offset' type: 'long'>
+ 	<var: 'dtzi' type: 'TIME_ZONE_INFORMATION'>
+ 	status := self GetTimeZoneInformation: (self addressOf: dtzi).
+ 	offset := (self cCode: 'dtzi.Bias' inSmalltalk: [0]) * 60.
+ 	"Adjust for DST if required"
+ 	status = 2 ifTrue: [offset := offset - 3600].
+ 	self cCode: 'statBufPointer->st_atime += offset'.
+ 	self cCode: 'statBufPointer->st_mtime += offset'.
+ 	self cCode: 'statBufPointer->st_ctime += offset'.!

Item was changed:
  ----- Method: FileAttributesPlugin>>oopFromTimeT: (in category 'private') -----
  oopFromTimeT: posixSeconds
  	"Answer an object representation of the provided time (time_t).
  	The size of time_t is platform dependent, so check the size and convert appropriately."
  
  	<var: 'posixSeconds' type: 'time_t'>
  
+ 	^(self sizeof: #time_t) = 4 ifTrue:
+ 		[interpreterProxy signed32BitIntegerFor: posixSeconds]
+ 	ifFalse:
+ 		[interpreterProxy signed64BitIntegerFor: posixSeconds].
- 	[(self cCode: 'sizeof(time_t)') = 4] ifTrue:
- 		[^interpreterProxy signed32BitIntegerFor: posixSeconds].
- 	"Must be 64 bit number"
- 	^interpreterProxy signed64BitIntegerFor: posixSeconds.
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>openDirectoryStream:ptr: (in category 'private - directory') -----
  openDirectoryStream: pathOOP ptr: osdirPtr
  	"Open a new directory stream. Answer a pointer to the directory stream or NULL."
  
  	| sPtr len dir |
  	<var: 'osdirPtr' type: 'osdir **'>
  	<var: 'sPtr' declareC: 'char *sPtr'>
  	<var: 'dir' type: 'osdir *'>
  	<returnTypeC: 'int'>
  	sPtr := interpreterProxy arrayValueOf: pathOOP.
  	len := interpreterProxy sizeOfSTArrayFromCPrimitive: sPtr.
  	"The path buffer needs room for a trailing slash and the file name, so subtracting 2 is conservative"
+ 	len > (#PATH_MAX - 2) ifTrue: [^self stringTooLong].
- 	len > (self cCode: 'PATH_MAX-2') ifTrue: [^self stringTooLong].
  	(self canOpenDirectoryStreamFor: sPtr length: len)
  		ifTrue:
  			[
  			dir := self cCode: '(osdir *) malloc(sizeof(osdir))'.
  			dir = nil ifTrue: [^self cantAllocateMemory].
+ 			self mem: dir path cp: sPtr y: len.
- 			self cCode: 'memcpy(dir->path, sPtr, len)'.
  			"Ensure path has a trailing slash"
  			self cCode: 'if (dir->path[len-1] !!= ''/'') {
  				dir->path[len++] = ''/'';
  				}'.
  			self cCode: 'dir->path_file = dir->path + len'.
  			self cCode: 'dir->path_file[0] = ''\0'''.
  			self cCode: 'dir->path_len = len'.
  			self cCode: 'dir->dp =  opendir(dir->path)'.
+ 			dir dp ifNil:
+ 				[self free: dir.
- 			(self cCode: 'dir->dp') = nil ifTrue:
- 				[dir free.
  				^self cantOpenDir].
+ 			osdirPtr at: 0 put: dir.
- 			self cCode: '*osdirPtr = dir'.
  			^0
  			].
  	"If we get here, we can't open the directory"
  	^self cantOpenDir
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>pointerFrom: (in category 'private - directory') -----
  pointerFrom: directoryPointerBytes
  	"Answer the machine address contained in anExternalAddressOop."
  
  	| ptr addressUnion idx |
  	<returnTypeC: 'void *'>
  	<var: 'ptr' type: 'unsigned char *'>
  	<var: 'addressUnion' type: 'union {void *address; unsigned char bytes[sizeof(void *)];}'>
+ 	((interpreterProxy is: directoryPointerBytes KindOf: 'ByteArray') and:
- 	((interpreterProxy isBytes: directoryPointerBytes) and:
  		[(interpreterProxy stSizeOf: directoryPointerBytes) = self sizeOfPointer])
  		ifFalse: [^ nil].
  	ptr := interpreterProxy arrayValueOf: directoryPointerBytes.
  	idx := 0.
  	[idx < self sizeOfPointer] whileTrue:
  		[self cCode: 'addressUnion.bytes[idx] = ptr[idx]'.
  		idx := idx + 1].
  	^ self cCode: 'addressUnion.address' inSmalltalk: [addressUnion]
  !

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."
- 	"Close the directory stream for dirPointerOop. Answer dirPointerOop on success."
  
  	| dirPointerOop dirStream result |
  	<export: true>
  	<var: 'dirStream' type: 'osdir *'>
+ 	dirPointerOop := interpreterProxy stackValue: 0.
- 	dirPointerOop := interpreterProxy stackObjectValue: 0.
- 	(dirPointerOop = interpreterProxy nilObject) ifTrue: 
- 		[^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
- 	(interpreterProxy is: dirPointerOop KindOf: 'ByteArray') ifFalse:
- 		[self cCode: 'fprintf(stderr, "primitiveClosedir: invalid argument, expected a ByteArray\n")'.
- 		^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
  	dirStream := self pointerFrom: dirPointerOop.
+ 	dirStream ifNil:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ 	result := self closedir: dirStream dp.
+ 	result = 0 ifFalse:
+ 		[^interpreterProxy primitiveFailForOSError: self unableToCloseDir].
+ 	self free: dirStream.
+ 	interpreterProxy pop: 2 thenPush: dirPointerOop!
- 	(dirStream = nil) ifTrue: [^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self corruptValue)].
- 	result := self cCode: 'closedir(dirStream->dp)'.
- 	(result = 0)	ifFalse:
- 		[self perror: 'closedir'.
- 		^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self corruptValue)].
- 	self cCode: 'free(dirStream)'.
- 	interpreterProxy pop: 2; push: 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 fileNameOop statBuf cPathName sizeIfFile mode creationDate status |
  	<export: true>
  	<var: 'statBuf' type: 'struct stat'>
  	<var: 'cPathName' declareC: 'char cPathName[PATH_MAX]'>
  	<var: 'creationDate' type: 'time_t'>
  
  	fileName := interpreterProxy stackObjectValue: 1.
  	attributeNumber := interpreterProxy stackIntegerValue: 0.
+ 	(interpreterProxy failed
+ 	or: [(attributeNumber between: 1 and: 16) not
+ 	or: [(interpreterProxy is: fileName KindOf: 'String') not]]) ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ 	status := self pathOop: fileName toBuffer: cPathName maxLen: #PATH_MAX.
+ 	status ~= 0 ifTrue:
+ 		[^interpreterProxy primitiveFailForOSError: status].
- 	(attributeNumber < 1 or: [attributeNumber > 16]) ifTrue:
- 		[^interpreterProxy pop: 3; push: (self wrappedErrorCode: self invalidArguments)].
- 	(interpreterProxy is: fileName KindOf: 'String') ifFalse:
- 		[^interpreterProxy pop: 3; push: (self wrappedErrorCode: self invalidArguments)].
- 	status := self pathOop: fileName toBuffer: cPathName maxLen: (self cCode: 'PATH_MAX').
- 	[status ~= 0] ifTrue:
- 		[^interpreterProxy pop: 3; push: (self wrappedErrorCode: status)].
  	resultOop := 0.
  
  	attributeNumber < 12 ifTrue:
  		"Get requested stat entry"
  		[
  		status := self
  			putStatFor: cPathName
  			intoBuffer: (self addressOf: statBuf)
  			targetName: (self addressOf: fileNameOop).
+ 		status ~= 0 ifTrue: 
+ 			[^interpreterProxy primitiveFailForOSError: status].
- 		(status ~= 0) ifTrue: 
- 			[^interpreterProxy pop: 3; push: (self wrappedErrorCode: status)].
  		"In C, this would naturally be a switch statement,
  		but I don't know to mix in the smalltalk code"
  		attributeNumber = 1 ifTrue: [resultOop := fileNameOop].
  		attributeNumber = 2 ifTrue:
+ 			[resultOop := interpreterProxy positiveMachineIntegerFor: statBuf st_mode].
- 			[resultOop := (self smallOrLargeIntegerObjectFor:
- 				(self cCode: 'statBuf.st_mode'))].
  		attributeNumber = 3 ifTrue:
+ 			[resultOop := interpreterProxy positive64BitIntegerFor: statBuf st_ino].
- 			[resultOop := (interpreterProxy positive64BitIntegerFor:
- 				(self cCode: 'statBuf.st_ino'))].
  		attributeNumber = 4 ifTrue:
+ 			[resultOop := interpreterProxy positive64BitIntegerFor: statBuf st_dev].
- 			[resultOop := (interpreterProxy positive64BitIntegerFor:
- 				(self cCode: 'statBuf.st_dev'))].
  		attributeNumber = 5 ifTrue:
+ 			[resultOop := interpreterProxy positive64BitIntegerFor: statBuf st_nlink].
- 			[resultOop := (interpreterProxy positive64BitIntegerFor:
- 				(self cCode: 'statBuf.st_nlink'))].
  		attributeNumber = 6 ifTrue:
+ 			[resultOop := interpreterProxy positiveMachineIntegerFor: statBuf st_uid].
- 			[resultOop := (self smallOrLargeIntegerObjectFor:
- 				(self cCode: 'statBuf.st_uid'))].
  		attributeNumber = 7 ifTrue:
+ 			[resultOop := interpreterProxy positiveMachineIntegerFor: statBuf st_gid].
- 			[resultOop := (self smallOrLargeIntegerObjectFor:
- 				(self cCode: 'statBuf.st_gid'))].
  		attributeNumber = 8 ifTrue:
  			[
+ 			sizeIfFile := ((self S_ISDIR: statBuf st_mode) = 0)
+ 							ifTrue: [statBuf st_size]
+ 							ifFalse: [0].
+ 			resultOop := interpreterProxy positiveMachineIntegerFor: sizeIfFile
- 			((self cCode: 'S_ISDIR(statBuf.st_mode)') = 0)
- 				ifTrue:
- 					[sizeIfFile := self cCode: 'statBuf.st_size']
- 				ifFalse:
- 					[sizeIfFile := 0].
- 			resultOop := self smallOrLargeIntegerObjectFor: sizeIfFile
  			].
  		attributeNumber = 9 ifTrue:
+ 			[resultOop := self oopFromTimeT: statBuf st_atime].
- 			[resultOop := self oopFromTimeT: (self cCode: 'statBuf.st_atime')].
  		attributeNumber = 10 ifTrue:
+ 			[resultOop := self oopFromTimeT: statBuf st_mtime].
- 			[resultOop := self oopFromTimeT: (self cCode: 'statBuf.st_mtime')].
  		attributeNumber = 11 ifTrue:
+ 			[resultOop := self oopFromTimeT: statBuf st_ctime].
- 			[resultOop := self oopFromTimeT: (self cCode: 'statBuf.st_ctime')].
  		]
  	ifFalse: [attributeNumber = 12  ifTrue:
  		[
+ 		self cppIf: #_WIN32 defined ifTrue: [
+ 			status := self fileCreationTimeFor: cPathName
+ 				length: cPathName strlen
+ 				to: (self addressOf: creationDate put: [:val| creationDate := val]).
+ 			status ~= 0 ifTrue:
+ 				[^interpreterProxy primitiveFailForOSError: status].
+ 			resultOop := self oopFromTimeT: creationDate ] 
+ 		ifFalse: [
+ 			resultOop := interpreterProxy nilObject ]
- 		status := self fileCreationTimeFor: cPathName
- 			length: cPathName strlen
- 			to: (self addressOf: creationDate).
- 		status ~= 0 ifTrue:
- 			[^interpreterProxy pop: 3; push: (self wrappedErrorCode: status)].
- 		resultOop := self oopFromTimeT: creationDate.
  		]
  	ifFalse: [attributeNumber < 16 ifTrue:
  		"Get requested access entry"
  		[
  		attributeNumber = 13 ifTrue: [mode := self fileReadableFlag].
  		attributeNumber = 14 ifTrue: [mode := self fileWriteableFlag].
  		attributeNumber = 15 ifTrue: [mode := self fileExecutableFlag].
+ 		resultOop := ((self acc: cPathName ess: mode) = 0)
+ 						ifTrue: [interpreterProxy trueObject]
+ 						ifFalse: [interpreterProxy falseObject].
- 		((self cCode: 'access(cPathName, mode)') = 0)
- 			ifTrue: [resultOop := interpreterProxy trueObject]
- 			ifFalse: [resultOop := interpreterProxy falseObject].
  		]
  	ifFalse: "attributeNumber = 16"
  		[
+ 		status := self isSymlink: cPathName boolean: (self addressOf: resultOop put: [:val| resultOop := val]).
+ 		status ~= 0 ifTrue: 
+ 			[^interpreterProxy primitiveFailForOSError: status].
- 		status := self isSymlink: cPathName boolean: (self addressOf: resultOop).
- 		(status ~= 0) ifTrue: 
- 			[^interpreterProxy pop: 3; push: (self wrappedErrorCode: status)].
  		]]].
  
+ 	resultOop = 0
- 	(resultOop = 0)
  		ifTrue: ["It shouldn't be possible to get here"
+ 			interpreterProxy primitiveFail]
+ 		ifFalse: [interpreterProxy pop: 3 thenPush: resultOop]!
- 			^ interpreterProxy primitiveFail]
- 		ifFalse: [interpreterProxy pop: 3; push: 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 cPathName status |
  	<export: true>
  	<var: 'cPathName' declareC: 'char cPathName[PATH_MAX]'>
  	fileName := interpreterProxy stackObjectValue: 1.
  	attributeMask := interpreterProxy stackIntegerValue: 0.
+ 	(interpreterProxy failed
+ 	or: [(interpreterProxy is: fileName KindOf: 'String') not]) ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ 	status := self pathOop: fileName toBuffer: cPathName maxLen: #PATH_MAX.
- 	(interpreterProxy is: fileName KindOf: 'String') ifFalse:
- 		[^interpreterProxy pop: 3; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
- 	status := self pathOop: fileName toBuffer: cPathName maxLen: (self cCode: 'PATH_MAX').
  	status ~= 0 ifTrue:
+ 		[^interpreterProxy primitiveFailForOSError: status].
- 		[^interpreterProxy pop: 3; push: (interpreterProxy signed32BitIntegerFor: status)].
  
+ 	status := self fileToAttributeArray: cPathName 
+ 					mask: attributeMask 
+ 					array: (self addressOf: attributeArray put: [:val| attributeArray := val]).
- 	status := self fileToAttributeArray: cPathName mask: attributeMask array: (self addressOf: attributeArray).
  	status ~= 0
+ 		ifTrue: [interpreterProxy primitiveFailForOSError: status]
+ 		ifFalse: [interpreterProxy pop: 3 thenPush: attributeArray]!
- 		ifTrue: [interpreterProxy pop: 3; push: (interpreterProxy signed32BitIntegerFor: status)]
- 		ifFalse: [interpreterProxy pop: 3; push: attributeArray]
- !

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveFileExists (in category 'file primitives') -----
  primitiveFileExists
  	"Check for existence of a file with a call to access()."
  
  	| pathString status accessFlag |
  	<export: true>
  	<var: 'accessFlag' type: 'sqInt'>
  	pathString := interpreterProxy stackObjectValue: 0.
  	(interpreterProxy is: pathString KindOf: 'String') ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- 		[^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
  	status := self checkAccess: pathString mode: self fileOKFlag to: (self addressOf: accessFlag).
+ 	status = 0 ifFalse: [^interpreterProxy primitiveFailForOSError: status].
+ 	interpreterProxy pop: 2 thenPush: (accessFlag = 0
+ 									ifTrue: [interpreterProxy trueObject]
+ 									ifFalse: [interpreterProxy falseObject])!
- 	[status = 0] ifFalse: [^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: status)].
- 	accessFlag = 0
- 		ifTrue: [interpreterProxy pop: 2; push: interpreterProxy trueObject]
- 		ifFalse: [interpreterProxy pop: 2; push: interpreterProxy falseObject]
- !

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 positiveMachineIntegerFor: #'S_IFMT').
+ 	self cppIf: #_WIN32 defined not
+ 		ifTrue:
+ 			[interpreterProxy
+ 				storePointer: 1
+ 				ofObject: masks
+ 				withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFSOCK').
+ 			interpreterProxy
+ 				storePointer: 2
+ 				ofObject: masks
+ 				withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFLNK')].
- 		withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFMT')).
- 	self cPreprocessorDirective: '#if !!defined(WIN32)'.
  	interpreterProxy
- 		storePointer: 1
- 		ofObject: masks
- 		withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFSOCK')).
- 	interpreterProxy
- 		storePointer: 2
- 		ofObject: masks
- 		withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFLNK')).
- 	self cPreprocessorDirective: '#endif'.
- 	interpreterProxy
  		storePointer: 3
  		ofObject: masks
+ 		withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFREG').
- 		withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFREG')).
  	interpreterProxy
  		storePointer: 4
  		ofObject: masks
+ 		withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFBLK').
- 		withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFBLK')).
  	interpreterProxy
  		storePointer: 5
  		ofObject: masks
+ 		withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFDIR').
- 		withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFDIR')).
  	interpreterProxy
  		storePointer: 6
  		ofObject: masks
+ 		withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFCHR').
- 		withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFCHR')).
  	interpreterProxy
  		storePointer: 7
  		ofObject: masks
+ 		withValue: (interpreterProxy positiveMachineIntegerFor: #'S_IFIFO').
- 		withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFIFO')).
  	interpreterProxy pop: 1 thenPush: masks!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveLogicalDrives (in category 'file primitives') -----
  primitiveLogicalDrives
  	"Answer the logical drive mask on windows"
  
- 	| mask |
  	<export: true>
  	<var: 'mask' type: #'unsigned int'>
+ 	self cppIf: #_WIN32 defined
+ 		ifTrue:
+ 			[| mask |
+ 			 mask := self GetLogicalDrives.
+ 			 mask ~= 0 ifTrue:
+ 				[^interpreterProxy pop: 1 thenPush: (interpreterProxy positive32BitIntegerFor: mask)]].
+ 	interpreterProxy primitiveFail!
- 	self cPreprocessorDirective: '#if defined(WIN32)'.
- 	mask := self cCode: 'GetLogicalDrives()'.
- 	[mask ~= 0] ifTrue:
- 		[^interpreterProxy pop: 1 thenPush: (interpreterProxy positive32BitIntegerFor: mask)].
- 	self cPreprocessorDirective: '#endif'.
- 	^interpreterProxy primitiveFail.!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveOpendir (in category 'file primitives') -----
  primitiveOpendir
  
  	"self primOpendir: '/etc'"
  
+ 	| dirName dir dirOop status |
- 	| dirName dir dirOop status dirOopArrayPointer |
  	<export: true>
  	<var: 'dir' type: 'osdir *'>
- 	<var: 'dirOopArrayPointer' type: 'unsigned char *'>
  	dirName := interpreterProxy stackObjectValue: 0.
  	(interpreterProxy is: dirName KindOf: 'String') ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- 		[self cCode: 'fprintf(stderr, "primitiveOpendir: invalid argument, expected a String\n")'.
- 		^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
  	status := self openDirectoryStream: dirName ptr: (self addressOf: dir).
+ 	status ~= 0 ifTrue: [^interpreterProxy primitiveFailForOSError: status].
- 	status ~= 0 ifTrue: [^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: status)].
  	dirOop := self addressObjectFor: dir.
+ 	interpreterProxy pop: 2 thenPush: dirOop!
- 	interpreterProxy pop: 2; push: dirOop
- !

Item was changed:
  ----- Method: FileAttributesPlugin>>primitivePathMax (in category 'file primitives') -----
  primitivePathMax
  	"Answer the value of PATH_MAX for the current VM"
  
  	<export: true>
+ 	^interpreterProxy pop: 1 thenPush: (interpreterProxy integerObjectOf: #PATH_MAX)!
- 	^interpreterProxy pop: 1 thenPush: (self smallOrLargeIntegerObjectFor: (self cCode: 'PATH_MAX')).!

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."
- 	error for end of directory stream."
  
  	| dirPointerOop dirStream ent entryName attributeArray resultArray haveEntry entry_len status |
  	<export: true>
  	<var: 'ent' type: 'struct dirent *'>
  	<var: 'dirStream' type: 'osdir *'>
  	<var: 'haveEntry' type: #int>
  
+ 	dirPointerOop := interpreterProxy stackValue: 0.
- 	dirPointerOop := interpreterProxy stackObjectValue: 0.
- 	(interpreterProxy is: dirPointerOop KindOf: 'ByteArray') ifFalse:
- 		[self cCode: 'fprintf(stderr, "primitiveReaddir: invalid argument, expected an ByteArray\n")'.
- 		^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
  	dirStream := self pointerFrom: dirPointerOop.
+ 	dirStream ifNil:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- 	(dirStream = nil) ifTrue: [^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
  	haveEntry := 0.
+ 	[ent := self readdir: dirStream dp.
+ 	 self cCode: 'if (ent == NULL ||
- 	self cCode: 'do {'.
- 	ent := self cCode: 'readdir(dirStream->dp)'.
- 	self cCode: 'if (ent == NULL ||
                   		((!! (ent->d_name[0] == ''.'' && strlen(ent->d_name) == 1)) && strcmp(ent->d_name, "..")))
+                      		haveEntry = 1'.
+ 	 haveEntry = 0] whileTrue.
+ 	ent ifNil: "This is the normal case for the end of a directory stream,
+ 			although it may indicate other error conditions for which errno would be updated.
+ 			Assume the normal case here."
+ 		[^interpreterProxy pop: 2 thenPush: interpreterProxy nilObject].
+ 	status := self byteArrayFromCString: ent d_name to: (self addressOf: entryName put: [:val| entryName := val]).
+ 	status ~= 0 ifTrue:
+ 		[^interpreterProxy primitiveFailForOSError: status].
-                      		haveEntry = 1;
- 		} while (haveEntry == 0)'.
- 	(ent = nil) ifTrue: ["This is the normal case for the end of a directory stream,
- 		although it may indicate other error conditions for which errno would be updated.
- 		Assume the normal case here."
- 		^interpreterProxy pop: 2; push: interpreterProxy nilObject].
- 	status := self byteArrayFromCString: (self cCode: 'ent->d_name') to: (self addressOf: entryName).
- 	[status ~= 0] ifTrue:
- 		[^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: status)].
  
  	"Build the path name (append the entry name to the path name)"
+ 	entry_len := self strlen: ent d_name.
+ 	[dirStream path_len + entry_len > (#PATH_MAX - 1)] ifTrue:
+ 		[^interpreterProxy primitiveFailForOSError: self stringTooLong].
+ 	self mem: dirStream path_file cp: ent d_name y: entry_len.
+ 	dirStream path_file at: entry_len put: 0.
- 	entry_len := self cCode: 'strlen(ent->d_name)'.
- 	[(self cCode: 'dirStream->path_len') + entry_len > (self cCode: 'PATH_MAX-1')] ifTrue:
- 		[^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self stringTooLong)].
- 	self cCode: 'memcpy(dirStream->path_file, ent->d_name, entry_len)'.
- 	self cCode: 'dirStream->path_file[entry_len] = ''\0'''.
  
+ 	status := self fileToAttributeArray: dirStream path mask: 1 array: (self addressOf: attributeArray put: [:val| attributeArray := val]).
- 	status := self fileToAttributeArray: (self cCode: 'dirStream->path') mask: 1 array: (self addressOf: attributeArray).
  	"If the stat() fails, still return the filename, just no attributes"
  	status ~= 0 ifTrue: [attributeArray := interpreterProxy nilObject].
  
+ 	self remapOop: #(entryName attributeArray)
+ 		in: [resultArray := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2].
+ 	resultArray ifNil:
+ 		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
- 	resultArray := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2.
  	interpreterProxy
+ 		storePointer: 0 ofObject: resultArray withValue: entryName;
+ 		storePointer: 1 ofObject: resultArray withValue: attributeArray;
+ 		pop: 2 thenPush: resultArray!
- 		storePointer: 0
- 		ofObject: resultArray
- 		withValue: entryName.
- 	interpreterProxy
- 		storePointer: 1
- 		ofObject: resultArray
- 		withValue: attributeArray.
- 
- 	interpreterProxy pop: 2; push: resultArray
- !

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveRewinddir (in category 'file primitives') -----
  primitiveRewinddir
  	"Set directoryStream to first entry. Answer dirPointerOop."
  
  	| dirPointerOop dirStream |
  	<export: true>
  	<var: 'dirStream' declareC: 'osdir *dirStream'>
+ 	dirPointerOop := interpreterProxy stackValue: 0.
- 	dirPointerOop := interpreterProxy stackObjectValue: 0.
- 	(interpreterProxy is: dirPointerOop KindOf: 'ByteArray') ifFalse:
- 		[self cCode: 'fprintf(stderr, "primitiveRewindir: invalid argument, expected an ByteArray\n")'.
- 		^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
  	dirStream := self pointerFrom: dirPointerOop.
+ 	dirStream ifNil:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ 	self rewinddir: dirStream dp.
+ 	interpreterProxy pop: 2 thenPush: dirPointerOop!
- 	(dirStream = nil) ifTrue: [^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
- 	self cCode: 'rewinddir(dirStream->dp)'.
- 	interpreterProxy pop: 2; push: dirPointerOop
- !

Item was changed:
  ----- Method: FileAttributesPlugin>>putLStatFor:intoBuffer:targetName: (in category 'private - file') -----
  putLStatFor: cPathName intoBuffer: statBufPointer targetName: fileNameOop
  	"Call stat() on cPathName, storing the results in
  	the buffer at statBufPointer."
  
+ 	| cLinkName len status |
- 	| cLinkName cLinkPtr len status |
  	<returnTypeC: 'sqInt'>
  	<var: 'cPathName' type: 'char *'>
  	<var: 'statBufPointer' type: 'struct stat *'>
  	<var: 'cLinkName' declareC: 'char cLinkName[PATH_MAX]'>
- 	<var: 'cLinkPtr' type: 'char *'>
  	<var: 'fileNameOop' type: 'sqInt *'>
  
+ 	self cppIf: #HAVE_LSTAT = 1 ifTrue: [
+ 		status := self lst: cPathName at: statBufPointer.
+ 		status ~= 0 ifTrue: [^self cantStatPath].
+ 		(self S_ISLNK: statBufPointer st_mode) = 0
+ 			ifFalse: [
+ 				len := self readLink: cPathName into: cLinkName maxLength: #PATH_MAX.
+ 				len < 0 ifTrue: [^len].
+ 				status := self byteArrayFromCString: cLinkName to: fileNameOop]
+ 			ifTrue:
+ 				[fileNameOop at: 0 put: interpreterProxy nilObject].
+ 	] ifFalse: [ "#HAVE_LSTAT = 1"
+ 		status := self invalidRequest.
+ 	].
- 	cLinkPtr := self cCode: '(char *) &cLinkName'.
- 	self cPreprocessorDirective: '#if HAVE_LSTAT == 1'.
- 	status := self cCode: 'lstat(cPathName, statBufPointer)'.
- 	(status ~= 0) ifTrue: [^self cantStatPath].
- 	"status := 0."
- 	((self cCode: 'S_ISLNK(statBufPointer->st_mode)') = 0)
- 		ifFalse: [
- 			len := self readLink: cPathName into: cLinkPtr maxLength: (self cCode: 'PATH_MAX').
- 			len < 0 ifTrue: [^len].
- 			status := self byteArrayFromCString: cLinkPtr to: fileNameOop]
- 		ifTrue:
- 			[self cCode: '*fileNameOop = interpreterProxy->nilObject()'].
- 	self cPreprocessorDirective: '#else'.
- 	status := self invalidRequest.
- 	self cPreprocessorDirective: '#endif'.
  	^status
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>putStatFor:intoBuffer:targetName: (in category 'private - file') -----
  putStatFor: cPathName intoBuffer: statBufPointer targetName: fileNameOop
  	"Call stat() on cPathName, storing the results in
  	the buffer at statBufPointer."
  
  	| status |
  	<var: 'cPathName' type: 'char *'>
  	<var: 'statBufPointer' type: 'struct stat *'>
  	<var: 'fileNameOop' type: 'sqInt *'>
+ 
+ 	status := self st: cPathName at: statBufPointer.
+ 	status ~= 0 ifTrue: [^self cantStatPath].
+ 	self cppIf: #_WIN32 defined
+ 		ifTrue: [self offsetStatBufTimesForWIN32: statBufPointer].
+ 	fileNameOop at: 0 put: interpreterProxy nilObject.
+ 	^0!
- 	self cPreprocessorDirective: '#ifdef WIN32
- 	TIME_ZONE_INFORMATION dtzi;
- 	#endif'.
- 	status :=self cCode: 'stat(cPathName, statBufPointer)'.
- 	(status ~= 0) ifTrue: [^self cantStatPath].
- 	self cPreprocessorDirective: '#if defined(WIN32)'.
- 	status := self cCode: 'GetTimeZoneInformation(&dtzi)'.
- 	[status = 2] ifTrue: [
- 		self cCode: 'statBufPointer->st_atime -= 3600'.
- 		self cCode: 'statBufPointer->st_mtime -= 3600'.
- 		self cCode: 'statBufPointer->st_ctime -= 3600'.
- 		].
- 	self cPreprocessorDirective: '#endif'.
- 	self cCode: '*fileNameOop = interpreterProxy->nilObject()'.
- 	^0
- !

Item was changed:
  ----- Method: FileAttributesPlugin>>readLink:into:maxLength: (in category 'private - file') -----
  readLink: cPathName into: cLinkPtr maxLength: maxLength
  	"Get the target filename of the supplied symbolic link."
  
  	| len |
- 	<returnTypeC: 'size_t'>
  	<var: 'cPathName' type: 'char *'>
  	<var: 'cLinkPtr' type: 'char *'>
  	<var: 'maxLength' type: 'size_t'>
+ 	<var: 'len' type: #sqInt> "len must be signed so that -1 can be communicated as an error."
- 	<var: 'len' type: 'size_t'>
  
+ 	len := self cppIf: #_WIN32 defined
+ 				ifTrue: [-1]
+ 				ifFalse: [self read: cPathName li: cLinkPtr nk: maxLength].
- 	self cPreprocessorDirective: '#if defined(WIN32)'.
- 	len := -1.
- 	self cPreprocessorDirective: '#else'.
- 	len := self cCode: 'readlink(cPathName, cLinkPtr, maxLength)'.
- 	self cPreprocessorDirective: '#endif'.
  	len < 0 ifTrue:
+ 		[self cppIf: #'INDEBUG' defined ifTrue: 
+ 			[self cCode: 'fprintf(stderr, "FileAttributesPlugin: unable to readlink(): %d, errno=%d\n", len, errno)'].
- 		[self cCode: 'fprintf(stderr, "FileAttributesPlugin: unable to readlink(): %d\n", len)'.
  		^self cantReadlink].
  	cLinkPtr at: len put: 0.
+ 	^len!
- 	^len.!

Item was changed:
  ----- Method: FileAttributesPlugin>>sizeOfPointer (in category 'private - directory') -----
  sizeOfPointer
  	"Size of a C pointer on this machine"
+ 	<inline: #always>
- 	<inline: true>
  	^self sizeof: #'void *'!

Item was removed:
- ----- Method: FileAttributesPlugin>>smallOrLargeIntegerObjectFor: (in category 'private') -----
- smallOrLargeIntegerObjectFor: aPositiveInteger
- 	"Answer an Integer object for aPositiveInteger. If the value is too large
- 	to fit in an SmallInteger, then answer a LargePositiveInteger. Note that
- 	smallIntegerMaxVal is a class variable with an initialization value determined
- 	when this class is translated to C code; see my #declareCVarsIn: class method."
- 
- 	(aPositiveInteger > smallIntegerMaxVal)
- 		ifTrue: [^ interpreterProxy integerObjectOf: aPositiveInteger]
- 		ifFalse: [^ interpreterProxy positive32BitIntegerFor: aPositiveInteger]
- !

Item was changed:
  ----- Method: FileAttributesPlugin>>statArrayFor:toArray:from:fileName: (in category 'private - file') -----
  statArrayFor: cPathName toArray: attributeArray from: statBufPointer fileName: fileNameOop
  	"Answer a file entry array from the supplied statBufPointer"
  
+ 	| sizeIfFile creationDate status |
- 	| index sizeIfFile creationDate status |
  	<var: 'cPathName' type: 'char *'>
  	<var: 'statBufPointer' type: 'struct stat *'>
  	<var: 'creationDate' type: 'time_t'>
  
+ 	sizeIfFile := (self S_ISDIR: statBufPointer st_mode) = 0
+ 					ifTrue: [statBufPointer st_size]
+ 					ifFalse: [0].
- 	((self cCode: 'S_ISDIR(statBufPointer->st_mode)') = 0)
- 		ifTrue:
- 			[sizeIfFile := self cCode: 'statBufPointer->st_size']
- 		ifFalse:
- 			[sizeIfFile := 0].
- 
- 	index := 0.
  	interpreterProxy
+ 		storePointer: 0
- 		storePointer: index
- 		ofObject: attributeArray
- 		withValue: fileNameOop.
- 	index := index + 1. "1"
- 	interpreterProxy
- 		storePointer: index
- 		ofObject: attributeArray
- 		withValue: (self smallOrLargeIntegerObjectFor:
- 			(self cCode: 'statBufPointer->st_mode' inSmalltalk: [0])).
- 	index := index + 1. "2"
- 	interpreterProxy
- 		storePointer: index
- 		ofObject: attributeArray
- 		withValue: (interpreterProxy positive64BitIntegerFor:
- 			(self cCode: 'statBufPointer->st_ino' inSmalltalk: [0])).
- 	index := index + 1. "3"
- 	interpreterProxy
- 		storePointer: index
- 		ofObject: attributeArray
- 		withValue: (interpreterProxy positive64BitIntegerFor:
- 			(self cCode: 'statBufPointer->st_dev' inSmalltalk: [0])).
- 	index := index + 1. "4"
- 	interpreterProxy
- 		storePointer: index
- 		ofObject: attributeArray
- 		withValue: (interpreterProxy positive64BitIntegerFor:
- 			(self cCode: 'statBufPointer->st_nlink' inSmalltalk: [0])).
- 	index := index + 1. "5"
- 	interpreterProxy
- 		storePointer: index
- 		ofObject: attributeArray
- 		withValue: (self smallOrLargeIntegerObjectFor:
- 			(self cCode: 'statBufPointer->st_uid' inSmalltalk: [0])).
- 	index := index + 1. "6"
- 	interpreterProxy
- 		storePointer: index
- 		ofObject: attributeArray
- 		withValue: (self smallOrLargeIntegerObjectFor:
- 			(self cCode: 'statBufPointer->st_gid' inSmalltalk: [0])).
- 	index := index + 1. "7"
- 	interpreterProxy
- 		storePointer: index
- 		ofObject: attributeArray
- 		withValue: (self smallOrLargeIntegerObjectFor: sizeIfFile).
- 	index := index + 1. "8"
- 	interpreterProxy
- 		storePointer: index
- 		ofObject: attributeArray
- 		withValue: (self oopFromTimeT:	(self cCode: 'statBufPointer->st_atime')).
- 	index := index + 1. "9"
- 	interpreterProxy
- 		storePointer: index
- 		ofObject: attributeArray
- 		withValue: (self oopFromTimeT:	(self cCode: 'statBufPointer->st_mtime')).
- 	index := index + 1. "10"
- 	interpreterProxy
- 		storePointer: index
- 		ofObject: attributeArray
- 		withValue: (self oopFromTimeT: (self cCode: 'statBufPointer->st_ctime')).
- 	index := index + 1. "11"
- 	self cPreprocessorDirective: '#if defined(WIN32)'.
- 		status := self fileCreationTimeFor: cPathName
- 			length: cPathName strlen
- 			to: (self cCode: '&creationDate').
- 			status = 0 ifTrue:
- 				[
- 				interpreterProxy
- 					storePointer: index
- 					ofObject: attributeArray
- 					withValue: (self oopFromTimeT: creationDate).
- 				]
- 			ifFalse:
- 				[
- 				interpreterProxy
- 					storePointer: index
- 					ofObject: attributeArray
- 					withValue: (interpreterProxy nilObject).
- 				].
- 	self cPreprocessorDirective: '#else'.
- 		interpreterProxy
- 			storePointer: index
  			ofObject: attributeArray
+ 				withValue: fileNameOop;
+ 		storePointer: 1
+ 			ofObject: attributeArray
+ 				withValue: (interpreterProxy positiveMachineIntegerFor: statBufPointer st_mode);
+ 		storePointer: 2
+ 			ofObject: attributeArray
+ 				withValue: (interpreterProxy positive64BitIntegerFor: statBufPointer st_ino);
+ 		storePointer: 3
+ 			ofObject: attributeArray
+ 				withValue: (interpreterProxy positive64BitIntegerFor: statBufPointer st_dev);
+ 		storePointer: 4
+ 			ofObject: attributeArray
+ 				withValue: (interpreterProxy positive64BitIntegerFor: statBufPointer st_nlink);
+ 		storePointer: 5
+ 			ofObject: attributeArray
+ 				withValue: (interpreterProxy positiveMachineIntegerFor: statBufPointer st_uid);
+ 		storePointer: 6
+ 			ofObject: attributeArray
+ 				withValue: (interpreterProxy positiveMachineIntegerFor: statBufPointer st_gid);
+ 		storePointer: 7
+ 			ofObject: attributeArray
+ 				withValue: (interpreterProxy positive64BitIntegerFor: sizeIfFile);
+ 		storePointer: 8
+ 			ofObject: attributeArray
+ 				withValue: (self oopFromTimeT:	statBufPointer st_atime);
+ 		storePointer: 9
+ 			ofObject: attributeArray
+ 				withValue: (self oopFromTimeT:	statBufPointer st_mtime);
+ 		storePointer: 10
+ 			ofObject: attributeArray
+ 				withValue: (self oopFromTimeT: statBufPointer st_ctime).
+ 	self cppIf: #_WIN32 defined
+ 		ifTrue:
+ 			[status := self	fileCreationTimeFor: cPathName
+ 							length: cPathName strlen
+ 							to: (self addressOf: creationDate put: [:val| creationDate := val]).
+ 			interpreterProxy
+ 				storePointer: 11
+ 				ofObject: attributeArray
+ 				withValue: (status = 0
+ 							ifTrue:  [self oopFromTimeT: creationDate]
+ 							ifFalse: [interpreterProxy nilObject])]
+ 		ifFalse:
+ 			[interpreterProxy
+ 				storePointer: 11
+ 				ofObject: attributeArray
+ 				withValue: interpreterProxy nilObject].
- 			withValue: (interpreterProxy nilObject).
- 	self cPreprocessorDirective: '#endif'.
  	^0!

Item was changed:
  ----- Method: FileAttributesPlugin>>statFailed (in category 'errors') -----
  statFailed
  	"A call to stat() failed"
+ 	<inline: #always>
  	^-2!

Item was changed:
  ----- Method: FileAttributesPlugin>>stringFromCString: (in category 'private') -----
  stringFromCString: aCString
  	"Answer a new String copied from a null-terminated C string.
  	Caution: This may invoke the garbage collector."
  
  	| len newString |
  	<var: 'aCString' type: 'const char *'>
  	len := self strlen: aCString.
  	newString := interpreterProxy
  		instantiateClass: interpreterProxy classString
  		indexableSize: len.
+ 	newString ifNil: [^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	self st: (interpreterProxy arrayValueOf: newString)
  		rn: aCString
  		cpy: len. "(char *)strncpy()"
  	^ newString
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>stringTooLong (in category 'errors') -----
  stringTooLong
  	"String too long.  A file path name was longer than PATH_MAX"
+ 	<inline: #always>
  	^-1!

Item was changed:
  ----- Method: FileAttributesPlugin>>timeConversionFailed (in category 'errors') -----
  timeConversionFailed
+ 	<inline: #always>
- 
  	^-5!

Item was added:
+ ----- Method: FileAttributesPlugin>>unableToCloseDir (in category 'errors') -----
+ unableToCloseDir
+ 	"The call to closedir() failed"
+ 	<inline: #always>
+ 	^-12!

Item was changed:
  ----- Method: FileAttributesPlugin>>versionString (in category 'version string') -----
  versionString
  	"Answer a string containing the version string for this plugin."
+ 	<inline: #always>
+ 	^'1.2.6'!
- 
- 	| version |
- 	<returnTypeC: 'char *'>
- 	<var: 'version' declareC: 'static char version[]= "1.0.0"'>
- 	^ self cCode: 'version' inSmalltalk: ['1.0.0']!

Item was removed:
- ----- Method: FileAttributesPlugin>>wrappedErrorCode: (in category 'private') -----
- wrappedErrorCode: aNumber
- 	"Answer a single element Array containing the supplied error code."
- 
- 	| newArray |
- 	newArray := interpreterProxy
- 		instantiateClass: interpreterProxy classArray
- 		indexableSize: 1.
- 	interpreterProxy
- 		storePointer: 0
- 		ofObject: newArray
- 		withValue: (interpreterProxy signed32BitIntegerFor: aNumber).
- 	^newArray!



More information about the Vm-dev mailing list