[Vm-dev] VM Maker: VMMaker.oscog-eem.1429.mcz

Nicolas Cellier nicolas.cellier.aka.nice at gmail.com
Mon Aug 10 20:32:05 UTC 2015


2015-08-10 22:25 GMT+02:00 Nicolas Cellier <
nicolas.cellier.aka.nice at gmail.com>:

> Hi Eliot,
>
> OK, I got it now:
> invert does not negate the boolean result as the old primitive incorrectly
> used to;
> it just reverse the parameters of comparison op which works well.
>
> or translated in Smalltalk,
>
> { (a < b) = (a >= b) not.   (a < b) = (b > a) }.
>
> The first one is not true when a and b are unordered
> The second one is true for partially ordered sets;
>
>
Hum, but then wait, see suspicious code below:


> Nicolas
>
> 2015-08-08 3:35 GMT+02:00 Eliot Miranda <eliot.miranda at gmail.com>:
>
>>
>> Hi Nicolas,
>>
>>     on the contrary, it fixed a bug.  It makes Integer receiver op float
>> arg behave the same as Float receiver op float arg.  If you look at (IIRC)
>> genDoubleComparison:invert: that dies the same thing.
>>
>> Sent from my iPhone
>>
>> On Aug 7, 2015, at 1:36 PM, Nicolas Cellier <
>> nicolas.cellier.aka.nice at gmail.com> wrote:
>>
>>
>>
>> 2015-08-07 20:47 GMT+02:00 <commits at source.squeak.org>:
>>
>>>
>>> Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
>>> http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1429.mcz
>>>
>>> ==================== Summary ====================
>>>
>>> Name: VMMaker.oscog-eem.1429
>>> Author: eem
>>> Time: 7 August 2015, 11:46:05.819 am
>>> UUID: 446c2481-93c9-43bc-86ac-0743223bfa0c
>>> Ancestors: VMMaker.oscog-rmacnak.1428
>>>
>>> Fix Integer receiver, float arg comparison with NaNs in the machine-code
>>> primitive.  This has started failing in the FloatTest>>testNaNCompare since
>>> the new machine-code perform primitive invoked the machine-code version of
>>> the primitive.  The Interpretewr code has always been correct and the old
>>> perform primitive would always run the Interpreter primitive if it exsted,
>>> since this would probably be faster.
>>>
>>> Luckily the ARM requires no changes.  It can continue to use FCMP
>>> instead of FCMPE.  Include a generator for the FCMPE instruction; it got
>>> written to experiment and does no harm remaining there unused.
>>>
>>> Refactor stack page list printing to include use counts.
>>>
>>> Simulator:
>>> Simplify and clean-up directory entry call.
>>>
>>> =============== Diff against VMMaker.oscog-rmacnak.1428 ===============
>>>
>>> Item was added:
>>> + ----- Method: CogARMCompiler>>fcmpeFrom:to: (in category 'ARM
>>> convenience instructions') -----
>>> + fcmpeFrom: regA to: regB
>>> +       "FCMPE or VCMPE instruction to compare two fpu double registers.
>>> +        ARM_ARM v5 DDI 01001.pdf pp. C4-12"
>>> +       <inline: true>
>>> +       ^(2r11101110101101000000101111000000 bitOr: (regA <<12)) bitOr:
>>> regB!
>>>
>>> Item was changed:
>>>   ----- Method: CogVMSimulator>>primitiveDirectoryEntry (in category
>>> 'file primitives') -----
>>>   primitiveDirectoryEntry
>>>         | name pathName array result |
>>>         name := self stringOf: self stackTop.
>>>         pathName := self stringOf: (self stackValue: 1).
>>>
>>>         self successful ifFalse:
>>>                 [^self primitiveFail].
>>>
>>>         array := FileDirectory default primLookupEntryIn: pathName name:
>>> name.
>>>         array == nil ifTrue:
>>>                 [self pop: 3 thenPush: objectMemory nilObject.
>>>                 ^array].
>>>         array == #badDirectoryPath ifTrue:
>>>                 [self halt.
>>>                 ^self primitiveFail].
>>>
>>>         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 thenPush: result!
>>> -       self pop: 3.
>>> -       self push: result!
>>>
>>> Item was removed:
>>> - ----- Method:
>>> InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:
>>> (in category 'file primitives') -----
>>> - makeDirEntryName: entryName size: entryNameSize createDate: createDate
>>> modDate: modifiedDate isDir: dirFlag fileSize: posixPermissions
>>> posixPermissions: fileSize
>>> -       <option: #PharoVM>
>>> -       <var: 'entryName' type: 'char *'>
>>> -
>>> -       | modDateOop createDateOop nameString results |
>>> -
>>> -       "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: ClassString)
>>> indexableSize: entryNameSize)..
>>> -       self pushRemappableOop: (self positive32BitIntegerFor:
>>> createDate).
>>> -       self pushRemappableOop: (self positive32BitIntegerFor:
>>> modifiedDate).
>>> -
>>> -       modDateOop   := self popRemappableOop.
>>> -       createDateOop := self popRemappableOop.
>>> -       nameString    := self popRemappableOop.
>>> -       results         := self popRemappableOop.
>>> -
>>> -       1 to: entryNameSize do: [ :i |
>>> -               self storeByte: i-1 ofObject: nameString withValue:
>>> (entryName at: i) asciiValue.
>>> -       ].
>>> -
>>> -       self storePointer: 0 ofObject: results withValue: nameString.
>>> -       self storePointer: 1 ofObject: results withValue: createDateOop.
>>> -       self storePointer: 2 ofObject: results withValue: modDateOop.
>>> -       dirFlag
>>> -               ifTrue: [ self storePointer: 3 ofObject: results
>>> withValue: trueObj ]
>>> -               ifFalse: [ self storePointer: 3 ofObject: results
>>> withValue: falseObj ].
>>> -       self storePointer: 4
>>> -               ofObject: results
>>> -               withValue: (self integerObjectOf: fileSize).
>>> -       self storePointer: 5
>>> -               ofObject: results
>>> -               withValue: (self integerObjectOf: posixPermissions).
>>> -
>>> -       ^ results
>>> - !
>>>
>>> Item was changed:
>>>   ----- Method: SimpleStackBasedCogit>>genPrimitiveEqual (in category
>>> 'primitive generators') -----
>>>   genPrimitiveEqual
>>> +       ^self genSmallIntegerComparison: JumpZero
>>> +               orDoubleComparison: #JumpFPEqual:
>>> +               invert: false!
>>> -       ^self genSmallIntegerComparison: JumpZero orDoubleComparison:
>>> #JumpFPEqual: asSymbol!
>>>
>>> Item was changed:
>>>   ----- Method: SimpleStackBasedCogit>>genPrimitiveGreaterOrEqual (in
>>> category 'primitive generators') -----
>>>   genPrimitiveGreaterOrEqual
>>> +       ^self genSmallIntegerComparison: JumpGreaterOrEqual
>>> +               orDoubleComparison: #JumpFPGreaterOrEqual:
>>> +               invert: false!
>>> -       ^self genSmallIntegerComparison: JumpGreaterOrEqual
>>> orDoubleComparison: #JumpFPGreaterOrEqual: asSymbol!
>>>
>>> Item was changed:
>>>   ----- Method: SimpleStackBasedCogit>>genPrimitiveGreaterThan (in
>>> category 'primitive generators') -----
>>>   genPrimitiveGreaterThan
>>> +       ^self genSmallIntegerComparison: JumpGreater
>>> +               orDoubleComparison: #JumpFPGreater:
>>> +               invert: false!
>>> -       ^self genSmallIntegerComparison: JumpGreater orDoubleComparison:
>>> #JumpFPGreater: asSymbol!
>>>
>>> Item was changed:
>>>   ----- Method: SimpleStackBasedCogit>>genPrimitiveLessOrEqual (in
>>> category 'primitive generators') -----
>>>   genPrimitiveLessOrEqual
>>> +       ^self
>>> +               genSmallIntegerComparison: JumpLessOrEqual
>>> +               orDoubleComparison: #JumpFPGreater:
>>>
>> Err...  shouldn't it be #JumpFPGreaterOrEqual: ???

+               invert: true!
>>> -       ^self genSmallIntegerComparison: JumpLessOrEqual
>>> orDoubleComparison: #JumpFPLessOrEqual: asSymbol!
>>>
>>
>>
>> ???
>> Isn't this going to be a regression when comparing with NaN?
>>
>> (2 <= Float nan) = false.
>> (2 > Float nan) not = true.
>>
>> They are not equivalent and using inversion is not correct.
>> Or is nan handled elsewhere?
>>
>>
>>>
>>> Item was changed:
>>>   ----- Method: SimpleStackBasedCogit>>genPrimitiveLessThan (in category
>>> 'primitive generators') -----
>>>   genPrimitiveLessThan
>>> +       ^self
>>> +               genSmallIntegerComparison: JumpLess
>>> +               orDoubleComparison: #JumpFPGreaterOrEqual:
>>>
>> and shouldn't it be JumpFPGreater ???

> +               invert: true!
>>> -       ^self genSmallIntegerComparison: JumpLess orDoubleComparison:
>>> #JumpFPLess: asSymbol!
>>>
>>> Item was changed:
>>>   ----- Method: SimpleStackBasedCogit>>genPrimitiveNotEqual (in category
>>> 'primitive generators') -----
>>>   genPrimitiveNotEqual
>>> +       ^self genSmallIntegerComparison: JumpNonZero
>>> +               orDoubleComparison: #JumpFPNotEqual:
>>> +               invert: false!
>>> -       ^self genSmallIntegerComparison: JumpNonZero orDoubleComparison:
>>> #JumpFPNotEqual: asSymbol!
>>>
>>> Item was removed:
>>> - ----- Method:
>>> SimpleStackBasedCogit>>genSmallIntegerComparison:orDoubleComparison: (in
>>> category 'primitive generators') -----
>>> - genSmallIntegerComparison: jumpOpcode orDoubleComparison:
>>> jumpFPOpcodeGenerator
>>> -       "Stack looks like
>>> -               receiver (also in ResultReceiverReg)
>>> -               arg
>>> -               return address"
>>> -       | jumpDouble jumpNonInt jumpFail jumpTrue jumpCond |
>>> -       <var: #jumpFPOpcodeGenerator declareC: 'AbstractInstruction
>>> *(*jumpFPOpcodeGenerator)(void *)'>
>>> -       <var: #jumpDouble type: #'AbstractInstruction *'>
>>> -       <var: #jumpNonInt type: #'AbstractInstruction *'>
>>> -       <var: #jumpCond type: #'AbstractInstruction *'>
>>> -       <var: #jumpTrue type: #'AbstractInstruction *'>
>>> -       <var: #jumpFail type: #'AbstractInstruction *'>
>>> -       backEnd hasDoublePrecisionFloatingPointSupport ifFalse:
>>> -               [^self genSmallIntegerComparison: jumpOpcode].
>>> -       self genLoadArgAtDepth: 0 into: ClassReg.
>>> -       jumpDouble := objectRepresentation genJumpNotSmallInteger:
>>> ClassReg scratchReg: TempReg.
>>> -       self CmpR: ClassReg R: ReceiverResultReg. "N.B. FLAGS := RRReg -
>>> ClassReg"
>>> -       jumpTrue := self gen: jumpOpcode.
>>> -       self genMoveFalseR: ReceiverResultReg.
>>> -       self RetN: (self primRetNOffsetFor: 1).
>>> -       jumpTrue jmpTarget: (self genMoveTrueR: ReceiverResultReg).
>>> -       self RetN: (self primRetNOffsetFor: 1).
>>> -
>>> -       "Argument may be a Float : let us check or fail"
>>> -       jumpDouble jmpTarget: self Label.
>>> -       objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
>>> -               [jumpNonInt := objectRepresentation genJumpImmediate:
>>> ClassReg].
>>> -       objectRepresentation genGetCompactClassIndexNonImmOf: ClassReg
>>> into: SendNumArgsReg.
>>> -       objectRepresentation genCmpClassFloatCompactIndexR:
>>> SendNumArgsReg.
>>> -       jumpFail := self JumpNonZero: 0.
>>> -
>>> -       "It was a Float, so convert the receiver to double and perform
>>> the operation"
>>> -       self MoveR: ReceiverResultReg R: TempReg.
>>> -       objectRepresentation genConvertSmallIntegerToIntegerInReg:
>>> TempReg.
>>> -       self ConvertR: TempReg Rd: DPFPReg0.
>>> -       objectRepresentation genGetDoubleValueOf: ClassReg into:
>>> DPFPReg1.
>>> -       self CmpRd: DPFPReg1 Rd: DPFPReg0.
>>> -       jumpCond := self perform: jumpFPOpcodeGenerator with: 0. "FP
>>> jumps are a little weird"
>>> -       self genMoveFalseR: ReceiverResultReg.
>>> -       self RetN: (self primRetNOffsetFor: 1).
>>> -       jumpCond jmpTarget: (self genMoveTrueR: ReceiverResultReg).
>>> -       self RetN: (self primRetNOffsetFor: 1).
>>> -
>>> -       objectRepresentation smallIntegerIsOnlyImmediateType
>>> -               ifTrue: [jumpFail jmpTarget: self Label]
>>> -               ifFalse: [jumpNonInt jmpTarget: (jumpFail jmpTarget:
>>> self Label)].
>>> -       ^0!
>>>
>>> Item was added:
>>> + ----- Method:
>>> SimpleStackBasedCogit>>genSmallIntegerComparison:orDoubleComparison:invert:
>>> (in category 'primitive generators') -----
>>> + genSmallIntegerComparison: jumpOpcode orDoubleComparison:
>>> jumpFPOpcodeGenerator invert: invertComparison
>>> +       "Stack looks like
>>> +               receiver (also in ResultReceiverReg)
>>> +               arg
>>> +               return address"
>>> +       | jumpDouble jumpNonInt jumpFail jumpTrue jumpCond |
>>> +       <var: #jumpFPOpcodeGenerator declareC: 'AbstractInstruction
>>> *(*jumpFPOpcodeGenerator)(void *)'>
>>> +       <var: #jumpDouble type: #'AbstractInstruction *'>
>>> +       <var: #jumpNonInt type: #'AbstractInstruction *'>
>>> +       <var: #jumpCond type: #'AbstractInstruction *'>
>>> +       <var: #jumpTrue type: #'AbstractInstruction *'>
>>> +       <var: #jumpFail type: #'AbstractInstruction *'>
>>> +       backEnd hasDoublePrecisionFloatingPointSupport ifFalse:
>>> +               [^self genSmallIntegerComparison: jumpOpcode].
>>> +       self genLoadArgAtDepth: 0 into: ClassReg.
>>> +       jumpDouble := objectRepresentation genJumpNotSmallInteger:
>>> ClassReg scratchReg: TempReg.
>>> +       self CmpR: ClassReg R: ReceiverResultReg. "N.B. FLAGS := RRReg -
>>> ClassReg"
>>> +       jumpTrue := self gen: jumpOpcode.
>>> +       self genMoveFalseR: ReceiverResultReg.
>>> +       self RetN: (self primRetNOffsetFor: 1).
>>> +       jumpTrue jmpTarget: (self genMoveTrueR: ReceiverResultReg).
>>> +       self RetN: (self primRetNOffsetFor: 1).
>>> +
>>> +       "Argument may be a Float : let us check or fail"
>>> +       jumpDouble jmpTarget: self Label.
>>> +       objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
>>> +               [jumpNonInt := objectRepresentation genJumpImmediate:
>>> ClassReg].
>>> +       objectRepresentation genGetCompactClassIndexNonImmOf: ClassReg
>>> into: SendNumArgsReg.
>>> +       objectRepresentation genCmpClassFloatCompactIndexR:
>>> SendNumArgsReg.
>>> +       jumpFail := self JumpNonZero: 0.
>>> +
>>> +       "It was a Float, so convert the receiver to double and perform
>>> the operation"
>>> +       self MoveR: ReceiverResultReg R: TempReg.
>>> +       objectRepresentation genConvertSmallIntegerToIntegerInReg:
>>> TempReg.
>>> +       self ConvertR: TempReg Rd: DPFPReg0.
>>> +       objectRepresentation genGetDoubleValueOf: ClassReg into:
>>> DPFPReg1.
>>> +       invertComparison "May need to invert for NaNs"
>>> +               ifTrue: [self CmpRd: DPFPReg0 Rd: DPFPReg1]
>>> +               ifFalse: [self CmpRd: DPFPReg1 Rd: DPFPReg0].
>>> +       jumpCond := self perform: jumpFPOpcodeGenerator with: 0. "FP
>>> jumps are a little weird"
>>> +       self genMoveFalseR: ReceiverResultReg.
>>> +       self RetN: (self primRetNOffsetFor: 1).
>>> +       jumpCond jmpTarget: (self genMoveTrueR: ReceiverResultReg).
>>> +       self RetN: (self primRetNOffsetFor: 1).
>>> +
>>> +       objectRepresentation smallIntegerIsOnlyImmediateType
>>> +               ifTrue: [jumpFail jmpTarget: self Label]
>>> +               ifFalse: [jumpNonInt jmpTarget: (jumpFail jmpTarget:
>>> self Label)].
>>> +       ^0!
>>>
>>> Item was changed:
>>>   ----- Method: StackInterpreter>>printStackPage: (in category 'debug
>>> printing') -----
>>>   printStackPage: page
>>> +       <inline: true>
>>> +       self printStackPage: page useCount: -1!
>>> -       <inline: false>
>>> -       <var: #page type: #'StackPage *'>
>>> -       self print: 'page '; printHexPtr: (self cCode: [page]
>>> inSmalltalk: [page baseAddress]);
>>> -               print: ' ('; printNum: (stackPages pageIndexFor: page
>>> realStackLimit);
>>> -               print: ')  (trace: '; printNum: page trace; printChar:
>>> $).
>>> -       (stackPages isFree: page) ifTrue:
>>> -               [self print: ' (free)'].
>>> -       page = stackPages mostRecentlyUsedPage ifTrue:
>>> -               [self print: ' (MRU)'].
>>> -       self cr; tab; print: 'ba: ';
>>> -               printHexPtr: page baseAddress; print: ' - sl: ';
>>> -               printHexPtr: page realStackLimit; print: ' - sl-so: ';
>>> -               printHexPtr: page realStackLimit - self
>>> stackLimitOffset; print: ' - la:';
>>> -               printHexPtr: page lastAddress.
>>> -       (stackPages isFree: page) ifFalse:
>>> -               [self cr; tab; print: 'baseFP '; printHexPtr: page
>>> baseFP.
>>> -                self "cr;" tab; print: 'headFP '; printHexPtr: page
>>> headFP.
>>> -                self "cr;" tab; print: 'headSP '; printHexPtr: page
>>> headSP].
>>> -       self cr; tab; print: 'prev '; printHexPtr: (self cCode:
>>> 'page->prevPage' inSmalltalk: [page prevPage baseAddress]);
>>> -               print: ' ('; printNum: (stackPages pageIndexFor: page
>>> prevPage realStackLimit); printChar: $).
>>> -       self tab; print: 'next '; printHexPtr: (self cCode:
>>> 'page->nextPage' inSmalltalk: [page nextPage baseAddress]);
>>> -               print: ' ('; printNum: (stackPages pageIndexFor: page
>>> nextPage realStackLimit); printChar: $).
>>> -       self cr!
>>>
>>> Item was added:
>>> + ----- Method: StackInterpreter>>printStackPage:useCount: (in category
>>> 'debug printing') -----
>>> + printStackPage: page useCount: n
>>> +       <inline: false>
>>> +       <var: #page type: #'StackPage *'>
>>> +       self print: 'page '; printHexPtr: (self cCode: [page]
>>> inSmalltalk: [page baseAddress]);
>>> +               print: ' ('; printNum: (stackPages pageIndexFor: page
>>> realStackLimit).
>>> +       n >= 0 ifTrue:
>>> +               [self print: ','; printNum: n].
>>> +       self print: ')  (trace: '; printNum: page trace; printChar: $).
>>> +       (stackPages isFree: page) ifTrue:
>>> +               [self print: ' (free)'].
>>> +       page = stackPages mostRecentlyUsedPage ifTrue:
>>> +               [self print: ' (MRU)'].
>>> +       page prevPage = stackPages mostRecentlyUsedPage ifTrue:
>>> +               [self print: ' (LRU)'].
>>> +       self cr; tab; print: 'ba: ';
>>> +               printHexPtr: page baseAddress; print: ' - sl: ';
>>> +               printHexPtr: page realStackLimit; print: ' - sl-so: ';
>>> +               printHexPtr: page realStackLimit - self
>>> stackLimitOffset; print: ' - la:';
>>> +               printHexPtr: page lastAddress.
>>> +       (stackPages isFree: page) ifFalse:
>>> +               [self cr; tab; print: 'baseFP '; printHexPtr: page
>>> baseFP.
>>> +                self "cr;" tab; print: 'headFP '; printHexPtr: page
>>> headFP.
>>> +                self "cr;" tab; print: 'headSP '; printHexPtr: page
>>> headSP].
>>> +       self cr; tab; print: 'prev '; printHexPtr: (self cCode:
>>> 'page->prevPage' inSmalltalk: [page prevPage baseAddress]);
>>> +               print: ' ('; printNum: (stackPages pageIndexFor: page
>>> prevPage realStackLimit); printChar: $).
>>> +       self tab; print: 'next '; printHexPtr: (self cCode:
>>> 'page->nextPage' inSmalltalk: [page nextPage baseAddress]);
>>> +               print: ' ('; printNum: (stackPages pageIndexFor: page
>>> nextPage realStackLimit); printChar: $).
>>> +       self cr!
>>>
>>> Item was changed:
>>>   ----- Method: StackInterpreter>>printStackPageListInUse (in category
>>> 'debug printing') -----
>>>   printStackPageListInUse
>>> +       | page n |
>>> -       | page |
>>>         <inline: false>
>>>         <var: #page type: #'StackPage *'>
>>>         page := stackPages mostRecentlyUsedPage.
>>> +       n := 0.
>>>         [(stackPages isFree: page) ifFalse:
>>> +               [self printStackPage: page useCount: n; cr.
>>> +                n := n + 1].
>>> -               [self printStackPage: page.
>>> -                self cr].
>>>          (page := page prevPage) ~= stackPages mostRecentlyUsedPage]
>>> whileTrue!
>>>
>>> Item was changed:
>>>   ----- Method: StackInterpreter>>printStackPagesInUse (in category
>>> 'debug printing') -----
>>>   printStackPagesInUse
>>> +       | n |
>>> +       n := 0.
>>>         0 to: numStackPages - 1 do:
>>>                 [:i|
>>>                 (stackPages isFree: (stackPages stackPageAt: i)) ifFalse:
>>> +                       [self printStackPage: (stackPages stackPageAt:
>>> i) useCount: n; cr.
>>> +                        n := n + 1]]!
>>> -                       [self printStackPage: (stackPages stackPageAt:
>>> i).
>>> -                        self cr]]!
>>>
>>> Item was removed:
>>> - ----- Method:
>>> StackInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:
>>> (in category 'file primitives') -----
>>> - makeDirEntryName: entryName size: entryNameSize createDate: createDate
>>> modDate: modifiedDate isDir: dirFlag fileSize: fileSize posixPermissions:
>>> posixPermissions
>>> -       <option: #PharoVM>
>>> -       <var: 'entryName' type: 'char *'>
>>> -
>>> -       | modDateOop createDateOop nameString results |
>>> -
>>> -       results                 := objectMemory instantiateClass:
>>> (objectMemory splObj: ClassArray) indexableSize: 5.
>>> -       nameString              := objectMemory instantiateClass:
>>> (objectMemory splObj: ClassString) indexableSize: entryNameSize.
>>> -       createDateOop   := self positive32BitIntegerFor: createDate.
>>> -       modDateOop      := self positive32BitIntegerFor: modifiedDate.
>>> -
>>> -       1 to: entryNameSize do:
>>> -               [ :i |
>>> -               objectMemory storeByte: i-1 ofObject: nameString
>>> withValue: (entryName at: i) asciiValue].
>>> -
>>> -       objectMemory storePointerUnchecked: 0 ofObject: results
>>> withValue: nameString.
>>> -       objectMemory storePointerUnchecked: 1 ofObject: results
>>> withValue: createDateOop.
>>> -       objectMemory storePointerUnchecked: 2 ofObject: results
>>> withValue: modDateOop.
>>> -       dirFlag
>>> -               ifTrue: [ objectMemory storePointerUnchecked: 3
>>> ofObject: results withValue: objectMemory trueObject ]
>>> -               ifFalse: [ objectMemory storePointerUnchecked: 3
>>> ofObject: results withValue: objectMemory falseObject ].
>>> -       objectMemory storePointerUnchecked: 4 ofObject: results
>>> withValue: (objectMemory integerObjectOf: fileSize).
>>> -       objectMemory storePointerUnchecked: 5 ofObject: results
>>> withValue: (objectMemory integerObjectOf: posixPermissions).
>>> -       ^ results!
>>>
>>> Item was changed:
>>>   ----- Method: StackInterpreterSimulator>>primitiveDirectoryEntry (in
>>> category 'file primitives') -----
>>>   primitiveDirectoryEntry
>>>         | name pathName array result |
>>>         name := self stringOf: self stackTop.
>>>         pathName := self stringOf: (self stackValue: 1).
>>>
>>>         self successful ifFalse:
>>>                 [^self primitiveFail].
>>>
>>>         array := FileDirectory default primLookupEntryIn: pathName name:
>>> name.
>>>         array == nil ifTrue:
>>>                 [self pop: 3 thenPush: objectMemory nilObject.
>>>                 ^array].
>>>         array == #badDirectoryPath ifTrue:
>>>                 [self halt.
>>>                 ^self primitiveFail].
>>>
>>>         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 thenPush: result!
>>> -       self pop: 3.
>>> -       self push: result!
>>>
>>> Item was removed:
>>> - ----- Method:
>>> StackToRegisterMappingCogit>>genSmallIntegerComparison:orDoubleComparison:
>>> (in category 'primitive generators') -----
>>> - genSmallIntegerComparison: jumpOpcode orDoubleComparison:
>>> jumpFPOpcodeGenerator
>>> -       "Stack looks like
>>> -               return address"
>>> -       | jumpDouble jumpNonInt jumpFail jumpTrue jumpCond |
>>> -       <var: #jumpFPOpcodeGenerator declareC: 'AbstractInstruction
>>> *(*jumpFPOpcodeGenerator)(void *)'>
>>> -       <var: #jumpDouble type: #'AbstractInstruction *'>
>>> -       <var: #jumpNonInt type: #'AbstractInstruction *'>
>>> -       <var: #jumpCond type: #'AbstractInstruction *'>
>>> -       <var: #jumpTrue type: #'AbstractInstruction *'>
>>> -       <var: #jumpFail type: #'AbstractInstruction *'>
>>> -       backEnd hasDoublePrecisionFloatingPointSupport ifFalse:
>>> -               [^self genSmallIntegerComparison: jumpOpcode].
>>> -       jumpDouble := objectRepresentation genJumpNotSmallInteger:
>>> Arg0Reg scratchReg: TempReg.
>>> -       self CmpR: Arg0Reg R: ReceiverResultReg. "N.B. FLAGS := RRReg -
>>> Arg0Reg"
>>> -       jumpTrue := self gen: jumpOpcode.
>>> -       self genMoveFalseR: ReceiverResultReg.
>>> -       self RetN: 0.
>>> -       jumpTrue jmpTarget: (self genMoveTrueR: ReceiverResultReg).
>>> -       self RetN: 0.
>>> -
>>> -       "Argument may be a Float : let us check or fail"
>>> -       jumpDouble jmpTarget: self Label.
>>> -       objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
>>> -               [jumpNonInt := objectRepresentation genJumpImmediate:
>>> Arg0Reg].
>>> -       objectRepresentation genGetCompactClassIndexNonImmOf: Arg0Reg
>>> into: SendNumArgsReg.
>>> -       objectRepresentation genCmpClassFloatCompactIndexR:
>>> SendNumArgsReg.
>>> -       jumpFail := self JumpNonZero: 0.
>>> -
>>> -       "It was a Float, so convert the receiver to double and perform
>>> the operation"
>>> -       objectRepresentation genConvertSmallIntegerToIntegerInReg:
>>> ReceiverResultReg.
>>> -       self ConvertR: ReceiverResultReg Rd: DPFPReg0.
>>> -       objectRepresentation genGetDoubleValueOf: Arg0Reg into: DPFPReg1.
>>> -       self CmpRd: DPFPReg1 Rd: DPFPReg0.
>>> -       jumpCond := self perform: jumpFPOpcodeGenerator with: 0. "FP
>>> jumps are a little weird"
>>> -       self genMoveFalseR: ReceiverResultReg.
>>> -       self RetN: 0.
>>> -       jumpCond jmpTarget: (self genMoveTrueR: ReceiverResultReg).
>>> -       self RetN: 0.
>>> -
>>> -       objectRepresentation smallIntegerIsOnlyImmediateType
>>> -               ifTrue: [jumpFail jmpTarget: self Label]
>>> -               ifFalse: [jumpNonInt jmpTarget: (jumpFail jmpTarget:
>>> self Label)].
>>> -       ^0!
>>>
>>> Item was added:
>>> + ----- Method:
>>> StackToRegisterMappingCogit>>genSmallIntegerComparison:orDoubleComparison:invert:
>>> (in category 'primitive generators') -----
>>> + genSmallIntegerComparison: jumpOpcode orDoubleComparison:
>>> jumpFPOpcodeGenerator invert: invertComparison
>>> +       "Stack looks like
>>> +               return address"
>>> +       | jumpDouble jumpNonInt jumpFail jumpTrue jumpCond |
>>> +       <var: #jumpFPOpcodeGenerator declareC: 'AbstractInstruction
>>> *(*jumpFPOpcodeGenerator)(void *)'>
>>> +       <var: #jumpDouble type: #'AbstractInstruction *'>
>>> +       <var: #jumpNonInt type: #'AbstractInstruction *'>
>>> +       <var: #jumpCond type: #'AbstractInstruction *'>
>>> +       <var: #jumpTrue type: #'AbstractInstruction *'>
>>> +       <var: #jumpFail type: #'AbstractInstruction *'>
>>> +       backEnd hasDoublePrecisionFloatingPointSupport ifFalse:
>>> +               [^self genSmallIntegerComparison: jumpOpcode].
>>> +       jumpDouble := objectRepresentation genJumpNotSmallInteger:
>>> Arg0Reg scratchReg: TempReg.
>>> +       self CmpR: Arg0Reg R: ReceiverResultReg. "N.B. FLAGS := RRReg -
>>> Arg0Reg"
>>> +       jumpTrue := self gen: jumpOpcode.
>>> +       self genMoveFalseR: ReceiverResultReg.
>>> +       self RetN: 0.
>>> +       jumpTrue jmpTarget: (self genMoveTrueR: ReceiverResultReg).
>>> +       self RetN: 0.
>>> +
>>> +       "Argument may be a Float : let us check or fail"
>>> +       jumpDouble jmpTarget: self Label.
>>> +       objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
>>> +               [jumpNonInt := objectRepresentation genJumpImmediate:
>>> Arg0Reg].
>>> +       objectRepresentation genGetCompactClassIndexNonImmOf: Arg0Reg
>>> into: SendNumArgsReg.
>>> +       objectRepresentation genCmpClassFloatCompactIndexR:
>>> SendNumArgsReg.
>>> +       jumpFail := self JumpNonZero: 0.
>>> +
>>> +       "It was a Float, so convert the receiver to double and perform
>>> the operation"
>>> +       objectRepresentation genConvertSmallIntegerToIntegerInReg:
>>> ReceiverResultReg.
>>> +       self ConvertR: ReceiverResultReg Rd: DPFPReg0.
>>> +       objectRepresentation genGetDoubleValueOf: Arg0Reg into: DPFPReg1.
>>> +       invertComparison "May need to invert for NaNs"
>>> +               ifTrue: [self CmpRd: DPFPReg0 Rd: DPFPReg1]
>>> +               ifFalse: [self CmpRd: DPFPReg1 Rd: DPFPReg0].
>>> +       jumpCond := self perform: jumpFPOpcodeGenerator with: 0. "FP
>>> jumps are a little weird"
>>> +       self genMoveFalseR: ReceiverResultReg.
>>> +       self RetN: 0.
>>> +       jumpCond jmpTarget: (self genMoveTrueR: ReceiverResultReg).
>>> +       self RetN: 0.
>>> +
>>> +       objectRepresentation smallIntegerIsOnlyImmediateType
>>> +               ifTrue: [jumpFail jmpTarget: self Label]
>>> +               ifFalse: [jumpNonInt jmpTarget: (jumpFail jmpTarget:
>>> self Label)].
>>> +       ^0!
>>>
>>>
>>
>>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20150810/12d74a22/attachment-0001.htm


More information about the Vm-dev mailing list