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

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


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;

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:
>> +               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:
>> +               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/6df03f33/attachment-0001.htm


More information about the Vm-dev mailing list