[Vm-dev] VM Maker: VMMaker-eem.397.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Sep 20 23:40:48 UTC 2018
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-eem.397.mcz
==================== Summary ====================
Name: VMMaker-eem.397
Author: eem
Time: 20 September 2018, 4:40:17.831313 pm
UUID: db24f1da-c1aa-416d-8f29-d5df182e43de
Ancestors: VMMaker-dtl.396
Add support for the varargs convention (good for eliminating cCode:). Port the much simplified FilePlugin/FilePluginSimulator directory primitive support from VMMaker.oscog.
=============== Diff against VMMaker-dtl.396 ===============
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 changed:
----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') -----
initializeCTranslationDictionary
"Initialize the dictionary mapping message names to actions for C code generation."
| pairs |
translationDict := Dictionary new: 200.
pairs := #(
#& #generateAnd:on:indent:
#| #generateOr:on:indent:
#and: #generateSequentialAnd:on:indent:
#or: #generateSequentialOr:on:indent:
#not #generateNot:on:indent:
#+ #generatePlus:on:indent:
#- #generateMinus:on:indent:
#negated #generateNegated:on:indent:
#* #generateTimes:on:indent:
#/ #generateDivide:on:indent:
#// #generateDivide:on:indent:
#\\ #generateModulo:on:indent:
#<< #generateShiftLeft:on:indent:
#>> #generateShiftRight:on:indent:
#min: #generateMin:on:indent:
#max: #generateMax:on:indent:
#between:and: #generateBetweenAnd:on:indent:
#bitAnd: #generateBitAnd:on:indent:
#bitOr: #generateBitOr:on:indent:
#bitXor: #generateBitXor:on:indent:
#bitShift: #generateBitShift:on:indent:
#signedBitShift: #generateSignedBitShift:on:indent:
#bitInvert32 #generateBitInvert32:on:indent:
#bitClear: #generateBitClear:on:indent:
#< #generateLessThan:on:indent:
#<= #generateLessThanOrEqual:on:indent:
#= #generateEqual:on:indent:
#> #generateGreaterThan:on:indent:
#>= #generateGreaterThanOrEqual:on:indent:
#~= #generateNotEqual:on:indent:
#== #generateEqual:on:indent:
#~~ #generateNotEqual:on:indent:
#isNil #generateIsNil:on:indent:
#notNil #generateNotNil:on:indent:
#whileTrue: #generateWhileTrue:on:indent:
#whileFalse: #generateWhileFalse:on:indent:
#whileTrue #generateDoWhileTrue:on:indent:
#whileFalse #generateDoWhileFalse:on:indent:
#to:do: #generateToDo:on:indent:
#to:by:do: #generateToByDo:on:indent:
#repeat #generateRepeat:on:indent:
#ifTrue: #generateIfTrue:on:indent:
#ifFalse: #generateIfFalse:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent:
#at: #generateAt:on:indent:
#at:put: #generateAtPut:on:indent:
#basicAt: #generateAt:on:indent:
#basicAt:put: #generateAtPut:on:indent:
#integerValueOf: #generateIntegerValueOf:on:indent:
#integerObjectOf: #generateIntegerObjectOf:on:indent:
#isIntegerObject: #generateIsIntegerObject:on:indent:
#cCode: #generateInlineCCode:on:indent:
#cCode:inSmalltalk: #generateInlineCCode:on:indent:
#cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent:
#preprocessorExpression: #generateInlineCppDirective:on:indent:
#isDefined:inSmalltalk:comment:ifTrue: #generateInlineCppIfDef:on:indent:
#isDefined:inSmalltalk:comment:ifTrue:ifFalse: #generateInlineCppIfDefElse:on:indent:
#isDefinedTrueExpression:inSmalltalk:comment:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent:
#cCoerce:to: #generateCCoercion:on:indent:
#cCoerceSimple:to: #generateCCoercion:on:indent:
#addressOf: #generateAddressOf:on:indent:
+ #addressOf:put: #generateAddressOf:on:indent:
+ #addressOf: #generateAddressOf:on:indent:
#signedIntFromLong #generateSignedIntFromLong:on:indent:
#signedIntToLong #generateSignedIntToLong:on:indent:
#signedIntFromShort #generateSignedIntFromShort:on:indent:
#signedIntToShort #generateSignedIntToShort:on:indent:
#preIncrement #generatePreIncrement:on:indent:
#preDecrement #generatePreDecrement:on:indent:
#inline: #generateInlineDirective:on:indent:
#asFloat #generateAsFloat:on:indent:
#asInteger #generateAsInteger:on:indent:
#asIntegerPtr #generateAsIntegerPtr:on:indent:
#asUnsignedInteger #generateAsUnsignedInteger:on:indent:
#asUnsignedIntegerPtr #generateAsUnsignedIntegerPtr:on:indent:
#asLong #generateAsLong:on:indent:
#asUnsignedLong #generateAsUnsignedLong:on:indent:
#asUnsignedLongLong #generateAsUnsignedLongLong:on:indent:
#asVoidPointer #generateAsVoidPointer:on:indent:
#asSymbol #generateAsSymbol:on:indent:
#flag: #generateFlag:on:indent:
#anyMask: #generateBitAnd:on:indent:
#raisedTo: #generateRaisedTo:on:indent:
#touch: #generateTouch:on:indent:
#bytesPerWord #generateBytesPerWord:on:indent:
#baseHeaderSize #generateBaseHeaderSize:on:indent:
#sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent:
#perform: #generatePerform:on:indent:
#perform:with: #generatePerform:on:indent:
#perform:with:with: #generatePerform:on:indent:
#perform:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with:with: #generatePerform:on:indent:
#value #generateValue:on:indent:
#value: #generateValue:on:indent:
#value:value: #generateValue:on:indent:
#shouldNotImplement #generateSmalltalkMetaError:on:indent:
#shouldBeImplemented #generateSmalltalkMetaError:on:indent:
).
1 to: pairs size by: 2 do: [:i |
translationDict at: (pairs at: i) put: (pairs at: i + 1)].
pairs := #(
#ifTrue: #generateIfTrueAsArgument:on:indent:
#ifFalse: #generateIfFalseAsArgument:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent:
#cCode: #generateInlineCCodeAsArgument:on:indent:
#cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent:
#value #generateValueAsArgument:on:indent:
#value: #generateValueAsArgument:on:indent:
#value:value: #generateValueAsArgument:on:indent:
).
asArgumentTranslationDict := Dictionary new: 8.
1 to: pairs size by: 2 do: [:i |
asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
!
Item was changed:
----- Method: FilePlugin>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'directory primitives') -----
makeDirEntryName: entryName size: entryNameSize
createDate: createDate modDate: modifiedDate
+ isDir: dirFlag fileSize: fileSize
+ <var: 'entryName' type: #'char *'>
+ <var: 'fileSize' type: #squeakFileOffsetType>
- isDir: dirFlag fileSize: fileSize
-
| modDateOop createDateOop nameString results stringPtr fileSizeOop |
+ <var: 'stringPtr' type: #'char *'>
- <var: 'entryName' type: 'char *'>
- <var: 'stringPtr' type:'char *'>
- <var: 'fileSize' type:'squeakFileOffsetType '>
"allocate storage for results, remapping newly allocated
+ oops if required in case GC happens during allocation"
+ results := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 5.
+ self remapOop: results in:
+ [nameString := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: entryNameSize.
+ self remapOop: nameString in:
+ [createDateOop := interpreterProxy positive32BitIntegerFor: createDate.
+ self remapOop: createDateOop in:
+ [modDateOop := interpreterProxy positive32BitIntegerFor: modifiedDate.
+ self remapOop: modDateOop in:
+ [fileSizeOop := interpreterProxy positive64BitIntegerFor: fileSize]]]].
- oops in case GC happens during allocation"
- interpreterProxy pushRemappableOop:
- (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 5).
- interpreterProxy pushRemappableOop:
- (interpreterProxy instantiateClass: (interpreterProxy classString) indexableSize: entryNameSize).
- interpreterProxy pushRemappableOop:
- (interpreterProxy positive32BitIntegerFor: createDate).
- interpreterProxy pushRemappableOop:
- (interpreterProxy positive32BitIntegerFor: modifiedDate).
- interpreterProxy pushRemappableOop:
- (interpreterProxy positive64BitIntegerFor: fileSize).
- fileSizeOop := interpreterProxy popRemappableOop.
- modDateOop := interpreterProxy popRemappableOop.
- createDateOop := interpreterProxy popRemappableOop.
- nameString := interpreterProxy popRemappableOop.
- results := interpreterProxy popRemappableOop.
-
"copy name into Smalltalk string"
stringPtr := interpreterProxy firstIndexableField: nameString.
+ 0 to: entryNameSize - 1 do:
+ [ :i |
+ self cCode: [stringPtr at: i put: (entryName at: i)]
+ inSmalltalk: [interpreterProxy storeByte: i ofObject: nameString withValue: (entryName at: i+1) asciiValue]].
- 0 to: entryNameSize - 1 do: [ :i |
- stringPtr at: i put: (entryName at: i).
- ].
+ interpreterProxy
+ storePointer: 0 ofObject: results withValue: nameString;
+ storePointer: 1 ofObject: results withValue: createDateOop;
+ storePointer: 2 ofObject: results withValue: modDateOop;
+ storePointer: 3 ofObject: results withValue: (dirFlag
+ ifTrue: [interpreterProxy trueObject]
+ ifFalse: [interpreterProxy falseObject]);
+ storePointer: 4 ofObject: results withValue: fileSizeOop.
+ ^results!
- interpreterProxy storePointer: 0 ofObject: results withValue: nameString.
- interpreterProxy storePointer: 1 ofObject: results withValue: createDateOop.
- interpreterProxy storePointer: 2 ofObject: results withValue: modDateOop.
- dirFlag
- ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ]
- ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ].
- interpreterProxy storePointer: 4 ofObject: results withValue: fileSizeOop.
- ^ results!
Item was added:
+ ----- 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].
+
+ "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
+ 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 isDefined: 'PharoVM'
- inSmalltalk: [ status := -1 ]
- comment: 'platform support code diverged for pharo'
- 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
- self isDefined: 'PharoVM'
- inSmalltalk: [ status := -1 ]
- comment: 'platform support code diverged for pharo'
- 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)!
- 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 changed:
----- Method: FilePluginSimulator>>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."
| path f index |
+ path := interpreterProxy asString: nameIndex size: nameSize.
- path := interpreterProxy interpreter asString: nameIndex size: nameSize.
f := writeFlag
ifTrue: [FileStream fileNamed: path]
ifFalse:
[(StandardFileStream isAFileNamed: path) ifTrue:
[FileStream readOnlyFileNamed: path]].
f ifNil: [^interpreterProxy primitiveFail].
f binary.
index := openFiles size + 1.
openFiles at: index put: f.
^interpreterProxy integerObjectOf: index!
Item was changed:
----- Method: FilePluginSimulator>>fileValueOf: (in category 'simulation') -----
fileValueOf: objectPointer
| index file |
index := (interpreterProxy isIntegerObject: objectPointer)
ifTrue: [interpreterProxy integerValueOf: objectPointer]
ifFalse:
[((interpreterProxy isBytes: objectPointer)
and: [(interpreterProxy byteSizeOf: objectPointer) = (self sizeof: #SQFile)]) ifFalse:
[interpreterProxy primitiveFail.
^nil].
interpreterProxy longAt: objectPointer + interpreterProxy baseHeaderSize].
+ file := openFiles at: index ifAbsent: [ interpreterProxy primitiveFail. ^ nil ].
- file := openFiles at: index.
"this attempts to preserve file positions across snapshots when debugging the VM
requires saving an image in full flight and pushing it over the cliff time after time..."
(file closed and: [states includesKey: file]) ifTrue:
[[:pos :isBinary|
file reopen; position: pos.
isBinary ifTrue:
[file binary]] valueWithArguments: (states at: file)].
^file!
Item was removed:
- ----- Method: FilePluginSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'simulation') -----
- makeDirEntryName: entryName size: entryNameSize
- createDate: createDate modDate: modifiedDate
- isDir: dirFlag fileSize: fileSize
-
- ^interpreterProxy
- makeDirEntryName: entryName size: entryNameSize
- createDate: createDate modDate: modifiedDate
- isDir: dirFlag fileSize: fileSize
- !
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 changed:
----- Method: FilePluginSimulator>>sqFile:Read:Into:At: (in category 'simulation') -----
+ sqFile: file Read: count Into: byteArrayIndexArg At: startIndex
+ | byteArrayIndex |
+ byteArrayIndex := byteArrayIndexArg asInteger. "Coerces CArray et al correctly"
- sqFile: file Read: count Into: byteArrayIndex At: startIndex
- | interpreter |
- interpreter := interpreterProxy interpreter.
[[startIndex to: startIndex + count - 1 do:
[ :i |
file atEnd ifTrue:
[(file isKindOf: FakeStdinStream) ifTrue: [file atEnd: false].
^i - startIndex].
+ interpreterProxy
- interpreter
byteAt: byteArrayIndex + i
put: file next asInteger]]
on: Error
do: [:ex|
(file isKindOf: TranscriptStream) ifFalse: [ex pass].
^0]]
ensure: [self recordStateOf: file].
^count!
Item was changed:
----- Method: FilePluginSimulator>>sqFile:Write:From:At: (in category 'simulation') -----
+ sqFile: file Write: count From: byteArrayIndexArg At: startIndex
+ | byteArrayIndex |
+ byteArrayIndex := byteArrayIndexArg asInteger. "Coerces CArray et al correctly"
- sqFile: file Write: count From: byteArrayIndex At: startIndex
- | interpreter |
- interpreter := interpreterProxy interpreter.
file isBinary
ifTrue:
[startIndex to: startIndex + count - 1 do:
+ [ :i | file nextPut: (interpreterProxy byteAt: byteArrayIndex + i)]]
- [ :i | file nextPut: (interpreter byteAt: byteArrayIndex + i)]]
ifFalse:
[startIndex to: startIndex + count - 1 do:
[ :i | | byte |
+ byte := interpreterProxy byteAt: byteArrayIndex + i.
- byte := interpreter byteAt: byteArrayIndex + i.
file nextPut: (Character value: (byte == 12 "lf" ifTrue: [15"cr"] ifFalse: [byte]))]].
self recordStateOf: file.
^count!
Item was changed:
----- Method: FilePluginSimulator>>sqFileDeleteName:Size: (in category 'simulation') -----
sqFileDeleteName: nameIndex Size: nameSize
| path |
+ path := interpreterProxy asString: nameIndex size: nameSize.
- path := interpreterProxy interpreter asString: nameIndex size: nameSize.
(StandardFileStream isAFileNamed: path) ifFalse:
[^interpreterProxy primitiveFail].
[FileDirectory deleteFilePath: path]
on: Error
do: [:ex| interpreterProxy primitiveFail]!
Item was added:
+ ----- Method: Interpreter>>stackIntegerValue: (in category 'internal interpreter access') -----
+ stackIntegerValue: offset
+ "In the StackInterpreter stacks grow down."
+ | integerPointer |
+ integerPointer := stackPages longAt: stackPointer + (offset * self bytesPerWord).
+ ^self checkedIntegerValueOf: integerPointer!
Item was changed:
----- Method: InterpreterSimulator>>loadNewPlugin: (in category 'plugin support') -----
loadNewPlugin: pluginString
| plugin plugins simulatorClasses |
transcript cr; show: 'Looking for module ', pluginString.
"but *why*??"
(#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: pluginString) ifTrue:
[transcript show: ' ... defeated'. ^nil].
plugins := InterpreterPlugin allSubclasses select: [:psc| psc moduleName asString = pluginString asString].
simulatorClasses := (plugins
select: [:psc| psc simulatorClass notNil]
thenCollect: [:psc| psc simulatorClass]) asSet.
simulatorClasses isEmpty ifTrue: [transcript show: ' ... not found'. ^nil].
simulatorClasses size > 1 ifTrue: [^self error: 'This won''t work...'].
plugins size > 1 ifTrue:
[transcript show: '...multiple plugin classes; choosing ', plugins last name].
plugin := simulatorClasses anyOne newFor: plugins last. "hopefully lowest in the hierarchy..."
+ plugin setInterpreter: objectMemory. "Ignore return value from setInterpreter"
- plugin setInterpreter: self. "Ignore return value from setInterpreter"
(plugin respondsTo: #initialiseModule) ifTrue:
[plugin initialiseModule ifFalse:
[transcript show: ' ... initialiser failed'. ^nil]]. "module initialiser failed"
pluginList := pluginList copyWith: (pluginString asString -> plugin).
transcript show: ' ... loaded'.
^pluginList last!
Item was changed:
----- Method: InterpreterSimulator>>openAsMorph (in category 'UI') -----
openAsMorph
"Open a morphic view on this simulation."
| window localImageName |
localImageName := FileDirectory default localNameFor: imageName.
window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
window addMorph: (displayView := ImageMorph new image: displayForm)
frame: (0 at 0 corner: 1 at 0.8).
transcript := TranscriptStream on: (String new: 10000).
window addMorph: (PluggableTextMorph on: transcript text: nil accept: nil
readSelection: nil menu: #codePaneMenu:shifted:)
frame: (0 at 0.8 corner: 0.7 at 1).
window addMorph: (PluggableTextMorph on: self
+ text: #byteCountText accept: nil) hideScrollBarsIndefinitely
- text: #byteCountText accept: nil) hideScrollBarIndefinitely
frame: (0.7 at 0.8 corner: 1 at 1).
window openInWorld!
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).
-
- self successful ifFalse:
- [^self primitiveFail].
-
- array := FileDirectory default primLookupEntryIn: pathName name: name.
- array == nil ifTrue:
- [self pop: 3 thenPush: objectMemory nilObj.
- ^array].
- array == #badDirectoryPath ifTrue:
- [self halt.
- ^self primitiveFail].
- array == #primFailed ifTrue:
- [self halt.
- ^self primitiveFail].
-
- result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- createDate: (array at: 2) modDate: (array at: 3)
- isDir: (array at: 4) fileSize: (array at: 5).
- 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)).
-
- self successful ifFalse: [
- ^self primitiveFail.
- ].
-
- array := FileDirectory default primLookupEntryIn: pathName index: index.
-
- array == nil ifTrue: [
- self pop: 3.
- self push: objectMemory nilObj.
- ^array.
- ].
- array == #badDirectoryPath ifTrue: [self halt.
- ^self primitiveFail.
- ].
-
- result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- createDate: (array at: 2) modDate: (array at: 3)
- isDir: (array at: 4) fileSize: (array at: 5).
- self pop: 3.
- self push: result.
- !
Item was changed:
----- Method: InterpreterSimulator>>primitiveMouseButtons (in category 'I/O primitives') -----
primitiveMouseButtons
| buttons |
self pop: 1.
+ buttons := Sensor oldPrimMouseButtons.
- buttons := Sensor primMouseButtons.
self pushInteger: buttons!
Item was added:
+ ----- Method: ObjectMemory>>interpreter (in category 'accessing') -----
+ interpreter
+ <doNotGenerate>
+ ^interpreter!
Item was added:
+ ----- Method: ObjectMemorySimulator>>booleanValueOf: (in category 'simulation only') -----
+ booleanValueOf: obj
+ "hack around the Interpreter/ObjectMemory split refactoring"
+ ^interpreter booleanValueOf: obj!
Item was added:
+ ----- Method: ObjectMemorySimulator>>failed (in category 'simulation only') -----
+ failed
+ "hack around the Interpreter/ObjectMemory split refactoring"
+ ^interpreter failed!
Item was added:
+ ----- Method: ObjectMemorySimulator>>ioLoadFunction:From: (in category 'simulation only') -----
+ ioLoadFunction: functionName From: moduleName
+ "hack around the Interpreter/ObjectMemory split refactoring.
+ provide accurate types for the VMPluginCodeGenerator."
+ <returnTypeC: #'void *'>
+ <var: #functionName type: #'char *'>
+ <var: #moduleName type: #'char *'>
+ ^interpreter ioLoadFunction: functionName From: moduleName!
Item was added:
+ ----- Method: ObjectMemorySimulator>>pop: (in category 'simulation only') -----
+ pop: nItems
+ "hack around the Interpreter/ObjectMemory split refactoring"
+ ^interpreter pop: nItems!
Item was added:
+ ----- Method: ObjectMemorySimulator>>pop:thenPush: (in category 'simulation only') -----
+ pop: nItems thenPush: oop
+ "hack around the Interpreter/ObjectMemory split refactoring"
+ ^interpreter pop: nItems thenPush: oop!
Item was added:
+ ----- Method: ObjectMemorySimulator>>positive32BitIntegerFor: (in category 'simulation only') -----
+ positive32BitIntegerFor: integerValue
+ "hack around the Interpreter/ObjectMemory split refactoring"
+ ^interpreter positive32BitIntegerFor: integerValue!
Item was added:
+ ----- Method: ObjectMemorySimulator>>positive32BitValueOf: (in category 'simulation only') -----
+ positive32BitValueOf: oop
+ "hack around the Interpreter/ObjectMemory split refactoring"
+ ^interpreter positive32BitValueOf: oop!
Item was added:
+ ----- Method: ObjectMemorySimulator>>positive64BitIntegerFor: (in category 'simulation only') -----
+ positive64BitIntegerFor: integerValue
+ "hack around the Interpreter/ObjectMemory split refactoring"
+ ^interpreter positive64BitIntegerFor: integerValue!
Item was added:
+ ----- Method: ObjectMemorySimulator>>positive64BitValueOf: (in category 'simulation only') -----
+ positive64BitValueOf: oop
+ "hack around the Interpreter/ObjectMemory split refactoring"
+ ^interpreter positive64BitValueOf: oop!
Item was added:
+ ----- Method: ObjectMemorySimulator>>primitiveFail (in category 'simulation only') -----
+ primitiveFail
+ "hack around the Interpreter/ObjectMemory split refactoring"
+ ^interpreter primitiveFail!
Item was added:
+ ----- Method: ObjectMemorySimulator>>stackFloatValue: (in category 'simulation only') -----
+ stackFloatValue: offset
+ "hack around the Interpreter/ObjectMemory split refactoring"
+ ^Interpreter stackFloatValue: offset!
Item was added:
+ ----- Method: ObjectMemorySimulator>>stackIntegerValue: (in category 'simulation only') -----
+ stackIntegerValue: offset
+ "hack around the Interpreter/ObjectMemory split refactoring"
+ ^interpreter stackIntegerValue: offset!
Item was added:
+ ----- Method: ObjectMemorySimulator>>stackObjectValue: (in category 'simulation only') -----
+ stackObjectValue: offset
+ "hack around the Interpreter/ObjectMemory split refactoring"
+ ^Interpreter stackObjectValue: offset!
Item was added:
+ ----- Method: ObjectMemorySimulator>>stackValue: (in category 'simulation only') -----
+ stackValue: offset
+ "hack around the Interpreter/ObjectMemory split refactoring"
+ ^interpreter stackValue: offset!
Item was removed:
- ----- Method: StackInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
- primitiveDirectoryEntry
- | name pathName array result |
- name := self stringOf: self stackTop.
- pathName := self stringOf: (self stackValue: 1).
-
- self successful ifFalse:
- [^self primitiveFail].
-
- array := FileDirectory default primLookupEntryIn: pathName name: name.
- array == nil ifTrue:
- [self pop: 3 thenPush: objectMemory nilObject.
- ^array].
- array == #badDirectoryPath ifTrue:
- [self halt.
- ^self primitiveFail].
-
- result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- createDate: (array at: 2) modDate: (array at: 3)
- isDir: (array at: 4) fileSize: (array at: 5).
- self pop: 3.
- self push: 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 == nil ifTrue:
- [self pop: 3 thenPush: objectMemory nilObject.
- ^array].
- array == #badDirectoryPath ifTrue:
- ["self halt."
- ^self primitiveFail].
-
- result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- createDate: (array at: 2) modDate: (array at: 3)
- isDir: (array at: 4) fileSize: (array at: 5).
- self pop: 3 thenPush: result!
Item was added:
+ ----- Method: VMClass>>addressOf: (in category 'translation support') -----
+ addressOf: anObject
+ <doNotGenerate>
+ "Translates into &anObject in C."
+ ^anObject!
Item was added:
+ ----- Method: VMClass>>addressOf:put: (in category 'translation support') -----
+ addressOf: anObject put: aBlock
+ <doNotGenerate>
+ "Simulate a C pointer. Translates into &anObject in C. Provides something
+ that evaluates aBlock with the new value in response to at:put:"
+ | thing |
+ thing := anObject.
+ ^CPluggableAccessor new
+ setObject: nil;
+ atBlock: [:obj :idx| thing]
+ atPutBlock: [:obj :idx :val| aBlock value: (thing := val)]!
Item was added:
+ ----- Method: VMClass>>asString:size: (in category 'C library extensions') -----
+ asString: stringIndex size: stringSize
+ "stringIndex is an address in the heap. Create a String of the requested length
+ form the bytes in the heap starting at stringIndex."
+ <doNotGenerate>
+ ^self strncpy: (ByteString new: stringSize) _: stringIndex _: stringSize!
Item was added:
+ ----- Method: VMClass>>strncpy:_:_: (in category 'C library simulation') -----
+ strncpy: aString _: bString _: n
+ <doNotGenerate>
+ "implementation of strncpy(3)"
+ aString isString
+ ifTrue:
+ [1 to: n do:
+ [:i| | v |
+ v := bString isString
+ ifTrue: [bString at: i]
+ ifFalse: [Character value: (self byteAt: bString + i - 1)].
+ aString at: i put: v.
+ v asInteger = 0 ifTrue: [^aString]]]
+ ifFalse:
+ [1 to: n do:
+ [:i| | v |
+ v := bString isString
+ ifTrue: [(bString at: i) asInteger]
+ ifFalse: [self byteAt: bString + i - 1].
+ self byteAt: aString + i - 1 put: v.
+ v = 0 ifTrue: [^aString]]].
+ ^aString!
More information about the Vm-dev
mailing list