[Vm-dev] VM Maker: VMMaker.oscog-eem.245.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Jan 3 01:46:42 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.245.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.245
Author: eem
Time: 2 January 2013, 5:44:32.298 pm
UUID: 3b27b42f-4c48-40b7-8261-2f05e76d11f2
Ancestors: VMMaker.oscog-eem.244
Add width failure cases to BMPReadWriterPlugin read & write 24Bmp
prims.
Use ClassByteString var in preference to ClassString var.
=============== Diff against VMMaker.oscog-eem.244 ===============
Item was changed:
----- Method: BMPReadWriterPlugin>>primitiveRead24BmpLine (in category 'primitives') -----
primitiveRead24BmpLine
| width formBitsIndex formBitsOop pixelLineOop formBitsSize formBits pixelLineSize pixelLine |
<export: true>
<inline: false>
<var: #formBits type: 'unsigned int *'>
<var: #pixelLine type: 'unsigned char *'>
interpreterProxy methodArgumentCount = 4
ifFalse:[^interpreterProxy primitiveFail].
width := interpreterProxy stackIntegerValue: 0.
+ width <= 0 ifTrue:[^interpreterProxy primitiveFail].
formBitsIndex := interpreterProxy stackIntegerValue: 1.
formBitsOop := interpreterProxy stackObjectValue: 2.
pixelLineOop := interpreterProxy stackObjectValue: 3.
interpreterProxy failed ifTrue:[^nil].
(interpreterProxy isWords: formBitsOop)
ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy isBytes: pixelLineOop)
ifFalse:[^interpreterProxy primitiveFail].
formBitsSize := interpreterProxy slotSizeOf: formBitsOop.
formBits := interpreterProxy firstIndexableField: formBitsOop.
pixelLineSize := interpreterProxy slotSizeOf: pixelLineOop.
pixelLine := interpreterProxy firstIndexableField: pixelLineOop.
(formBitsIndex + width <= formBitsSize and:[width*3 <= pixelLineSize])
ifFalse:[^interpreterProxy primitiveFail].
"do the actual work"
self cCode:'
formBits += formBitsIndex-1;
while(width--) {
unsigned int rgb;
rgb = (*pixelLine++);
rgb += (*pixelLine++) << 8;
rgb += (*pixelLine++) << 16;
if(rgb) rgb |= 0xFF000000; else rgb |= 0xFF000001;
*formBits++ = rgb;
}
' inSmalltalk:[formBits. pixelLine. ^interpreterProxy primitiveFail].
interpreterProxy pop: 4. "args"
!
Item was changed:
----- Method: BMPReadWriterPlugin>>primitiveWrite24BmpLine (in category 'primitives') -----
primitiveWrite24BmpLine
| width formBitsIndex formBitsOop pixelLineOop formBitsSize formBits pixelLineSize pixelLine |
<export: true>
<inline: false>
<var: #formBits type: 'unsigned int *'>
<var: #pixelLine type: 'unsigned char *'>
interpreterProxy methodArgumentCount = 4
ifFalse:[^interpreterProxy primitiveFail].
width := interpreterProxy stackIntegerValue: 0.
+ width <= 0 ifTrue:[^interpreterProxy primitiveFail].
formBitsIndex := interpreterProxy stackIntegerValue: 1.
formBitsOop := interpreterProxy stackObjectValue: 2.
pixelLineOop := interpreterProxy stackObjectValue: 3.
interpreterProxy failed ifTrue:[^nil].
(interpreterProxy isWords: formBitsOop)
ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy isBytes: pixelLineOop)
ifFalse:[^interpreterProxy primitiveFail].
formBitsSize := interpreterProxy slotSizeOf: formBitsOop.
formBits := interpreterProxy firstIndexableField: formBitsOop.
pixelLineSize := interpreterProxy slotSizeOf: pixelLineOop.
pixelLine := interpreterProxy firstIndexableField: pixelLineOop.
(formBitsIndex + width <= formBitsSize and:[width*3 <= pixelLineSize])
ifFalse:[^interpreterProxy primitiveFail].
"do the actual work. Read 32 bit at a time from formBits, and store the low order 24 bits
or each word into pixelLine in little endian order."
self cCode:'
formBits += formBitsIndex-1;
while(width--) {
unsigned int rgb;
rgb = *formBits++;
(*pixelLine++) = (rgb ) & 0xFF;
(*pixelLine++) = (rgb >> 8 ) & 0xFF;
(*pixelLine++) = (rgb >> 16) & 0xFF;
}
' inSmalltalk:[formBits. pixelLine. ^interpreterProxy primitiveFail].
interpreterProxy pop: 4. "args"
!
Item was changed:
----- Method: CogVMSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'file primitives') -----
makeDirEntryName: entryName size: entryNameSize
createDate: createDate modDate: modifiedDate
isDir: dirFlag fileSize: fileSize
| modDateOop createDateOop nameString results |
<var: 'entryName' type: 'char *'>
results := objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 5.
+ nameString := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: entryNameSize.
- nameString := objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: entryNameSize.
createDateOop := self positive32BitIntegerFor: createDate.
modDateOop := self positive32BitIntegerFor: modifiedDate.
1 to: entryNameSize do:
[ :i |
objectMemory storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue].
objectMemory storePointerUnchecked: 0 ofObject: results withValue: nameString.
objectMemory storePointerUnchecked: 1 ofObject: results withValue: createDateOop.
objectMemory storePointerUnchecked: 2 ofObject: results withValue: modDateOop.
dirFlag
ifTrue: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory trueObject ]
ifFalse: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory falseObject ].
objectMemory storePointerUnchecked: 4 ofObject: results withValue: (objectMemory integerObjectOf: fileSize).
^ results!
Item was changed:
----- Method: CogVMSimulator>>primitiveGetAttribute (in category 'other primitives') -----
primitiveGetAttribute
"Fetch the system attribute with the given integer ID. The result is a string, which will be empty if the attribute is not defined."
| index s attribute |
index := self stackIntegerValue: 0.
self successful ifTrue: [
attribute := systemAttributes at: index ifAbsent: [Smalltalk getSystemAttribute: index].
attribute ifNil: [ ^self primitiveFail ].
+ s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: attribute size.
- s := objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: attribute size.
1 to: attribute size do: [ :i |
objectMemory storeByte: i-1 ofObject: s withValue: (attribute at: i) asciiValue].
self pop: 2. "rcvr, attr"
self push: s]!
Item was changed:
----- Method: CogVMSimulator>>primitiveImageName (in category 'file primitives') -----
primitiveImageName
"Note: For now, this only implements getting, not setting, the image file name."
| result imageNameSize |
self pop: 1.
imageNameSize := imageName size.
+ result := objectMemory instantiateClass: (objectMemory splObj: ClassByteString)
- result := objectMemory instantiateClass: (objectMemory splObj: ClassString)
indexableSize: imageNameSize.
1 to: imageNameSize do:
[:i | objectMemory storeByte: i-1 ofObject: result
withValue: (imageName at: i) asciiValue].
self push: result.!
Item was changed:
----- Method: Interpreter>>primitiveClipboardText (in category 'I/O primitives') -----
primitiveClipboardText
"When called with a single string argument, post the string to
the clipboard. When called with zero arguments, return a
string containing the current clipboard contents."
| s sz |
argumentCount = 1
ifTrue: [s := self stackTop.
(self isBytes: s) ifFalse: [^ self primitiveFail].
successFlag
ifTrue: [sz := self stSizeOf: s.
self clipboardWrite: sz From: s + BaseHeaderSize At: 0.
self pop: 1]]
ifFalse: [sz := self clipboardSize.
(self sufficientSpaceToAllocate: sz) ifFalse:[^self primitiveFail].
+ s := self instantiateClass: (self splObj: ClassByteString) indexableSize: sz.
- s := self instantiateClass: (self splObj: ClassString) indexableSize: sz.
self clipboardRead: sz Into: s + BaseHeaderSize At: 0.
self pop: 1 thenPush: s]!
Item was changed:
----- Method: Interpreter>>primitiveGetAttribute (in category 'system control primitives') -----
primitiveGetAttribute
"Fetch the system attribute with the given integer ID. The
result is a string, which will be empty if the attribute is not
defined."
| attr sz s |
attr := self stackIntegerValue: 0.
successFlag
ifTrue: [sz := self attributeSize: attr].
successFlag
ifTrue: [s := self
+ instantiateClass: (self splObj: ClassByteString)
- instantiateClass: (self splObj: ClassString)
indexableSize: sz.
self
getAttribute: attr
Into: s + BaseHeaderSize
Length: sz.
self pop: 2 thenPush: s]!
Item was changed:
----- Method: Interpreter>>primitiveImageName (in category 'other primitives') -----
primitiveImageName
"When called with a single string argument, record the string as the current image file name. When called with zero arguments, return a string containing the current image file name."
| s sz sCRIfn okToRename |
<var: #sCRIfn type: 'void *'>
argumentCount = 1 ifTrue: [
"If the security plugin can be loaded, use it to check for rename permission.
If not, assume it's ok"
sCRIfn := self ioLoadFunction: 'secCanRenameImage' From: 'SecurityPlugin'.
sCRIfn ~= 0 ifTrue:[okToRename := self cCode:' ((sqInt (*)(void))sCRIfn)()'.
okToRename ifFalse:[^self primitiveFail]].
s := self stackTop.
+ self assertClassOf: s is: (self splObj: ClassByteString).
- self assertClassOf: s is: (self splObj: ClassString).
successFlag ifTrue: [
sz := self stSizeOf: s.
self imageNamePut: (s + BaseHeaderSize) Length: sz.
self pop: 1. "pop s, leave rcvr on stack"
].
] ifFalse: [
sz := self imageNameSize.
+ s := self instantiateClass: (self splObj: ClassByteString) indexableSize: sz.
- s := self instantiateClass: (self splObj: ClassString) indexableSize: sz.
self imageNameGet: (s + BaseHeaderSize) Length: sz.
self pop: 1. "rcvr"
self push: s.
].
!
Item was changed:
----- Method: Interpreter>>primitiveVMPath (in category 'system control primitives') -----
primitiveVMPath
"Return a string containing the path name of VM's directory."
| s sz |
sz := self vmPathSize.
+ s := self instantiateClass: (self splObj: ClassByteString) indexableSize: sz.
- s := self instantiateClass: (self splObj: ClassString) indexableSize: sz.
self vmPathGet: (s + BaseHeaderSize) Length: sz.
self pop: 1 thenPush: s.
!
Item was changed:
----- Method: InterpreterPrimitives>>isInstanceOfClassByteString: (in category 'primitive support') -----
isInstanceOfClassByteString: oop
<inline: true>
"N.B. Because Slang always inlines is:instanceOf:compactClassIndex:
(because is:instanceOf:compactClassIndex: has an inline: pragma) the
+ phrase (objectMemory splObj: ClassByteString) is expanded in-place and
- phrase (objectMemory splObj: ClassString) is expanded in-place and
is _not_ evaluated if oop has a non-zero CompactClassIndex."
^objectMemory
is: oop
+ instanceOf: (objectMemory splObj: ClassByteString)
- instanceOf: (objectMemory splObj: ClassString)
compactClassIndex: ClassByteStringCompactIndex!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveBitShift (in category 'arithmetic integer primitives') -----
primitiveBitShift
| integerReceiver integerArgument shifted |
integerArgument := self popInteger.
integerReceiver := self popPos32BitInteger.
self successful ifTrue: [
integerArgument >= 0 ifTrue: [
"Left shift -- must fail if we lose bits beyond 32"
self success: integerArgument <= 31.
shifted := integerReceiver << integerArgument.
self success: (shifted >> integerArgument) = integerReceiver.
] ifFalse: [
"Right shift -- OK to lose bits"
self success: integerArgument >= -31.
+ shifted := integerReceiver >> (0 - integerArgument).
- shifted := integerReceiver bitShift: integerArgument.
].
].
self successful
ifTrue: [self push: (self positive32BitIntegerFor: shifted)]
ifFalse: [self unPop: 2]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveClipboardText (in category 'I/O primitives') -----
primitiveClipboardText
"When called with a single string argument, post the string to
the clipboard. When called with zero arguments, return a
string containing the current clipboard contents."
| s sz |
argumentCount = 1
ifTrue: [s := self stackTop.
(objectMemory isBytes: s) ifFalse: [^ self primitiveFail].
self successful
ifTrue: [sz := self stSizeOf: s.
self clipboardWrite: sz From: s + BaseHeaderSize At: 0.
self pop: 1]]
ifFalse: [sz := self clipboardSize.
(objectMemory sufficientSpaceToAllocate: sz) ifFalse:[^self primitiveFail].
+ s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: sz.
- s := objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: sz.
self clipboardRead: sz Into: s + BaseHeaderSize At: 0.
self pop: 1 thenPush: s]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveGetAttribute (in category 'system control primitives') -----
primitiveGetAttribute
"Fetch the system attribute with the given integer ID. The
result is a string, which will be empty if the attribute is not
defined."
| attr sz s |
attr := self stackIntegerValue: 0.
self successful
ifTrue: [sz := self attributeSize: attr].
self successful
ifTrue: [s := objectMemory
+ instantiateClass: (objectMemory splObj: ClassByteString)
- instantiateClass: (objectMemory splObj: ClassString)
indexableSize: sz.
self
getAttribute: attr
Into: s + BaseHeaderSize
Length: sz.
self pop: 2 thenPush: s]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveImageName (in category 'other primitives') -----
primitiveImageName
"When called with a single string argument, record the string as the current image file name. When called with zero arguments, return a string containing the current image file name."
| s sz sCRIfn okToRename |
<var: #sCRIfn type: 'void *'>
argumentCount = 1 ifTrue: [
"If the security plugin can be loaded, use it to check for rename permission.
If not, assume it's ok"
sCRIfn := self ioLoadFunction: 'secCanRenameImage' From: 'SecurityPlugin'.
sCRIfn ~= 0 ifTrue:[okToRename := self cCode:' ((sqInt (*)(void))sCRIfn)()'.
okToRename ifFalse:[^self primitiveFail]].
s := self stackTop.
+ self assertClassOf: s is: (objectMemory splObj: ClassByteString).
- self assertClassOf: s is: (objectMemory splObj: ClassString).
self successful ifTrue: [
sz := self stSizeOf: s.
self imageNamePut: (s + BaseHeaderSize) Length: sz.
self pop: 1. "pop s, leave rcvr on stack"
].
] ifFalse: [
sz := self imageNameSize.
+ s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: sz.
- s := objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: sz.
self imageNameGet: (s + BaseHeaderSize) Length: sz.
self pop: 1. "rcvr"
self push: s.
]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveVMPath (in category 'system control primitives') -----
primitiveVMPath
"Return a string containing the path name of VM's directory."
| s sz |
sz := self vmPathSize.
+ s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: sz.
- s := objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: sz.
self vmPathGet: (s + BaseHeaderSize) Length: sz.
self pop: 1 thenPush: s.
!
Item was changed:
----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'file primitives') -----
makeDirEntryName: entryName size: entryNameSize
createDate: createDate modDate: modifiedDate
isDir: dirFlag fileSize: fileSize
| modDateOop createDateOop nameString results |
<var: 'entryName' type: 'char *'>
"allocate storage for results, remapping newly allocated
oops in case GC happens during allocation"
self pushRemappableOop:
(self instantiateClass: (self splObj: ClassArray) indexableSize: 5).
self pushRemappableOop:
+ (self instantiateClass: (self splObj: ClassByteString) indexableSize: entryNameSize)..
- (self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize)..
self pushRemappableOop: (self positive32BitIntegerFor: createDate).
self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
modDateOop := self popRemappableOop.
createDateOop := self popRemappableOop.
nameString := self popRemappableOop.
results := self popRemappableOop.
1 to: entryNameSize do: [ :i |
self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
].
self storePointer: 0 ofObject: results withValue: nameString.
self storePointer: 1 ofObject: results withValue: createDateOop.
self storePointer: 2 ofObject: results withValue: modDateOop.
dirFlag
ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
self storePointer: 4 ofObject: results
withValue: (self integerObjectOf: fileSize).
^ results
!
Item was changed:
----- Method: InterpreterSimulator>>primitiveGetAttribute (in category 'other primitives') -----
primitiveGetAttribute
"Fetch the system attribute with the given integer ID. The result is a string, which will be empty if the attribute is not defined."
| attr s attribute |
attr := self stackIntegerValue: 0.
successFlag ifTrue: [
attribute := Smalltalk getSystemAttribute: attr.
attribute ifNil: [ ^self primitiveFail ].
+ s := self instantiateClass: (self splObj: ClassByteString) indexableSize: attribute size.
- s := self instantiateClass: (self splObj: ClassString) indexableSize: attribute size.
1 to: attribute size do: [ :i |
self storeByte: i-1 ofObject: s withValue: (attribute at: i) asciiValue].
self pop: 2. "rcvr, attr"
self push: s].
!
Item was changed:
----- Method: InterpreterSimulator>>primitiveImageName (in category 'file primitives') -----
primitiveImageName
"Note: For now, this only implements getting, not setting, the image file name."
| result imageNameSize |
self pop: 1.
imageNameSize := imageName size.
+ result := self instantiateClass: (self splObj: ClassByteString)
- result := self instantiateClass: (self splObj: ClassString)
indexableSize: imageNameSize.
1 to: imageNameSize do:
[:i | self storeByte: i-1 ofObject: result
withValue: (imageName at: i) asciiValue].
self push: result.!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveClipboardText (in category 'I/O primitives') -----
primitiveClipboardText
"When called with a single string argument, post the string to
the clipboard. When called with zero arguments, return a
string containing the current clipboard contents."
| s sz |
argumentCount = 1
ifTrue: [s := self stackTop.
(self isBytes: s) ifFalse: [^ self primitiveFail].
self successful
ifTrue: [sz := self stSizeOf: s.
self clipboardWrite: sz From: s + BaseHeaderSize At: 0.
self pop: 1]]
ifFalse: [sz := self clipboardSize.
(self sufficientSpaceToAllocate: sz) ifFalse:[^self primitiveFail].
+ s := self instantiateClass: (self splObj: ClassByteString) indexableSize: sz.
- s := self instantiateClass: (self splObj: ClassString) indexableSize: sz.
self clipboardRead: sz Into: s + BaseHeaderSize At: 0.
self pop: 1 thenPush: s]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveGetAttribute (in category 'system control primitives') -----
primitiveGetAttribute
"Fetch the system attribute with the given integer ID. The
result is a string, which will be empty if the attribute is not
defined."
| attr sz s |
attr := self stackIntegerValue: 0.
self successful
ifTrue: [sz := self attributeSize: attr].
self successful
ifTrue: [s := self
+ instantiateClass: (self splObj: ClassByteString)
- instantiateClass: (self splObj: ClassString)
indexableSize: sz.
self
getAttribute: attr
Into: s + BaseHeaderSize
Length: sz.
self pop: 2 thenPush: s]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveImageName (in category 'other primitives') -----
primitiveImageName
"When called with a single string argument, record the string as the current image file name. When called with zero arguments, return a string containing the current image file name."
| s sz sCRIfn okToRename |
<var: #sCRIfn type: 'void *'>
argumentCount = 1 ifTrue: [
"If the security plugin can be loaded, use it to check for rename permission.
If not, assume it's ok"
sCRIfn := self ioLoadFunction: 'secCanRenameImage' From: 'SecurityPlugin'.
sCRIfn ~= 0 ifTrue:[okToRename := self cCode:' ((sqInt (*)(void))sCRIfn)()'.
okToRename ifFalse:[^self primitiveFail]].
s := self stackTop.
+ self assertClassOf: s is: (self splObj: ClassByteString).
- self assertClassOf: s is: (self splObj: ClassString).
self successful ifTrue: [
sz := self stSizeOf: s.
self imageNamePut: (s + BaseHeaderSize) Length: sz.
self pop: 1. "pop s, leave rcvr on stack"
].
] ifFalse: [
sz := self imageNameSize.
+ s := self instantiateClass: (self splObj: ClassByteString) indexableSize: sz.
- s := self instantiateClass: (self splObj: ClassString) indexableSize: sz.
self imageNameGet: (s + BaseHeaderSize) Length: sz.
self pop: 1. "rcvr"
self push: s.
].
!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveVMPath (in category 'system control primitives') -----
primitiveVMPath
"Return a string containing the path name of VM's directory."
| s sz |
sz := self vmPathSize.
+ s := self instantiateClass: (self splObj: ClassByteString) indexableSize: sz.
- s := self instantiateClass: (self splObj: ClassString) indexableSize: sz.
self vmPathGet: (s + BaseHeaderSize) Length: sz.
self pop: 1 thenPush: s.
!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'file primitives') -----
makeDirEntryName: entryName size: entryNameSize
createDate: createDate modDate: modifiedDate
isDir: dirFlag fileSize: fileSize
| modDateOop createDateOop nameString results |
<var: 'entryName' type: 'char *'>
"allocate storage for results, remapping newly allocated
oops in case GC happens during allocation"
self pushRemappableOop:
(self instantiateClass: (self splObj: ClassArray) indexableSize: 5).
self pushRemappableOop:
+ (self instantiateClass: (self splObj: ClassByteString) indexableSize: entryNameSize)..
- (self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize)..
self pushRemappableOop: (self positive32BitIntegerFor: createDate).
self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
modDateOop := self popRemappableOop.
createDateOop := self popRemappableOop.
nameString := self popRemappableOop.
results := self popRemappableOop.
1 to: entryNameSize do: [ :i |
self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
].
self storePointer: 0 ofObject: results withValue: nameString.
self storePointer: 1 ofObject: results withValue: createDateOop.
self storePointer: 2 ofObject: results withValue: modDateOop.
dirFlag
ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
self storePointer: 4 ofObject: results
withValue: (self integerObjectOf: fileSize).
^ results
!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>primitiveGetAttribute (in category 'other primitives') -----
primitiveGetAttribute
"Fetch the system attribute with the given integer ID. The result is a string, which will be empty if the attribute is not defined."
| attr s attribute |
attr := self stackIntegerValue: 0.
self successful ifTrue: [
attribute := Smalltalk getSystemAttribute: attr.
attribute ifNil: [ ^self primitiveFail ].
+ s := self instantiateClass: (self splObj: ClassByteString) indexableSize: attribute size.
- s := self instantiateClass: (self splObj: ClassString) indexableSize: attribute size.
1 to: attribute size do: [ :i |
self storeByte: i-1 ofObject: s withValue: (attribute at: i) asciiValue].
self pop: 2. "rcvr, attr"
self push: s].
!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>primitiveImageName (in category 'file primitives') -----
primitiveImageName
"Note: For now, this only implements getting, not setting, the image file name."
| result imageNameSize |
self pop: 1.
imageNameSize := imageName size.
+ result := self instantiateClass: (self splObj: ClassByteString)
- result := self instantiateClass: (self splObj: ClassString)
indexableSize: imageNameSize.
1 to: imageNameSize do:
[:i | self storeByte: i-1 ofObject: result
withValue: (imageName at: i) asciiValue].
self push: result.!
Item was changed:
----- Method: ObjectMemory>>classString (in category 'plugin support') -----
classString
+ ^self splObj: ClassByteString!
- ^self splObj: ClassString!
Item was changed:
----- Method: StackInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'file primitives') -----
makeDirEntryName: entryName size: entryNameSize
createDate: createDate modDate: modifiedDate
isDir: dirFlag fileSize: fileSize
| modDateOop createDateOop nameString results |
<var: 'entryName' type: 'char *'>
results := objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 5.
+ nameString := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: entryNameSize.
- nameString := objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: entryNameSize.
createDateOop := self positive32BitIntegerFor: createDate.
modDateOop := self positive32BitIntegerFor: modifiedDate.
1 to: entryNameSize do:
[ :i |
objectMemory storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue].
objectMemory storePointerUnchecked: 0 ofObject: results withValue: nameString.
objectMemory storePointerUnchecked: 1 ofObject: results withValue: createDateOop.
objectMemory storePointerUnchecked: 2 ofObject: results withValue: modDateOop.
dirFlag
ifTrue: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory trueObject ]
ifFalse: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory falseObject ].
objectMemory storePointerUnchecked: 4 ofObject: results withValue: (objectMemory integerObjectOf: fileSize).
^ results!
Item was changed:
----- Method: StackInterpreterSimulator>>primitiveGetAttribute (in category 'other primitives') -----
primitiveGetAttribute
"Fetch the system attribute with the given integer ID. The result is a string, which will be empty if the attribute is not defined."
| attr s attribute |
attr := self stackIntegerValue: 0.
self successful ifTrue: [
attribute := Smalltalk getSystemAttribute: attr.
attribute ifNil: [ ^self primitiveFail ].
+ s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: attribute size.
- s := objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: attribute size.
1 to: attribute size do: [ :i |
objectMemory storeByte: i-1 ofObject: s withValue: (attribute at: i) asciiValue].
self pop: 2. "rcvr, attr"
self push: s]!
Item was changed:
----- Method: StackInterpreterSimulator>>primitiveImageName (in category 'file primitives') -----
primitiveImageName
"Note: For now, this only implements getting, not setting, the image file name."
| result imageNameSize |
self pop: 1.
imageNameSize := imageName size.
+ result := objectMemory instantiateClass: (objectMemory splObj: ClassByteString)
- result := objectMemory instantiateClass: (objectMemory splObj: ClassString)
indexableSize: imageNameSize.
1 to: imageNameSize do:
[:i | objectMemory storeByte: i-1 ofObject: result
withValue: (imageName at: i) asciiValue].
self push: result.!
More information about the Vm-dev
mailing list