Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2935.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2935 Author: eem Time: 15 January 2021, 6:58:00.402875 pm UUID: 51b2c0b0-0b96-402b-8823-e578d4b939c4 Ancestors: VMMaker.oscog-eem.2934 OCD (and not so OCD) cleanup of the FilePlugin. Simulate primitiveFileDescriptorType. =============== Diff against VMMaker.oscog-eem.2934 =============== Item was changed: ----- Method: FilePlugin>>connectToFd:write: (in category 'private') ----- connectToFd: fd write: writeFlag "Connect to the supplied file descriptor. Answer the file oop. On POSIX platforms this translates to fdopen(). writeFlag must be compatible with the existing file access." | file fileOop | - <var: 'file' type: #'SQFile *'> <var: 'fd' type: #int> fileOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self fileRecordSize. file := self fileValueOf: fileOop. interpreterProxy failed ifFalse: [self sqConnect: file ToFile: fd Descriptor: writeFlag]. ^fileOop! Item was changed: ----- Method: FilePlugin>>connectToFile:write: (in category 'private') ----- connectToFile: cfile write: writeFlag "Open the FILE* as file. Answer the file oop. writeFlag must be compatible with the existing file access." | file fileOop | - <var: 'file' type: #'SQFile *'> <var: 'cfile' type: #'void *'> fileOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self fileRecordSize. file := self fileValueOf: fileOop. interpreterProxy failed ifFalse: [self sqConnect: file To: cfile File: writeFlag]. ^fileOop! Item was changed: ----- Method: FilePlugin>>fileOpenName:size:write:secure: (in category 'file primitives') ----- fileOpenName: nameIndex size: nameSize write: writeFlag secure: secureFlag "Open the named file, possibly checking security. Answer the file oop." | file fileOop okToOpen | + <var: 'nameIndex' type: #'char *'> - <var: #file type: 'SQFile *'> - <var: 'nameIndex' type: 'char *'> <export: true> fileOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self fileRecordSize. file := self fileValueOf: fileOop. + interpreterProxy failed ifFalse: + [secureFlag ifTrue: + "If the security plugin can be loaded, use it to check for permission. + If not, assume it's ok" + [sCOFfn ~= 0 ifTrue: + [okToOpen := self cCode: '((sqInt (*) (char *, sqInt, sqInt)) sCOFfn)(nameIndex, nameSize, writeFlag)'. + okToOpen ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrOperationFailed]]]. + self sqFileOpen: file _: nameIndex _: nameSize _: writeFlag]. + ^fileOop! - interpreterProxy failed - ifFalse: [ secureFlag ifTrue: [ - "If the security plugin can be loaded, use it to check for permission. - If not, assume it's ok" - sCOFfn ~= 0 - ifTrue: [okToOpen := self cCode: '((sqInt (*) (char *, sqInt, sqInt)) sCOFfn)(nameIndex, nameSize, writeFlag)' inSmalltalk:[true]. - okToOpen - ifFalse: [interpreterProxy primitiveFail]]]]. - interpreterProxy failed - ifFalse: [self cCode: 'sqFileOpen(file, nameIndex, nameSize, writeFlag)' inSmalltalk: [file]]. - ^ fileOop! Item was changed: ----- Method: FilePlugin>>fileOpenNewName:size:secure: (in category 'file primitives') ----- fileOpenNewName: nameIndex size: nameSize secure: secureFlag "Open the new named file, possibly checking security. Answer the file oop." + | file fileOop okToOpen exists | + <var: 'nameIndex' type: #'char *'> - | file fileOop okToOpen | - <var: #file type: 'SQFile *'> - <var: 'nameIndex' type: 'char *'> <export: true> fileOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self fileRecordSize. file := self fileValueOf: fileOop. + interpreterProxy failed ifFalse: + [secureFlag ifTrue: + "If the security plugin can be loaded, use it to check for permission. + If not, assume it's ok" + [sCOFfn ~= 0 ifTrue: + [okToOpen := self cCode: '((sqInt (*) (char *, sqInt, sqInt)) sCOFfn)(nameIndex, nameSize, true)'. + okToOpen ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrOperationFailed]]]. + exists := false. + self sqFileOpenNew: file _: nameIndex _: nameSize _: (self addressOf: exists). + (interpreterProxy failed or: [exists]) ifTrue: "worry not; it is sqFileOpenNew's responsibility to close the file if it exists" + [interpreterProxy primitiveFailFor: PrimErrInappropriate]]. + ^fileOop! - interpreterProxy failed - ifFalse: [ secureFlag ifTrue: [ - "If the security plugin can be loaded, use it to check for permission. - If not, assume it's ok" - sCOFfn ~= 0 - ifTrue: [ - okToOpen := self cCode: '((sqInt (*) (char *, sqInt, sqInt)) sCOFfn)(nameIndex, nameSize, true)' inSmalltalk:[true]. - okToOpen - ifFalse: [interpreterProxy primitiveFail]]]]. - interpreterProxy failed - ifFalse: [| exists | - exists := false. - self cCode: 'sqFileOpenNew(file, nameIndex, nameSize, &exists)' inSmalltalk: [file]. - (interpreterProxy failed - and: [exists]) - ifTrue: [interpreterProxy primitiveFailFor: PrimErrInappropriate]]. - ^ fileOop! Item was changed: ----- Method: FilePlugin>>fileValueOf: (in category 'file primitives') ----- fileValueOf: objectPointer "Return a pointer to the first byte of of the file record within the given Smalltalk object, or nil if objectPointer is not a file record." <returnTypeC: #'SQFile *'> <static: false> + (((interpreterProxy isBytes: objectPointer) + and: [(interpreterProxy byteSizeOf: objectPointer) = self fileRecordSize])) ifFalse: + [interpreterProxy primitiveFailFor: PrimErrBadArgument. ^nil]. - (((interpreterProxy isBytes: objectPointer) and: - [(interpreterProxy byteSizeOf: objectPointer) = self fileRecordSize])) - ifFalse:[interpreterProxy primitiveFail. ^nil]. ^interpreterProxy firstIndexableField: objectPointer! Item was changed: ----- Method: FilePlugin>>pointerFrom: (in category 'private') ----- pointerFrom: pointerByteArray "Answer the machine address contained in anExternalAddressOop." + <inline: #always> + | ptr | + <var: 'ptr' type: #'void **'> + ((interpreterProxy isBytes: pointerByteArray) + and: [(interpreterProxy stSizeOf: pointerByteArray) = (self sizeof: #'void *')]) ifFalse: + [interpreterProxy primitiveFailFor: PrimErrBadArgument. + ^nil]. + ptr := interpreterProxy firstIndexableField: pointerByteArray. + ^ptr at: 0! - - | ptr addressUnion idx | - <returnTypeC: #'void *'> - <var: 'ptr' type: #'unsigned char *'> - <var: 'addressUnion' type: #'union {void *address; unsigned char bytes[sizeof(void *)];}'> - ((interpreterProxy is: pointerByteArray KindOf: 'ByteArray') and: - [(interpreterProxy stSizeOf: pointerByteArray) = self sizeOfPointer]) - ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. - ptr := interpreterProxy arrayValueOf: pointerByteArray. - interpreterProxy failed ifTrue: [^nil]. - 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: FilePlugin>>primitiveConnectToFileDescriptor (in category 'file primitives') ----- primitiveConnectToFileDescriptor "Connect to the existing file identified by fileDescriptor. fileDescriptor must be an integer. writeFlag is aboolean indicating whether to open in read or write mode and must be compatible with the existing file access." + | writeFlag fdPointer filePointer | - | writeFlag fdPointer fd filePointer | - <var: 'fd' type: #int> <export: true> writeFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0). fdPointer := interpreterProxy stackValue: 1. + (interpreterProxy failed not + and: [interpreterProxy isIntegerObject: fdPointer]) ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + filePointer := self connectToFd: (interpreterProxy integerValueOf: fdPointer) write: writeFlag. - (interpreterProxy isIntegerObject: fdPointer) - ifFalse: [^ interpreterProxy primitiveFailFor: PrimErrBadArgument]. - fd := interpreterProxy integerValueOf: fdPointer. - interpreterProxy failed ifTrue: [ - "Ensure that the appropriate failure code has been set" - ^interpreterProxy primitiveFailFor: PrimErrBadArgument]. - filePointer := self connectToFd: fd write: writeFlag. interpreterProxy failed ifFalse: [interpreterProxy methodReturnValue: filePointer]! Item was changed: ----- Method: FilePlugin>>primitiveDirectoryDelete (in category 'directory primitives') ----- primitiveDirectoryDelete | dirName dirNameIndex dirNameSize okToDelete | + <var: #dirNameIndex type: #'char *'> - <var: #dirNameIndex type: 'char *'> <export: true> dirName := interpreterProxy stackValue: 0. (interpreterProxy isBytes: dirName) ifFalse: [^interpreterProxy primitiveFail]. dirNameIndex := interpreterProxy firstIndexableField: dirName. dirNameSize := interpreterProxy byteSizeOf: dirName. "If the security plugin can be loaded, use it to check for permission. If not, assume it's ok" sCDPfn ~= 0 ifTrue: [okToDelete := self cCode: ' ((sqInt (*)(char *, sqInt))sCDPfn)(dirNameIndex, dirNameSize)' inSmalltalk: [false]. okToDelete ifFalse: [^interpreterProxy primitiveFail]]. (self cCode: 'dir_Delete(dirNameIndex, dirNameSize)' inSmalltalk: [false]) ifFalse: [^interpreterProxy primitiveFail]. interpreterProxy pop: 1! 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 | <var: 'entryName' declareC: 'char entryName[256]'> + <var: 'pathNameIndex' type: #'char *'> + <var: 'reqNameIndex' type: #'char *'> + <var: 'fileSize' type: #squeakFileOffsetType> - <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. self cCode: '' inSmalltalk: [entryName := ByteString new: 256. entryNameSize := createDate := modifiedDate := dirFlag := fileSize := posixPermissions := symlinkFlag := nil]. "If the security plugin can be loaded, use it to check for permission. If not, assume it's ok" okToList := sCLPfn ~= 0 ifTrue: [self cCode: '((sqInt (*)(char *, sqInt))sCLPfn)(pathNameIndex, pathNameSize)' inSmalltalk: [true]] ifFalse: [true]. status := okToList ifTrue: [self dir_EntryLookup: pathNameIndex _: pathNameSize _: reqNameIndex _: reqNameSize _: entryName _: (self addressOf: entryNameSize put: [:v| entryNameSize := v]) _: (self addressOf: createDate put: [:v| createDate := v]) _: (self addressOf: modifiedDate put: [:v| modifiedDate := v]) _: (self addressOf: dirFlag put: [:v| dirFlag := v]) _: (self addressOf: fileSize put: [:v| fileSize := v]) _: (self addressOf: posixPermissions put: [:v| posixPermissions := v]) _: (self addressOf: symlinkFlag put: [:v| symlinkFlag := v])] ifFalse: [DirNoMoreEntries]. interpreterProxy failed ifTrue: [^nil]. status = DirNoMoreEntries ifTrue: "no entry; return nil" [interpreterProxy "pop pathName, index, rcvr" pop: 3 thenPush: interpreterProxy nilObject. ^nil]. status = DirBadPath ifTrue: [^interpreterProxy primitiveFail]."bad path" interpreterProxy pop: 3 "pop pathName, index, rcvr" thenPush: (self cppIf: PharoVM ifTrue: [self makeDirEntryName: entryName size: entryNameSize createDate: createDate modDate: modifiedDate isDir: dirFlag fileSize: fileSize posixPermissions: posixPermissions isSymlink: symlinkFlag] ifFalse: [self makeDirEntryName: entryName size: entryNameSize createDate: createDate modDate: modifiedDate isDir: dirFlag fileSize: fileSize])! Item was changed: ----- Method: FilePlugin>>primitiveDirectoryGetMacTypeAndCreator (in category 'directory primitives') ----- primitiveDirectoryGetMacTypeAndCreator | creatorString typeString fileName creatorStringIndex typeStringIndex fileNameIndex fileNameSize okToGet | + <var: 'creatorStringIndex' type: #'char *'> + <var: 'typeStringIndex' type: #'char *'> + <var: 'fileNameIndex' type: #'char *'> - <var: 'creatorStringIndex' type: 'char *'> - <var: 'typeStringIndex' type: 'char *'> - <var: 'fileNameIndex' type: 'char *'> <export: true> creatorString := interpreterProxy stackValue: 0. typeString := interpreterProxy stackValue: 1. fileName := interpreterProxy stackValue: 2. ((interpreterProxy isBytes: creatorString) and: [(interpreterProxy byteSizeOf: creatorString) = 4]) ifFalse: [^interpreterProxy primitiveFail]. ((interpreterProxy isBytes: typeString) and: [(interpreterProxy byteSizeOf: typeString) = 4]) ifFalse: [^interpreterProxy primitiveFail]. (interpreterProxy isBytes: fileName) ifFalse: [^interpreterProxy primitiveFail]. creatorStringIndex := interpreterProxy firstIndexableField: creatorString. typeStringIndex := interpreterProxy firstIndexableField: typeString. fileNameIndex := interpreterProxy firstIndexableField: fileName. fileNameSize := interpreterProxy byteSizeOf: fileName. "If the security plugin can be loaded, use it to check for permission. If not, assume it's ok" sCGFTfn ~= 0 ifTrue: [okToGet := self cCode: ' ((sqInt (*)(char *, sqInt))sCGFTfn)(fileNameIndex, fileNameSize)'. okToGet ifFalse: [^interpreterProxy primitiveFail]]. (self cCode: 'dir_GetMacFileTypeAndCreator(fileNameIndex, fileNameSize, typeStringIndex, creatorStringIndex)' inSmalltalk: [true]) ifFalse: [^interpreterProxy primitiveFail]. interpreterProxy pop: 3! 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 | <var: 'entryName' declareC: 'char entryName[256]'> + <var: 'pathNameIndex' type: #'char *'> + <var: 'fileSize' type: #squeakFileOffsetType> - <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. self cCode: '' inSmalltalk: [entryName := ByteString new: 256. entryNameSize := createDate := modifiedDate := dirFlag := fileSize := posixPermissions := symlinkFlag := nil]. "If the security plugin can be loaded, use it to check for permission. If not, assume it's ok" okToList := sCLPfn ~= 0 ifTrue: [self cCode: '((sqInt (*)(char *, sqInt))sCLPfn)(pathNameIndex, pathNameSize)' inSmalltalk: [true]] ifFalse: [true]. status := okToList ifTrue: [self dir_Lookup: pathNameIndex _: pathNameSize _: index _: entryName _: (self addressOf: entryNameSize put: [:v| entryNameSize := v]) _: (self addressOf: createDate put: [:v| createDate := v]) _: (self addressOf: modifiedDate put: [:v| modifiedDate := v]) _: (self addressOf: dirFlag put: [:v| dirFlag := v]) _: (self addressOf: fileSize put: [:v| fileSize := v]) _: (self addressOf: posixPermissions put: [:v| posixPermissions := v]) _: (self addressOf: symlinkFlag put: [:v| symlinkFlag := v])] ifFalse: [DirNoMoreEntries]. interpreterProxy failed ifTrue: [^nil]. status = DirNoMoreEntries ifTrue: "no more entries; return nil" [interpreterProxy "pop pathName, index, rcvr" pop: 3 thenPush: interpreterProxy nilObject. ^nil]. status = DirBadPath ifTrue: [^interpreterProxy primitiveFail]."bad path" interpreterProxy pop: 3 "pop pathName, index, rcvr" thenPush: (self cppIf: PharoVM ifTrue: [self makeDirEntryName: entryName size: entryNameSize createDate: createDate modDate: modifiedDate isDir: dirFlag fileSize: fileSize posixPermissions: posixPermissions isSymlink: symlinkFlag] ifFalse: [self makeDirEntryName: entryName size: entryNameSize createDate: createDate modDate: modifiedDate isDir: dirFlag fileSize: fileSize])! Item was changed: ----- Method: FilePlugin>>primitiveDirectorySetMacTypeAndCreator (in category 'directory primitives') ----- primitiveDirectorySetMacTypeAndCreator | creatorString typeString fileName creatorStringIndex typeStringIndex fileNameIndex fileNameSize okToSet | + <var: 'creatorStringIndex' type: #'char *'> + <var: 'typeStringIndex' type: #'char *'> + <var: 'fileNameIndex' type: #'char *'> - <var: 'creatorStringIndex' type: 'char *'> - <var: 'typeStringIndex' type: 'char *'> - <var: 'fileNameIndex' type: 'char *'> <export: true> creatorString := interpreterProxy stackValue: 0. typeString := interpreterProxy stackValue: 1. fileName := interpreterProxy stackValue: 2. ((interpreterProxy isBytes: creatorString) and: [(interpreterProxy isBytes: typeString) and: [(interpreterProxy isBytes: fileName) and: [(interpreterProxy byteSizeOf: creatorString) = 4 and: [(interpreterProxy byteSizeOf: typeString) = 4]]]]) ifFalse: [^interpreterProxy primitiveFail]. creatorStringIndex := interpreterProxy firstIndexableField: creatorString. typeStringIndex := interpreterProxy firstIndexableField: typeString. fileNameIndex := interpreterProxy firstIndexableField: fileName. fileNameSize := interpreterProxy byteSizeOf: fileName. "If the security plugin can be loaded, use it to check for permission. If not, assume it's ok" sCSFTfn ~= 0 ifTrue: [okToSet := self cCode: '((sqInt (*)(char *, sqInt))sCSFTfn)(fileNameIndex, fileNameSize)' inSmalltalk: [true]. okToSet ifFalse: [^interpreterProxy primitiveFail]]. (self cCode: 'dir_SetMacFileTypeAndCreator(fileNameIndex, fileNameSize, typeStringIndex, creatorStringIndex)' inSmalltalk: [true]) ifFalse: [^interpreterProxy primitiveFail]. interpreterProxy pop: 3! Item was changed: ----- Method: FilePlugin>>primitiveFileAtEnd (in category 'file primitives') ----- primitiveFileAtEnd | file atEnd | <export: true> - <var: 'file' type: 'SQFile *'> file := self fileValueOf: (interpreterProxy stackValue: 0). + interpreterProxy failed ifFalse: + [atEnd := self sqFileAtEnd: file. + interpreterProxy failed ifFalse: + [interpreterProxy methodReturnBool: atEnd]]! - interpreterProxy failed - ifFalse: [atEnd := self sqFileAtEnd: file]. - interpreterProxy failed - ifFalse: [interpreterProxy methodReturnBool: atEnd]! Item was changed: ----- Method: FilePlugin>>primitiveFileClose (in category 'file primitives') ----- primitiveFileClose - | file | <export: true> - <var: 'file' type: 'SQFile *'> file := self fileValueOf: (interpreterProxy stackValue: 0). + interpreterProxy failed ifFalse: + [self sqFileClose: file. + interpreterProxy failed ifFalse: + [interpreterProxy pop: 1]] "pop file; leave rcvr on stack"! - interpreterProxy failed ifFalse: [ self sqFileClose: file ]. - interpreterProxy failed ifFalse: [ interpreterProxy pop: 1 "pop file; leave rcvr on stack" ].! Item was changed: ----- Method: FilePlugin>>primitiveFileDelete (in category 'file primitives') ----- primitiveFileDelete | namePointer nameIndex nameSize okToDelete | + <var: 'nameIndex' type: #'char *'> - <var: 'nameIndex' type: 'char *'> <export: true> namePointer := interpreterProxy stackValue: 0. + (interpreterProxy isBytes: namePointer) ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. - (interpreterProxy isBytes: namePointer) - ifFalse: [^ interpreterProxy primitiveFail]. nameIndex := interpreterProxy firstIndexableField: namePointer. nameSize := interpreterProxy byteSizeOf: namePointer. "If the security plugin can be loaded, use it to check for permission. If not, assume it's ok" sCDFfn ~= 0 ifTrue: [okToDelete := self cCode: ' ((sqInt (*)(char *, sqInt))sCDFfn)(nameIndex, nameSize)' inSmalltalk: [true]. okToDelete ifFalse: [^ interpreterProxy primitiveFail]]. self sqFileDeleteName: nameIndex Size: nameSize. interpreterProxy failed ifFalse: [interpreterProxy pop: 1]! Item was changed: ----- Method: FilePlugin>>primitiveFileDescriptorType (in category 'file primitives') ----- primitiveFileDescriptorType + | fdPointer | - | fileType fd fdPointer | "Allow to test if the standard input/output files are from a console or not Return values: * -1 - Error * 0 - no console (windows only) * 1 - normal terminal (unix terminal / windows console) * 2 - pipe * 3 - file * 4 - cygwin terminal (windows only)" <var: 'fd' type: #int> <export: true> fdPointer := interpreterProxy stackValue: 0. + (interpreterProxy isIntegerObject: fdPointer) ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + interpreterProxy methodReturnInteger: (self sqFileDescriptorType: (interpreterProxy integerValueOf: fdPointer))! - (interpreterProxy isIntegerObject: fdPointer) - ifFalse: [^ interpreterProxy primitiveFailFor: PrimErrBadArgument]. - fd := interpreterProxy integerValueOf: fdPointer. - interpreterProxy failed ifTrue: [ - "Ensure that the appropriate failure code has been set" - ^interpreterProxy primitiveFailFor: PrimErrBadArgument]. - fileType := self - cCode: 'sqFileDescriptorType(fd)' - inSmalltalk: [1]. - interpreterProxy methodReturnInteger: fileType! Item was changed: ----- Method: FilePlugin>>primitiveFileFlush (in category 'file primitives') ----- primitiveFileFlush | file | - <var: 'file' type: 'SQFile *'> <export: true> file := self fileValueOf: (interpreterProxy stackValue: 0). + interpreterProxy failed ifFalse: + [self sqFileFlush: file. + interpreterProxy failed ifFalse: + [interpreterProxy pop: 1]]! - interpreterProxy failed ifFalse:[self sqFileFlush: file]. - interpreterProxy failed ifFalse: [interpreterProxy pop: 1].! Item was changed: ----- Method: FilePlugin>>primitiveFileGetPosition (in category 'file primitives') ----- primitiveFileGetPosition | file position | + <var: 'position' type: #squeakFileOffsetType> - <var: 'file' type: 'SQFile *'> - <var: 'position' type: 'squeakFileOffsetType'> <export: true> file := self fileValueOf: (interpreterProxy stackValue: 0). + interpreterProxy failed ifFalse: + [position := self sqFileGetPosition: file. + interpreterProxy failed ifFalse: + [interpreterProxy methodReturnValue: (interpreterProxy positive64BitIntegerFor: position)]]! - interpreterProxy failed ifFalse: [position := self sqFileGetPosition: file]. - interpreterProxy failed ifFalse: [ - interpreterProxy methodReturnValue: (interpreterProxy positive64BitIntegerFor: position)].! Item was changed: ----- Method: FilePlugin>>primitiveFileOpen (in category 'file primitives') ----- primitiveFileOpen | writeFlag namePointer filePointer nameIndex nameSize | + <var: 'nameIndex' type: #'char *'> - <var: 'nameIndex' type: 'char *'> <export: true> + writeFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0). - writeFlag := interpreterProxy - booleanValueOf: (interpreterProxy stackValue: 0). namePointer := interpreterProxy stackValue: 1. + (interpreterProxy isBytes: namePointer) ifFalse: + [^interpreterProxy primitiveFail]. - (interpreterProxy isBytes: namePointer) - ifFalse: [^ interpreterProxy primitiveFail]. nameIndex := interpreterProxy firstIndexableField: namePointer. nameSize := interpreterProxy byteSizeOf: namePointer. filePointer := self fileOpenName: nameIndex size: nameSize write: writeFlag secure: true. + interpreterProxy failed ifFalse: + [interpreterProxy methodReturnValue: filePointer]! - interpreterProxy failed - ifFalse: [interpreterProxy methodReturnValue: filePointer] - ! Item was changed: ----- Method: FilePlugin>>primitiveFileOpenNew (in category 'file primitives') ----- primitiveFileOpenNew | namePointer filePointer nameIndex nameSize | + <var: 'nameIndex' type: #'char *'> - <var: 'nameIndex' type: 'char *'> <export: true> namePointer := interpreterProxy stackValue: 0. + (interpreterProxy isBytes: namePointer) ifFalse: + [^interpreterProxy primitiveFail]. - (interpreterProxy isBytes: namePointer) - ifFalse: [^ interpreterProxy primitiveFail]. nameIndex := interpreterProxy firstIndexableField: namePointer. nameSize := interpreterProxy byteSizeOf: namePointer. filePointer := self fileOpenNewName: nameIndex size: nameSize secure: true. + interpreterProxy failed ifFalse: + [interpreterProxy methodReturnValue: filePointer]! - interpreterProxy failed - ifFalse: [ - interpreterProxy methodReturnValue: filePointer] - ! Item was changed: ----- Method: FilePlugin>>primitiveFileReadWithPinning (in category 'file primitives') ----- primitiveFileReadWithPinning "This version of primitiveFileRead is for garbage collectors that support pinning." | count startIndex array file slotSize elementSize bytesRead | <inline: true> - <var: 'file' type: #'SQFile *'> <var: 'count' type: #'size_t'> <var: 'startIndex' type: #'size_t'> <var: 'slotSize' type: #'size_t'> <var: 'elementSize' type: #'size_t'> count := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 0). startIndex := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 1). array := interpreterProxy stackValue: 2. file := self fileValueOf: (interpreterProxy stackValue: 3). (interpreterProxy failed "buffer can be any indexable words or bytes object except CompiledMethod" or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. slotSize := interpreterProxy slotSizeOf: array. (startIndex >= 1 and: [startIndex + count - 1 <= slotSize]) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. "Note: adjust startIndex for zero-origin byte indexing" elementSize := slotSize = 0 ifTrue: [1] ifFalse: [(interpreterProxy byteSizeOf: array) // slotSize]. bytesRead := self sqFile: file Read: count * elementSize Into: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *') At: startIndex - 1 * elementSize. interpreterProxy failed ifFalse: [interpreterProxy methodReturnInteger: bytesRead // elementSize] "answer # of elements read"! Item was changed: ----- Method: FilePlugin>>primitiveFileReadWithoutPinning (in category 'file primitives') ----- primitiveFileReadWithoutPinning "This version of primitiveFileRead is for garbage collectors without support for pinning." | retryCount count startIndex array file elementSize bytesRead | <inline: true> - <var: 'file' type: #'SQFile *'> <var: 'count' type: #'size_t'> <var: 'startIndex' type: #'size_t'> <var: 'elementSize' type: #'size_t'> retryCount := 0. count := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0). startIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1). [array := interpreterProxy stackValue: 2. file := self fileValueOf: (interpreterProxy stackValue: 3). (interpreterProxy failed "buffer can be any indexable words or bytes object except CompiledMethod" or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. elementSize := (interpreterProxy isWords: array) ifTrue: [4] ifFalse: [1]. (startIndex >= 1 and: [(startIndex + count - 1) <= (interpreterProxy slotSizeOf: array)]) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. "Note: adjust startIndex for zero-origin indexing" bytesRead := self sqFile: file Read: count * elementSize Into: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *') At: (startIndex - 1) * elementSize. interpreterProxy primitiveFailureCode = PrimErrObjectMayMove and: [(retryCount := retryCount + 1) <= 2] "Two objects, the file and the array can move"] whileTrue: [interpreterProxy tenuringIncrementalGC; primitiveFailFor: PrimNoErr]. interpreterProxy failed ifFalse: [interpreterProxy methodReturnInteger: bytesRead // elementSize "push # of elements read"]! Item was changed: ----- Method: FilePlugin>>primitiveFileRename (in category 'file primitives') ----- primitiveFileRename | oldNamePointer newNamePointer oldNameIndex oldNameSize newNameIndex newNameSize okToRename | + <var: 'oldNameIndex' type: #'char *'> + <var: 'newNameIndex' type: #'char *'> - <var: 'oldNameIndex' type: 'char *'> - <var: 'newNameIndex' type: 'char *'> <export: true> newNamePointer := interpreterProxy stackValue: 0. oldNamePointer := interpreterProxy stackValue: 1. ((interpreterProxy isBytes: newNamePointer) + and: [interpreterProxy isBytes: oldNamePointer]) ifFalse: + [^interpreterProxy primitiveFail]. - and: [interpreterProxy isBytes: oldNamePointer]) - ifFalse: [^interpreterProxy primitiveFail]. newNameIndex := interpreterProxy firstIndexableField: newNamePointer. newNameSize := interpreterProxy byteSizeOf: newNamePointer. oldNameIndex := interpreterProxy firstIndexableField: oldNamePointer. oldNameSize := interpreterProxy byteSizeOf: oldNamePointer. "If the security plugin can be loaded, use it to check for rename permission. If not, assume it's ok" sCRFfn ~= 0 ifTrue: [okToRename := self cCode: ' ((sqInt (*)(char *, sqInt))sCRFfn)(oldNameIndex, oldNameSize)' inSmalltalk: [true]. okToRename ifFalse: [^interpreterProxy primitiveFail]]. self sqFileRenameOld: oldNameIndex Size: oldNameSize New: newNameIndex Size: newNameSize. interpreterProxy failed ifFalse: [interpreterProxy pop: 2]! Item was changed: ----- Method: FilePlugin>>primitiveFileSetPosition (in category 'file primitives') ----- primitiveFileSetPosition | newPosition file | + <var: 'newPosition' type: #squeakFileOffsetType> - <var: 'file' type: 'SQFile *'> - <var: 'newPosition' type: 'squeakFileOffsetType'> <export: true> (interpreterProxy byteSizeOf: (interpreterProxy stackValue: 0)) > (self sizeof: #squeakFileOffsetType) ifTrue: [^interpreterProxy primitiveFail]. newPosition := interpreterProxy positive64BitValueOf: (interpreterProxy stackValue: 0). file := self fileValueOf: (interpreterProxy stackValue: 1). interpreterProxy failed ifFalse: + [self sqFile: file SetPosition: newPosition. + interpreterProxy failed ifFalse: + [interpreterProxy pop: 2]] "pop position, file; leave rcvr on stack"! - [self sqFile: file SetPosition: newPosition ]. - interpreterProxy failed ifFalse: - [interpreterProxy pop: 2] "pop position, file; leave rcvr on stack"! Item was changed: ----- Method: FilePlugin>>primitiveFileSize (in category 'file primitives') ----- primitiveFileSize | file size | + <var: 'size' type: #squeakFileOffsetType> - <var: 'file' type: 'SQFile *'> - <var: 'size' type: 'squeakFileOffsetType'> <export: true> file := self fileValueOf: (interpreterProxy stackValue: 0). interpreterProxy failed ifFalse:[size := self sqFileSize: file]. + interpreterProxy failed ifFalse: + [interpreterProxy methodReturnValue: (interpreterProxy positive64BitIntegerFor: size)].! - interpreterProxy failed ifFalse: [ - interpreterProxy methodReturnValue: (interpreterProxy positive64BitIntegerFor: size)].! Item was changed: ----- Method: FilePlugin>>primitiveFileSync (in category 'file primitives') ----- primitiveFileSync | file | - <var: 'file' type: 'SQFile *'> <export: true> file := self fileValueOf: (interpreterProxy stackValue: 0). interpreterProxy failed ifFalse:[self sqFileSync: file]. interpreterProxy failed ifFalse: [interpreterProxy pop: 1].! Item was changed: ----- Method: FilePlugin>>primitiveFileTruncate (in category 'file primitives') ----- primitiveFileTruncate + "ftruncate is not an ansi function so we have a macro to point to a suitable platform implementation" - "ftruncate is not an ansi function so we have a macro to point to a suitable platform implementation" | truncatePosition file | - <var: 'file' type: #'SQFile *'> <var: 'truncatePosition' type: #squeakFileOffsetType> <export: true> (interpreterProxy isIntegerObject: (interpreterProxy stackValue: 0)) ifFalse: [(interpreterProxy byteSizeOf: (interpreterProxy stackValue: 0)) > (self sizeof: #squeakFileOffsetType) ifTrue: [^interpreterProxy primitiveFail]]. truncatePosition := interpreterProxy positive64BitValueOf: (interpreterProxy stackValue: 0). file := self fileValueOf: (interpreterProxy stackValue: 1). interpreterProxy failed ifFalse: [self sqFile: file Truncate: truncatePosition]. interpreterProxy failed ifFalse: [interpreterProxy pop: 2 "pop position, file; leave rcvr on stack"]! Item was changed: ----- Method: FilePlugin>>primitiveFileWrite (in category 'file primitives') ----- primitiveFileWrite | count startIndex array file slotSize elementSize bytesWritten | + <var: 'count' type: #'size_t'> + <var: 'startIndex' type: #'size_t'> - <var: 'file' type: 'SQFile *'> - <var: 'count' type: 'size_t'> - <var: 'startIndex' type: 'size_t'> <var: 'slotSize' type: #'size_t'> <var: 'elementSize' type: #'size_t'> <export: true> count := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 0). startIndex := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 1). array := interpreterProxy stackValue: 2. file := self fileValueOf: (interpreterProxy stackValue: 3). (interpreterProxy failed "buffer can be any indexable words or bytes object except CompiledMethod" or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. slotSize := interpreterProxy slotSizeOf: array. (startIndex >= 1 and: [startIndex + count - 1 <= slotSize]) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. "Note: adjust startIndex for zero-origin byte indexing" elementSize := slotSize = 0 ifTrue: [1] ifFalse: [(interpreterProxy byteSizeOf: array) // slotSize]. bytesWritten := self sqFile: file Write: count * elementSize From: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *') At: startIndex - 1 * elementSize. interpreterProxy failed ifFalse: [interpreterProxy methodReturnInteger: bytesWritten // elementSize] "answer # of elements written"! Item was added: + ----- Method: FilePluginSimulator>>sqFileDescriptorType: (in category 'simulation') ----- + sqFileDescriptorType: fd + "Allow to test if the standard input/output files are from a console or not + Return values: + -1 - Error + 0 - no console (windows only) + 1 - normal terminal (unix terminal / windows console) + 2 - pipe + 3 - file + 4 - cygwin terminal (windows only)" + ^fd < 0 + ifTrue: [-1] + ifFalse: + [fd <= 2 "i.e. stdio,stdout,stderr" + ifTrue: [1] + ifFalse: [3]]! |
Free forum by Nabble | Edit this page |