Vm-dev September 2018

vm-dev@lists.squeakfoundation.org

19 participants
41 discussions

VM Maker: VMMaker.oscog-eem.2441.mcz
by commits＠source.squeak.org 19 Sep '18

19 Sep '18

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2441.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2441 Author: eem Time: 18 September 2018, 3:45:34.562807 pm UUID: 6617be67-a815-4239-a328-88ac9e9c6bd9 Ancestors: VMMaker.oscog-eem.2440 Make sure is:KindOf: has a valid return type. =============== Diff against VMMaker.oscog-eem.2440 =============== Item was changed: ----- Method: InterpreterProxy>>is:KindOf: (in category 'testing') ----- is: oop KindOf: aString "InterpreterProxy new is: 42 KindOf: 'Number'" + <var: #aString type: 'char *'> + <returnTypeC: #sqInt> - <var: #aString type:'char *'> (Smalltalk at: aString asSymbol ifAbsent:[nil]) ifNil:[false] ifNotNil: [:theClass| oop isKindOf: theClass]!

1 0

VM Maker: VMMaker.oscog-eem.2440.mcz
by commits＠source.squeak.org 19 Sep '18

19 Sep '18

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2440.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2440 Author: eem Time: 18 September 2018, 3:37:44.633153 pm UUID: d7f5e4fc-4d3c-4afa-aa43-5d8668d0b5c9 Ancestors: VMMaker.oscog-eem.2439 More Pharo compatibility. Refactor FilePluginSimulator simulation of primitiveDirectoryEntry & primitiveDirectoryLookup (primLookupEntryIn:name: & primLookupEntryIn:index:) so that the actual primitives in FilePlugin are simulated. Modify Slang to strip trailing underscores from selectors when constructing C function names, allowing a nice "varargs" convention (we should use this to get rid of my horrible hacks such as mem:cp:y:, st:rn:cpy: et al, which are too difficult to read or remember). Improve CObjectAccessor printing for cases like dir_[Entry]Lookup:_:_:_:_:_:_:_:_:_:_:_: so we can see the fake pointer accessors. Eliminate the variation on dir_[Entry]Lookup between PharoVM and SqueakVM, leaving the difference only in makeDirEntryName:size:createDate:modDate:isDir:fileSize:[posixPermissions:isSymlink:]. (Hence a new FilePlugin must be coordinated with platfiorm code changes). Fix a bug in attemptToComputeTempNamesFor: with methods with blocks but no top level temps. Haver statementsFor:varName: work in Pharo as well as Squeak. Remove an and:and: from bindVariableUsesIn:andConstantFoldIf:in: =============== Diff against VMMaker.oscog-eem.2439 =============== Item was changed: ----- Method: CCodeGenerator>>cFunctionNameFor: (in category 'C code generator') ----- cFunctionNameFor: aSelector "Create a C function name from the given selector by finding + a specific translation, or if none, simply omitting colons, and + any trailing underscores (this supports a varargs convention)." + ^selectorTranslations + at: aSelector + ifAbsent: + [| cSelector | + cSelector := aSelector copyWithout: $:. + [cSelector last = $_] whileTrue: + [cSelector := cSelector allButLast]. + cSelector]! - a specific translation, or if none, simply omitting colons." - ^selectorTranslations at: aSelector ifAbsent: [aSelector copyWithout: $:]! Item was removed: - ----- Method: CObjectAccessor>>printOnStream: (in category 'printing') ----- - printOnStream: aStream - super printOnStream: aStream. - aStream - print:' on: '; - write: object.! Item was added: + ----- Method: CPluggableAccessor>>printOn: (in category 'printing') ----- + printOn: aStream + super printOn: aStream. + (object isNil and: [readBlock notNil or: [writeBlock notNil]]) ifTrue: + [[aStream nextPutAll: ' in '; print: (readBlock home tempAt: 2) home] + on: Error + do: [:ex| ]]! Item was removed: - ----- Method: CogVMSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'file primitives') ----- - makeDirEntryName: entryName size: entryNameSize - createDate: createDate modDate: modifiedDate - isDir: dirFlag fileSize: fileSize - - ^(pluginList - detect: [:assoc| assoc key = 'FilePlugin'] - ifNone: [self error: 'this message should not be sent unless the FilePlugin has been loaded']) value - makeDirEntryName: entryName size: entryNameSize - createDate: createDate modDate: modifiedDate - isDir: dirFlag fileSize: fileSize! Item was removed: - ----- 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: fileSize posixPermissions: posixPermissions isSymlink: symlinkFlag - - ^(pluginList - detect: [:assoc| assoc key = 'FilePlugin'] - ifNone: [self error: 'this message should not be sent unless the FilePlugin has been loaded']) value - makeDirEntryName: entryName size: entryNameSize - createDate: createDate modDate: modifiedDate - isDir: dirFlag fileSize: fileSize - posixPermissions: fileSize isSymlink: symlinkFlag! Item was removed: - ----- Method: CogVMSimulator>>primitiveDirectoryEntry (in category 'file primitives') ----- - primitiveDirectoryEntry - | name pathName arrayNilOrSymbol result | - name := self stringOf: self stackTop. - pathName := self stringOf: (self stackValue: 1). - - self successful ifFalse: - [^self primitiveFail]. - - arrayNilOrSymbol := FileDirectory default primLookupEntryIn: pathName name: name. - arrayNilOrSymbol ifNil: - [self pop: 3 thenPush: objectMemory nilObject. - ^self]. - arrayNilOrSymbol isArray ifFalse: - ["arrayNilOrSymbol ~~ #primFailed ifTrue: - [self halt]. " - self transcript show: name, ' NOT FOUND'. - ^self primitiveFail]. - - result := PharoVM - ifTrue: - [self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size - createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3) - isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) - posixPermissions: (arrayNilOrSymbol at: 6 ifAbsent: [8r644]) isSymlink: (arrayNilOrSymbol at: 7 ifAbsent: [false])] - ifFalse: - [self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size - createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3) - isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) ]. - self pop: 3 thenPush: result! Item was removed: - ----- 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 ifNil: - [self pop: 3 thenPush: objectMemory nilObject. - ^array]. - array == #badDirectoryPath ifTrue: - [^self "halt" primitiveFail]. - - result := PharoVM - ifTrue: [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 ifAbsent: 8r664) isSymlink: (array at: 7 ifAbsent: [false]) ] - ifFalse: [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)]. - - self pop: 3 thenPush: result! Item was changed: ----- Method: Cogit class>>attemptToComputeTempNamesFor: (in category 'in-image compilation support') ----- attemptToComputeTempNamesFor: aCompiledMethod (aCompiledMethod respondsTo: #tempNames) ifTrue: [| schematicTemps blocks | schematicTemps := aCompiledMethod methodNode schematicTempNamesString. blocks := aCompiledMethod embeddedBlockClosures. InitializationOptions at: #tempNames put: (Dictionary newFrom: {aCompiledMethod initialPC -> (self decomposeSchematicTemps: (schematicTemps copyUpTo: $[))}, (blocks ifEmpty: [#()] ifNotEmpty: [aCompiledMethod embeddedBlockClosures + with: (schematicTemps first = $[ + ifTrue: [schematicTemps piecesCutWhere: [:a :b| b = $[]] + ifFalse: [(schematicTemps piecesCutWhere: [:a :b| b = $[]) allButFirst]) - with: (schematicTemps piecesCutWhere: [:a :b| b = $[]) allButFirst collect: [:c :s| c startpc -> (self decomposeSchematicTemps: (s copyWithoutAll: '[]'))]]))]! Item was changed: ----- Method: CompiledMethod>>asTranslationMethodOfClass: (in category '*VMMaker-C translation') ----- asTranslationMethodOfClass: aTMethodClass "Answer a TMethod (or subclass) derived from the receiver." ^((CompiledMethod includesSelector: #ast) + ifTrue: [self parseTree] "Pharo Opal Bytecode Compiler" - ifTrue: [self ast] "Pharo Opal Bytecode Compiler" ifFalse: [self methodNode]) "Squeak Smalltalk-80 Bytecode Compiler" asTranslationMethodOfClass: aTMethodClass! 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'> <export: true> requestedName := interpreterProxy stackValue: 0. pathName := interpreterProxy stackValue: 1. + (interpreterProxy isBytes: pathName) ifFalse: + [^interpreterProxy primitiveFail]. - (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]. - If not, assume it's ok" - sCLPfn ~= 0 - ifTrue: [okToList := self cCode: '((sqInt (*)(char *, sqInt))sCLPfn)(pathNameIndex, pathNameSize)'] - ifFalse: [okToList := true]. - okToList - ifTrue: [ - self - cppIf: PharoVM - ifTrue: [ - status := self cCode: 'dir_EntryLookup(pathNameIndex, pathNameSize, reqNameIndex, reqNameSize, - entryName, &entryNameSize, &createDate, - &modifiedDate, &dirFlag, &fileSize, - &posixPermissions, &symlinkFlag)' ] - ifFalse: [ - status := self cCode: 'dir_EntryLookup(pathNameIndex, pathNameSize, reqNameIndex, reqNameSize, - entryName, &entryNameSize, &createDate, - &modifiedDate, &dirFlag, &fileSize)'] ] - ifFalse: [status := DirNoMoreEntries]. + interpreterProxy failed ifTrue: + [^nil]. + status = DirNoMoreEntries ifTrue: "no entry; return nil" + [interpreterProxy "pop pathName, index, rcvr" + pop: 3 thenPush: interpreterProxy nilObject. - 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" - 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])! - self - cppIf: PharoVM - ifTrue: [ - 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) ] - ifFalse: [ - interpreterProxy - pop: 3 "pop pathName, fName, rcvr" - thenPush: (self - makeDirEntryName: entryName - size: entryNameSize - createDate: createDate - modDate: modifiedDate - isDir: dirFlag - fileSize: fileSize) ]! 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'> <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" - sCLPfn ~= 0 - ifTrue: [okToList := self cCode: '((sqInt (*)(char *, sqInt))sCLPfn)(pathNameIndex, pathNameSize)'] - ifFalse: [okToList := true]. - okToList - ifTrue: [ - self - cppIf: PharoVM - ifTrue: [ - status := self cCode: 'dir_Lookup(pathNameIndex, pathNameSize, index, - entryName, &entryNameSize, &createDate, - &modifiedDate, &dirFlag, &fileSize, - &posixPermissions, &symlinkFlag)' ] - ifFalse: [ - status := self cCode: 'dir_Lookup(pathNameIndex, pathNameSize, index, - entryName, &entryNameSize, &createDate, - &modifiedDate, &dirFlag, &fileSize)' ] ] - 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 + cppIf: PharoVM + ifTrue: + [self - self - cppIf: PharoVM - ifTrue: [ - 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) ] - ifFalse: [ - 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] + ifFalse: + [self + makeDirEntryName: entryName + size: entryNameSize + createDate: createDate + modDate: modifiedDate + isDir: dirFlag + fileSize: fileSize])! - fileSize: fileSize) ]! Item was added: + ----- Method: FilePluginSimulator>>dir_EntryLookup:_:_:_:_:_:_:_:_:_:_:_: (in category 'simulation') ----- + dir_EntryLookup: pathString _: pathStringLength _: entryNameString _: entryNameStringLength _: name _: nameLength _: creationDate _: modificationDate _: isDirectory _: sizeIfFile _: posixPermissions _: isSymlink + "sqInt dir_EntryLookup(char *pathString, sqInt pathStringLength, char *nameString, sqInt nameStringLength, + /* outputs: */ char *name, sqInt *nameLength, sqInt *creationDate, sqInt *modificationDate, + sqInt *isDirectory, squeakFileOffsetType *sizeIfFile, sqInt *posixPermissions, sqInt *isSymlink)" + | result pathName entryName | + pathName := ((0 to: pathStringLength - 1) collect: [:i| (pathString at: i) asCharacter]) as: ByteString. + entryName := ((0 to: entryNameStringLength - 1) collect: [:i| (entryNameString at: i) asCharacter]) as: ByteString. + result := self primLookupEntryIn: pathName name: entryName. + result ifNil: [^DirNoMoreEntries]. + result isInteger ifTrue: + [result > 1 ifTrue: + [interpreterProxy primitiveFailFor: result]. + ^DirBadPath]. + name replaceFrom: 1 to: result first size with: result first startingAt: 1. + nameLength at: 0 put: result first size. + creationDate at: 0 put: (result at: 2). + modificationDate at: 0 put: (result at: 3). + isDirectory at: 0 put: (result at: 4). + sizeIfFile at: 0 put: (result at: 5). + posixPermissions at: 0 put: (result at: 6 ifAbsent: [(result at: 4) ifTrue: [8r755] ifFalse: [8r644]]). + isSymlink at: 0 put: (result at: 7 ifAbsent: [false]). + ^DirEntryFound! Item was added: + ----- Method: FilePluginSimulator>>dir_Lookup:_:_:_:_:_:_:_:_:_:_: (in category 'simulation') ----- + dir_Lookup: pathString _: pathStringLength _: index _: name _: nameLength _: creationDate _: modificationDate _: isDirectory _: sizeIfFile _: posixPermissions _: isSymlink + "sqInt dir_Lookup( char *pathString, sqInt pathStringLength, sqInt index, + /* outputs: */ char *name, sqInt *nameLength, sqInt *creationDate, sqInt *modificationDate, + sqInt *isDirectory, squeakFileOffsetType *sizeIfFile, sqInt * posixPermissions, sqInt *isSymlink)" + | result pathName | + pathName := ((0 to: pathStringLength - 1) collect: [:i| (pathString at: i) asCharacter]) as: ByteString. + result := self primLookupEntryIn: pathName index: index. + result ifNil: [^DirNoMoreEntries]. + result isInteger ifTrue: + [result > 1 ifTrue: + [interpreterProxy primitiveFailFor: result]. + ^DirBadPath]. + name replaceFrom: 1 to: result first size with: result first startingAt: 1. + nameLength at: 0 put: result first size. + creationDate at: 0 put: (result at: 2). + modificationDate at: 0 put: (result at: 3). + isDirectory at: 0 put: (result at: 4). + sizeIfFile at: 0 put: (result at: 5). + posixPermissions at: 0 put: (result at: 6 ifAbsent: [(result at: 4) ifTrue: [8r755] ifFalse: [8r644]]). + isSymlink at: 0 put: (result at: 7 ifAbsent: [false]). + ^DirEntryFound! Item was added: + ----- Method: FilePluginSimulator>>primLookupEntryIn:index: (in category 'simulation') ----- + primLookupEntryIn: fullPath index: index + "Look up the index-th entry of the directory with the given fully-qualified path (i.e., starting from the root of the file hierarchy) and return an array containing: + + <name> <creationTime> <modificationTime> <dirFlag> <fileSize> + + The empty string enumerates the top-level files or drives. (For example, on Unix, the empty path enumerates the contents of '/'. On Macs and PCs, it enumerates the mounted volumes/drives.) + + The creation and modification times are in seconds since the start of the Smalltalk time epoch. DirFlag is true if the entry is a directory. FileSize the file size in bytes or zero for directories. The primitive returns nil when index is past the end of the directory. It fails if the given path is bad." + + <primitive: 'primitiveDirectoryLookup' module: 'FilePlugin' error: ec> + ^ec isInteger + ifTrue: [ec] + ifFalse: + [Smalltalk primitiveErrorTable + indexOf: ec + ifAbsent: [Smalltalk primitiveErrorTable size + 1]]! Item was added: + ----- Method: FilePluginSimulator>>primLookupEntryIn:name: (in category 'simulation') ----- + primLookupEntryIn: fullPath name: fName + "Look up <fName> (a simple file name) in the directory identified by <fullPath> + and return an array containing: + + <fName> <creationTime> <modificationTime> <dirFlag> <fileSize> + + On Unix, the empty path denotes '/'. + On Macs and PCs, it is the container of the system volumes.) + + The creation and modification times are in seconds since the start of the Smalltalk time epoch. DirFlag is true if the entry is a directory. FileSize the file size in bytes or zero for directories. The primitive returns nil when index is past the end of the directory. It fails if the given path is bad." + + <primitive: 'primitiveDirectoryEntry' module: 'FilePlugin' error: ec> + ^ec isInteger + ifTrue: [ec] + ifFalse: + [Smalltalk primitiveErrorTable + indexOf: ec + ifAbsent: [Smalltalk primitiveErrorTable size + 1]]! Item was removed: - ----- Method: FilePluginSimulator>>primitiveDirectoryEntry (in category 'simulation') ----- - primitiveDirectoryEntry - ^interpreterProxy interpreter primitiveDirectoryEntry! Item was removed: - ----- Method: FilePluginSimulator>>primitiveDirectoryLookup (in category 'simulation') ----- - primitiveDirectoryLookup - ^interpreterProxy interpreter primitiveDirectoryLookup! Item was removed: - ----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'file primitives') ----- - makeDirEntryName: entryName size: entryNameSize - createDate: createDate modDate: modifiedDate - isDir: dirFlag fileSize: fileSize - - ^(pluginList - detect: [:assoc| assoc key = 'FilePlugin'] - ifNone: [self error: 'this message should not be sent unless the FilePlugin has been loaded']) value - makeDirEntryName: entryName size: entryNameSize - createDate: createDate modDate: modifiedDate - isDir: dirFlag fileSize: fileSize! Item was removed: - ----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'file primitives') ----- - makeDirEntryName: entryName size: entryNameSize createDate: createDate modDate: modifiedDate isDir: dirFlag fileSize: posixPermissions posixPermissions: fileSize isSymlink: symlinkFlag - - ^(pluginList - detect: [:assoc| assoc key = 'FilePlugin'] - ifNone: [self error: 'this message should not be sent unless the FilePlugin has been loaded']) value - makeDirEntryName: entryName size: entryNameSize - createDate: createDate modDate: modifiedDate - isDir: dirFlag fileSize: fileSize - posixPermissions: fileSize isSymlink: symlinkFlag! Item was removed: - ----- 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]. - - PharoVM - ifTrue: [ - 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) ] - ifFalse: [ - 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) ]. - self pop: 3. - self push: result! Item was removed: - ----- 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. - ]. - - PharoVM - ifTrue: [ - 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) ] - ifFalse: [ - 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) ]. - self pop: 3. - self push: result. - ! Item was added: + ----- Method: SlangTests>>testStatementsHaveNoArguments (in category 'tests') ----- + testStatementsHaveNoArguments + "The inliner expects the body of a TMethod to have no arguments." + + | tMethod | + tMethod := InterpreterStackPages>>#pageIndexFor: asTranslationMethodOfClass: TMethod. + self assert: (tMethod parseTree args isNil or: [tMethod parseTree args isEmpty])! Item was removed: - ----- Method: StackInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'file primitives') ----- - makeDirEntryName: entryName size: entryNameSize - createDate: createDate modDate: modifiedDate - isDir: dirFlag fileSize: fileSize - - ^(pluginList - detect: [:assoc| assoc key = 'FilePlugin'] - ifNone: [self error: 'this message should not be sent unless the FilePlugin has been loaded']) value - makeDirEntryName: entryName size: entryNameSize - createDate: createDate modDate: modifiedDate - isDir: dirFlag fileSize: fileSize! Item was removed: - ----- Method: StackInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'file primitives') ----- - makeDirEntryName: entryName size: entryNameSize createDate: createDate modDate: modifiedDate isDir: dirFlag fileSize: fileSize posixPermissions: posixPermissions isSymlink: symlinkFlag - - ^(pluginList - detect: [:assoc| assoc key = 'FilePlugin'] - ifNone: [self error: 'this message should not be sent unless the FilePlugin has been loaded']) value - makeDirEntryName: entryName size: entryNameSize - createDate: createDate modDate: modifiedDate - isDir: dirFlag fileSize: fileSize - posixPermissions: fileSize isSymlink: symlinkFlag! Item was removed: - ----- Method: StackInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') ----- - primitiveDirectoryEntry - | name pathName arrayNilOrSymbol result | - name := self stringOf: self stackTop. - pathName := self stringOf: (self stackValue: 1). - - self successful ifFalse: - [^self primitiveFail]. - - arrayNilOrSymbol := FileDirectory default primLookupEntryIn: pathName name: name. - arrayNilOrSymbol ifNil: - [self pop: 3 thenPush: objectMemory nilObject. - ^self]. - arrayNilOrSymbol isArray ifFalse: - ["arrayNilOrSymbol ~~ #primFailed ifTrue: - [self halt]. " - self transcript show: name , ' NOT FOUND'. - ^self primitiveFail]. - - result := PharoVM - ifTrue: - [self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size - createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3) - isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) - posixPermissions: (arrayNilOrSymbol at: 6 ifAbsent: [8r644]) isSymlink: (arrayNilOrSymbol at: 7 ifAbsent: [false]) ] - ifFalse: - [self makeDirEntryName: (arrayNilOrSymbol at: 1) size: (arrayNilOrSymbol at: 1) size - createDate: (arrayNilOrSymbol at: 2) modDate: (arrayNilOrSymbol at: 3) - isDir: (arrayNilOrSymbol at: 4) fileSize: (arrayNilOrSymbol at: 5) ]. - self pop: 3 thenPush: result! Item was removed: - ----- 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 ifNil: - [self pop: 3 thenPush: objectMemory nilObject. - ^array]. - array == #badDirectoryPath ifTrue: - [^self "halt" primitiveFail]. - - result := PharoVM - ifTrue: [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 ifAbsent: 8r664) isSymlink: (array at: 7 ifAbsent: [false]) ] - ifFalse: [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)]. - - self pop: 3 thenPush: result! Item was changed: ----- Method: TMethod>>statementsFor:varName: (in category 'primitive compilation') ----- statementsFor: sourceText varName: varName "Return the parse tree for the given expression. The result is the statements list of the method parsed from the given source text." "Details: Various variables are declared as locals to avoid Undeclared warnings from the parser." | s | + s := WriteStream on: String new. + s nextPutAll: 'temp'; cr; crtab. - s := WriteStream on: ''. - s nextPutAll: 'temp'; cr; cr; tab. self printTempsAndVar: varName on: s. s nextPutAll: sourceText. + ^ (([Smalltalk compiler parse: s contents] "Pharo" + on: MessageNotUnderstood + do: [:ex| + ex message selector == #compiler ifFalse: + [ex pass]. + Compiler new parse: s contents in: Object notifying: nil]) "Squeak" - ^ ((Compiler new parse: s contents in: Object notifying: nil) asTranslationMethodOfClass: self class) removeFinalSelfReturnIn: nil; statements ! Item was changed: ----- Method: TSendNode>>bindVariableUsesIn:andConstantFoldIf:in: (in category 'transformations') ----- bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen "Answer either the receiver, if it contains no references to the given variables, or a new node with the given variables rebound. Attempt to constant-fold and answer a constant node commented with the original expression. Commenting with the original expression is important because it allows us to detect shared cases. e.g. currentBytecode bitAnd: 15 is the same in case 1 and case 17, but '1 /* 1 bitAnd: 15 */' differs from '1 /* 17 bitAnd: 15 */', whereas '1 /* currentBytecode bitAnd: 15 */' doesn't change." | newReceiver newArguments | "Constant-fold shiftForWord, but not BytesPerWord" ((VMBasicConstants mostBasicConstantSelectors includes: selector) and: [(codeGen isBuiltinSelector: selector) not]) ifTrue: [codeGen isConstantNode: self valueInto: [:val| ^TConstantNode new setValue: val; yourself]]. newReceiver := receiver bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen. newArguments := arguments collect: [:a| a bindVariableUsesIn: aDictionary andConstantFoldIf: constantFold in: codeGen]. (newReceiver = receiver and: [newArguments = arguments]) ifTrue: [^self]. (constantFold + and: [newReceiver isConstant and: [newReceiver value isInteger - and: [newReceiver isConstant and: [newReceiver value isInteger] and: [(newArguments allSatisfy: [:ea| ea isConstant and: [ea value isInteger]]) + and: [codeGen isBuiltinSelector: selector]]]]) ifTrue: - and: [codeGen isBuiltinSelector: selector]]]) ifTrue: [| value | value := [newReceiver value perform: selector withArguments: (newArguments collect: [:ea| ea value])] on: Error do: [:ea| nil]. (value isInteger or: [value == true or: [value == false]]) ifTrue: [^TConstantNode new setValue: value; "We assume Message prints its keywords and arguments interleaved. e.g. that (Message selector: #between:and: arguments: #(0 1)) printString = 'between: 0 and: 1'" comment: (receiver isLeaf ifTrue: [receiver printString] ifFalse: ['(', receiver printString, ')']), ' ', (Message selector: selector arguments: (arguments collect: [:ea| ea value])) printString; yourself]]. ^self shallowCopy receiver: newReceiver; arguments: newArguments; yourself !

1 0

Re: [Vm-dev] [squeak-dev] The Inbox: Collections-nice.807.mcz
by Eliot Miranda 18 Sep '18

18 Sep '18

Hi All, On Sat, Sep 15, 2018 at 6:36 PM Bert Freudenberg <bert(a)freudenbergs.de> wrote: > On Sat, Sep 15, 2018 at 4:58 PM Levente Uzonyi <leves(a)caesar.elte.hu> > wrote: > >> Hi Eliot, >> >> Here is a very simple test case: >> >> { >> [ 1 to: 500000000 do: [ :i | i = 1 ifTrue: [ true ] ifFalse: [ >> false ] ] ] timeToRun. >> [ 1 to: 500000000 do: [ :i | i = 1 ] ] timeToRun. >> } >> >> On my machine it gives #(992 1436). >> > > Huh, interesting. > > Eliot, if you figure this out, please let us know what it was ... > hmmm. It's my fault. It is to do with the criteria the StackToRegisterMappingCogit uses to decide whether to inline comparison operations. The code I wrote in genSpecialSelectorComparison says "Only interested in inlining if followed by a conditional branch." inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]. "Further, only interested in inlining = and ~= if there's a SmallInteger constant involved. The relational operators successfully statically predict SmallIntegers; the equality operators do not." (inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue: [inlineCAB := argIsIntConst or: [rcvrIsInt]]. inlineCAB ifFalse: [^self genSpecialSelectorSend]. So the Cogit inlines the = 1 in the first case because it is followed by the branch for the ifTrue: [true] ifFalse: [false], but does not inline = 1 in the second case. So the second case is a true send, and the true send code (load a register with i, another with 1, another with the SmallInteger tag, call the checked entry point of SmallInteger>>#=, tag test the receiver, tag test the argument, compare, reify as true or false, return) is more costly, essentially because it has a call/return. I'll discuss with Clément and Sophie we'll think about measuring this tradeoff. This is perhaps a good student project. If anyone has good arguments why the heuristics above are bogus or good measurements please post. In the mean time sorry for the late reply; I was airborne on the way back from Cagliari, or sleeping in the terminal in Rome and was none too fresh. ESUG was glorious though. Thanks to all the organisers!! _,,,^..^,,,_ best, Eliot

2 2

[OpenSmalltalk/opensmalltalk-vm] getGoodSpurVM.sh does not work on Mac 32 bits (#284)
by Hernan Wilkinson 16 Sep '18

16 Sep '18

It tries to read "squeak.cog.spur_macos32_x86_" instead of "squeak.cog.spur_macos32x86_" -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/284

2 2

Smalltalk stack dump from gdb
by Alistair Grant 13 Sep '18

13 Sep '18

Hi Eliot and Everyone, Is it possible to print out a smalltalk stack dump from within gdb (while debugging a plugin)? The latest changes I'm making to fix UTF8 support in FileAttributesPlugin are causing a segmentation fault, but I can only trigger it during image startup and the fault occurs after returning from the primitive. I assume I'm corrupting memory somewhere, but haven't been able to track it down yet. Wishing I was at ESUG, Alistair

2 2

Call for Papers: <Programming> 2019
by Fabio Niephaus 10 Sep '18

10 Sep '18

<Programming> 2019 : The Art, Science, and Engineering of Programming April 1-4, 2019, Genova, Italy http://2019.programming-conference.org The International Conference on the Art, Science, and Engineering of Programming is a new conference focused on programming topics including the experience of programming. We have named it <Programming> for short. <Programming> seeks for papers that advance knowledge of programming on any relevant topic, including programming practice and experience. Paper submissions and publications are handled by the the Art, Science, and Engineering of Programming journal (http://programming-journal.org). Accepted papers must be presented at the conference. ******************************************************** CALL FOR PAPERS ******************************************************** <Programming> 2019 accepts scholarly papers that advance knowledge of programming. Almost anything about programming is in scope, but in each case there should be a clear relevance to the act and experience of programming. PAPER SUBMISSIONS: October 1, 2018 URL FOR SUBMISSIONS: http://programming-journal.org/submission/ Submissions covering several areas of expertise are accepted, including but not limited to: • General-purpose programming • Distributed systems programming • Parallel and multi-core programming • Graphics and GPU programming • Security programming • User interface programming • Database programming • Visual and live programming • Data mining and machine learning programming • Interpreters, virtual machines and compilers • Modularity and separation of concerns • Model-based development • Metaprogramming and reflection • Testing and debugging • Program verification • Programming education • Programming environments • Social coding ******************************************************** IMPORTANT DATES ******************************************************** Research paper submissions: October 1, 2018 Research paper first notifications: December 1, 2018 Research paper final notifications: January 7, 2019 ******************************************************** ORGANIZATION ******************************************************** General Chair: Davide Ancona, University of Genova Local Organizing Chair: Elena Zucca, University of Genova Program Chair: Matthew Flatt, University of Utah Organizing Committee: Walter Cazzola (Workshops Co-Chair), Università degli Studi di Milano Stefan Marr (Workshops Co-Chair), University of Kent Fabio Niephaus (Publicity Co-Chair), Hasso Plattner Institute, University of Potsdam Guido Salvaneschi (Publicity Co-Chair), Darmstadt University of Technology Tobias Pape (Web Technology Chair), Hasso Plattner Institute, University of Potsdam Program Committee: Anya Helene Bagge, University of Bergen Mehdi Bagherzadeh, Oakland University Walter Cazzola, Università degli Studi di Milano Ravi Chugh, University of Chicago Joeri De Koster, Vrije Universiteit Brussel Christos Dimoulas, Northwestern University Susan Eisenbach, Imperial College London Richard P. Gabriel, Dream Songs, Inc. & HPI Jeremy Gibbons, University of Oxford Michael Greenberg, Pomona College Philipp Haller, KTH Royal Institute of Technology Robert Hirschfeld, HPI, University of Potsdam Eunsuk Kang, Carnegie Mellon University Stephen Kell, University of Cambridge Stefan Marr, University of Kent Tamara Rezk, Inria Joshua Sunshine, Carnegie Mellon University Steffen Zschaler, King's College London ******************************************************** <Programming> 2019 is kindly supported by AOSA ******************************************************** For more information, visit http://2019.programming-conference.org

1 0

VM Maker: VMMakerCompatibilityForPharo6-eem.8.mcz
by commits＠source.squeak.org 09 Sep '18

09 Sep '18

Eliot Miranda uploaded a new version of VMMakerCompatibilityForPharo6 to project VM Maker: http://source.squeak.org/VMMaker/VMMakerCompatibilityForPharo6-eem.8.mcz ==================== Summary ==================== Name: VMMakerCompatibilityForPharo6-eem.8 Author: eem Time: 9 September 2018, 7:57:29.62651 pm UUID: 816211b6-d531-0d00-bcd1-bebc012ef449 Ancestors: VMMakerCompatibilityForPharo6-eem.7 Add translation support for brace constructs in case statements. And include a *Tools extension for TranscriptStream. =============== Diff against VMMakerCompatibilityForPharo6-eem.7 =============== Item was added: + ----- Method: RBArrayNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- + asTranslatorNodeIn: aTMethod + "Answer a TParseNode subclass equivalent of me." + + "This is for case statements" + (statements allSatisfy: [:elem| elem isMessage and: [elem selector = #->]]) ifTrue: + [self assert: (statements allSatisfy: + [:elem| + elem receiver isBlockNode + and: [elem arguments first isBlockNode + and: [elem receiver isPotentialCCaseLabelIn: aTMethod]]]). + ^TBraceCaseNode new + caseLabels: (statements collect: [:elem| elem receiver asTranslatorNodeIn: aTMethod]); + cases: (statements collect: [:elem| elem arguments first asTranslatorNodeIn: aTMethod]); + comment: statements]. + + "This is for varargs selectors (variants of printf:)" + ^statements collect: [:elem| elem asTranslatorNodeIn: aTMethod]! Item was added: + ----- Method: RBBlockNode>>isPotentialCCaseLabel:in: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- + isPotentialCCaseLabel: stmt in: aTMethod + (stmt isVariable + or: [stmt isLiteralNode + and: [stmt isConstantNumber or: [stmt literalValue isSymbol]]]) ifTrue: + [^true]. + stmt isMessage ifTrue: + [| selector implementingClass method | + selector := stmt selector. + (#(* + -) includes: selector) ifTrue: + [^(self isPotentialCCaseLabel: stmt receiver in: aTMethod) + and: [self isPotentialCCaseLabel: stmt arguments first in: aTMethod]]. + + (selector = #asSymbol + and: [stmt receiver isLiteralNode + and: [stmt receiver literalValue isSymbol]]) ifTrue: + [^true]. + + (stmt arguments isEmpty + and: [implementingClass := aTMethod definingClass whichClassIncludesSelector: selector. + implementingClass ifNil: + [implementingClass := aTMethod definingClass objectMemoryClass whichClassIncludesSelector: selector]. + method := implementingClass >> selector. + (method isQuick + or: [(method literalAt: 1) isInteger + and: [method numLiterals = 3]]) + and: [(implementingClass basicNew perform: selector) isInteger]]) ifTrue: + [^true]]. + ^false! Item was added: + ----- Method: RBBlockNode>>isPotentialCCaseLabelIn: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- + isPotentialCCaseLabelIn: aTMethod + body statements size ~= 1 ifTrue: [^false]. + ^self isPotentialCCaseLabel: body statements first in: aTMethod! Item was added: + ----- Method: RBLiteralValueNode>>isConstantNumber (in category '*VMMakerCompatibilityForPharo6-testing') ----- + isConstantNumber + ^value isNumber! Item was changed: ----- Method: RBMessageNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- asTranslatorNodeIn: aTMethod "Answer a TParseNode subclass equivalent of me" "selector is sometimes a Symbol, sometimes a SelectorNode!! On top of this, numArgs is needed due to the (truly grody) use of arguments as a place to store the extra expressions needed to generate code for in-line to:by:do:, etc. see below, where it is used. Expand super nodes in place. Elide sends of halt so that halts can be sprinkled through the simulator but will be eliminated from the generated C." | rcvrOrNil sel args ifNotNilBlock | rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod]. (rcvrOrNil notNil and: [rcvrOrNil isVariable and: [rcvrOrNil name = 'super']]) ifTrue: + [^aTMethod superExpansionNodeFor: selector args: arguments]. + sel := selector. "historical; can be simply selector" - [^aTMethod superExpansionNodeFor: selector key args: arguments]. - sel := selector isSymbol ifTrue: [selector] ifFalse: [selector key]. sel == #halt ifTrue: [^rcvrOrNil]. (sel == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block." or: [sel == #cCode:]) ifTrue: [arguments first isBlockNode ifTrue: [| block | ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1 ifTrue: [block statements first] ifFalse: [block]]. (arguments first isLiteralNode and: [arguments first value isString and: [arguments first value isEmpty]]) ifTrue: [^arguments first asTranslatorNodeIn: aTMethod]]. + args := arguments collect: [:arg| arg asTranslatorNodeIn: aTMethod]. - args := arguments - select: [:arg| arg notNil] - thenCollect: [:arg| arg asTranslatorNodeIn: aTMethod]. false ifTrue: [(sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) ifTrue: ["Restore limit expr that got moved by transformToDo:" args := {(arguments at: 7) value asTranslatorNodeIn: aTMethod. args second. args third. "add the limit var as a hidden extra argument; we may need it later" TVariableNode new setName: arguments first key}]. (sel == #ifTrue:ifFalse: and: [arguments first isNodeNil]) ifTrue: [sel := #ifFalse:. args := {args last}]. (sel == #ifTrue:ifFalse: and: [arguments last isNodeNil]) ifTrue: [sel := #ifTrue:. args := {args first}]. (sel == #ifFalse:ifTrue: and: [arguments first isNodeNil]) ifTrue: [sel := #ifTrue:. args := {args last}]. (sel == #ifFalse:ifTrue: and: [arguments last isNodeNil]) ifTrue: [sel := #ifTrue:. args := {args first}]. ((sel == #ifFalse: or: [sel == #or:]) and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue: ["Restore argument block that got moved by transformOr: or transformIfFalse:" args := {(arguments at: 2) asTranslatorNodeIn: aTMethod}]. (args size > sel numArgs and: [sel ~~ #to:by:do:]) ifTrue: "to:by:do: has iLimiT hidden in last arg" ["prune the extra blocks left by ifTrue:, ifFalse:, and: & or:" self assert: args size - sel numArgs = 1. self assert: (args last isStmtList and: [args last statements size = 1 and: [(args last statements first isVariable or: [args last statements first isConstant]) and: [#('nil' true false) includes: args last statements first nameOrValue]]]). args := args first: sel numArgs]. "For the benefit of later passes, e.g. value: inlining, transform e ifNotNil: [:v| ...] into v := e. v ifNotNil: [...], which in fact means transforming (v := e) ifTrue: [:v|...] into v := e. v ifTrue: [...]." ((sel == #ifTrue: or: [sel == #ifFalse: or: [sel == #ifTrue:ifFalse: or: [sel == #ifFalse:ifTrue:]]]) and: [receiver notNil and: [receiver isAssignmentEqualsEqualsNil and: [(ifNotNilBlock := args detect: [:arg| arg isStmtList and: [arg args size = 1]] ifNone: []) notNil]]]) ifTrue: [ifNotNilBlock setArguments: #(). ^TStmtListNode new setArguments: #() statements: { receiver receiver asTranslatorNodeIn: aTMethod. TSendNode new setSelector: sel receiver: (TSendNode new setSelector: #== receiver: (receiver receiver variable asTranslatorNodeIn: aTMethod) arguments: {receiver arguments first asTranslatorNodeIn: aTMethod}) arguments: args }]]. ((CCodeGenerator isVarargsSelector: sel) and: [args last isCollection and: [args last isSequenceable]]) ifTrue: [args := args allButLast, args last]. ^TSendNode new setSelector: sel receiver: rcvrOrNil arguments: args! Item was added: + ----- Method: RBProgramNode>>isConstantNumber (in category '*VMMakerCompatibilityForPharo6-testing') ----- + isConstantNumber "Overridden in RBLiteralValueNode" + ^false! Item was added: + ----- Method: RBVariableNode>>key (in category '*VMMakerCompatibilityForPharo6-accessing') ----- + key + ^name! Item was added: + ----- Method: TranscriptStream>>codePaneMenu:shifted: (in category 'Tools compatibility') ----- + codePaneMenu: aMenu shifted: shifted + "Note that unless we override perform:orSendTo:, PluggableTextController will respond to all menu items" + + | donorMenu | + donorMenu := shifted + ifTrue: [SmalltalkEditor shiftedYellowButtonMenu] + ifFalse: [SmalltalkEditor yellowButtonMenu]. + ^aMenu addAllFrom: donorMenu!

1 0

VM Maker: VMMakerCompatibilityForPharo6-eem.7.mcz
by commits＠source.squeak.org 09 Sep '18

09 Sep '18

Eliot Miranda uploaded a new version of VMMakerCompatibilityForPharo6 to project VM Maker: http://source.squeak.org/VMMaker/VMMakerCompatibilityForPharo6-eem.7.mcz ==================== Summary ==================== Name: VMMakerCompatibilityForPharo6-eem.7 Author: eem Time: 9 September 2018, 7:13:24.202454 pm UUID: a86a6318-d531-0d00-bcd0-6cc8012ef449 Ancestors: VMMakerCompatibilityForPharo6-eem.6 Add LongTestCase & access for the return of a quick method to RBMethodNode needed for cmacro: methods. =============== Diff against VMMakerCompatibilityForPharo6-eem.6 =============== Item was changed: SystemOrganization addCategory: #VMMakerCompatibilityForPharo6! SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-Kernel-Methods'! + SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-SUnit-Extensions'! SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-System'! Item was added: + TestCase subclass: #LongTestCase + instanceVariableNames: '' + classVariableNames: 'ShouldRun' + poolDictionaries: '' + category: 'VMMakerCompatibilityForPharo6-SUnit-Extensions'! + + !LongTestCase commentStamp: 'ul 12/15/2009 13:06' prior: 0! + A LongTestCase is a TestCase that usually takes a long time to run. Because of this users can decide if they want to execute these or not, by changing the "Run long test cases" preference.! Item was added: + ----- Method: LongTestCase class>>allTestSelectors (in category 'accessing') ----- + allTestSelectors + + self shouldRun ifTrue: [ + ^super testSelectors ]. + ^#().! Item was added: + ----- Method: LongTestCase class>>buildSuite (in category 'instance creation') ----- + buildSuite + + self shouldRun ifTrue: [ ^super buildSuite ]. + ^self suiteClass new! Item was added: + ----- Method: LongTestCase class>>doNotRunLongTestCases (in category 'accessing') ----- + doNotRunLongTestCases + + self shouldRun: false! Item was added: + ----- Method: LongTestCase class>>isAbstract (in category 'testing') ----- + isAbstract + "Override to true if a TestCase subclass is Abstract and should not have + TestCase instances built from it" + + ^self name == #LongTestCase + ! Item was added: + ----- Method: LongTestCase class>>runLongTestCases (in category 'accessing') ----- + runLongTestCases + + self shouldRun: true! Item was added: + ----- Method: LongTestCase class>>shouldRun (in category 'accessing') ----- + shouldRun + + <preference: 'Run long test cases' + category: 'SUnit' + description: 'If true, the tests defined as taking a long time to run (those in subclasses of LongTestCase) will run when they are selected in the Test Runner.' + type: #Boolean> + ^ShouldRun ifNil: [ true ]! Item was added: + ----- Method: LongTestCase class>>shouldRun: (in category 'accessing') ----- + shouldRun: aBoolean + + ShouldRun := aBoolean! Item was added: + ----- Method: LongTestCase>>defaultTimeout (in category 'as yet unclassified') ----- + defaultTimeout + "Answer the default timeout to use for tests in this test case. The timeout is a value in seconds." + + ^super defaultTimeout * 10! Item was added: + ----- Method: RBMethodNode>>quickMethodReturnLiteral (in category '*VMMakerCompatibilityForPharo6-C translation') ----- + quickMethodReturnLiteral + | node | + node := body statements last value. + ^node isVariable + ifTrue: [node name] + ifFalse: [node value]!

1 0

VM Maker: VMMaker.oscog-eem.2439.mcz
by commits＠source.squeak.org 09 Sep '18

09 Sep '18

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2439.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2439 Author: eem Time: 9 September 2018, 10:09:01.654985 am UUID: f6046fd7-5079-4f12-8e79-bd515107612f Ancestors: VMMaker.oscog-eem.2438 Slang: more Pharo/Squeak compatibiltiy refactoring. =============== Diff against VMMaker.oscog-eem.2438 =============== Item was changed: ----- Method: CCodeGenerator>>addMethodFor:selector: (in category 'utilities') ----- addMethodFor: aClass selector: selector "Add the given method to the code base and answer its translation or nil if it shouldn't be translated." | method tmethod | method := aClass compiledMethodAt: selector. (method pragmaAt: #doNotGenerate) ifNotNil: ["only remove a previous method if this one overrides it, i.e. this is a subclass method. If the existing method is in a different hierarchy this method must be merely a redeirect." (methods at: selector ifAbsent: []) ifNotNil: [:tm| (aClass includesBehavior: tm definingClass) ifTrue: [self removeMethodForSelector: selector]]. ^nil]. method isSubclassResponsibility ifTrue: [^nil]. (self shouldIncludeMethodFor: aClass selector: selector) ifFalse: [^nil]. tmethod := self compileToTMethodSelector: selector in: aClass. "Even though we exclude initialize methods, we must consider their global variable usage, otherwise globals may be incorrectly localized." selector == #initialize ifTrue: [self checkForGlobalUsage: (tmethod allReferencedVariablesUsing: self) in: tmethod. ^nil]. self addMethod: tmethod. "If the method has a macro then add the macro. But keep the method for analysis purposes (e.g. its variable accesses)." (method pragmaAt: #cmacro:) ifNotNil: [:pragma| self addMacro: (pragma argumentAt: 1) for: selector. (inlineList includes: selector) ifTrue: [inlineList := inlineList copyWithout: selector]]. (method pragmaAt: #cmacro) ifNotNil: [:pragma| | literal | "Method should be just foo ^const" self assert: (method numArgs = 0 and: [method numLiterals = 3 or: [method isQuick]]). literal := method isQuick + ifTrue: [method decompile quickMethodReturnLiteral] - ifTrue: [method decompile block statements last expr key] ifFalse: [method literalAt: 1]. self addMacro: '() ', (method isReturnField ifTrue: [literal] ifFalse: [self cLiteralFor: literal value name: method selector]) for: selector. (inlineList includes: selector) ifTrue: [inlineList := inlineList copyWithout: selector]]. ^tmethod! Item was changed: ----- Method: CCodeGenerator>>nonStructClassesForTranslationClasses: (in category 'utilities') ----- nonStructClassesForTranslationClasses: classes "Answer in superclass order (any superclass precedes any subclass) the ancilliaryClasses that are not struct classes for all the given classes." | nonStructClasses | nonStructClasses := OrderedCollection new. classes do: [:aTranslationClass| ([aTranslationClass ancilliaryClasses] on: MessageNotUnderstood do: [:ex| ex message selector == #ancilliaryClasses ifTrue: [#()] ifFalse: [ex pass]]) do: [:class| (vmClass isNil or: [vmClass isAcceptableAncilliaryClass: class]) ifTrue: [(class isStructClass or: [(nonStructClasses includes: class) or: [classes includes: class]]) ifFalse: [nonStructClasses addLast: class]]]]. + ^self superclassOrder: nonStructClasses! - ^ChangeSet superclassOrder: nonStructClasses! Item was changed: ----- Method: CCodeGenerator>>structClassesForTranslationClasses: (in category 'utilities') ----- structClassesForTranslationClasses: classes "Answer in superclass order (any superclass precedes any subclass) the ancilliaryClasses that are struct classes for all the given classes." | theStructClasses | theStructClasses := OrderedCollection new. classes do: [:aTranslationClass| ([aTranslationClass ancilliaryClasses] on: MessageNotUnderstood do: [:ex| ex message selector == #ancilliaryClasses ifTrue: [#()] ifFalse: [ex pass]]) do: [:class| (class isStructClass and: [(vmClass isNil or: [vmClass isAcceptableAncilliaryClass: class]) and: [(theStructClasses includes: class) not]]) ifTrue: [theStructClasses addLast: class]]]. + ^self superclassOrder: theStructClasses! - ^ChangeSet superclassOrder: theStructClasses! Item was added: + ----- Method: CCodeGenerator>>superclassOrder: (in category 'utilities') ----- + superclassOrder: classes + ^[ChangeSet superclassOrder: classes] "Squeak" + on: MessageNotUnderstood + do: [ :ex| + ex message selector == #superclassOrder: ifFalse: + [ex pass]. + Class superclassOrder: classes] "Pharo"! Item was added: + ----- Method: MethodNode>>quickMethodReturnLiteral (in category '*VMMaker-C translation') ----- + quickMethodReturnLiteral + ^self block statements last expr key!

1 0

VM Maker: VMMakerCompatibilityForPharo6-eem.6.mcz
by commits＠source.squeak.org 09 Sep '18

09 Sep '18

Eliot Miranda uploaded a new version of VMMakerCompatibilityForPharo6 to project VM Maker: http://source.squeak.org/VMMaker/VMMakerCompatibilityForPharo6-eem.6.mcz ==================== Summary ==================== Name: VMMakerCompatibilityForPharo6-eem.6 Author: eem Time: 9 September 2018, 6:48:54.587661 pm UUID: 10e0cac0-d431-0d00-bccf-c5da012ef449 Ancestors: VMMakerCompatibilityForPharo6-eem.5 Add translation support to RBProgramNode such that simple methods such as primitiveMakePoint can be translated to C. Still work needed to run the workspace translation scripts, which translate everything to be able to run inlining before generating C for a single method. Add ClosureExtractor, DisplayText and TranscriptStream as needed support classes now missing in Pharo6. Add bytesPerElement to the Collection hierarchy, again support dropped from Pharo6 (perhaps because image segments are not supported?). =============== Diff against VMMakerCompatibilityForPharo6-eem.5 =============== Item was added: + DisplayObject subclass: #DisplayText + instanceVariableNames: 'text textStyle offset form foreColor backColor' + classVariableNames: '' + poolDictionaries: 'TextConstants' + category: 'VMMakerCompatibilityForPharo6'! + + !DisplayText commentStamp: '<historical>' prior: 0! + I represent Text whose emphasis changes are mapped to a set of fonts. My instances have an offset used in determining screen placement for displaying. They get used two different ways in the system. In the user interface, they mainly hold onto some text which is viewed by some form of ParagraphEditor. However, as a DisplayObject, they may need to display efficiently, so my instances have a cache for the bits.! Item was added: + ----- Method: DisplayText class>>example (in category 'examples') ----- + example + "Continually prints two lines of text wherever you point with the cursor. Terminate by pressing any button on the + mouse." + | tx | + tx := 'this is a line of characters and + this is the second line.' asDisplayText. + tx foregroundColor: Color black backgroundColor: Color transparent. + tx := tx alignedTo: #center. + [Sensor anyButtonPressed] + whileFalse: + [tx displayOn: Display at: Sensor cursorPoint] + + "DisplayText example."! Item was added: + ----- Method: DisplayText class>>text: (in category 'instance creation') ----- + text: aText + "Answer an instance of me such that the text displayed is aText + according to the system's default text style." + + ^self new + setText: aText + textStyle: DefaultTextStyle copy + offset: 0 @ 0! Item was added: + ----- Method: DisplayText class>>text:textStyle: (in category 'instance creation') ----- + text: aText textStyle: aTextStyle + "Answer an instance of me such that the text displayed is aText + according to the style specified by aTextStyle." + + ^self new + setText: aText + textStyle: aTextStyle + offset: 0 @ 0! Item was added: + ----- Method: DisplayText class>>text:textStyle:offset: (in category 'instance creation') ----- + text: aText textStyle: aTextStyle offset: aPoint + "Answer an instance of me such that the text displayed is aText + according to the style specified by aTextStyle. The display of the + information should be offset by the amount given as the argument, + aPoint." + + ^self new + setText: aText + textStyle: aTextStyle + offset: aPoint! Item was added: + ----- Method: DisplayText>>alignedTo: (in category 'accessing') ----- + alignedTo: alignPointSelector + "Return a copy with offset according to alignPointSelector which is one of... + #(topLeft, topCenter, topRight, leftCenter, center, etc)" + | boundingBox | + boundingBox := 0@0 corner: self form extent. + ^ self shallowCopy offset: (0@0) - (boundingBox perform: alignPointSelector)! Item was added: + ----- Method: DisplayText>>backgroundColor (in category 'color') ----- + backgroundColor + backColor == nil ifTrue: [^ Color transparent]. + ^ backColor! Item was added: + ----- Method: DisplayText>>boundingBox (in category 'display box access') ----- + boundingBox + "Refer to the comment in DisplayObject|boundingBox." + + ^self form boundingBox! Item was added: + ----- Method: DisplayText>>composeForm (in category 'private') ----- + composeForm + | tmpText canvas | + tmpText := TextMorph new contentsAsIs: self text deepCopy. + self foregroundColor ifNotNil: [:color | + tmpText text addAttribute: (TextColor color: color)]. + self backgroundColor ifNotNil: [:color | + tmpText backgroundColor: color]. + tmpText setTextStyle: "displayText textStyle" TextStyle default. + canvas := FormCanvas on: (Form extent: tmpText extent depth: 32). + tmpText drawOn: canvas. + form := canvas form! Item was added: + ----- Method: DisplayText>>computeBoundingBox (in category 'display box access') ----- + computeBoundingBox + "Compute minimum enclosing rectangle around characters." + + | character font width carriageReturn lineWidth lineHeight | + carriageReturn := Character cr. + width := lineWidth := 0. + font := textStyle defaultFont. + lineHeight := textStyle lineGrid. + 1 to: text size do: + [:i | + character := text at: i. + character = carriageReturn + ifTrue: + [lineWidth := lineWidth max: width. + lineHeight := lineHeight + textStyle lineGrid. + width := 0] + ifFalse: [width := width + (font widthOf: character)]]. + lineWidth := lineWidth max: width. + ^offset extent: lineWidth @ lineHeight! Item was added: + ----- Method: DisplayText>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger fillColor: aForm + "For TT font, rule 34 is used if possible." + "Refer to the comment in + DisplayObject|displayOn:at:clippingBox:rule:mask:." + + | form1 rule | + form1 := self form. + rule := (ruleInteger = Form over and: [backColor isTransparent]) + ifTrue: [form1 depth = 32 ifTrue: [rule := 34] ifFalse: [Form paint]] + ifFalse: [ruleInteger]. + form1 depth = 32 ifTrue: [rule := 34]. + form1 + displayOn: aDisplayMedium + at: aDisplayPoint + offset + clippingBox: clipRectangle + rule: rule + fillColor: aForm! Item was added: + ----- Method: DisplayText>>displayOn:transformation:clippingBox:align:with:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle align: alignmentPoint with: relativePoint rule: ruleInteger fillColor: aForm + "Refer to the comment in + DisplayObject|displayOn:transformation:clippingBox:align:with:rule:mask:." + + | absolutePoint | + absolutePoint := displayTransformation applyTo: relativePoint. + absolutePoint := absolutePoint x asInteger @ absolutePoint y asInteger. + self displayOn: aDisplayMedium + at: absolutePoint - alignmentPoint + clippingBox: clipRectangle + rule: ruleInteger + fillColor: aForm! Item was added: + ----- Method: DisplayText>>displayOnPort:at: (in category 'displaying') ----- + displayOnPort: aPort at: location + self form displayOnPort: aPort at: location + offset! Item was added: + ----- Method: DisplayText>>fontsUsed (in category 'accessing') ----- + fontsUsed + "Return a list of all fonts used currently in this text. 8/19/96 tk" + + ^ text runs values asSet collect: [:each | textStyle fontAt: each]! Item was added: + ----- Method: DisplayText>>foregroundColor (in category 'color') ----- + foregroundColor + foreColor == nil ifTrue: [^ Color black]. + ^ foreColor! Item was added: + ----- Method: DisplayText>>foregroundColor:backgroundColor: (in category 'color') ----- + foregroundColor: cf backgroundColor: cb + foreColor := cf. + backColor := cb! Item was added: + ----- Method: DisplayText>>form (in category 'accessing') ----- + form + "Answer the form into which the receiver's display bits are cached." + + form == nil ifTrue: [self composeForm]. + ^form! Item was added: + ----- Method: DisplayText>>lineGrid (in category 'accessing') ----- + lineGrid + "Answer the relative space between lines of the receiver's text." + + ^textStyle lineGrid! Item was added: + ----- Method: DisplayText>>numberOfLines (in category 'accessing') ----- + numberOfLines + "Answer the number of lines of text in the receiver." + + ^self height // text lineGrid! Item was added: + ----- Method: DisplayText>>offset (in category 'accessing') ----- + offset + "Refer to the comment in DisplayObject|offset." + + ^offset! Item was added: + ----- Method: DisplayText>>offset: (in category 'accessing') ----- + offset: aPoint + "Refer to the comment in DisplayObject|offset:." + + offset := aPoint! Item was added: + ----- Method: DisplayText>>setText:textStyle:offset: (in category 'private') ----- + setText: aText textStyle: aTextStyle offset: aPoint + + text := aText. + textStyle := aTextStyle. + offset := aPoint. + form := nil! Item was added: + ----- Method: DisplayText>>string (in category 'accessing') ----- + string + "Answer the string of the characters displayed by the receiver." + + ^text string! Item was added: + ----- Method: DisplayText>>text (in category 'accessing') ----- + text + "Answer the text displayed by the receiver." + + ^text! Item was added: + ----- Method: DisplayText>>text: (in category 'accessing') ----- + text: aText + "Set the receiver to display the argument, aText." + + text := aText. + form := nil. + self changed. + ! Item was added: + ----- Method: DisplayText>>textStyle (in category 'accessing') ----- + textStyle + "Answer the style by which the receiver displays its text." + + ^textStyle! Item was added: + ----- Method: DisplayText>>textStyle: (in category 'accessing') ----- + textStyle: aTextStyle + "Set the style by which the receiver should display its text." + + textStyle := aTextStyle. + form := nil. + self changed. + ! Item was added: + ----- Method: MenuMorph>>add:action: (in category '*VMMakerCompatibilityForPharo6-construction') ----- + add: aString action: aSymbolOrValuable + "Append a menu item with the given label. If the item is selected, it will send the given selector to the default target object." + "Details: Note that the menu item added captures the default target object at the time the item is added; the default target can later be changed before added additional items without affecting the targets of previously added entries. The model is that each entry is like a button that knows everything it needs to perform its action." + aSymbolOrValuable isSymbol + ifTrue: + [ self + add: aString + target: defaultTarget + selector: aSymbolOrValuable + argumentList: Array empty ] + ifFalse: + [ self + add: aString + target: aSymbolOrValuable + selector: #value + argumentList: Array empty ]! Item was added: + ----- Method: MenuMorph>>add:target:action: (in category '*VMMakerCompatibilityForPharo6-construction') ----- + add: aString target: aTarget action: aSymbol + self + add: aString + target: aTarget + selector: aSymbol + argumentList: Array empty! Item was added: + ----- Method: RBAssignmentNode>>anyReturns: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- + anyReturns: aSequenceOfNodes + aSequenceOfNodes do: + [:node| + node nodesDo: + [:n| + n isReturn ifTrue: + [^true]]]. + ^false! Item was changed: ----- Method: RBAssignmentNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- asTranslatorNodeIn: aTMethod "Answer a TParseNode subclass equivalent of me" | varNode valueNode | varNode := variable asTranslatorNodeIn: aTMethod. valueNode := value asTranslatorNodeIn: aTMethod. valueNode isStmtList ifFalse: [^TAssignmentNode new setVariable: varNode expression: valueNode; + comment: self missingCommentNeededForCTranslation]. - comment: comment]. "This is a super expansion. We are in trouble if any statement other than the last is a return." (self anyReturns: valueNode statements allButLast) ifTrue: [self error: 'haven''t implemented pushing down assignments into other than the last return']. "As of 6/25/2012 19:30 superExpansionNodeFor:args: elides the final return." self assert: valueNode statements last isReturn not. ^TStmtListNode new setStatements: valueNode statements allButLast, { TAssignmentNode new setVariable: varNode expression: valueNode statements last; + comment: self missingCommentNeededForCTranslation }; - comment: comment }; yourself! Item was changed: ----- Method: RBBlockNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- asTranslatorNodeIn: aTMethod "Answer a TParseNode subclass equivalent of me" | statementList | statementList := OrderedCollection new. body statements do: [:s | | newS | newS := s asTranslatorNodeIn: aTMethod. "inline the statement list returned when a CascadeNode is translated and/or when ifNotNil: is transformed" newS isStmtList ifTrue: [statementList addAll: newS statements] ifFalse: [statementList add: newS]]. ^TStmtListNode new + setArguments: (arguments asArray collect: [:arg | arg name]) - setArguments: (arguments asArray collect: [:arg | arg key]) statements: statementList; comment: self missingCommentNeededForCTranslation! Item was changed: ----- Method: RBCascadeNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- asTranslatorNodeIn: aTMethod "Answer a TParseNode subclass equivalent of me." ^TStmtListNode new setArguments: #() statements: (Array streamContents: [:s| | receiverNode | + receiverNode := messages first receiver asTranslatorNodeIn: aTMethod. - receiverNode := receiver asTranslatorNodeIn: aTMethod. "don't expand the receiver if it is a send to get an implicit receiver, e.g self interpreter printHex: oop => printHex(oop), /not/ printHex(cascade0,oop)." (receiverNode isSend and: [aTMethod definingClass isNonArgumentImplicitReceiverVariableName: receiverNode selector]) ifTrue: [receiverNode := TVariableNode new setName: receiverNode selector]. receiverNode isLeaf ifFalse: [| varNode | varNode := aTMethod newCascadeTempFor: receiverNode. s nextPut: (TAssignmentNode new setVariable: varNode expression: receiverNode). receiverNode := varNode]. messages do: [ :msg | s nextPut: ((msg asTranslatorNodeIn: aTMethod) receiver: receiverNode)]]); + comment: self missingCommentNeededForCTranslation! - comment: comment! Item was changed: ----- Method: RBLiteralNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- asTranslatorNodeIn: aTMethod "Answer a TParseNode subclass equivalent of me" + ^TConstantNode new setValue: self value! - ^TConstantNode new setValue: key! Item was changed: ----- Method: RBMessageNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- asTranslatorNodeIn: aTMethod "Answer a TParseNode subclass equivalent of me" "selector is sometimes a Symbol, sometimes a SelectorNode!! On top of this, numArgs is needed due to the (truly grody) use of arguments as a place to store the extra expressions needed to generate code for in-line to:by:do:, etc. see below, where it is used. Expand super nodes in place. Elide sends of halt so that halts can be sprinkled through the simulator but will be eliminated from the generated C." | rcvrOrNil sel args ifNotNilBlock | rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod]. (rcvrOrNil notNil and: [rcvrOrNil isVariable and: [rcvrOrNil name = 'super']]) ifTrue: [^aTMethod superExpansionNodeFor: selector key args: arguments]. sel := selector isSymbol ifTrue: [selector] ifFalse: [selector key]. sel == #halt ifTrue: [^rcvrOrNil]. (sel == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block." or: [sel == #cCode:]) ifTrue: [arguments first isBlockNode ifTrue: [| block | ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1 ifTrue: [block statements first] ifFalse: [block]]. (arguments first isLiteralNode + and: [arguments first value isString + and: [arguments first value isEmpty]]) ifTrue: - and: [arguments first key isString - and: [arguments first key isEmpty]]) ifTrue: [^arguments first asTranslatorNodeIn: aTMethod]]. args := arguments select: [:arg| arg notNil] thenCollect: [:arg| arg asTranslatorNodeIn: aTMethod]. + false ifTrue: + [(sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) ifTrue: - (sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) ifTrue: ["Restore limit expr that got moved by transformToDo:" args := {(arguments at: 7) value asTranslatorNodeIn: aTMethod. args second. args third. "add the limit var as a hidden extra argument; we may need it later" TVariableNode new setName: arguments first key}]. (sel == #ifTrue:ifFalse: and: [arguments first isNodeNil]) ifTrue: [sel := #ifFalse:. args := {args last}]. (sel == #ifTrue:ifFalse: and: [arguments last isNodeNil]) ifTrue: [sel := #ifTrue:. args := {args first}]. (sel == #ifFalse:ifTrue: and: [arguments first isNodeNil]) ifTrue: [sel := #ifTrue:. args := {args last}]. (sel == #ifFalse:ifTrue: and: [arguments last isNodeNil]) ifTrue: [sel := #ifTrue:. args := {args first}]. ((sel == #ifFalse: or: [sel == #or:]) and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue: ["Restore argument block that got moved by transformOr: or transformIfFalse:" args := {(arguments at: 2) asTranslatorNodeIn: aTMethod}]. (args size > sel numArgs and: [sel ~~ #to:by:do:]) ifTrue: "to:by:do: has iLimiT hidden in last arg" ["prune the extra blocks left by ifTrue:, ifFalse:, and: & or:" self assert: args size - sel numArgs = 1. self assert: (args last isStmtList and: [args last statements size = 1 and: [(args last statements first isVariable or: [args last statements first isConstant]) and: [#('nil' true false) includes: args last statements first nameOrValue]]]). args := args first: sel numArgs]. "For the benefit of later passes, e.g. value: inlining, transform e ifNotNil: [:v| ...] into v := e. v ifNotNil: [...], which in fact means transforming (v := e) ifTrue: [:v|...] into v := e. v ifTrue: [...]." ((sel == #ifTrue: or: [sel == #ifFalse: or: [sel == #ifTrue:ifFalse: or: [sel == #ifFalse:ifTrue:]]]) and: [receiver notNil and: [receiver isAssignmentEqualsEqualsNil and: [(ifNotNilBlock := args detect: [:arg| arg isStmtList and: [arg args size = 1]] ifNone: []) notNil]]]) ifTrue: [ifNotNilBlock setArguments: #(). ^TStmtListNode new setArguments: #() statements: { receiver receiver asTranslatorNodeIn: aTMethod. TSendNode new setSelector: sel receiver: (TSendNode new setSelector: #== receiver: (receiver receiver variable asTranslatorNodeIn: aTMethod) arguments: {receiver arguments first asTranslatorNodeIn: aTMethod}) + arguments: args }]]. - arguments: args }]. ((CCodeGenerator isVarargsSelector: sel) and: [args last isCollection and: [args last isSequenceable]]) ifTrue: [args := args allButLast, args last]. ^TSendNode new setSelector: sel receiver: rcvrOrNil arguments: args! Item was changed: ----- Method: RBMethodNode>>asTranslationMethodOfClass: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- asTranslationMethodOfClass: aTMethodClass "Answer a TMethod (or subclass) derived from the receiver." ^aTMethodClass new setSelector: selector + definingClass: scope instanceScope outerScope getClass - definingClass: scope instanceScope outerScope class args: arguments locals: ((self allDefinedVariables copyWithoutAll: arguments) collect: [:string| string -> string]) block: body primitive: ((pragmas ifNotNil: [pragmas detect: [:pragmaNode| pragmaNode selector beginsWith: #primitve:] ifNone: []]) ifNil: [0] ifNotNil: [:pragmaNode| pragmaNode arguments first value]) properties: (properties ifNil: [AdditionalMethodState new]) comment: self missingCommentNeededForCTranslation! Item was changed: ----- Method: RBReturnNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- asTranslatorNodeIn: aTMethod "Answer a TParseNode subclass equivalent of a return." | exprTranslation lastExpr | + exprTranslation := value asTranslatorNodeIn: aTMethod. + (value isMessage + and: [value receiver isVariable + and: [value receiver name = 'super' - exprTranslation := expr asTranslatorNodeIn: aTMethod. - (expr isMessage - and: [expr receiver isVariableNode - and: [expr receiver key = 'super' and: [exprTranslation isStmtList]]]) ifTrue: ["super expansions containing returns are fine, and (as of 6/25/2012 19:27) the last return is elided from the expansion by TMethod>>superExpansionNodeFor:args:. So we need to ensure the last expression is a return and simply reuse any other returns in the expansion." lastExpr := exprTranslation statements last. (lastExpr isReturn or: [lastExpr isReturningIf]) ifFalse: [exprTranslation statements at: exprTranslation statements size put: (TReturnNode new setExpression: lastExpr; + comment: self missingCommentNeededForCTranslation; - comment: comment; yourself)]. ^exprTranslation]. ^TReturnNode new setExpression: exprTranslation; + comment: self missingCommentNeededForCTranslation; - comment: comment; yourself! Item was changed: ----- Method: RBSequenceNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') ----- asTranslatorNodeIn: aTMethod "Answer a TParseNode subclass equivalent of me" | statementList | statementList := OrderedCollection new. statements do: [:s | | newS | newS := s asTranslatorNodeIn: aTMethod. "inline the statement list returned when a CascadeNode is translated and/or when ifNotNil: is transformed" newS isStmtList ifTrue: [statementList addAll: newS statements] ifFalse: [statementList add: newS]]. ^TStmtListNode new + setArguments: (parent arguments asArray collect: [:arg | arg name]) - setArguments: (parent arguments asArray collect: [:arg | arg key]) statements: statementList; comment: self missingCommentNeededForCTranslation! Item was added: + ----- Method: String>>asDisplayText (in category '*VMMakerCompatibilityForPharo6-converting') ----- + asDisplayText + "Answer a DisplayText whose text string is the receiver." + + ^DisplayText text: self asText! Item was added: + WriteStream subclass: #TranscriptStream + instanceVariableNames: 'lastChar' + classVariableNames: 'AccessSema CharacterLimit ForceUpdate RedirectToStdOut' + poolDictionaries: '' + category: 'VMMakerCompatibilityForPharo6'! + + !TranscriptStream commentStamp: 'fbs 12/30/2013 09:53' prior: 0! + This class is a much simpler implementation of Transcript protocol that supports multiple views and very simple conversion to morphic. Because it inherits from Stream, it is automatically compatible with code that is designed to write to streams.! Item was added: + ----- Method: TranscriptStream class>>characterLimit (in category 'preferences') ----- + characterLimit + <preference: 'Maximum number of characters in a transcript' + categoryList: #(printing morphic debug) + description: 'When the number of characters in a transcript exceeds this limit, characters at the start of the text are discarded.' + type: #Number> + ^CharacterLimit ifNil: [20000]! Item was added: + ----- Method: TranscriptStream class>>characterLimit: (in category 'preferences') ----- + characterLimit: anInteger + + CharacterLimit := anInteger.! Item was added: + ----- Method: TranscriptStream class>>forceUpdate (in category 'preferences') ----- + forceUpdate + + <preference: 'Force transcript updates to screen' + categoryList: #(printing morphic debug) + description: 'When enabled, transcript updates will immediately shown in the screen no matter how busy the UI process is.' + type: #Boolean> + ^ ForceUpdate ifNil: [true]! Item was added: + ----- Method: TranscriptStream class>>forceUpdate: (in category 'preferences') ----- + forceUpdate: aBoolean + + ForceUpdate := aBoolean.! Item was added: + ----- Method: TranscriptStream class>>initialize (in category 'class initialization') ----- + initialize + + self registerInFlapsRegistry. ! Item was added: + ----- Method: TranscriptStream class>>new (in category 'instance creation') ----- + new + ^ self on: (String new: 1000) + " + INSTALLING: + TextCollector allInstances do: + [:t | t breakDependents. + t become: TranscriptStream new]. + + TESTING: (Execute this text in a workspace) + Do this first... + tt := TranscriptStream new. + tt openLabel: 'Transcript test 1'. + Then this will open a second view -- ooooh... + tt openLabel: 'Transcript test 2'. + And finally make them do something... + tt clear. + [Sensor anyButtonPressed] whileFalse: + [1 to: 20 do: [:i | tt print: (2 raisedTo: i-1); cr; endEntry]]. + "! Item was added: + ----- Method: TranscriptStream class>>newTranscript: (in category 'instance creation') ----- + newTranscript: aTextCollector + "Store aTextCollector as the value of the system global Transcript." + Smalltalk at: #Transcript put: aTextCollector! Item was added: + ----- Method: TranscriptStream class>>redirectToStdOut (in category 'preferences') ----- + redirectToStdOut + <preference: 'Redirect transcript to stdout' + categoryList: #(printing morphic debug) + description: 'When enabled, anything sent to the transcript will be redirected to the stdout stream and (hopefully) the OS terminal.' + type: #Boolean> + ^ RedirectToStdOut ifNil: [false]! Item was added: + ----- Method: TranscriptStream class>>redirectToStdOut: (in category 'preferences') ----- + redirectToStdOut: aBoolean + "In setting up redirection, first remove all dependents that are stdout, + which may include stale files from the last session. Then add a dependency + only if asked to redirect to stdout. Blithely doing + Transcript removeDependent: FileStream stdout + raises an error if stdout is unavailable." + Transcript dependents do: + [:dep| + (dep isStream and: [dep name = #stdout]) ifTrue: + [Transcript removeDependent: dep]]. + (RedirectToStdOut := aBoolean) ifTrue: + [Transcript addDependent: FileStream stdout]! Item was added: + ----- Method: TranscriptStream class>>registerInFlapsRegistry (in category 'class initialization') ----- + registerInFlapsRegistry + "Register the receiver in the system's flaps registry" + self environment + at: #Flaps + ifPresent: [:cl | cl registerQuad: {#TranscriptStream. #openMorphicTranscript. 'Transcript' translatedNoop. 'A Transcript is a window usable for logging and debugging; browse references to #Transcript for examples of how to write to it.' translatedNoop} + forFlapNamed: 'Tools'] + ! Item was added: + ----- Method: TranscriptStream class>>themeProperties (in category 'preferences') ----- + themeProperties + + ^ Model themeProperties! Item was added: + ----- Method: TranscriptStream class>>unload (in category 'class initialization') ----- + unload + "Unload the receiver from global registries" + + self environment at: #Flaps ifPresent: [:cl | + cl unregisterQuadsWithReceiver: self] ! Item was added: + ----- Method: TranscriptStream>>applyUserInterfaceTheme (in category 'model protocol') ----- + applyUserInterfaceTheme + + self dependents do: [:ea | + ea isSystemWindow ifTrue: [ + ea refreshWindowColor]].! Item was added: + ----- Method: TranscriptStream>>bs (in category 'stream extensions') ----- + bs + self position > 0 ifTrue: [^ self skip: -1]. + self changed: #bs! Item was added: + ----- Method: TranscriptStream>>characterLimit (in category 'accessing') ----- + characterLimit + "Tell the views how much to retain on screen" + ^self class characterLimit! Item was added: + ----- Method: TranscriptStream>>clear (in category 'stream extensions') ----- + clear + "Clear all characters and redisplay the view" + self changed: #clearText. + self reset! Item was added: + ----- Method: TranscriptStream>>closeAllViews (in category 'initialization') ----- + closeAllViews + "Transcript closeAllViews" + + self changed: #close + ! Item was added: + ----- Method: TranscriptStream>>contents (in category 'accessing') ----- + contents + "Override to update lastChar." + position > 0 ifTrue: + [lastChar := collection at: position]. + ^super contents! Item was added: + ----- Method: TranscriptStream>>countOpenTranscripts (in category 'private') ----- + countOpenTranscripts + "Transcript countOpenTranscripts" + + ^ (self dependents select: [:e | e isTextView]) size + ! Item was added: + ----- Method: TranscriptStream>>endEntry (in category 'stream extensions') ----- + endEntry + "Display all the characters since the last endEntry, and reset the stream" + self semaphore critical:[ + self class forceUpdate + ifTrue: [self changed: #appendEntry] + ifFalse: [self changed: #appendEntryLater]. + self reset. + ].! Item was added: + ----- Method: TranscriptStream>>flush (in category 'stream extensions') ----- + flush + self endEntry + ! Item was added: + ----- Method: TranscriptStream>>nextPut: (in category 'stream extensions') ----- + nextPut: anObject + self target == self ifFalse: [self target nextPut: anObject]. "delegated to stdout" + ^ super nextPut: anObject.! Item was added: + ----- Method: TranscriptStream>>nextPutAll: (in category 'stream extensions') ----- + nextPutAll: aCollection + self target == self ifFalse: [self target nextPutAll: aCollection]. "delegated to stdout" + ^ super nextPutAll: aCollection.! Item was added: + ----- Method: TranscriptStream>>pastEndPut: (in category 'stream extensions') ----- + pastEndPut: anObject + "If the stream reaches its limit, just output the contents and reset." + self endEntry. + ^ self nextPut: anObject! Item was added: + ----- Method: TranscriptStream>>peekLast (in category 'character writing') ----- + peekLast + "Return that item just put at the end of the stream" + + ^ position > 0 + ifTrue: [collection at: position] + ifFalse: [lastChar]! Item was added: + ----- Method: TranscriptStream>>perform:orSendTo: (in category 'model protocol') ----- + perform: selector orSendTo: otherTarget + "Selector was just chosen from a menu by a user. If can respond, then + perform it on myself. If not, send it to otherTarget, presumably the + editPane from which the menu was invoked." + + (self respondsTo: selector) + ifTrue: [^ self perform: selector] + ifFalse: [^ otherTarget perform: selector]! Item was added: + ----- Method: TranscriptStream>>release (in category 'model protocol') ----- + release + + self dependents do: + [:view | (view isMorph and: [view isInWorld not]) + ifTrue: [self removeDependent: view]]! Item was added: + ----- Method: TranscriptStream>>reset (in category 'positioning') ----- + reset + "Override to set lastChar" + position > 0 ifTrue: + [lastChar := collection at: position]. + ^super reset! Item was added: + ----- Method: TranscriptStream>>semaphore (in category 'private') ----- + semaphore + ^AccessSema ifNil:[AccessSema := Semaphore forMutualExclusion]! Item was added: + ----- Method: TranscriptStream>>show: (in category 'stream extensions') ----- + show: anObject + "TextCollector compatibility" + + [ + self nextPutAll: anObject asString. + self endEntry + ] on: FileWriteError do: [self class redirectToStdOut: false].! Item was added: + ----- Method: TranscriptStream>>showln: (in category 'stream extensions') ----- + showln: anObject + "TextCollector compatibility. Ensure a new line before inserting a message." + + [ + self + cr; + nextPutAll: anObject asString. + self endEntry. + ] on: FileWriteError do: [self class redirectToStdOut: false].! Item was added: + ----- Method: TranscriptStream>>step (in category 'model protocol') ----- + step + "Objects that may be models of SystemWindows need to respond to this, albeit vacuously"! Item was added: + ----- Method: TranscriptStream>>target (in category 'stream extensions') ----- + target + + ^ self class redirectToStdOut + ifTrue: [FileStream stdout] + ifFalse: [self]! Item was added: + ----- Method: TranscriptStream>>windowActiveOnFirstClick (in category 'model protocol') ----- + windowActiveOnFirstClick + + ^ Model windowActiveOnFirstClick! Item was added: + ----- Method: TranscriptStream>>windowColorToUse (in category 'model protocol') ----- + windowColorToUse + + ^ Color colorFrom: (Model useColorfulWindows + ifTrue: [self userInterfaceTheme customWindowColor ifNil: [Color r: 0.9 g: 0.75 b: 0.45]] + ifFalse: [self userInterfaceTheme uniformWindowColor ifNil: [Color veryVeryLightGray]])!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev September 2018