VM Maker: FileAttributesPlugin.oscog-akg.46.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: FileAttributesPlugin.oscog-akg.46.mcz

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

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

Name: FileAttributesPlugin.oscog-akg.46
Author: akg
Time: 14 December 2018, 3:58:12.347186 pm
UUID: 0f7242c3-9c0f-4b8b-a95f-444ce5873dcd
Ancestors: FileAttributesPlugin.oscog-akg.45

FileAttributesPlugin 2.0.6

- Handle VM restart mid directory iteration
- Handle long file names on Windows

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

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

Item was added:
+ ----- Method: FileAttributesPlugin>>badSessionId (in category 'errors / status') -----
+ badSessionId
+ "The supplied session Id doesn't match the current VM session Id"
+
+ ^-17!

Item was added:
+ ----- Method: FileAttributesPlugin>>faSuccess (in category 'errors / status') -----
+ faSuccess
+
+ ^0!

Item was removed:
- ----- 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:
- [
- 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 added:
+ ----- Method: FileAttributesPlugin>>interpreterError (in category 'errors / status') -----
+ interpreterError
+ "The actual error code is stored by the interpreterProxy"
+ <inline: #always>
+ ^-15!

Item was added:
+ ----- Method: FileAttributesPlugin>>objectFromStruct:size: (in category 'private - directory') -----
+ objectFromStruct: aMachineAddress size: structSize
+ "Answer a ByteArray object which copies the structure at aMachineAddress"
+
+ | addressOop addressOopArrayPointer |
+ <var: 'aMachineAddress' type: #'void *'>
+ <var: 'addressOopArrayPointer' type: #'unsigned char *'>
+
+ addressOop := interpreterProxy
+ instantiateClass: interpreterProxy classByteArray
+ indexableSize: structSize.
+ addressOop ifNil:
+ [^interpreterProxy primitiveFailFor: PrimErrNoMemory].
+ addressOopArrayPointer := interpreterProxy arrayValueOf: addressOop.
+ self memcpy: addressOopArrayPointer _: aMachineAddress _: structSize.
+ ^ addressOop
+ !

Item was removed:
- ----- 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]).
- interpreterProxy
- storePointer: 8
- ofObject: attributeArray
- withValue: (interpreterProxy signed64BitIntegerFor: attributeDate).
- attributeDate := self faConvertUnixToLongSqueakTime: (self
- cCode: 'statBufPointer->st_mtime'
- inSmalltalk: [statBufPointer contents at: 10]).
- interpreterProxy
- storePointer: 9
- ofObject: attributeArray
- withValue: (interpreterProxy signed64BitIntegerFor: attributeDate).
- attributeDate := self faConvertUnixToLongSqueakTime: (self
- cCode: 'statBufPointer->st_ctime'
- inSmalltalk: [statBufPointer contents at: 11]).
- 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 faPathPtr faPath result |
- | dirPointerOop faPath result |
  <export: true>
+ <var: 'faPath' type: #'fapath *'>
+ <var: 'faPathPtr' type: #'fapathptr *'>
- <var: 'fapath' type: #'faPath *'>
 
  dirPointerOop := interpreterProxy stackValue: 0.
+ faPathPtr := self cCode: '(fapathptr *)structFromObjectsize(dirPointerOop, sizeof(fapathptr))'
+ inSmalltalk: [self structFromObject: dirPointerOop size: self sizeOfFaPathPtr].
+ faPathPtr = 0 ifTrue:
- faPath := self pointerFrom: dirPointerOop.
- faPath ifNil:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self faValidateSessionId: (self cCode: 'faPathPtr->sessionId' inSmalltalk: [faPathPtr first])) ifFalse:
+ [self free: faPathPtr.
+ ^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ faPath := self cCode: 'faPathPtr->faPath' inSmalltalk: [faPathPtr second].
 
  result := self faCloseDirectory: faPath.
+ self faInvalidateSessionId: (self cCode: '&faPathPtr->sessionId' inSmalltalk: [faPathPtr]).
  result = 0 ifFalse:
  [^interpreterProxy primitiveFailForOSError: result].
+ self free: faPathPtr.
  self free: faPath.
  interpreterProxy 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 = 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 faPath status resultOop  |
- | 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 = nil ifTrue: [^interpreterProxy primitiveFailForOSError: self cantAllocateMemory].
  self faSetStPathOop: faPath _: fileName.
  interpreterProxy failed ifTrue: [
  self free: faPath.
  ^interpreterProxy primitiveFailureCode].
 
+ status := self attributeArray: (self addressOf: resultOop put: [ :val | resultOop := val]) for: faPath mask: attributeMask.
- status := self fileToAttributeArray: faPath
- mask: attributeMask
- array: (self addressOf: attributeArray put: [:val| attributeArray := val]).
  self free: faPath.
+ status ~= 0 ifTrue:
+ [^interpreterProxy primitiveFailForOSError: status].
+ ^interpreterProxy methodReturnValue: resultOop!
- status ~= 0
- ifTrue: [interpreterProxy primitiveFailForOSError: status]
- ifFalse: [interpreterProxy methodReturnValue: attributeArray]!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveOpendir (in category 'file primitives') -----
  primitiveOpendir
+ "Open the supplied directory and answer the first entry and directory pointer.
+ If the directory is empty, answer nil as the first entry.
+ If the directory can't be opened, answer an error (cantOpenDir)"
-
  "self primOpendir: '/etc'"
 
+ | dirName faPath faPathPtr dirOop status resultOop |
- | dirName faPath dirOop status resultOop |
  <export: true>
  <var: 'faPath' type: #'fapath *'>
+ <var: 'faPathPtr' type: #'fapathptr'>
 
+ "Process the parameters"
  dirName := interpreterProxy stackObjectValue: 0.
  (interpreterProxy isBytes: dirName) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
 
+ "Allocate and initialise faPath"
  faPath := self cCode: '(fapath *) calloc(1, sizeof(fapath))'
  inSmalltalk: [self simulatedFaPath].
  faPath = nil ifTrue: [^interpreterProxy primitiveFailForOSError: self cantAllocateMemory].
  self faSetStDirOop: faPath _: dirName.
  interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailureCode].
 
  (self canOpenDirectoryStreamFor: (self faGetStPath: faPath) length: (self faGetStPathLen: faPath)) ifFalse: [
  self free: faPath.
  ^interpreterProxy primitiveFailForOSError: self cantOpenDir].
 
+ "Open the directory and process the first entry"
  status := self faOpenDirectory: faPath.
  status = self noMoreData ifTrue: [
  self free: faPath.
+ ^interpreterProxy methodReturnValue: interpreterProxy nilObject].
- ^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 ].
 
+ "Set the faPathPtr"
+ self faInitSessionId: (self cCode: '&faPathPtr.sessionId' inSmalltalk: [faPathPtr := Array new: 2]).
+ self cCode: 'faPathPtr.faPath = faPath'
+ inSmalltalk: [faPathPtr at: 2 put: faPath].
  self remapOop: resultOop in:
+ [ dirOop := self objectFromStruct: (self addressOf: faPathPtr) size: self sizeOfFaPathPtr ].
+
- [ 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 faPathPtr faPath resultArray status |
- | dirPointerOop faPath resultArray status |
  <export: true>
  <var: 'faPath' type: #'fapath *'>
+ <var: 'faPathPtr' type: #'fapathptr *'>
 
  dirPointerOop := interpreterProxy stackValue: 0.
+ faPathPtr := self cCode: '(fapathptr *)structFromObjectsize(dirPointerOop, sizeof(fapathptr))'
+ inSmalltalk: [self structFromObject: dirPointerOop size: self sizeOfFaPathPtr].
+ faPathPtr = 0 ifTrue:
- faPath := self pointerFrom: dirPointerOop.
- faPath ifNil:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self faValidateSessionId: (self cCode: 'faPathPtr->sessionId' inSmalltalk: [faPathPtr first])) ifFalse:
+ [self free: faPathPtr.
+ ^interpreterProxy primitiveFailForOSError: self badSessionId].
+ faPath := self cCode: 'faPathPtr->faPath' inSmalltalk: [faPathPtr second].
 
  status := self faReadDirectory: faPath.
  status = self noMoreData ifTrue:
+ [self free: faPathPtr.
+ ^interpreterProxy pop: 2 thenPush: interpreterProxy nilObject].
- [^interpreterProxy pop: 2 thenPush: interpreterProxy nilObject].
  status < 0 ifTrue:
+ [self free: faPathPtr.
+ ^interpreterProxy primitiveFailForOSError: status].
- [^interpreterProxy primitiveFailForOSError: status].
  resultArray := self processDirectory: faPath.
+ self free: faPathPtr.
  interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailureCode].
 
+ ^interpreterProxy methodReturnValue: resultArray.
+ !
- interpreterProxy
- pop: 2 thenPush: resultArray!

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

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 ~= 0 ifTrue:
  [ ^interpreterProxy primitiveFailForOSError: status].
 
+ status := self attributeArray: (self addressOf: attributeArray put: [ :val | attributeArray := val ]) for: faPath mask: 1.
- 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:
+ [status = self cantStatPath ifTrue:
+ [attributeArray := interpreterProxy nilObject]
+ ifFalse:
+ [^interpreterProxy primitiveFailForOSError: status]].
- 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 added:
+ ----- Method: FileAttributesPlugin>>sizeOfFaPath (in category 'private') -----
+ sizeOfFaPath
+ "Answer the size of fapath"
+
+ ^self cCode: 'sizeof(fapath)'
+ inSmalltalk: [6].!

Item was added:
+ ----- Method: FileAttributesPlugin>>sizeOfFaPathPtr (in category 'private') -----
+ sizeOfFaPathPtr
+ "Answer the size of fapathptr.
+ The simulation uses a two element array."
+
+ ^self cCode: 'sizeof(fapathptr)'
+ inSmalltalk: [2].!

Item was removed:
- ----- 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 |
- <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]]]
- ifFalse: [0].
- interpreterProxy
- storePointer: 0
- ofObject: attributeArray
- withValue: (self cCode: 'fileNameOop' inSmalltalk: [self toOop: fileNameOop contents]);
- storePointer: 1
- ofObject: attributeArray
- withValue: (interpreterProxy positive64BitIntegerFor: (self
- cCode: 'statBufPointer->st_mode'
- inSmalltalk: [statBufPointer contents at: 2]));
- storePointer: 2
- ofObject: attributeArray
- withValue: (interpreterProxy positive64BitIntegerFor: (self
- cCode: 'statBufPointer->st_ino'
- inSmalltalk: [statBufPointer contents at: 3]));
- storePointer: 3
- ofObject: attributeArray
- withValue: (interpreterProxy positive64BitIntegerFor: (self
- cCode: 'statBufPointer->st_dev'
- inSmalltalk: [statBufPointer contents at: 4]));
- storePointer: 4
- ofObject: attributeArray
- withValue: (interpreterProxy positive64BitIntegerFor: (self
- cCode: 'statBufPointer->st_nlink'
- inSmalltalk: [statBufPointer contents at: 5]));
- storePointer: 5
- ofObject: attributeArray
- withValue: (interpreterProxy positive64BitIntegerFor: (self
- cCode: 'statBufPointer->st_uid'
- inSmalltalk: [statBufPointer contents at: 6]));
- storePointer: 6
- ofObject: attributeArray
- withValue: (interpreterProxy positive64BitIntegerFor: (self
- cCode: 'statBufPointer->st_gid'
- inSmalltalk: [statBufPointer contents at: 7]));
- 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 added:
+ ----- Method: FileAttributesPlugin>>structFromObject:size: (in category 'private - directory') -----
+ structFromObject: anObject size: structSize
+ "Allocate memory of the requiested size and copy the contents of anObject in to it.
+ anObject is expected to be bytes, e.g. ByteArray or String.
+ The sender is responsible for freeing the memory."
+
+ | buffer |
+ <returnTypeC: #'void *'>
+ <var: 'buffer' type: #'void *'>
+
+ buffer := 0.
+ (interpreterProxy stSizeOf: anObject) = structSize ifFalse:
+ [interpreterProxy primitiveFailFor: PrimErrBadArgument.
+ ^buffer].
+ buffer := self malloc: structSize.
+ buffer = 0 ifTrue:
+ [interpreterProxy primitiveFailFor: PrimErrNoCMemory.
+ ^buffer].
+ self memcpy: buffer
+ _: (interpreterProxy arrayValueOf: anObject)
+ _: structSize.
+ ^buffer!

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

Item was removed:
- ----- Method: FileAttributesPlugin>>winFileCreationTimeFor:to: (in category 'private - windows') -----
- winFileCreationTimeFor: winAttrs to: creationDate
- "Set the file creation time from the supplied attributes."
- <option: #_WIN32>
-
- | sysTime fileTime |
-
- <var: 'winAttrs' type: #'WIN32_FILE_ATTRIBUTE_DATA *'>
- <var: 'creationDate' type: #'sqLong *'>
- <var: 'fileTime' type: #'FILETIME'>
- <var: 'sysTime' type: #'SYSTEMTIME'>
-
- self touch: sysTime.
- self touch: fileTime.
-
- (self cCode: 'FileTimeToLocalFileTime(&winAttrs->ftCreationTime, &fileTime)') = 0 ifTrue:
-   [^self timeConversionFailed].
- (self cCode: 'FileTimeToSystemTime(&fileTime, &sysTime)') = 0 ifTrue:
-   [^self timeConversionFailed].
- self cCode: '*creationDate = convertWinToSqueakTime(sysTime)'.
-
- ^0!

Item was removed:
- ----- Method: FileAttributesPlugin>>winFileLastAccessTimeFor:to: (in category 'private - windows') -----
- winFileLastAccessTimeFor: winAttrs to: accessDate
- "Set the file creation time from the supplied attributes."
- <option: #_WIN32>
-
- | sysTime fileTime |
-
- <var: 'winAttrs' type: #'WIN32_FILE_ATTRIBUTE_DATA *'>
- <var: 'accessDate' type: #'sqLong *'>
- <var: 'fileTime' type: #'FILETIME'>
- <var: 'sysTime' type: #'SYSTEMTIME'>
-
- self touch: sysTime.
- self touch: fileTime.
-
- (self cCode: 'FileTimeToLocalFileTime(&winAttrs->ftLastAccessTime, &fileTime)') = 0 ifTrue:
-   [^self timeConversionFailed].
- (self cCode: 'FileTimeToSystemTime(&fileTime, &sysTime)') = 0 ifTrue:
-   [^self timeConversionFailed].
- self cCode: '*accessDate = convertWinToSqueakTime(sysTime)'.
-
- ^0!

Item was removed:
- ----- Method: FileAttributesPlugin>>winFileLastWriteTimeFor:to: (in category 'private - windows') -----
- winFileLastWriteTimeFor: winAttrs to: writeDate
- "Set the file write time from the supplied attributes."
- <option: #_WIN32>
-
- | sysTime fileTime |
-
- <var: 'winAttrs' type: #'WIN32_FILE_ATTRIBUTE_DATA *'>
- <var: 'writeDate' type: #'sqLong *'>
- <var: 'fileTime' type: #'FILETIME'>
- <var: 'sysTime' type: #'SYSTEMTIME'>
-
- self touch: sysTime.
- self touch: fileTime.
-
- (self cCode: 'FileTimeToLocalFileTime(&winAttrs->ftLastWriteTime, &fileTime)') = 0 ifTrue:
-   [^self timeConversionFailed].
- (self cCode: 'FileTimeToSystemTime(&fileTime, &sysTime)') = 0 ifTrue:
-   [^self timeConversionFailed].
- self cCode: '*writeDate = convertWinToSqueakTime(sysTime)'.
-
- ^0!

Item was removed:
- ----- Method: FileAttributesPlugin>>winFileTimesFor:to: (in category 'private - windows') -----
- winFileTimesFor: faPath to: attributeArray
- <inline: #never>
- <option: #_WIN32>
-
- | winAttrs attributeDate status |
- <var: 'faPath' type: #'fapath *'>
- <var: 'attributeDate' type: #'sqLong'>
- <var: 'winAttrs' type: #'WIN32_FILE_ATTRIBUTE_DATA'>
-
- "Get the file attributes"
- status := self cCode: 'GetFileAttributesExW(faGetPlatPath(faPath), GetFileExInfoStandard, &winAttrs)'.
- status = 0 ifTrue: [^self getAttributesFailed].
-
- "Set the accessDate"
- status := self winFileLastAccessTimeFor: (self addressOf: winAttrs) to: (self addressOf: attributeDate).
- status = 0 ifFalse: [^status].
- interpreterProxy
- storePointer: 8
- ofObject: attributeArray
- withValue: (interpreterProxy signed64BitIntegerFor: attributeDate).
-
- "Set the modifiedDate"
- status := self winFileLastWriteTimeFor: (self addressOf: winAttrs) to: (self addressOf: attributeDate).
- status = 0 ifFalse: [^status].
- interpreterProxy
- storePointer: 9
- ofObject: attributeArray
- withValue: (interpreterProxy signed64BitIntegerFor: attributeDate).
-
- "Set the changeDate"
- interpreterProxy
- storePointer: 10
- ofObject: attributeArray
- withValue: interpreterProxy nilObject.
-
- "Set the creationDate"
- status := self winFileCreationTimeFor: (self addressOf: winAttrs) to: (self addressOf: attributeDate).
- status = 0 ifFalse: [^status].
- interpreterProxy
- storePointer: 11
- ofObject: attributeArray
- withValue: (interpreterProxy signed64BitIntegerFor: attributeDate).
-
- ^0
- !

Item was changed:
  FileAttributesPlugin subclass: #FileAttributesPluginSimulator
  instanceVariableNames: 'maxPathLen'
  classVariableNames: 'FA_PATH_MAX HAVE_CHMOD HAVE_CHOWN HAVE_LSTAT PATH_MAX S_IFBLK S_IFCHR S_IFDIR S_IFIFO S_IFLNK S_IFMT S_IFREG S_IFSOCK'
  poolDictionaries: ''
  category: 'FileAttributesPlugin'!
 
+ !FileAttributesPluginSimulator commentStamp: 'akg 11/28/2018 22:14' prior: 0!
- !FileAttributesPluginSimulator commentStamp: 'akg 10/19/2018 16:12' 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 session ID
+ 2. The input path in precomposed UTF8.
+ 3. The file name when iterating over directories.
+ 4. The input path with platform specific encoding
+ 5. The file name when iterating over directories with platform specific encoding
+ 6. The pointer to the real faPath used by the plugin.
- 1. The input path in precomposed UTF8.
- 2. The file name when iterating over directories.
- 3. The input path with platform specific encoding
- 4. The file name when iterating over directories with platform specific encoding
- 5. The pointer to the real faPath used by the plugin.
 
  The third and fourth entries (platform specific encoding) are only valid in specific cases, e.g. primitivePlatToStPath and primitiveStToPlatPath.
 
 
  Instance Variables
  !

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

Item was changed:
  ----- 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 isNumber ifFalse:
+ [faPath at: 6 put: nil.
- [faPath at: 3 put: nil.
  status := 0 ]
  ifTrue:
  [status := result < 0
  ifTrue: [result]
  ifFalse: [self unableToCloseDir]].
  ^status
  !

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

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

Item was changed:
  ----- Method: FileAttributesPluginSimulator>>faGetPlatPath: (in category 'simulation') -----
  faGetPlatPath: faPath
  "Answer the Plat format of the path.
+ In the simulation, actually answer the St format, this is required as the real primitive will eventually be called, which requires the St format."
- Horrible kludge: Within the simulation: if the platform encoding hasn't been set we're about to call the real primitive, which means that actually the St form is required."
 
+ ^self faGetStPath: faPath!
- | path |
-
- path := (faPath at: 3) ifNil:
- [faPath
- at: 4 put: nil;
- at: 3 put: (self primToPlatformPath: (self faGetStPath: faPath))].
- (faPath at: 4) ifNotNil: [
- path := path, (faPath at: 4)].
- ^path!

Item was changed:
  ----- Method: FileAttributesPluginSimulator>>faGetPlatPathByteCount: (in category 'simulation') -----
  faGetPlatPathByteCount: faPath
  "Answer the number of bytes in the platform specific encoding"
+
-
  ^(self faGetPlatPath: faPath) size!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faGetPlatformPath: (in category 'simulation') -----
+ faGetPlatformPath: faPath
+ "Answer the Platform format of the path.
+ This isn't normally used within the simulation as the simulation ultimately calls the actual primitive, which requires the St format of the path."
+
+ | path |
+
+ path := (faPath at: 4) ifNil:
+ [faPath
+ at: 5 put: nil;
+ at: 4 put: (self primToPlatformPath: (self faGetStPath: faPath))].
+ (faPath at: 5) ifNotNil: [
+ path := path, (faPath at: 5)].
+ ^path!

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

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

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

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faInitSessionId: (in category 'simulation') -----
+ faInitSessionId: faPathPtr
+ "Set the session id in the supplied pointer (a 2 element array in the simulation)"
+
+ faPathPtr at: 1 put: interpreterProxy getThisSessionID.
+ ^self faSuccess!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faInvalidateSessionId: (in category 'simulation') -----
+ faInvalidateSessionId: faPathPtr
+ "Clear the session ID in the faPathPtr, marking it invalid"
+
+ faPathPtr at: 1 put: nil.
+ ^self faSuccess!

Item was changed:
  ----- 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: (self faGetStPath: faPath).
+ result ifNotNil: [
+ faPath
+ at: 3 put: (result at: 1);
+ at: 6 put: (result at: 3).
+ status := 0 ]
+ ifNil: [status := self noMoreData].
- result := self primOpendir: faPath first.
- result ifNil:
- [status := self noMoreData]
- ifNotNil:
- [result isInteger ifTrue:
- [status := result]
- ifFalse:
- [faPath
- at: 2 put: (result at: 1);
- at: 3 put: (result at: 3).
- status := 0 ]].
  ^status
  !

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

Item was changed:
  ----- 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: 3 put: (result at: 1).
- faPath at: 2 put: (result at: 1).
  status := 0 ]
  ifNil: [status := self noMoreData].
  ^status
  !

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faSessionId: (in category 'simulation') -----
+ faSessionId: faPath
+ "Answer the session id of the current path"
+
+ ^faPath first!

Item was changed:
  ----- Method: FileAttributesPluginSimulator>>faSetPlatPathOop:_: (in category 'simulation') -----
  faSetPlatPathOop: faPath _: fileNameOop
  "Simulate setting the platform encoded file name in the supplied faPath."
 
  | fileNameBytes len path stPath |
 
  fileNameBytes := interpreterProxy arrayValueOf: fileNameOop.
+ len := interpreterProxy stSizeOf: fileNameOop.
- len := self strlen: fileNameBytes.
  path := ByteArray new: len.
  self strncpy: path _: fileNameBytes _: len.
+ faPath
+ at: 4 put: path;
+ at: 5 put: nil.
- self simFaPathPlatPath: faPath set: path.
  stPath := self primFromPlatformPath: path.
+ faPath
+ at: 2 put: stPath;
+ at: 3 put: nil.!
- self simFaPathStPath: faPath set: stPath!

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

Item was changed:
  ----- Method: FileAttributesPluginSimulator>>faSetStPathOop:_: (in category 'simulation') -----
  faSetStPathOop: faPath _: fileNameOop
+ "Set the St encoded path."
- "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 := interpreterProxy stSizeOf: fileNameOop.
- len := self strlen: fileNameBytes.
  path := ByteArray new: len.
  self strncpy: path _: fileNameBytes _: len.
  faPath
+ at: 2 put: path;
+ at: 3 put: nil.!
- at: 1 put: path;
- at: 2 put: nil.!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faValidatePath: (in category 'simulation') -----
+ faValidatePath: faPath
+ "The simulation currently doesn't keep track of the sessionId."
+
+ ^(self faSessionId: faPath) = interpreterProxy getThisSessionID!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>faValidateSessionId: (in category 'simulation') -----
+ faValidateSessionId: anInteger
+ "Answer a boolean indicating whether the supplied session id matches the current one."
+
+ ^anInteger = interpreterProxy getThisSessionID!

Item was changed:
  ----- 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].
  cls = ByteString ifTrue: [^self byteStringFromOop: anOop].
+ cls = LargePositiveInteger ifTrue: [^self largePositiveIntegerFromOop: anOop].
+ cls = SmallInteger ifTrue: [^self smallIntegerFromOop: anOop].
  self error: 'Unknown class'.!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>largePositiveIntegerFromOop: (in category 'simulation support') -----
+ largePositiveIntegerFromOop: anOop
+ "Answer a copy of the supplied large positive integer Oop"
+
+ | sz array ptr |
+
+ sz := interpreterProxy stSizeOf: anOop.
+ ptr := interpreterProxy arrayValueOf: anOop.
+ array := ByteArray new: 8.
+ 1 to: sz do: [ :i |
+ array at: i put: (interpreterProxy byteAt: ptr+i-1)].
+ ^Integer
+ byte1: (array at: 1)
+ byte2: (array at: 2)
+ byte3: (array at: 3)
+ byte4: (array at: 4)
+ byte5: (array at: 5)
+ byte6: (array at: 6)
+ byte7: (array at: 7)
+ byte8: (array at: 8)
+ !

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>objectFromStruct:size: (in category 'private') -----
+ objectFromStruct: anObject size: structSize
+ "Copy the simulation path in to the simulated image"
+
+ ^self toOop: anObject!

Item was removed:
- ----- Method: FileAttributesPluginSimulator>>simFaPathPlatDir: (in category 'faPath simulation') -----
- simFaPathPlatDir: faPath
- "Answer the directory name"
-
- ^faPath at: 3!

Item was removed:
- ----- Method: FileAttributesPluginSimulator>>simFaPathPlatFIleName: (in category 'faPath simulation') -----
- simFaPathPlatFIleName: faPath
- "Answer the file name, nil if not present"
-
- ^faPath at: 4!

Item was removed:
- ----- Method: FileAttributesPluginSimulator>>simFaPathPlatPath: (in category 'faPath simulation') -----
- simFaPathPlatPath: faPath
- "Answer the full path name, i.e. combine the directory and file name (if present)"
-
- | path |
-
- path := faPath at: 3.
- (faPath at: 4) ifNotNil:
- [path := path, (faPath at: 4)].
- ^path!

Item was removed:
- ----- Method: FileAttributesPluginSimulator>>simFaPathPlatPath:set: (in category 'faPath simulation') -----
- simFaPathPlatPath: faPath set: pathName
- "Set the full path name"
-
- faPath
- at: 3 put: pathName;
- at: 4 put: nil.
- ^pathName!

Item was removed:
- ----- Method: FileAttributesPluginSimulator>>simFaPathPtr: (in category 'faPath simulation') -----
- simFaPathPtr: faPath
- "Answer the address of the actual faPath buffer"
-
- ^faPath at: 5!

Item was removed:
- ----- Method: FileAttributesPluginSimulator>>simFaPathStDir: (in category 'faPath simulation') -----
- simFaPathStDir: faPath
- "Answer the directory name"
-
- ^faPath at: 1!

Item was removed:
- ----- Method: FileAttributesPluginSimulator>>simFaPathStFIleName: (in category 'faPath simulation') -----
- simFaPathStFIleName: faPath
- "Answer the file name, nil if not present"
-
- ^faPath at: 2!

Item was removed:
- ----- Method: FileAttributesPluginSimulator>>simFaPathStPath: (in category 'faPath simulation') -----
- simFaPathStPath: faPath
- "Answer the full path name, i.e. combine the directory and file name (if present)"
-
- | path |
-
- path := faPath at: 1.
- (faPath at: 2) ifNotNil:
- [path := path, (faPath at: 2)].
- ^path!

Item was removed:
- ----- Method: FileAttributesPluginSimulator>>simFaPathStPath:set: (in category 'faPath simulation') -----
- simFaPathStPath: faPath set: path
- "Set the full path name"
-
- faPath
- at: 1 put: path;
- at: 2 put: nil.
- ^path!

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

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>smallIntegerFromOop: (in category 'simulation support') -----
+ smallIntegerFromOop: anOop
+ "Answer a copy of the supplied large positive integer Oop"
+
+ ^interpreterProxy integerValueOf: anOop!

Item was added:
+ ----- Method: FileAttributesPluginSimulator>>structFromObject:size: (in category 'private') -----
+ structFromObject: anOop size: structSize
+ "Copy the object from the simulated image to the simulator.
+ At the moment, all objects are passed in Arrays with structSize elements."
+
+ | array |
+
+ array := self fromOop: anOop.
+ array isArray ifFalse: [^0].
+ array size = structSize ifFalse: [^0].
+ ^array!