VM Maker: FileAttributesPlugin-nice.15.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-nice.15.mcz

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

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

Name: FileAttributesPlugin-nice.15
Author: nice
Time: 27 August 2017, 10:36:29.077771 pm
UUID: c966771e-2a05-469c-b059-ad136f1cd4f0
Ancestors: FileAttributesPlugin-nice.14

Simplify sizeOfPointer and make simulation 64-bits friendly.

Use #var:type: rather than #var:declareC: when possible (to avoid repeating var name)

=============== Diff against FileAttributesPlugin-AlistairGrant.12 ===============

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 > (self cCode: 'PATH_MAX') ifTrue: [^self stringTooLong].
  newByteArray := interpreterProxy
  instantiateClass: interpreterProxy classByteArray
  indexableSize: len.
  byteArrayPtr := interpreterProxy arrayValueOf: newByteArray.
+ self mem: byteArrayPtr cp: aCString y: len.
- self cCode: 'memcpy(byteArrayPtr, aCString, len)'.
  self cCode: '*byteArrayOop = newByteArray'.
  ^0.!

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 >= (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.
- self cCode: 'memcpy(cString, sPtr, len)'.
  cString at: len put: 0.
  self cCode: '*flag = access(cString, mode)'.
  ^0
  !

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 statBufPointer  |
  <returnTypeC: 'int'>
  <var: 'cPathName' type: 'char *'>
  <var: 'attributeArray' type: 'sqInt *'>
  <var: 'statBuf' type: 'struct stat'>
+ <var: 'statBufPointer' type: 'struct stat *'>
- <var: 'statBufPointer' declareC: 'struct stat *statBufPointer= &statBuf'>
 
+ statBufPointer := self addressOf: statBuf.
  "Determine which attributes to retrieve"
  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 bitAnd: 4) = 4.
  statArray := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 12.
  useLstat ifFalse:
  [ status := self putStatFor: cPathName
  intoBuffer: statBufPointer
+ targetName:  (self addressOf: fileNameOop) ]
- targetName:  (self cCode: '&fileNameOop') ]
  ifTrue:
  [ status := self putLStatFor: cPathName
  intoBuffer: statBufPointer
+ targetName:  (self addressOf: fileNameOop) ].
- targetName:  (self cCode: '&fileNameOop') ].
  status ~= 0 ifTrue: [^status].
  status := self statArrayFor: cPathName toArray: statArray from: statBufPointer fileName: fileNameOop.
  status ~= 0 ifTrue: [^status].
  "Set attributeArray in case only stat() attributes have been requested"
  self cCode: '*attributeArray = statArray'.
  ].
  getAccess ifTrue:
  [
  accessArray := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 3.
  self accessAttributesForFilename: cPathName into: accessArray startingAt: 0.
  "Set attributeArray in case only access() attributes have been requested"
  self cCode: '*attributeArray = accessArray'.
  ].
  [getStats and: [getAccess]] ifTrue:
  [
  combinedArray := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2.
  self cCode: '*attributeArray = combinedArray'.
  interpreterProxy
  storePointer: 0
  ofObject: combinedArray
  withValue: statArray.
  interpreterProxy
  storePointer: 1
  ofObject: combinedArray
  withValue: accessArray.
  ].
 
  ^0!

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 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"
- self isDefinedTrueExpression: 'HAVE_LSTAT == 1'
- inSmalltalk: []
- comment: ''
- ifTrue: [
- 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()'].
- ]
- ifFalse: [].
  ^0
  !

Item was changed:
  ----- Method: FileAttributesPlugin>>pathOop:toBuffer:maxLen: (in category 'private - file') -----
  pathOop: pathNameOop toBuffer: cPathName maxLen: maxLen
  "Copy the supplied path name string object to the supplied c string buffer"
 
  | len sPtr |
  <var: 'cPathName' type: 'char *'>
+ <var: 'sPtr' type: 'char *'>
- <var: 'sPtr' declareC: 'char *sPtr'>
  <returnTypeC: 'int'>
 
  len := interpreterProxy stSizeOf: pathNameOop.
  (len >= maxLen) ifTrue: [^self stringTooLong].
  "Copy pathName to the new string"
  sPtr := interpreterProxy arrayValueOf: pathNameOop.
  ((self canStatFilePath: sPtr length: len) = 0) ifTrue: [^self cantStatPath].
+ self mem: cPathName cp: sPtr y: len.
- self cCode: 'memcpy(cPathName, sPtr, len)'.
  cPathName at: len put: 0.
  ^0.
  !

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 *)];}'>
- <var: 'ptr' declareC: 'unsigned char *ptr'>
- <var: 'addressUnion' declareC: 'union {void *address; unsigned char bytes[sizeof(void *)];} addressUnion'>
  ((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."
 
  | dirPointerOop dirStream result |
  <export: true>
+ <var: 'dirStream' type: 'osdir *'>
- <var: 'dirStream' declareC: 'osdir *dirStream'>
  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")'.
- [self cCode: 'fprintf(stderr, "primitiveClosedir: invalid argument, expected an ByteArray\n")'.
  ^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
  dirStream := self pointerFrom: 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 |
- | fileName attributeNumber resultOop fileNameOop cPathName statBuf statBufPointer sizeIfFile mode creationDate status |
  <export: true>
+ <var: 'statBuf' type: 'struct stat'>
- <var: 'statBuf' declareC: 'struct stat statBuf'>
- <var: 'statBufPointer' declareC: 'struct stat *statBufPointer= &statBuf'>
  <var: 'cPathName' declareC: 'char cPathName[PATH_MAX]'>
  <var: 'creationDate' type: 'time_t'>
 
  fileName := interpreterProxy stackObjectValue: 1.
  attributeNumber := interpreterProxy stackIntegerValue: 0.
  (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).
- intoBuffer: statBufPointer
- targetName: (self cCode: '&fileNameOop').
  (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 := (self smallOrLargeIntegerObjectFor:
  (self cCode: 'statBuf.st_mode'))].
  attributeNumber = 3 ifTrue:
  [resultOop := (interpreterProxy positive64BitIntegerFor:
  (self cCode: 'statBuf.st_ino'))].
  attributeNumber = 4 ifTrue:
  [resultOop := (interpreterProxy positive64BitIntegerFor:
  (self cCode: 'statBuf.st_dev'))].
  attributeNumber = 5 ifTrue:
  [resultOop := (interpreterProxy positive64BitIntegerFor:
  (self cCode: 'statBuf.st_nlink'))].
  attributeNumber = 6 ifTrue:
  [resultOop := (self smallOrLargeIntegerObjectFor:
  (self cCode: 'statBuf.st_uid'))].
  attributeNumber = 7 ifTrue:
  [resultOop := (self smallOrLargeIntegerObjectFor:
  (self cCode: 'statBuf.st_gid'))].
  attributeNumber = 8 ifTrue:
  [
  ((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: (self cCode: 'statBuf.st_atime')].
  attributeNumber = 10 ifTrue:
  [resultOop := self oopFromTimeT: (self cCode: 'statBuf.st_mtime')].
  attributeNumber = 11 ifTrue:
  [resultOop := self oopFromTimeT: (self cCode: 'statBuf.st_ctime')].
  ]
  ifFalse: [attributeNumber = 12  ifTrue:
  [
  status := self fileCreationTimeFor: cPathName
  length: cPathName strlen
+ to: (self addressOf: creationDate).
- to: (self cCode: '&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].
  ((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).
- status := self isSymlink: cPathName boolean: (self cCode: '&resultOop').
  (status ~= 0) ifTrue:
  [^interpreterProxy pop: 3; push: (self wrappedErrorCode: status)].
  ]]].
 
  (resultOop = 0)
  ifTrue: ["It shouldn't be possible to get here"
  ^ 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 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 pop: 3; push: (interpreterProxy signed32BitIntegerFor: status)].
 
+ status := self fileToAttributeArray: cPathName mask: attributeMask array: (self addressOf: attributeArray).
- status := self fileToAttributeArray: cPathName mask: attributeMask array: (self cCode: '&attributeArray').
  status ~= 0
  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 pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
+ status := self checkAccess: pathString mode: self fileOKFlag to: (self addressOf: accessFlag).
- status := self checkAccess: pathString mode: self fileOKFlag to: (self cCode: '&accessFlag').
  [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.
  interpreterProxy
  storePointer: 0
  ofObject: masks
  withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFMT')).
+ self cPreprocessorDirective: '#if !!defined(WIN32)'.
- self isDefinedTrueExpression: 'defined(WIN32)'
- inSmalltalk: []
- comment: 'windows doesn''t have SOCK or SYMLINK file types'
- ifTrue: []
- ifFalse: [
- interpreterProxy
- storePointer: 1
- ofObject: masks
- withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFSOCK')).
- interpreterProxy
- storePointer: 2
- ofObject: masks
- withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFLNK')).
- ].
  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: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFREG')).
  interpreterProxy
  storePointer: 4
  ofObject: masks
  withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFBLK')).
  interpreterProxy
  storePointer: 5
  ofObject: masks
  withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFDIR')).
  interpreterProxy
  storePointer: 6
  ofObject: masks
  withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFCHR')).
  interpreterProxy
  storePointer: 7
  ofObject: masks
  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 cPreprocessorDirective: '#if defined(WIN32)'.
+ mask := self cCode: 'GetLogicalDrives()'.
+ [mask ~= 0] ifTrue:
+ [^interpreterProxy pop: 1 thenPush: (interpreterProxy positive32BitIntegerFor: mask)].
+ self cPreprocessorDirective: '#endif'.
- self isDefinedTrueExpression: 'defined(WIN32)'
- inSmalltalk: []
- comment: 'Answer the logical drive mask on windows'
- ifTrue: [
- mask := self cCode: 'GetLogicalDrives()'.
- [mask ~= 0] ifTrue:
- [^interpreterProxy pop: 1 thenPush: (interpreterProxy positive32BitIntegerFor: mask)]
- ]
- ifFalse: [].
  ^interpreterProxy primitiveFail.!

Item was changed:
  ----- Method: FileAttributesPlugin>>primitiveOpendir (in category 'file primitives') -----
  primitiveOpendir
 
  "self primOpendir: '/etc'"
 
+ | dirName dir dirOop status dirOopArrayPointer |
- | dirName dir dirOop status |
  <export: true>
  <var: 'dir' type: 'osdir *'>
+ <var: 'dirOopArrayPointer' type: 'unsigned char *'>
- <var: 'dirOopArrayPointer' declareC: 'unsigned char *dirOopArrayPointer'>
  dirName := interpreterProxy stackObjectValue: 0.
  (interpreterProxy is: dirName KindOf: 'String') ifFalse:
  [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 := self openDirectoryStream: dirName ptr: (self cCode: '&dir').
  status ~= 0 ifTrue: [^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: status)].
  dirOop := self addressObjectFor: dir.
  interpreterProxy pop: 2; push: dirOop
  !

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
  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>
- <var: 'ent' declareC: 'struct dirent *ent'>
- <var: 'dirStream' declareC: 'osdir *dirStream'>
- <var: 'haveEntry' declareC: 'int haveEntry'>
 
  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 = nil) ifTrue: [^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
  haveEntry := 0.
  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;
  } 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 := self byteArrayFromCString: (self cCode: 'ent->d_name') to: (self cCode: '&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 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: (self cCode: 'dirStream->path') mask: 1 array: (self addressOf: attributeArray).
- status := self fileToAttributeArray: (self cCode: 'dirStream->path') mask: 1 array: (self cCode: '&attributeArray').
  "If the stat() fails, still return the filename, just no attributes"
  status ~= 0 ifTrue: [attributeArray := interpreterProxy nilObject].
 
  resultArray := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2.
  interpreterProxy
  storePointer: 0
  ofObject: resultArray
  withValue: entryName.
  interpreterProxy
  storePointer: 1
  ofObject: resultArray
  withValue: attributeArray.
 
  interpreterProxy pop: 2; push: resultArray
  !

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 cLinkPtr len status |
+ <returnTypeC: 'sqInt'>
- | result cLinkName cLinkPtr len status |
  <var: 'cPathName' type: 'char *'>
  <var: 'statBufPointer' type: 'struct stat *'>
  <var: 'cLinkName' declareC: 'char cLinkName[PATH_MAX]'>
+ <var: 'cLinkPtr' type: 'char *'>
- <var: 'cLinkPtr' declareC: 'char *cLinkPtr = (char *) &cLinkName'>
  <var: 'fileNameOop' type: 'sqInt *'>
 
+ 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
- self isDefinedTrueExpression: 'HAVE_LSTAT == 1'
- inSmalltalk: []
- comment: 'Platforms which do not have lstat() should #define HAVE_LSTAT 0'
- ifTrue: [
- result := self cCode: 'lstat(cPathName, statBufPointer)'.
- (result ~= 0) ifTrue: [^self cantStatPath].
- ((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.
- [status ~= 0] ifTrue: [^status]]
- ifTrue:
- [self cCode: '*fileNameOop = interpreterProxy->nilObject()'].
- ]
- ifFalse:
- [^self invalidRequest].
- ^0
  !

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 |
- | result status |
  <var: 'cPathName' type: 'char *'>
  <var: 'statBufPointer' type: 'struct stat *'>
  <var: 'fileNameOop' type: 'sqInt *'>
+ self cPreprocessorDirective: '#ifdef WIN32
- self cCode: '#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'.
- result :=self cCode: 'stat(cPathName, statBufPointer)'.
- (result ~= 0) ifTrue: [^self cantStatPath].
- self isDefinedTrueExpression: 'defined(WIN32)'
- inSmalltalk: []
- comment: 'The windows version of stat() looks like it doesn''t handle dst properly.  Adjust for DST.  Remove this code if ever switching to cygwin stat().'
- ifTrue: [
- 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'.
- ].
- ]
- ifFalse: [].
  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: 'size_t'>
 
+ self cPreprocessorDirective: '#if defined(WIN32)'.
+ len := -1.
+ self cPreprocessorDirective: '#else'.
+ len := self cCode: 'readlink(cPathName, cLinkPtr, maxLength)'.
+ self cPreprocessorDirective: '#endif'.
- self isDefinedTrueExpression: 'defined(WIN32)'
- inSmalltalk: []
- comment: 'This should never be called on WIN32, just indicate failure'
- ifTrue: [len := -1]
- ifFalse: [len := self cCode: 'readlink(cPathName, cLinkPtr, maxLength)'].
  len < 0 ifTrue:
  [self cCode: 'fprintf(stderr, "FileAttributesPlugin: unable to readlink(): %d\n", len)'.
  ^self cantReadlink].
  cLinkPtr at: len put: 0.
  ^len.!

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

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"
 
  | index sizeIfFile creationDate status |
  <var: 'cPathName' type: 'char *'>
  <var: 'statBufPointer' type: 'struct stat *'>
  <var: 'creationDate' type: 'time_t'>
 
  ((self cCode: 'S_ISDIR(statBufPointer->st_mode)') = 0)
  ifTrue:
  [sizeIfFile := self cCode: 'statBufPointer->st_size']
  ifFalse:
  [sizeIfFile := 0].
 
  index := 0.
  interpreterProxy
  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').
- self isDefinedTrueExpression: 'defined(WIN32)'
- inSmalltalk: []
- comment: 'windows supports creation date'
- ifTrue:
- [
- 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: (interpreterProxy nilObject).
+ self cPreprocessorDirective: '#endif'.
- ]
- ]
- ifFalse:
- [
- interpreterProxy
- storePointer: index
- ofObject: attributeArray
- withValue: (interpreterProxy nilObject).
- ].
-
  ^0!