Esteban Lorenzano uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-oscog-EstebanLorenzano.164.mcz
==================== Summary ====================
Name: VMMaker-oscog-EstebanLorenzano.164 Author: EstebanLorenzano Time: 25 September 2012, 9:20:45.153 am UUID: d77dee73-00f5-4d00-847b-00646b08329d Ancestors: VMMaker-oscog-IgorStasenko.163
- added file plugin permissions and link support
=============== Diff against VMMaker-oscog-IgorStasenko.163 ===============
Item was added: + ----- Method: CogVMSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') ----- + makeDirEntryName: entryName + size: entryNameSize + createDate: createDate + modDate: modifiedDate + isDir: dirFlag + fileSize: posixPermissions + posixPermissions: fileSize + isSymlink: symlinkFlag + + | modDateOop createDateOop nameString results | + <var: 'entryName' type: 'char *'> + + results := objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 6. + nameString := objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: entryNameSize. + createDateOop := self positive32BitIntegerFor: createDate. + modDateOop := self positive32BitIntegerFor: modifiedDate. + + 1 to: entryNameSize do: + [ :i | + objectMemory storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue]. + + objectMemory storePointerUnchecked: 0 ofObject: results withValue: nameString. + objectMemory storePointerUnchecked: 1 ofObject: results withValue: createDateOop. + objectMemory storePointerUnchecked: 2 ofObject: results withValue: modDateOop. + dirFlag + ifTrue: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory trueObject ] + ifFalse: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory falseObject ]. + objectMemory storePointerUnchecked: 4 ofObject: results withValue: (objectMemory integerObjectOf: fileSize). + objectMemory storePointerUnchecked: 5 ofObject: results withValue: (objectMemory integerObjectOf: posixPermissions). + symlinkFlag + ifTrue: [ objectMemory storePointerUnchecked: 6 ofObject: results withValue: objectMemory trueObject ] + ifFalse: [ objectMemory storePointerUnchecked: 6 ofObject: results withValue: objectMemory falseObject ]. + ^ results!
Item was changed: ----- Method: CogVMSimulator>>primitiveDirectoryEntry (in category 'file primitives') ----- primitiveDirectoryEntry | name pathName array result | name := self stringOf: self stackTop. pathName := self stringOf: (self stackValue: 1). self successful ifFalse: [^self primitiveFail].
array := FileDirectory default primLookupEntryIn: pathName name: name. array == nil ifTrue: [self pop: 3 thenPush: objectMemory nilObject. ^array]. array == #badDirectoryPath ifTrue: [self halt. ^self primitiveFail].
result := self makeDirEntryName: (array at: 1) size: (array at: 1) size createDate: (array at: 2) modDate: (array at: 3) isDir: (array at: 4) fileSize: (array at: 5) + posixPermissions: (array at: 6) + isSymlink: (array at: 7). - posixPermissions: (array at: 6). self pop: 3. self push: result!
Item was changed: ----- Method: CogVMSimulator>>primitiveDirectoryLookup (in category 'file primitives') ----- primitiveDirectoryLookup | index pathName array result | index := self stackIntegerValue: 0. pathName := (self stringOf: (self stackValue: 1)). self successful ifFalse: [^self primitiveFail].
array := FileDirectory default primLookupEntryIn: pathName index: index.
array == nil ifTrue: [self pop: 3 thenPush: objectMemory nilObject. ^array]. array == #badDirectoryPath ifTrue: ["self halt." ^self primitiveFail].
result := self makeDirEntryName: (array at: 1) size: (array at: 1) size createDate: (array at: 2) modDate: (array at: 3) isDir: (array at: 4) fileSize: (array at: 5) + posixPermissions: (array at: 6) + isSymlink: (array at: 7). - posixPermissions: (array at: 6). self pop: 3 thenPush: result!
Item was added: + ----- Method: FilePlugin>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') ----- + makeDirEntryName: entryName + size: entryNameSize + createDate: createDate + modDate: modifiedDate + isDir: dirFlag + fileSize: fileSize + posixPermissions: posixPermissions + isSymlink: symlinkFlag + + | modDateOop createDateOop nameString results stringPtr posixPermissionsOop fileSizeOop | + <var: 'entryName' type: 'char *'> + <var: 'stringPtr' type: 'char *'> + <var: 'fileSize' type: 'squeakFileOffsetType '> + + "allocate storage for results, remapping newly allocated + oops in case GC happens during allocation" + interpreterProxy pushRemappableOop: + (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 7). + interpreterProxy pushRemappableOop: + (interpreterProxy instantiateClass: (interpreterProxy classString) indexableSize: entryNameSize). + interpreterProxy pushRemappableOop: + (interpreterProxy positive32BitIntegerFor: createDate). + interpreterProxy pushRemappableOop: + (interpreterProxy positive32BitIntegerFor: modifiedDate). + interpreterProxy pushRemappableOop: + (interpreterProxy positive64BitIntegerFor: fileSize). + interpreterProxy pushRemappableOop: + (interpreterProxy positive32BitIntegerFor: posixPermissions). + + posixPermissionsOop := interpreterProxy popRemappableOop. + fileSizeOop := interpreterProxy popRemappableOop. + modDateOop := interpreterProxy popRemappableOop. + createDateOop := interpreterProxy popRemappableOop. + nameString := interpreterProxy popRemappableOop. + results := interpreterProxy popRemappableOop. + + "copy name into Smalltalk string" + stringPtr := interpreterProxy firstIndexableField: nameString. + 0 to: entryNameSize - 1 do: [ :i | + stringPtr at: i put: (entryName at: i). + ]. + + interpreterProxy storePointer: 0 ofObject: results withValue: nameString. + interpreterProxy storePointer: 1 ofObject: results withValue: createDateOop. + interpreterProxy storePointer: 2 ofObject: results withValue: modDateOop. + dirFlag + ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ] + ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ]. + interpreterProxy storePointer: 4 ofObject: results withValue: fileSizeOop. + interpreterProxy storePointer: 5 ofObject: results withValue: posixPermissionsOop. + symlinkFlag + ifTrue: [ interpreterProxy storePointer: 6 ofObject: results withValue: interpreterProxy trueObject ] + ifFalse: [ interpreterProxy storePointer: 6 ofObject: results withValue: interpreterProxy falseObject ]. + ^ results!
Item was changed: ----- Method: FilePlugin>>primitiveDirectoryEntry (in category 'directory primitives') ----- primitiveDirectoryEntry
"Two arguments - directory path, and simple file name; returns an array (see primitiveDirectoryLookup) describing the file or directory, or nil if it does not exist. Primitive fails if the outer path does not identify a readable directory. (This is a lookup-by-name variant of primitiveDirectoryLookup.)"
+ | requestedName pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag posixPermissions symlinkFlag fileSize okToList reqNameIndex reqNameSize | - | requestedName pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag posixPermissions fileSize okToList reqNameIndex reqNameSize | <var: 'entryName' declareC: 'char entryName[256]'> <var: 'pathNameIndex' type: 'char *'> <var: 'reqNameIndex' type: 'char *'> <var: 'fileSize' type: 'squeakFileOffsetType'> <export: true>
requestedName := interpreterProxy stackValue: 0. pathName := interpreterProxy stackValue: 1. (interpreterProxy isBytes: pathName) ifFalse: [^interpreterProxy primitiveFail].
"Outbound string parameters" pathNameIndex := interpreterProxy firstIndexableField: pathName. pathNameSize := interpreterProxy byteSizeOf: pathName.
reqNameIndex := interpreterProxy firstIndexableField: requestedName. reqNameSize := interpreterProxy byteSizeOf: requestedName.
"If the security plugin can be loaded, use it to check for permission. If not, assume it's ok" sCLPfn ~= 0 ifTrue: [okToList := self cCode: '((sqInt (*)(char *, sqInt))sCLPfn)(pathNameIndex, pathNameSize)'] ifFalse: [okToList := true]. okToList ifTrue: [status := self cCode: 'dir_EntryLookup( pathNameIndex, pathNameSize, reqNameIndex, reqNameSize, entryName, &entryNameSize, &createDate, &modifiedDate, &dirFlag, &fileSize, + &posixPermissions, + &symlinkFlag)'] - &posixPermissions)'] ifFalse: [status := DirNoMoreEntries].
interpreterProxy failed ifTrue: [^nil]. status = DirNoMoreEntries ifTrue: ["no entry; return nil" interpreterProxy pop: 3 "pop pathName, index, rcvr" thenPush: interpreterProxy nilObject. ^nil]. status = DirBadPath ifTrue: [^interpreterProxy primitiveFail]."bad path"
interpreterProxy pop: 3 "pop pathName, fName, rcvr" thenPush: (self makeDirEntryName: entryName size: entryNameSize createDate: createDate modDate: modifiedDate isDir: dirFlag fileSize: fileSize + posixPermissions: posixPermissions + isSymlink: symlinkFlag)! - posixPermissions: posixPermissions)!
Item was changed: ----- Method: FilePlugin>>primitiveDirectoryLookup (in category 'directory primitives') ----- primitiveDirectoryLookup
+ | index pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag symlinkFlag posixPermissions fileSize okToList | - | index pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag posixPermissions fileSize okToList | <var: 'entryName' declareC: 'char entryName[256]'> <var: 'pathNameIndex' type: 'char *'> <var: 'fileSize' type: 'squeakFileOffsetType'> <export: true>
index := interpreterProxy stackIntegerValue: 0. pathName := interpreterProxy stackValue: 1. (interpreterProxy isBytes: pathName) ifFalse: [^interpreterProxy primitiveFail]. pathNameIndex := interpreterProxy firstIndexableField: pathName. pathNameSize := interpreterProxy byteSizeOf: pathName. "If the security plugin can be loaded, use it to check for permission. If not, assume it's ok" sCLPfn ~= 0 ifTrue: [okToList := self cCode: '((sqInt (*)(char *, sqInt))sCLPfn)(pathNameIndex, pathNameSize)'] ifFalse: [okToList := true]. okToList ifTrue: [status := self cCode: 'dir_Lookup( pathNameIndex, pathNameSize, index, entryName, &entryNameSize, &createDate, &modifiedDate, &dirFlag, &fileSize, + &posixPermissions, + &symlinkFlag)'] - &posixPermissions)'] ifFalse: [status := DirNoMoreEntries]. interpreterProxy failed ifTrue: [^nil]. status = DirNoMoreEntries ifTrue: ["no more entries; return nil" interpreterProxy pop: 3 "pop pathName, index, rcvr" thenPush: interpreterProxy nilObject. ^nil]. status = DirBadPath ifTrue: [^interpreterProxy primitiveFail]."bad path"
interpreterProxy pop: 3 "pop pathName, index, rcvr" thenPush: (self makeDirEntryName: entryName size: entryNameSize createDate: createDate modDate: modifiedDate isDir: dirFlag fileSize: fileSize + posixPermissions: posixPermissions + isSymlink: symlinkFlag)! - posixPermissions: posixPermissions)!
Item was added: + ----- Method: FilePluginSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') ----- + makeDirEntryName: entryName + size: entryNameSize + createDate: createDate + modDate: modifiedDate + isDir: dirFlag + fileSize: fileSize + posixPermissions: posixPermissions + isSymlink: symlinkFlag + + ^interpreterProxy + makeDirEntryName: entryName + size: entryNameSize + createDate: createDate + modDate: modifiedDate + isDir: dirFlag + fileSize: fileSize + posixPermissions: posixPermissions + isSymlink: symlinkFlag + !
Item was added: + ----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') ----- + makeDirEntryName: entryName + size: entryNameSize + createDate: createDate + modDate: modifiedDate + isDir: dirFlag + fileSize: posixPermissions + posixPermissions: fileSize + isSymlink: symlinkFlag + + | modDateOop createDateOop nameString results | + <var: 'entryName' type: 'char *'> + + "allocate storage for results, remapping newly allocated + oops in case GC happens during allocation" + self pushRemappableOop: + (self instantiateClass: (self splObj: ClassArray) indexableSize: 6). + self pushRemappableOop: + (self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize).. + self pushRemappableOop: (self positive32BitIntegerFor: createDate). + self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate). + + modDateOop := self popRemappableOop. + createDateOop := self popRemappableOop. + nameString := self popRemappableOop. + results := self popRemappableOop. + + 1 to: entryNameSize do: [ :i | + self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue. + ]. + + self storePointer: 0 ofObject: results withValue: nameString. + self storePointer: 1 ofObject: results withValue: createDateOop. + self storePointer: 2 ofObject: results withValue: modDateOop. + dirFlag + ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ] + ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ]. + self storePointer: 4 + ofObject: results + withValue: (self integerObjectOf: fileSize). + self storePointer: 5 + ofObject: results + withValue: (self integerObjectOf: posixPermissions). + dirFlag + ifTrue: [ self storePointer: 6 ofObject: results withValue: trueObj ] + ifFalse: [ self storePointer: 6 ofObject: results withValue: falseObj ]. + + ^ results + !
Item was changed: ----- Method: InterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') ----- primitiveDirectoryEntry | name pathName array result | name := self stringOf: self stackTop. pathName := self stringOf: (self stackValue: 1). successFlag ifFalse: [^self primitiveFail].
array := FileDirectory default primLookupEntryIn: pathName name: name. array == nil ifTrue: [self pop: 3 thenPush: nilObj. ^array]. array == #badDirectoryPath ifTrue: [self halt. ^self primitiveFail].
result := self makeDirEntryName: (array at: 1) size: (array at: 1) size createDate: (array at: 2) modDate: (array at: 3) isDir: (array at: 4) fileSize: (array at: 5) + posixPermissions: (array at: 6) + isSymlink: (array at: 7). - posixPermissions: (array at: 6). self pop: 3. self push: result!
Item was changed: ----- Method: InterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') ----- primitiveDirectoryLookup | index pathName array result | index := self stackIntegerValue: 0. pathName := (self stringOf: (self stackValue: 1)). successFlag ifFalse: [ ^self primitiveFail. ].
array := FileDirectory default primLookupEntryIn: pathName index: index.
array == nil ifTrue: [ self pop: 3. self push: nilObj. ^array. ]. array == #badDirectoryPath ifTrue: [self halt. ^self primitiveFail. ].
result := self makeDirEntryName: (array at: 1) size: (array at: 1) size createDate: (array at: 2) modDate: (array at: 3) isDir: (array at: 4) fileSize: (array at: 5) + posixPermissions: (array at: 6) + isSymlink: (array at: 7). - posixPermissions: (array at: 6). self pop: 3. self push: result. !
Item was added: + ----- Method: NewspeakInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') ----- + makeDirEntryName: entryName + size: entryNameSize + createDate: createDate + modDate: modifiedDate + isDir: dirFlag + fileSize: posixPermissions + posixPermissions: fileSize + isSymlink: symlinkFlag + + | modDateOop createDateOop nameString results | + <var: 'entryName' type: 'char *'> + + "allocate storage for results, remapping newly allocated + oops in case GC happens during allocation" + self pushRemappableOop: + (self instantiateClass: (self splObj: ClassArray) indexableSize: 6). + self pushRemappableOop: + (self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize). + self pushRemappableOop: (self positive32BitIntegerFor: createDate). + self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate). + + modDateOop := self popRemappableOop. + createDateOop := self popRemappableOop. + nameString := self popRemappableOop. + results := self popRemappableOop. + + 1 to: entryNameSize do: [ :i | + self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue. + ]. + + self storePointer: 0 ofObject: results withValue: nameString. + self storePointer: 1 ofObject: results withValue: createDateOop. + self storePointer: 2 ofObject: results withValue: modDateOop. + dirFlag + ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ] + ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ]. + self storePointer: 4 ofObject: results + withValue: (self integerObjectOf: fileSize). + self storePointer: 5 ofObject: results + withValue: (self integerObjectOf: posixPermissions). + symlinkFlag + ifTrue: [ self storePointer: 6 ofObject: results withValue: trueObj ] + ifFalse: [ self storePointer: 6 ofObject: results withValue: falseObj ]. + + ^ results + !
Item was changed: ----- Method: NewspeakInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') ----- primitiveDirectoryEntry | name pathName array result | name := self stringOf: self stackTop. pathName := self stringOf: (self stackValue: 1). self successful ifFalse: [^self primitiveFail].
array := FileDirectory default primLookupEntryIn: pathName name: name. array == nil ifTrue: [self pop: 3 thenPush: nilObj. ^array]. array == #badDirectoryPath ifTrue: [self halt. ^self primitiveFail].
result := self makeDirEntryName: (array at: 1) size: (array at: 1) size createDate: (array at: 2) modDate: (array at: 3) isDir: (array at: 4) fileSize: (array at: 5) + posixPermissions: (array at: 6) + isSymlink: (array at: 7). - posixPermissions: (array at: 6). self pop: 3. self push: result!
Item was changed: ----- Method: NewspeakInterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') ----- primitiveDirectoryLookup | index pathName array result | index := self stackIntegerValue: 0. pathName := (self stringOf: (self stackValue: 1)). self successful ifFalse: [ ^self primitiveFail. ].
array := FileDirectory default primLookupEntryIn: pathName index: index.
array == nil ifTrue: [ self pop: 3. self push: nilObj. ^array. ]. array == #badDirectoryPath ifTrue: [self halt. ^self primitiveFail. ].
result := self makeDirEntryName: (array at: 1) size: (array at: 1) size createDate: (array at: 2) modDate: (array at: 3) isDir: (array at: 4) fileSize: (array at: 5) + posixPermissions: (array at: 6) + isSymlink: (array at: 7). - posixPermissions: (array at: 6). self pop: 3. self push: result. !
Item was added: + ----- Method: StackInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') ----- + makeDirEntryName: entryName + size: entryNameSize + createDate: createDate + modDate: modifiedDate + isDir: dirFlag + fileSize: posixPermissions + posixPermissions: fileSize + isSymlink: symlinkFlag + + | modDateOop createDateOop nameString results | + <var: 'entryName' type: 'char *'> + + results := objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 6. + nameString := objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: entryNameSize. + createDateOop := self positive32BitIntegerFor: createDate. + modDateOop := self positive32BitIntegerFor: modifiedDate. + + 1 to: entryNameSize do: + [ :i | + objectMemory storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue]. + + objectMemory storePointerUnchecked: 0 ofObject: results withValue: nameString. + objectMemory storePointerUnchecked: 1 ofObject: results withValue: createDateOop. + objectMemory storePointerUnchecked: 2 ofObject: results withValue: modDateOop. + dirFlag + ifTrue: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory trueObject ] + ifFalse: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory falseObject ]. + objectMemory storePointerUnchecked: 4 ofObject: results withValue: (objectMemory integerObjectOf: fileSize). + objectMemory storePointerUnchecked: 5 ofObject: results withValue: (objectMemory integerObjectOf: posixPermissions). + symlinkFlag + ifTrue: [ objectMemory storePointerUnchecked: 6 ofObject: results withValue: objectMemory trueObject ] + ifFalse: [ objectMemory storePointerUnchecked: 6 ofObject: results withValue: objectMemory falseObject ]. + + ^ results!
Item was changed: ----- Method: StackInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') ----- primitiveDirectoryEntry | name pathName array result | name := self stringOf: self stackTop. pathName := self stringOf: (self stackValue: 1). self successful ifFalse: [^self primitiveFail].
array := FileDirectory default primLookupEntryIn: pathName name: name. array == nil ifTrue: [self pop: 3 thenPush: objectMemory nilObject. ^array]. array == #badDirectoryPath ifTrue: [self halt. ^self primitiveFail].
result := self makeDirEntryName: (array at: 1) size: (array at: 1) size createDate: (array at: 2) modDate: (array at: 3) isDir: (array at: 4) fileSize: (array at: 5) + posixPermissions: (array at: 6) + isSymlink: (array at: 7). - posixPermissions: (array at: 6). self pop: 3. self push: result!
Item was changed: ----- Method: StackInterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') ----- primitiveDirectoryLookup | index pathName array result | index := self stackIntegerValue: 0. pathName := (self stringOf: (self stackValue: 1)). self successful ifFalse: [^self primitiveFail].
array := FileDirectory default primLookupEntryIn: pathName index: index.
array == nil ifTrue: [self pop: 3 thenPush: objectMemory nilObject. ^array]. array == #badDirectoryPath ifTrue: ["self halt." ^self primitiveFail].
result := self makeDirEntryName: (array at: 1) size: (array at: 1) size createDate: (array at: 2) modDate: (array at: 3) isDir: (array at: 4) fileSize: (array at: 5) + posixPermissions: (array at: 6) + isSymlink: (array at: 7). - posixPermissions: (array at: 6). self pop: 3 thenPush: result!
vm-dev@lists.squeakfoundation.org