Vm-dev February 2014

vm-dev@lists.squeakfoundation.org

33 participants
83 discussions

StackVM builds...need to debug..asking first
by gettimothy 19 Feb '14

19 Feb '14

Howdy all. I am able to build the source for the StackIntepreter and do a make install. (very gratifying) I had to remove the UUID from plugins.int for the build to succeed (I will be investigating this later)* I tried launching a Squeak 3.0, 2.8 , 4.0 and finally the 4.5 image in that order. I kept getting variants of This interpreter (vers. 6505) cannot read image file (vers. 1712914432). Press CR to quit.. The 4.5 (the image from which it was built) is the only one that attempts to run; no World launches While I am dusting off my ddd manual to debug this, I thought I would post this to get your thoughts in case there are any flashing red lights that are obvious to anybody. My 'working thoughts' at the moment are: 1. UUID could be required for the thing to run, but I don't know that. 2. Since it is StackInterpreter, I assumed it would have to run against an older pre-Cog image, but it refuses to launch the image Thinking about it, this semi-makes sense because StackInterpreter is under NewObjectMemory in the class hierarchy 3. Verify why plugins.int/ext did not get modified from VMMakerTool and had to be hand-edited (which I prefer, btw). I am pretty sure Eliot mentioned this in an email to Tim R. Thanks for your time. tty. *the include /usr/include/uuid/uuid.h is there as is the function definition that burps--probably a 32bit compat lib issue--no big deal for now.

2 2

Re: [Pharo-dev] On things we do when our stack overflows
by Stefan Marr 19 Feb '14

19 Feb '14

Hi: On 18 Feb 2014, at 15:58, Sven Van Caekenberghe <sven(a)stfx.eu> wrote: > The VM could sure use stack overflow protection, it would/could help catch numerous 'hangs' due to infinite loops. > > On 18 Feb 2014, at 13:08, Sebastian Sastre <sebastian(a)flowingconcept.com> wrote: > >> Hi there, >> >> Toyota shoot its foot and learnt how not to anymore. >> >> This is a nice read on the things our software do when the stack overflows. >> Are We Shooting Ourselves in the Foot with Stack Overflow? >> http://embeddedgurus.com/state-space/2014/02/are-we-shooting-ourselves-in-t… >> >> The question on the table is >> >> are we following time proven safety rules when the same thing happen to our VM? From the top of my head, I would expect operating systems for non-embedded devises to allocate a protected page at the end of the stack to detect stack overflows. And, most of the standard OSes should use Address Space Layout Randomization, which you need to turn off explicitly if you actually want to make sure that your stack is at a predefined position. I think, this article is really targeted towards embedded systems, where you might not even got a MMU. And, if you are interested in those things, it might be best to follow Eliot’s suggestion and discuss it on the VM list. Best regards Stefan -- Stefan Marr INRIA Lille - Nord Europe http://stefan-marr.de/research/

2 1

VM Maker: VMMaker.oscog-eem.619.mcz
by commits＠source.squeak.org 19 Feb '14

19 Feb '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.619.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.619 Author: eem Time: 18 February 2014, 3:57:13.565 pm UUID: 9cd188c5-a1b6-46c2-8408-99190a15f19f Ancestors: VMMaker.oscog-eem.618 Spur: Get obj stack swizzling correct. Add some missing simulation plumbing. =============== Diff against VMMaker.oscog-eem.618 =============== Item was added: + ----- Method: SpurMemoryManager>>ioLoadModule:OfLength: (in category 'simulation only') ----- + ioLoadModule: moduleNameIndex OfLength: moduleLength + <doNotGenerate> + <returnTypeC: #'void *'> + "Dummy - provided by support code" + ^0! Item was added: + ----- Method: SpurMemoryManager>>signed32BitValueOf: (in category 'simulation only') ----- + signed32BitValueOf: oop + "hack around the CoInterpreter/ObjectMemory split refactoring" + <doNotGenerate> + ^coInterpreter signed32BitValueOf: oop! Item was changed: ----- Method: SpurMemoryManager>>swizzleObjStackAt: (in category 'obj stacks') ----- swizzleObjStackAt: objStackRootIndex "On load, swizzle the pointers in an obj stack. Answer the obj stack's oop." | firstPage page stackOrNil index field | firstPage := stackOrNil := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj. stackOrNil = nilObj ifTrue: [^stackOrNil]. [self assert: (self numSlotsOfAny: stackOrNil) = ObjStackPageSlots. self assert: (self fetchPointer: ObjStackMyx ofObject: stackOrNil) = objStackRootIndex. "There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so if there were 5 slots in an oop stack, full would be 2, and the last 0-rel index is 4. Hence the last index is topx + fixed slots - 1, or topx + ObjStackNextx" index := (self fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx. + "swizzle fields including ObjStackNextx, excluding ObjStackFreex and leave field containing the next link." - "swizzle fields including ObjStackNextx and leave field containing the next link." [field := self fetchPointer: index ofObject: stackOrNil. (field = 0 or: [self isImmediate: field]) ifFalse: [field := segmentManager swizzleObj: field. self storePointer: index ofObjStack: stackOrNil withValue: field]. + (index := index - 1) >= ObjStackNextx] whileTrue. - (index := index - 1) > ObjStackMyx] whileTrue. (stackOrNil := field) ~= 0] whileTrue. (stackOrNil := self fetchPointer: ObjStackFreex ofObject: firstPage) ~= 0 ifTrue: + [page := firstPage. + [stackOrNil := segmentManager swizzleObj: stackOrNil. + self storePointer: ObjStackFreex ofObjStack: page withValue: stackOrNil. + page := stackOrNil. + (stackOrNil := self fetchPointer: ObjStackFreex ofObject: page) ~= 0] whileTrue]. - [[page := self fetchPointer: ObjStackFreex ofObject: stackOrNil. - page ~= 0] whileTrue: - [field := segmentManager swizzleObj: page. - self storePointer: ObjStackFreex ofObjStack: stackOrNil withValue: field. - stackOrNil := field]]. - (stackOrNil := self fetchPointer: ObjStackNextx ofObject: firstPage) ~= 0 ifTrue: - [[page := self fetchPointer: ObjStackNextx ofObject: stackOrNil. - page ~= 0] whileTrue: - [field := segmentManager swizzleObj: page. - self storePointer: ObjStackNextx ofObjStack: stackOrNil withValue: field. - stackOrNil := field]]. self assert: (self isValidObjStackAt: objStackRootIndex). ^self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj!

1 0

VM Maker: VMMaker.oscog-eem.618.mcz
by commits＠source.squeak.org 18 Feb '14

18 Feb '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.618.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.618 Author: eem Time: 18 February 2014, 2:28:48.587 pm UUID: db6b9128-3c54-41b7-b3d9-0063d6001b70 Ancestors: VMMaker.oscog-eem.617 Spur: Update firstFreeChunk correctly when it is allocated in the compaction routines. Break out of the search loop sooner in allocateOldSpaceChunkOfBytes:suchThat:. Make the halt in globalGarbageCollect informative. =============== Diff against VMMaker.oscog-eem.617 =============== Item was changed: ----- Method: Spur32BitMMLESimulator>>globalGarbageCollect (in category 'gc - global') ----- globalGarbageCollect + self halt: 'GC number ', statFullGCs printString. - self halt. ^super globalGarbageCollect! Item was changed: ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes:suchThat: (in category 'free space') ----- allocateOldSpaceChunkOfBytes: chunkBytes suchThat: acceptanceBlock "Answer a chunk of oldSpace from the free lists that satisfies acceptanceBlock, if available, otherwise answer nil. Break up a larger chunk if one of the exact size cannot be found. N.B. the chunk is simply a pointer, it has no valid header. The caller *must* fill in the header correctly." | initialIndex node next prev index child childBytes acceptedChunk acceptedNode | <inline: true> "must inline for acceptanceBlock" self assert: (lastSubdividedFreeChunk := 0) = 0. "for debugging:" "totalFreeOldSpace := self totalFreeListBytes" totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)" initialIndex := chunkBytes / self allocationUnit. (initialIndex < self numFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue: [(freeListsMask anyMask: 1 << initialIndex) ifTrue: [(node := freeLists at: initialIndex) = 0 ifTrue: [freeListsMask := freeListsMask - (1 << initialIndex)] ifFalse: [prev := 0. [node ~= 0] whileTrue: [self assert: node = (self startOfObject: node). self assert: (self isValidFreeObject: node). next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. (acceptanceBlock value: node) ifTrue: [prev = 0 ifTrue: [freeLists at: initialIndex put: next] ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. ^node]. prev := node. node := next]]]. "first search for free chunks of a multiple of chunkBytes in size" index := initialIndex. [(index := index + initialIndex) < self numFreeLists and: [1 << index <= freeListsMask]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(node := freeLists at: index) = 0 ifTrue: [freeListsMask := freeListsMask - (1 << index)] ifFalse: [prev := 0. [node ~= 0] whileTrue: [self assert: node = (self startOfObject: node). self assert: (self isValidFreeObject: node). next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. (acceptanceBlock value: node) ifTrue: [prev = 0 ifTrue: [freeLists at: index put: next] ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: node) + chunkBytes. ^node]. prev := node. node := next]]]]. "now get desperate and use the first that'll fit. Note that because the minimum free size is 16 bytes (2 * allocationUnit), to leave room for the forwarding pointer/next free link, we can only break chunks that are at least 16 bytes larger, hence start at initialIndex + 2." index := initialIndex + 1. [(index := index + 1) < self numFreeLists and: [1 << index <= freeListsMask]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(node := freeLists at: index) = 0 ifTrue: [freeListsMask := freeListsMask - (1 << index)] ifFalse: [prev := 0. [node ~= 0] whileTrue: [self assert: node = (self startOfObject: node). self assert: (self isValidFreeObject: node). next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. (acceptanceBlock value: node) ifTrue: [prev = 0 ifTrue: [freeLists at: index put: next] ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: node) + chunkBytes. ^node]. prev := node. node := next]]]]]. "Large chunk, or no space on small free lists. Search the large chunk list. Large chunk list organized as a tree, each node of which is a list of chunks of the same size. Beneath the node are smaller and larger blocks. When the search ends parent should hold the smallest chunk at least as large as chunkBytes, or 0 if none. acceptedChunk and acceptedNode save us from having to back-up when the acceptanceBlock filters-out all nodes of the right size, but there are nodes of the wrong size it does accept." child := freeLists at: 0. node := acceptedChunk := acceptedNode := 0. [child ~= 0] whileTrue: [self assert: (self isValidFreeObject: child). childBytes := self bytesInObject: child. childBytes = chunkBytes ifTrue: "size match; try to remove from list at node." [node := child. [prev := node. node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node. node ~= 0] whileTrue: [(acceptanceBlock value: node) ifTrue: [self assert: (self isValidFreeObject: node). self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node). ^self startOfObject: node]]. (acceptanceBlock value: child) ifTrue: [next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. next = 0 ifTrue: "no list; remove the interior node" [self unlinkSolitaryFreeTreeNode: child] ifFalse: "list; replace node with it" [self inFreeTreeReplace: child with: next]. ^self startOfObject: child]]. child ~= 0 ifTrue: ["Note that because the minimum free size is 16 bytes (2 * allocationUnit), to leave room for the forwarding pointer/next free link, we can only break chunks that are at least 16 bytes larger, hence reject chunks < 2 * allocationUnit larger." childBytes <= (chunkBytes + self allocationUnit) ifTrue: "node too small; walk down the larger size of the tree" [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child] ifFalse: [self flag: 'we can do better here; preferentially choosing the lowest node. That would be a form of best-fit since we are trying to compact down'. + node := child. + child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: node. acceptedNode = 0 ifTrue: + [acceptedChunk := node. - [acceptedChunk := child. "first search the list." [acceptedChunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedChunk. (acceptedChunk ~= 0 and: [acceptanceBlock value: acceptedChunk]) ifTrue: + [acceptedNode := node]. - [acceptedNode := child]. acceptedChunk ~= 0 and: [acceptedNode = 0]] whileTrue. "nothing on the list; will the node do? This prefers acceptable nodes higher up the tree over acceptable list elements further down, but we haven't got all day..." (acceptedNode = 0 + and: [acceptanceBlock value: node]) ifTrue: + [acceptedNode := node. + child := 0 "break out of loop now we have an acceptedNode"]]]]]. - and: [acceptanceBlock value: child]) ifTrue: - [acceptedNode := child]]. - child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]]. acceptedNode ~= 0 ifTrue: [acceptedChunk ~= 0 ifTrue: [self assert: (self bytesInObject: acceptedChunk) >= (chunkBytes + self allocationUnit). [next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode. next ~= acceptedChunk] whileTrue: [acceptedNode := next]. self storePointer: self freeChunkNextIndex ofFreeChunk: acceptedNode withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedChunk). self freeChunkWithBytes: (self bytesInObject: acceptedChunk) - chunkBytes at: (self startOfObject: acceptedChunk) + chunkBytes. ^self startOfObject: acceptedChunk]. next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode. next = 0 ifTrue: "no list; remove the interior node" [self unlinkSolitaryFreeTreeNode: acceptedNode] ifFalse: "list; replace node with it" [self inFreeTreeReplace: acceptedNode with: next]. self assert: (self bytesInObject: acceptedNode) >= (chunkBytes + self allocationUnit). self freeChunkWithBytes: (self bytesInObject: acceptedNode) - chunkBytes at: (self startOfObject: acceptedNode) + chunkBytes. ^self startOfObject: acceptedNode]. totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded" ^nil! Item was changed: ----- Method: SpurMemoryManager>>exactFitCompact (in category 'compaction') ----- exactFitCompact "Compact all of memory above firstFreeChunk using exact-fit, assuming free space is sorted and that as many of the the highest objects as will fit are recorded in highestObjects. Don't move pinned objects. Note that we don't actually move; we merely copy and forward. Eliminating forwarders will be done in a final pass. Leave the objects that don't fit exactly (the misfits), and hence aren't moved, in highestObjects." <inline: false> | misfits first nfits nmiss nHighest nMisses savedLimit | <var: #misfits type: #usqInt> self checkFreeSpace. totalFreeOldSpace = 0 ifTrue: [^self]. highestObjects isEmpty ifTrue: [^self]. nfits := nmiss := 0. misfits := highestObjects last + self wordSize. [statCompactPassCount := statCompactPassCount + 1. highestObjects from: misfits - self wordSize reverseDo: [:o| | b | (self oop: o isGreaterThan: firstFreeChunk) ifFalse: [highestObjects first: misfits. coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr. ^self]. ((self isForwarded: o) or: [self isPinned: o]) ifFalse: [b := self bytesInObject: o. (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o]) ifNil: [nmiss := nmiss + 1. misfits := misfits - self wordSize. misfits < highestObjects start ifTrue: [misfits := highestObjects limit - self wordSize]. self longAt: misfits put: o] ifNotNil: + [:f| | fo | - [:f| nfits := nfits + 1. - self copyAndForward: o withBytes: b toFreeChunk: f. "here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk is a large chunk then firstFreeChunk will no longer point to an object header. So check and adjust firstFreeChunk if it is assigned to." + fo := self objectStartingAt: f. + fo = firstFreeChunk ifTrue: + [firstFreeChunk := self objectAfter: fo]. + self copyAndForward: o withBytes: b toFreeChunk: f]]]. - f = firstFreeChunk ifTrue: - [firstFreeChunk := self objectStartingAt: f]]]]. self checkFreeSpace. "now highestObjects contains only misfits, if any, from misfits to last. set first to first failure and refill buffer. next cycle will add more misfits. give up on exact-fit when half of the highest objects fail to fit." first := self longAt: highestObjects first. self assert: (self oop: first isGreaterThan: firstFreeChunk). nHighest := highestObjects usedSize. highestObjects first: misfits. nMisses := highestObjects usedSize. nMisses > (nHighest // 2) ifTrue: [coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr. ^self]. savedLimit := self moveMisfitsToTopOfHighestObjects: misfits. self fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo: first. misfits := self moveMisfitsInHighestObjectsBack: savedLimit. highestObjects usedSize > 0] whileTrue! Item was changed: ----- Method: SpurMemoryManager>>firstFitCompact (in category 'compaction') ----- firstFitCompact "Compact all of memory above firstFreeChunk using first-fit, assuming free space is sorted and that as many of the the highest objects as will fit are recorded in highestObjects. Don't move pinned objects. Note that we don't actually move; we merely copy and forward. Eliminating forwarders will be done in a final pass." <inline: false> | first nhits nmisses | self checkFreeSpace. totalFreeOldSpace = 0 ifTrue: [^self]. highestObjects isEmpty ifTrue: [^self]. nhits := nmisses := 0. [statCompactPassCount := statCompactPassCount + 1. highestObjects reverseDo: [:o| | b | + self assert: (firstFreeChunk = 0 + or: [(self isFreeObject: firstFreeChunk) + or: [self isValidClassIndex: (self classIndexOf: firstFreeChunk)]]). (self oop: o isLessThanOrEqualTo: firstFreeChunk) ifTrue: [coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr. ^self]. ((self isForwarded: o) or: [self isPinned: o]) ifFalse: [b := self bytesInObject: o. (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNil: [nmisses := nmisses + 1] ifNotNil: + [:f| | fo | - [:f| nhits := nhits + 1. - self copyAndForward: o withBytes: b toFreeChunk: f. "here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk is a large chunk then firstFreeChunk will no longer point to an object header. So check and adjust firstFreeChunk if it is assigned to." + fo := self objectStartingAt: f. + fo = firstFreeChunk ifTrue: + [firstFreeChunk := lastSubdividedFreeChunk = 0 + ifTrue: [self objectAfter: fo] + ifFalse: [self objectStartingAt: lastSubdividedFreeChunk]]. + self copyAndForward: o withBytes: b toFreeChunk: f. - f = firstFreeChunk ifTrue: - [firstFreeChunk := self objectStartingAt: f]. self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: (self objectStartingAt: f)) = lastSubdividedFreeChunk])]]]. self checkFreeSpace. first := self longAt: highestObjects first. self assert: (self oop: first isGreaterThan: firstFreeChunk). self fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo: first. highestObjects usedSize > 0] whileTrue. coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr!

1 0

Mill CPU
by dsg 18 Feb '14

18 Feb '14

Just curious if anyone else in vm-dev has been looking at the Mill CPU? http://ootbcomp.com/docs/ <http://ootbcomp.com/docs/> One thing that caught my eye is the comparison to a stack machine architecture and was curious if this meshes with the stack vm? http://www.eetimes.com/author.asp?section_id=36&doc_id=1320257 <http://www.eetimes.com/author.asp?section_id=36&doc_id=1320257> -- View this message in context: http://forum.world.st/Mill-CPU-tp4744509.html Sent from the Squeak VM mailing list archive at Nabble.com.

2 1

Re: [Vm-dev] VM Maker: ..VMMaker.oscog-eem.618.mcz
by Levente Uzonyi 18 Feb '14

18 Feb '14

Is it intentional that this package and the previous one are prefixed with dots? Levente On Thu, 13 Feb 2014, commits(a)source.squeak.org wrote: > > Eliot Miranda uploaded a new version of VMMaker to project VM Maker: > http://source.squeak.org/VMMaker/..VMMaker.oscog-eem.618.mcz > > ==================== Summary ==================== > > Name: ..VMMaker.oscog-eem.618 > Author: eem > Time: 13 February 2014, 11:51:10.104 am > UUID: 3756532a-fdbf-4e96-8cc9-be0f35157864 > Ancestors: ..VMMaker.oscog-eem.617 > > Some musings on Spur compaction. > > =============== Diff against ..VMMaker.oscog-eem.617 =============== > > Item was added: > + ----- Method: SpurMemoryManager>>abstractCompaction (in category 'compaction - analysis') ----- > + abstractCompaction > + "This method answers a rough estimate of compactibility." > + <doNotGenerate> > + | lowestFree freeChunks used movable | > + lowestFree := SmallInteger maxVal. > + freeChunks := Set new. > + used := Set new. > + movable := Set new. > + self allObjectsInFreeTreeDo: > + [:f| > + (self addressAfter: f) < endOfMemory ifTrue: > + [freeChunks add: f. > + f < lowestFree ifTrue: [lowestFree := f]]]. > + self allOldSpaceObjectsFrom: lowestFree do: > + [:o| | size delta best | > + size := self bytesInObject: o. > + delta := SmallInteger maxVal. > + freeChunks do: [:f| | fs | > + ((fs := self bytesInObject: f) >= size) ifTrue: > + [delta > (fs - size) ifTrue: > + [delta := fs - size. best := f]]]. > + best ifNotNil: > + [movable add: o. > + used add: (freeChunks remove: best)]]. > + ^{ totalFreeOldSpace. movable inject: 0 into: [:s :o| s + (self bytesInObject: o)]. used inject: 0 into: [:s :o| s + (self bytesInObject: o)] }! > > Item was added: > + ----- Method: SpurMemoryManager>>abstractPigCompaction (in category 'compaction - analysis') ----- > + abstractPigCompaction > + "This method answers a rough estimate of compactibility using a pig (a large free chunk)." > + <doNotGenerate> > + | pig pork moved unmoved nmoved nunmoved | > + pig := self findAPig. > + pork := self bytesInObject: pig. > + moved := unmoved := nmoved := nunmoved := 0. > + self allOldSpaceObjectsFrom: pig do: > + [:o| | bytes | > + bytes := self bytesInObject: o. > + bytes <= pork > + ifTrue: > + [moved := moved + bytes. > + nmoved := nmoved + 1. > + pork := pork - bytes] > + ifFalse: > + [unmoved := unmoved + bytes. > + nunmoved := nunmoved + 1]]. > + ^{ self bytesInObject: pig. pork. moved. nmoved. unmoved. nunmoved }! > > Item was added: > + ----- Method: SpurMemoryManager>>biggies (in category 'compaction - analysis') ----- > + biggies > + "This method answers a sorted collection of the objects >= 1,000,000 bytes long, > + above the lowest large free chunk, sandwiched between nilObj and the end of memory." > + <doNotGenerate> > + | lowestFree biggies | > + lowestFree := SmallInteger maxVal. > + self allObjectsInFreeTreeDo: > + [:f| (self addressAfter: f) < endOfMemory ifTrue: [f < lowestFree ifTrue: [lowestFree := f]]]. > + biggies := SortedCollection new. > + self allOldSpaceObjectsFrom: lowestFree do: > + [:f| > + (self bytesInObject: f) >= 1000000 ifTrue: > + [biggies add: f]]. > + ^{{nilObj hex. #nil}}, (biggies collect: [:f| {f hex. self bytesInObject: f}]), {{endOfMemory hex. #endOfMemory}}! > > Item was added: > + ----- Method: SpurMemoryManager>>compactionIssues (in category 'compaction - analysis') ----- > + compactionIssues > + <doNotGenerate> > + "Compaction isn't working well. It rarely moves more than a few tens of kilobytes. Why? > + Load an image and before you run it, or just before a GC, run these anaylsis routines. > + e.g. > + self abstractCompaction #(63230272 75456 63210648) > + shows we can move 75456 bytes of objects, but that would use 63210648 of free space. > + i.e. there are lots of big free chunks in play, not many small ones that fit the bill. > + > + self largeFreeChunkDistribution > + #( #('16r31C788' #nil) > + #('16r1423AC0' 2061864) > + #('16r1B705E8' 1515200) > + #('16r1D31D20' 2011152) > + #('16r1F37818' 1491480) > + #('16r2225968' 1450512) > + #('16r24C92C8' 48575672) (16r24C92C8 + 48575672) hex '16r531C780' a free chunk > + #('16r531C788' #endOfMemory)) > + shows there's plenty of large free chunks. And the trailing 16-byte free chunk shows coallescing is not working properly. > + > + self biggies #(#('16r31C788' #nil) #('16r531C788' #endOfMemory)) > + shows there are no large objects to be moved. > + > + So... looks like compaction should hold onto the lowest large chunk and preferentially move objects into that. > + Let's call it a pig. Compaction needs to whittle away at the pig. > + > + e.g. > + self abstractPigCompaction #(2061864 0 2061864 18759 2018224 34757) > + shows we can move 18759 objects that will occupy 2018224 bytes into that > + low pig of 2061864 bytes."! > > Item was added: > + ----- Method: SpurMemoryManager>>findAPig (in category 'compaction - analysis') ----- > + findAPig > + "Answer a large low free chuink." > + <doNotGenerate> > + | pig | > + self allObjectsInFreeTreeDo: > + [:f| > + (self bytesInObject: f) >= 1000000 ifTrue: > + [(pig isNil or: [pig > f]) ifTrue: > + [pig := f]]]. > + ^pig! > > Item was added: > + ----- Method: SpurMemoryManager>>largeFreeChunkDistribution (in category 'compaction - analysis') ----- > + largeFreeChunkDistribution > + "This method answers a sorted collection of the free chunks >= 1,000,000 bytes long, > + sandwiched between nilObj and the end of memory (ignoring the large chunk often found at the end of the heap)." > + <doNotGenerate> > + | freeChunks | > + freeChunks := SortedCollection new. > + self allObjectsInFreeTreeDo: > + [:f| > + ((self addressAfter: f) < endOfMemory > + and: [(self bytesInObject: f) >= 1000000]) ifTrue: > + [freeChunks add: f]]. > + ^{{nilObj hex. #nil}}, (freeChunks collect: [:f| {f hex. self bytesInObject: f}]), {{endOfMemory hex. #endOfMemory}}! > >

5 10

What squeakvm.org/branch and subdirecty to use to build the StackInterpreter?
by gettimothy 18 Feb '14

18 Feb '14

Howdy, I figured its time to build the StackInterpreter so I can get my hands dirty with plugins and maybe figure out the keyEvents at that level. After a couple of missteps I was able to generate the source using VMMakerTool just fine into the src directory of svn co http://www.squeakvm.org/svn/squeak/branches/Cog tree. (Thanks Tim. R and dtl for the instructions on the wiki http://wiki.squeak.org/squeak/6177) After some failed configures and builds, I am thinking I am in the wrong branch and/or subdirectory To build the StackInterpreter, should I be on the Squeak branch with its structure? Should I build in Cog branch/unixbuild? or Cog branch/stackbuild? (which does not have a unix build directory) http://www.squeakvm.org/svn/squeak/ BRANCH Build Directory Cog unixbuild <---I WAS HERE (seemed to build cog fine, replacing svn src/ directory with VMMakerTool generated sources did not configure) Cog stackbuild <--Should I be here? Squeak platforms/unix <--or here ... <--or someplace else entirely? thx. tty

2 4

[commit][2868] Add a linux stack build.
by commits＠squeakvm.org 18 Feb '14

18 Feb '14

Revision: 2868 Author: eliot Date: 2014-02-17 16:00:50 -0800 (Mon, 17 Feb 2014) Log Message: ----------- Add a linux stack build. Added Paths: ----------- branches/Cog/stackbuild/unixbuild/ branches/Cog/stackbuild/unixbuild/HowToBuild branches/Cog/stackbuild/unixbuild/astbld/ branches/Cog/stackbuild/unixbuild/astbld/mvm branches/Cog/stackbuild/unixbuild/astbld/plugins.ext branches/Cog/stackbuild/unixbuild/astbld/plugins.int branches/Cog/stackbuild/unixbuild/astbldt/ branches/Cog/stackbuild/unixbuild/astbldt/mvm branches/Cog/stackbuild/unixbuild/astbldt/plugins.ext branches/Cog/stackbuild/unixbuild/astbldt/plugins.int branches/Cog/stackbuild/unixbuild/bld/ branches/Cog/stackbuild/unixbuild/bld/mvm branches/Cog/stackbuild/unixbuild/bld/plugins.ext branches/Cog/stackbuild/unixbuild/bld/plugins.int branches/Cog/stackbuild/unixbuild/bldt/ branches/Cog/stackbuild/unixbuild/bldt/mvm branches/Cog/stackbuild/unixbuild/bldt/plugins.ext branches/Cog/stackbuild/unixbuild/bldt/plugins.int branches/Cog/stackbuild/unixbuild/dbgbld/ branches/Cog/stackbuild/unixbuild/dbgbld/mvm branches/Cog/stackbuild/unixbuild/dbgbld/plugins.ext branches/Cog/stackbuild/unixbuild/dbgbld/plugins.int branches/Cog/stackbuild/unixbuild/dbgbldt/ branches/Cog/stackbuild/unixbuild/dbgbldt/mvm branches/Cog/stackbuild/unixbuild/dbgbldt/plugins.ext branches/Cog/stackbuild/unixbuild/dbgbldt/plugins.int branches/Cog/stackbuild/unixbuild/mkNamedPrims.sh Added: branches/Cog/stackbuild/unixbuild/HowToBuild =================================================================== --- branches/Cog/stackbuild/unixbuild/HowToBuild (rev 0) +++ branches/Cog/stackbuild/unixbuild/HowToBuild 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,104 @@ +How To Build On Linux +--------------------- + +Contents: + - How to build the Stack VM on Unix + - Testing an external plugin has completely linked + - Compiling in 32-bit mode on a 64-bit linux + - Testing an external plugin has completely linked + - N.B. Please read: Optimization level and gcc version + +How to build the Newspeak VM on Unix +------------------------------- +1. Install the tools (gcc, X11-devel, etc (e.g. libpng, libX11 & libxt source)) +2. Check out the following sources from svn (if you haven't already - if you're + reading this in unixbuild its likely you've already got the sources) + svn co http://www.squeakvm.org/svn/squeak/branches/Cog/platforms + svn co http://www.squeakvm.org/svn/squeak/branches/Cog/stacksrc + svn co http://www.squeakvm.org/svn/squeak/branches/Cog/stackbuild +3. Open a shell, cd into the stackbuild/unixbuild/bld directory and execute + the mvm script. This installs a VM in the stklinux directory alongside + stacksrc et al. Alternatively you can configure your own VM, e.g. with + ../../../platforms/unix/config/configure --with-src=stacksrc --with-plugins=src/plugins --disable-cogit CFLAGS="-g -O2 -msse2 -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DNDEBUG -DNO_VM_PROFILE=1 -DDEBUGVM=0" LIBS="-lpthread -luuid" LDFLAGS=-Wl,-z,now + make install prefix=WhereYouWantTheVmToGo + + N.B. On Ubuntu *do not* supply "LIBS="-lpthread -luuid"", i.e. use + ../../../platforms/unix/config/configure --with-src=stacksrc --with-plugins=src/plugins --disable-cogit CFLAGS="-g -O2 -msse2 -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DNDEBUG -DNO_VM_PROFILE=1 -DDEBUGVM=0" LDFLAGS=-Wl,-z,now + +4. At the end of it you'll get a new VM in stklinux, or in the path provided + via -prefix + +N.B. The plugin set is defined by plugins.ext and plugins.int in the build dir. + + +3a. For an assert-enabled VM use the astbld directory's mvm and find a vm in + stklinuxast, or do + ../../../platforms/unix/config/configure --with-src=stacksrc --with-plugins=src/plugins --disable-cogit CFLAGS="-g -O1 -msse2 -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DNO_VM_PROFILE=1 -DDEBUGVM=0 -fno-omit-frame-pointer -mno-omit-leaf-frame-pointer" LIBS="-lpthread -luuid" LDFLAGS=-Wl,-z,now + +3b. For a full debug VM use the dbgbld's mvm and find a vm in stklinuxdbg, + or do + CFLAGS="-g -O0 -msse2 -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DNO_VM_PROFILE=1 -DDEBUGVM=1 -fno-omit-frame-pointer -mno-omit-leaf-frame-pointer" LIBS="-lpthread -luuid" LDFLAGS=-Wl,-z,now + +3c. If you're building the VM on a 64-bit OS, you'll need a compiler which can +compile and link to 32-bit binaries. On most Linuxes the gcc-multilib package +provides the 32-bit compiler and the ia32-libs provides the 32-bit libraries. +You'll also have to add the -m32 switch to all gcc & g++ invocations. The +easiest way to do this is to add CC="gcc -m32" & CXX="g++ -m32" to the configure +script: + ../../../platforms/unix/config/configure CC="gcc -m32" CXX="g++ -m32" --with-src=stacksrc --with-plugins=src/plugins --disable-cogit CFLAGS="-g -O2 -msse2 -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DNDEBUG -DNO_VM_PROFILE=1" LIBS="-lpthread -luuid" +To run a 32-bit VM on a 64-bit OS, you'll also need the 32-bit libraries +provided by the ia32-libs package. + + +3c. (see Compiling in 32-bit mode on a 64-bit linux below) +If you're building the VM on a 64-bit OS, you'll need a compiler which can +compile and link to 32-bit binaries. On most Linuxes the gcc-multilib package +provides the 32-bit compiler and the ia32-libs provides the 32-bit libraries. +You'll also have to add the -m32 switch to all gcc & g++ invocations. The +easiest way to do this is to add CC="gcc -m32" & CXX="g++ -m32" to the configure +script: + ../../platforms/unix/config/configure CC="gcc -m32" CXX="g++ -m32" --without-npsqueak --with-src=stacksrc --with-plugins=src/plugins --disable-cogit CFLAGS="-g -O2 -msse2 -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DNDEBUG -DNO_VM_PROFILE=1 -DCOGMTVM=0 -DDEBUGVM=0" LIBS=-lpthread +To run a 32-bit VM on a 64-bit OS, you'll also need the 32-bit libraries +provided by the ia32-libs package. + +Compiling in 32-bit mode on a 64-bit linux +------------------------------- +Follow 3c. above. Also note that according to Paul DeBruicker the following +packages need to be installed to compile in 32-bt mode on 64-bit ubuntu. YMMV. + +build-essential +ia32-libs +gcc-multilib +g++multilib + +In addition phil(a)highoctane.be installed libc6dev-i386. + +This in itself may not be enough, but persistence will pay off. See for example +http://permalink.gmane.org/gmane.comp.lang.smalltalk.pharo.devel/75198. + +Testing an external plugin has completely linked +------------------------------- +You may find that an external plugin compiles and links but does not load. +This is usually because it contans undefined symbols. To find undefined +symbols, remake the plugin, capturing the link step and then supply + -Wl,--warn-unresolved-symbols -Wl,--no-allow-shlib-undefined +when manually repeating the link command + + +Optimization level and gcc version +---------------------------------- +There are issues with gcc version > 4.2.1. Any of the following flags may break the build at -O2: +-ftree-pre +-fpartial-inlining +-fcaller-saves + +So turn them off. e.g. + ../../platforms/unix/config/configure --without-npsqueak CFLAGS="-g -O2 -msse2 -fno-caller-saves -fno-partial-inlining -fno-tree-pre -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DNDEBUG -DNO_VM_PROFILE=1 -DCOGMTVM=0 -DDEBUGVM=0" LIBS=-lpthread +See http://smallissimo.blogspot.fr/2013/02/compiling-squeak-cog-virtual-machine… + +There appear to be issues with 3.4.x gcc version on RedHat. In particular +compiling the Newspeak VM with either of + gcc version 3.4.6 20060404 (Red Hat 3.4.6-3) + gcc version 3.4.6 20060404 (Red Hat 3.4.6-10) +using -O2 results in a VM that segfaults early in startup. For these compilers +it is probably wise to use -O1, even though -O3 seems to work. Added: branches/Cog/stackbuild/unixbuild/astbld/mvm =================================================================== --- branches/Cog/stackbuild/unixbuild/astbld/mvm (rev 0) +++ branches/Cog/stackbuild/unixbuild/astbld/mvm 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,28 @@ +#!/bin/bash +INSTALLDIR=stklinuxast +if [ $# -ge 1 ]; then + case "$1" in + -*) ;; + *) INSTALLDIR="$1"; shift + esac +fi +OPT=-O1 + +echo -n "clean? " +read a +case $a in +n|no|N|NO) echo "ok but this isn't safe!!";; +*) rm config.h; test -f Makefile && make reallyclean +esac +test -f config.h || ../../../platforms/unix/config/configure \ + --with-src=stacksrc --with-plugins=src/plugins --disable-cogit \ + --without-vm-display-fbdev --without-npsqueak \ + CC="gcc -m32" \ + CFLAGS="-g $OPT -msse2 -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DTIIMER_HEARTBEAT=1 -DDEBUGVM=0 -fno-omit-frame-pointer -mno-omit-leaf-frame-pointer" \ + LIBS="-lpthread -luuid" \ + LDFLAGS=-Wl,-z,now +../../../scripts/nukeversion +rm -rf ../../../$INSTALLDIR +# would prefer make install prefix=`readlink -f \`pwd\`/../../../$INSTALLDIR` +# but older linux readlinks lack the -f flag +make install prefix=`(cd ../../../;pwd)`/$INSTALLDIR Property changes on: branches/Cog/stackbuild/unixbuild/astbld/mvm ___________________________________________________________________ Added: svn:executable + * Added: branches/Cog/stackbuild/unixbuild/astbld/plugins.ext =================================================================== --- branches/Cog/stackbuild/unixbuild/astbld/plugins.ext (rev 0) +++ branches/Cog/stackbuild/unixbuild/astbld/plugins.ext 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,3 @@ +# Copied, perhaps edited, from ../../../nscogsrc/examplePlugins.ext +EXTERNAL_PLUGINS = \ +SqueakSSL Added: branches/Cog/stackbuild/unixbuild/astbld/plugins.int =================================================================== --- branches/Cog/stackbuild/unixbuild/astbld/plugins.int (rev 0) +++ branches/Cog/stackbuild/unixbuild/astbld/plugins.int 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,26 @@ +# Copied, perhaps edited, from ../../../nscogsrc/examplePlugins.int +INTERNAL_PLUGINS = \ +AsynchFilePlugin \ +BMPReadWriterPlugin \ +B2DPlugin \ +BitBltPlugin \ +DSAPrims \ +DropPlugin \ +FileCopyPlugin \ +FilePlugin \ +FloatArrayPlugin \ +FloatMathPlugin \ +ZipPlugin \ +JPEGReadWriter2Plugin \ +JPEGReaderPlugin \ +LargeIntegers \ +Matrix2x3Plugin \ +MiscPrimitivePlugin \ +IA32ABI \ +RePlugin \ +SecurityPlugin \ +SocketPlugin \ +SurfacePlugin \ +UUIDPlugin \ +UnixOSProcessPlugin \ +VMProfileLinuxSupportPlugin Added: branches/Cog/stackbuild/unixbuild/astbldt/mvm =================================================================== --- branches/Cog/stackbuild/unixbuild/astbldt/mvm (rev 0) +++ branches/Cog/stackbuild/unixbuild/astbldt/mvm 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,29 @@ +#!/bin/bash +# VM with VM profiler and threaded heartbeat assuming multiple thread priorities +INSTALLDIR=stklinuxastht +if [ $# -ge 1 ]; then + case "$1" in + -*) ;; + *) INSTALLDIR="$1"; shift + esac +fi +OPT=-O1 + +echo -n "clean? " +read a +case $a in +n|no|N|NO) echo "ok but this isn't safe!!";; +*) rm config.h; test -f Makefile && make reallyclean +esac +test -f config.h || ../../../platforms/unix/config/configure \ + --with-src=stacksrc --with-plugins=src/plugins --disable-cogit \ + --without-vm-display-fbdev --without-npsqueak \ + CC="gcc -m32" \ + CFLAGS="-g $OPT -msse2 -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DDEBUGVM=0 -fno-omit-frame-pointer -mno-omit-leaf-frame-pointer" \ + LIBS="-lpthread -luuid" \ + LDFLAGS=-Wl,-z,now +../../../scripts/nukeversion +rm -rf ../../../$INSTALLDIR +# would prefer make install prefix=`readlink -f \`pwd\`/../../../$INSTALLDIR` +# but older linux readlinks lack the -f flag +make install prefix=`(cd ../../../;pwd)`/$INSTALLDIR Property changes on: branches/Cog/stackbuild/unixbuild/astbldt/mvm ___________________________________________________________________ Added: svn:executable + * Added: branches/Cog/stackbuild/unixbuild/astbldt/plugins.ext =================================================================== --- branches/Cog/stackbuild/unixbuild/astbldt/plugins.ext (rev 0) +++ branches/Cog/stackbuild/unixbuild/astbldt/plugins.ext 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,3 @@ +# Copied, perhaps edited, from ../../../nscogsrc/examplePlugins.ext +EXTERNAL_PLUGINS = \ +SqueakSSL Added: branches/Cog/stackbuild/unixbuild/astbldt/plugins.int =================================================================== --- branches/Cog/stackbuild/unixbuild/astbldt/plugins.int (rev 0) +++ branches/Cog/stackbuild/unixbuild/astbldt/plugins.int 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,26 @@ +# Copied, perhaps edited, from ../../../nscogsrc/examplePlugins.int +INTERNAL_PLUGINS = \ +AsynchFilePlugin \ +BMPReadWriterPlugin \ +B2DPlugin \ +BitBltPlugin \ +DSAPrims \ +DropPlugin \ +FileCopyPlugin \ +FilePlugin \ +FloatArrayPlugin \ +FloatMathPlugin \ +ZipPlugin \ +JPEGReadWriter2Plugin \ +JPEGReaderPlugin \ +LargeIntegers \ +Matrix2x3Plugin \ +MiscPrimitivePlugin \ +IA32ABI \ +RePlugin \ +SecurityPlugin \ +SocketPlugin \ +SurfacePlugin \ +UUIDPlugin \ +UnixOSProcessPlugin \ +VMProfileLinuxSupportPlugin Added: branches/Cog/stackbuild/unixbuild/bld/mvm =================================================================== --- branches/Cog/stackbuild/unixbuild/bld/mvm (rev 0) +++ branches/Cog/stackbuild/unixbuild/bld/mvm 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,32 @@ +#!/bin/bash +INSTALLDIR=stklinux +if [ $# -ge 1 ]; then + case "$1" in + -*) ;; + *) INSTALLDIR="$1"; shift + esac +fi +# Some gcc versions create a broken VM using -O2 +case `gcc -v 2>&1 | grep version | sed 's/gcc version *//'` in +3.4.*) OPT=-O1;; +*) OPT=-O2;; +esac + +echo -n "clean? " +read a +case $a in +n|no|N|NO) echo "ok but this isn't safe!!";; +*) rm config.h; test -f Makefile && make reallyclean +esac +test -f config.h || ../../../platforms/unix/config/configure \ + --with-src=stacksrc --with-plugins=src/plugins --disable-cogit \ + --without-vm-display-fbdev --without-npsqueak \ + CC="gcc -m32" \ + CFLAGS="-g $OPT -msse2 -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DNDEBUG -DITIMER_HEARTBEAT=1 -DDEBUGVM=0" \ + LIBS="-lpthread -luuid" \ + LDFLAGS=-Wl,-z,now +../../../scripts/nukeversion +rm -rf ../../../$INSTALLDIR +# would prefer make install prefix=`readlink -f \`pwd\`/../../../$INSTALLDIR` +# but older linux readlinks lack the -f flag +make install prefix=`(cd ../../../;pwd)`/$INSTALLDIR Property changes on: branches/Cog/stackbuild/unixbuild/bld/mvm ___________________________________________________________________ Added: svn:executable + * Added: branches/Cog/stackbuild/unixbuild/bld/plugins.ext =================================================================== --- branches/Cog/stackbuild/unixbuild/bld/plugins.ext (rev 0) +++ branches/Cog/stackbuild/unixbuild/bld/plugins.ext 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,3 @@ +# Copied, perhaps edited, from ../../../nscogsrc/examplePlugins.ext +EXTERNAL_PLUGINS = \ +SqueakSSL Added: branches/Cog/stackbuild/unixbuild/bld/plugins.int =================================================================== --- branches/Cog/stackbuild/unixbuild/bld/plugins.int (rev 0) +++ branches/Cog/stackbuild/unixbuild/bld/plugins.int 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,26 @@ +# Copied, perhaps edited, from ../../../nscogsrc/examplePlugins.int +INTERNAL_PLUGINS = \ +AsynchFilePlugin \ +BMPReadWriterPlugin \ +B2DPlugin \ +BitBltPlugin \ +DSAPrims \ +DropPlugin \ +FileCopyPlugin \ +FilePlugin \ +FloatArrayPlugin \ +FloatMathPlugin \ +ZipPlugin \ +JPEGReadWriter2Plugin \ +JPEGReaderPlugin \ +LargeIntegers \ +Matrix2x3Plugin \ +MiscPrimitivePlugin \ +IA32ABI \ +RePlugin \ +SecurityPlugin \ +SocketPlugin \ +SurfacePlugin \ +UUIDPlugin \ +UnixOSProcessPlugin \ +VMProfileLinuxSupportPlugin Added: branches/Cog/stackbuild/unixbuild/bldt/mvm =================================================================== --- branches/Cog/stackbuild/unixbuild/bldt/mvm (rev 0) +++ branches/Cog/stackbuild/unixbuild/bldt/mvm 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,33 @@ +#!/bin/bash +# VM with VM profiler and threaded heartbeat assuming multiple thread priorities +INSTALLDIR=stklinuxht +if [ $# -ge 1 ]; then + case "$1" in + -*) ;; + *) INSTALLDIR="$1"; shift + esac +fi +# Some gcc versions create a broken VM using -O2 +case `gcc -v 2>&1 | grep version | sed 's/gcc version *//'` in +3.4.*) OPT=-O1;; +*) OPT=-O2;; +esac + +echo -n "clean? " +read a +case $a in +n|no|N|NO) echo "ok but this isn't safe!!";; +*) rm config.h; test -f Makefile && make reallyclean +esac +test -f config.h || ../../../platforms/unix/config/configure \ + --with-src=stacksrc --with-plugins=src/plugins --disable-cogit \ + --without-vm-display-fbdev --without-npsqueak \ + CC="gcc -m32" \ + CFLAGS="-g $OPT -msse2 -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DNDEBUG -DDEBUGVM=0" \ + LIBS="-lpthread -luuid" \ + LDFLAGS=-Wl,-z,now +../../../scripts/nukeversion +rm -rf ../../../$INSTALLDIR +# would prefer make install prefix=`readlink -f \`pwd\`/../../../$INSTALLDIR` +# but older linux readlinks lack the -f flag +make install prefix=`(cd ../../../;pwd)`/$INSTALLDIR Property changes on: branches/Cog/stackbuild/unixbuild/bldt/mvm ___________________________________________________________________ Added: svn:executable + * Added: branches/Cog/stackbuild/unixbuild/bldt/plugins.ext =================================================================== --- branches/Cog/stackbuild/unixbuild/bldt/plugins.ext (rev 0) +++ branches/Cog/stackbuild/unixbuild/bldt/plugins.ext 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,3 @@ +# Copied, perhaps edited, from ../../../nscogsrc/examplePlugins.ext +EXTERNAL_PLUGINS = \ +SqueakSSL Added: branches/Cog/stackbuild/unixbuild/bldt/plugins.int =================================================================== --- branches/Cog/stackbuild/unixbuild/bldt/plugins.int (rev 0) +++ branches/Cog/stackbuild/unixbuild/bldt/plugins.int 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,26 @@ +# Copied, perhaps edited, from ../../../nscogsrc/examplePlugins.int +INTERNAL_PLUGINS = \ +AsynchFilePlugin \ +BMPReadWriterPlugin \ +B2DPlugin \ +BitBltPlugin \ +DSAPrims \ +DropPlugin \ +FileCopyPlugin \ +FilePlugin \ +FloatArrayPlugin \ +FloatMathPlugin \ +ZipPlugin \ +JPEGReadWriter2Plugin \ +JPEGReaderPlugin \ +LargeIntegers \ +Matrix2x3Plugin \ +MiscPrimitivePlugin \ +IA32ABI \ +RePlugin \ +SecurityPlugin \ +SocketPlugin \ +SurfacePlugin \ +UUIDPlugin \ +UnixOSProcessPlugin \ +VMProfileLinuxSupportPlugin Added: branches/Cog/stackbuild/unixbuild/dbgbld/mvm =================================================================== --- branches/Cog/stackbuild/unixbuild/dbgbld/mvm (rev 0) +++ branches/Cog/stackbuild/unixbuild/dbgbld/mvm 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,28 @@ +#!/bin/bash +INSTALLDIR=stklinuxdbg +if [ $# -ge 1 ]; then + case "$1" in + -*) ;; + *) INSTALLDIR="$1"; shift + esac +fi +OPT=-O0 + +echo -n "clean? " +read a +case $a in +n|no|N|NO) echo "ok but this isn't safe!!";; +*) rm config.h; test -f Makefile && make reallyclean +esac +test -f config.h || ../../../platforms/unix/config/configure \ + --with-src=stacksrc --with-plugins=src/plugins --disable-cogit \ + --without-vm-display-fbdev --without-npsqueak \ + CC="gcc -m32" \ + CFLAGS="-g $OPT -msse2 -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DITIMER_HEARTBEAT=1 -DDEBUGVM=1 -fno-omit-frame-pointer -mno-omit-leaf-frame-pointer" \ + LIBS="-lpthread -luuid" \ + LDFLAGS=-Wl,-z,now +../../../scripts/nukeversion +rm -rf ../../../$INSTALLDIR +# would prefer make install prefix=`readlink -f \`pwd\`/../../../$INSTALLDIR` +# but older linux readlinks lack the -f flag +make install prefix=`(cd ../../../;pwd)`/$INSTALLDIR Property changes on: branches/Cog/stackbuild/unixbuild/dbgbld/mvm ___________________________________________________________________ Added: svn:executable + * Added: branches/Cog/stackbuild/unixbuild/dbgbld/plugins.ext =================================================================== --- branches/Cog/stackbuild/unixbuild/dbgbld/plugins.ext (rev 0) +++ branches/Cog/stackbuild/unixbuild/dbgbld/plugins.ext 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,3 @@ +# Copied, perhaps edited, from ../../../nscogsrc/examplePlugins.ext +EXTERNAL_PLUGINS = \ +SqueakSSL Added: branches/Cog/stackbuild/unixbuild/dbgbld/plugins.int =================================================================== --- branches/Cog/stackbuild/unixbuild/dbgbld/plugins.int (rev 0) +++ branches/Cog/stackbuild/unixbuild/dbgbld/plugins.int 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,26 @@ +# Copied, perhaps edited, from ../../../nscogsrc/examplePlugins.int +INTERNAL_PLUGINS = \ +AsynchFilePlugin \ +BMPReadWriterPlugin \ +B2DPlugin \ +BitBltPlugin \ +DSAPrims \ +DropPlugin \ +FileCopyPlugin \ +FilePlugin \ +FloatArrayPlugin \ +FloatMathPlugin \ +ZipPlugin \ +JPEGReadWriter2Plugin \ +JPEGReaderPlugin \ +LargeIntegers \ +Matrix2x3Plugin \ +MiscPrimitivePlugin \ +IA32ABI \ +RePlugin \ +SecurityPlugin \ +SocketPlugin \ +SurfacePlugin \ +UUIDPlugin \ +UnixOSProcessPlugin \ +VMProfileLinuxSupportPlugin Added: branches/Cog/stackbuild/unixbuild/dbgbldt/mvm =================================================================== --- branches/Cog/stackbuild/unixbuild/dbgbldt/mvm (rev 0) +++ branches/Cog/stackbuild/unixbuild/dbgbldt/mvm 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,29 @@ +#!/bin/bash +# VM with VM profiler and threaded heartbeat assuming multiple thread priorities +INSTALLDIR=stklinuxdbght +if [ $# -ge 1 ]; then + case "$1" in + -*) ;; + *) INSTALLDIR="$1"; shift + esac +fi +OPT=-O0 + +echo -n "clean? " +read a +case $a in +n|no|N|NO) echo "ok but this isn't safe!!";; +*) rm config.h; test -f Makefile && make reallyclean +esac +test -f config.h || ../../../platforms/unix/config/configure \ + --with-src=stacksrc --with-plugins=src/plugins --disable-cogit \ + --without-vm-display-fbdev --without-npsqueak \ + CC="gcc -m32" \ + CFLAGS="-g $OPT -msse2 -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DDEBUGVM=1 -fno-omit-frame-pointer -mno-omit-leaf-frame-pointer" \ + LIBS="-lpthread -luuid" \ + LDFLAGS=-Wl,-z,now +../../../scripts/nukeversion +rm -rf ../../../$INSTALLDIR +# would prefer make install prefix=`readlink -f \`pwd\`/../../../$INSTALLDIR` +# but older linux readlinks lack the -f flag +make install prefix=`(cd ../../../;pwd)`/$INSTALLDIR Property changes on: branches/Cog/stackbuild/unixbuild/dbgbldt/mvm ___________________________________________________________________ Added: svn:executable + * Added: branches/Cog/stackbuild/unixbuild/dbgbldt/plugins.ext =================================================================== --- branches/Cog/stackbuild/unixbuild/dbgbldt/plugins.ext (rev 0) +++ branches/Cog/stackbuild/unixbuild/dbgbldt/plugins.ext 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,3 @@ +# Copied, perhaps edited, from ../../../nscogsrc/examplePlugins.ext +EXTERNAL_PLUGINS = \ +SqueakSSL Added: branches/Cog/stackbuild/unixbuild/dbgbldt/plugins.int =================================================================== --- branches/Cog/stackbuild/unixbuild/dbgbldt/plugins.int (rev 0) +++ branches/Cog/stackbuild/unixbuild/dbgbldt/plugins.int 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,26 @@ +# Copied, perhaps edited, from ../../../nscogsrc/examplePlugins.int +INTERNAL_PLUGINS = \ +AsynchFilePlugin \ +BMPReadWriterPlugin \ +B2DPlugin \ +BitBltPlugin \ +DSAPrims \ +DropPlugin \ +FileCopyPlugin \ +FilePlugin \ +FloatArrayPlugin \ +FloatMathPlugin \ +ZipPlugin \ +JPEGReadWriter2Plugin \ +JPEGReaderPlugin \ +LargeIntegers \ +Matrix2x3Plugin \ +MiscPrimitivePlugin \ +IA32ABI \ +RePlugin \ +SecurityPlugin \ +SocketPlugin \ +SurfacePlugin \ +UUIDPlugin \ +UnixOSProcessPlugin \ +VMProfileLinuxSupportPlugin Added: branches/Cog/stackbuild/unixbuild/mkNamedPrims.sh =================================================================== --- branches/Cog/stackbuild/unixbuild/mkNamedPrims.sh (rev 0) +++ branches/Cog/stackbuild/unixbuild/mkNamedPrims.sh 2014-02-18 00:00:50 UTC (rev 2868) @@ -0,0 +1,24 @@ +#!/bin/sh +# Generate a sqNamedPrims.h file from plugins.int. The plugins.int used should +# be the one and only argument. +if [ $# != 1 -o ! -f "$1" ]; then + echo usage $0 plugins.int ">sqNamedPrims.h" 1>&2 + exit 1 +fi +echo "/* Automatically generated on "`date`" */" +echo "extern sqExport vm_exports[];"; +echo "extern sqExport os_exports[];"; +for p in `grep -v '^#' "$1" | sed 's/INTERNAL_PLUGINS = //' | tr -d '\\\\\\012'` +do + echo "extern sqExport "$p"_exports[];" +done +echo +echo "sqExport *pluginExports[] = {" +echo " vm_exports," +echo " os_exports," +for p in `grep -v '^#' "$1" | sed 's/INTERNAL_PLUGINS = //' | tr -d '\\\\\\012'` +do + echo " "$p"_exports," +done +echo " NULL" +echo "};" Property changes on: branches/Cog/stackbuild/unixbuild/mkNamedPrims.sh ___________________________________________________________________ Added: svn:executable + *

1 0

SqueakSSL fixes
by Göran Krampe 17 Feb '14

17 Feb '14

Hey! Ok, so I sat down and "packaged" some fixes to mainly iOS SqueakSSL that we have done here at 3DICC. We have no intention to keep stuff like this for ourselves, but daily we work using our own repos so it needs some attention and time to get it out there :) Sorry if this email is long but I just wanted to make it easy for people to know how to integrate this. The fixes span: * A new SqueakSSL Monticello package, that has other fixes too done at 3DICC. I haven't looked through them all in detail, so here a bit of manual cherry picking is needed. For example we removed some "compatibility code" for Squeak 4.2 causing us some problems. * Modified platform files: platforms/Cross/plugins/SqueakSSL/SqueakSSL.h platforms/iOS/plugins/SqueakSSL/sqMacSSL.c platforms/unix/plugins/SqueakSSL/sqUnixOpenSSL.c platforms/win32/plugins/SqueakSSL/sqWin32SSL.c I have so far only tested the new sqMacSSL.c on iOS - OSX 10.8.5. The changes in the other platforms are not complicated, its about being able to disable certificate check mainly so I don't think they should fail. As of now SqueakSSL-Tests show 14 run, 3 passes, 8 expected failures and 3 errors on my Mac. The errors still left are: testSSLSockets, testSocketAccept, testSocketConnect. AFAIK all these try to use a test certificate and Accept - and *that* I haven't implemented on Mac (well, ok, I started - there is a way to at least set a Mac test cert into the plugin - but I didn't go further). New methods in the classes: SqueakSSL,SecureSocketStream>>certVerify: aBoolean Now one can tell the plugin to verify certs or just skip that. SqueakSSL,SecureSocketStream>>logLevel: anInteger Now one can set the logLevel in the plugin, 0 or 1 so far. Attached ssl-fix.zip which contains: . ├── platforms │ ├── Cross │ │ └── plugins │ │ └── SqueakSSL │ │ └── SqueakSSL.h │ ├── iOS │ │ └── plugins │ │ └── SqueakSSL │ │ └── sqMacSSL.c │ ├── unix │ │ └── plugins │ │ └── SqueakSSL │ │ └── sqUnixOpenSSL.c │ └── win32 │ └── plugins │ └── SqueakSSL │ └── sqWin32SSL.c ├── SqueakSSL-Core-gk.36.mcz ├── SqueakSSL-Tests-ar.17.mcz └── ssl-fix.patch I threw in the latest SqueakSSL-Core and Tests that we have here at 3DICC. The Tests package is the same as on SS. The Core has 4 more fixes from Ron I think, just look in "History" to see commit messages there. ssl-fix.patch - this should show you what I have done in the platform files, and I produced it using git diff on those four files with this command: git diff 83bce99715cddd8a82c3d94c487e45ec0213be19 platforms/Cross/plugins/SqueakSSL/SqueakSSL.h platforms/iOS/plugins/SqueakSSL/sqMacSSL.c platforms/unix/plugins/SqueakSSL/sqUnixOpenSSL.c platforms/win32/plugins/SqueakSSL/sqWin32SSL.c > ssl-fix.patch The SHA is: commit 83bce99715cddd8a82c3d94c487e45ec0213be19 Author: Camillo Bruni <camillobruni(a)gmail.com> Date: Fri Nov 15 12:24:11 2013 +0100 fixed wrong path ------------------------------ ...phew. Ok, let me know if you need anything more and ask questions. regards, Göran

3 5

VM Maker: VMMaker.oscog-eem.617.mcz
by commits＠source.squeak.org 17 Feb '14

17 Feb '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.617.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.617 Author: eem Time: 17 February 2014, 12:19:53.448 pm UUID: 3683f3df-b4c0-4145-9b2c-758146d91de7 Ancestors: VMMaker.oscog-tty.616 Merge with VMMaker.oscog-tty.616 & VMMaker.oscog-dtl.615. Recommit changes in misnamed .VMMaker.oscog-eem.615 et al: Make Spur snapshot avoid writing trailing free space in each segment to the image file Fix initialization of primitiveAccessorDepthTable during simulation. Use Smalltalk vm getSystemAttribute: instead of plain old Smalltalk getSystemAttribute: Some musings on Spur compaction. =============== Diff against VMMaker.oscog-tty.616 =============== Item was changed: ----- Method: CCodeGenerator>>shouldIncludeMethodFor:selector: (in category 'utilities') ----- shouldIncludeMethodFor: aClass selector: selector "process optional methods by interpreting the argument to the option: pragma as either a Cogit class name or a class variable name or a variable name in VMBasicConstants." (aClass >> selector pragmaAt: #option:) ifNotNil: [:pragma| | key | key := pragma argumentAt: 1. vmMaker ifNotNil: [(Cogit withAllSubclasses anySatisfy: [:c| c name = key]) ifTrue: [| cogitClass optionClass | cogitClass := Smalltalk classNamed: vmMaker cogitClassName. optionClass := Smalltalk classNamed: key. ^cogitClass includesBehavior: optionClass]. + ((vmClass + ifNotNil: [vmClass initializationOptions] + ifNil: [vmMaker options]) at: key ifAbsent: [false]) ifNotNil: - (vmMaker options at: key ifAbsent: [false]) ifNotNil: [:option| option ~~ false ifTrue: [^true]]. (aClass bindingOf: key) ifNotNil: [:binding| binding value ~~ false ifTrue: [^true]]. (VMBasicConstants bindingOf: key) ifNotNil: [:binding| binding value ~~ false ifTrue: [^true]]]. ^false]. ^true! Item was added: + ----- Method: CogVMSimulator>>codeGeneratorToComputeAccessorDepth (in category 'primitive support') ----- + codeGeneratorToComputeAccessorDepth + ^VMMaker new + cogitClass: (Smalltalk classNamed: (self class initializationOptions + at: #Cogit + ifAbsent: [self class cogitClass name])); + buildCodeGeneratorForInterpreter: CoInterpreterPrimitives + includeAPIMethods: false + initializeClasses: false! Item was changed: ----- Method: CogVMSimulator>>initialize (in category 'initialization') ----- initialize "Initialize the CogVMSimulator when running the interpreter inside Smalltalk. The primary responsibility of this method is to allocate Smalltalk Arrays for variables that will be declared as statically-allocated global arrays in the translated code." + transcript := Transcript. + objectMemory ifNil: [objectMemory := self class objectMemoryClass simulatorClass new]. cogit ifNil: [cogit := self class cogitClass new setInterpreter: self]. objectMemory coInterpreter: self cogit: cogit. cogit numRegArgs > 0 ifTrue: [debugStackDepthDictionary := Dictionary new]. cogThreadManager ifNotNil: [super initialize]. "Note: we must initialize ConstMinusOne & HasBeenReturnedFromMCPC differently for simulation, due to the fact that the simulator works only with +ve 32-bit values" ConstMinusOne := objectMemory integerObjectOf: -1. HasBeenReturnedFromMCPC := objectMemory integerObjectOf: -1. cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())" enableCog := true. methodCache := Array new: MethodCacheSize. atCache := Array new: AtCacheTotalSize. self flushMethodCache. self flushAtCache. cogCompiledCodeCompactionCalledFor := false. gcSemaphoreIndex := 0. externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #(). externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize). externalPrimitiveTableFirstFreeIndex := 0. primitiveTable := self class primitiveTable copy. - primitiveAccessorDepthTable := objectMemory hasSpurMemoryManagerAPI ifTrue: - [self class primitiveAccessorDepthTable]. - pluginList := {'' -> self }. mappedPluginEntries := OrderedCollection new. + objectMemory hasSpurMemoryManagerAPI + ifTrue: + [primitiveAccessorDepthTable := Array new: primitiveTable size. + pluginList := {}. + self loadNewPlugin: ''] + ifFalse: + [pluginList := {'' -> self }]. desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0. "This is initialized on loading the image, but convenient for testing stack page values..." numStackPages := self defaultNumStackPages. startMicroseconds := Time totalSeconds * 1000000. maxLiteralCountForCompile := MaxLiteralCountForCompile. minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile. flagInterpretedMethods := false. "initialize InterpreterSimulator variables used for debugging" byteCount := lastPollCount := sendCount := 0. quitBlock := [^ self]. traceOn := true. printSends := printFrameAtEachStep := printBytecodeAtEachStep := false. myBitBlt := BitBltSimulator new setInterpreter: self. - transcript := Transcript. displayForm := 'Display has not yet been installed' asDisplayText form. suppressHeartbeatFlag := deferSmash := deferredSmash := false. systemAttributes := Dictionary new. primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0). primTraceLogIndex := 0. traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0). traceLogIndex := 0. traceSources := TraceSources. statCodeCompactionCount := 0. statCodeCompactionUsecs := 0. extSemTabSize := 256! 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 vm getSystemAttribute: index]. - attribute := systemAttributes at: index ifAbsent: [Smalltalk getSystemAttribute: index]. attribute ifNil: [ ^self primitiveFail ]. s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) 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" thenPush: s]! - self pop: 2. "rcvr, attr" - self push: s]! Item was changed: ----- Method: FilePlugin>>primitiveDirectorySetMacTypeAndCreator (in category 'directory primitives') ----- primitiveDirectorySetMacTypeAndCreator + | creatorString typeString fileName creatorStringIndex typeStringIndex fileNameIndex fileNameSize okToSet | - | creatorString typeString fileName creatorStringIndex typeStringIndex fileNameIndex fileNameSize okToSet | <var: 'creatorStringIndex' type: 'char *'> <var: 'typeStringIndex' type: 'char *'> <var: 'fileNameIndex' type: 'char *'> <export: true> creatorString := interpreterProxy stackValue: 0. typeString := interpreterProxy stackValue: 1. fileName := interpreterProxy stackValue: 2. ((interpreterProxy isBytes: creatorString) + and: [(interpreterProxy isBytes: typeString) + and: [(interpreterProxy isBytes: fileName) + and: [(interpreterProxy byteSizeOf: creatorString) = 4 + and: [(interpreterProxy byteSizeOf: typeString) = 4]]]]) ifFalse: + [^interpreterProxy primitiveFail]. - and: [(interpreterProxy byteSizeOf: creatorString) - = 4]) - ifFalse: [^interpreterProxy primitiveFail]. - ((interpreterProxy isBytes: typeString) - and: [(interpreterProxy byteSizeOf: typeString) - = 4]) - ifFalse: [^interpreterProxy primitiveFail]. - (interpreterProxy isBytes: fileName) - ifFalse: [^interpreterProxy primitiveFail]. creatorStringIndex := interpreterProxy firstIndexableField: creatorString. typeStringIndex := interpreterProxy firstIndexableField: typeString. fileNameIndex := interpreterProxy firstIndexableField: fileName. fileNameSize := interpreterProxy byteSizeOf: fileName. "If the security plugin can be loaded, use it to check for permission. If not, assume it's ok" + sCSFTfn ~= 0 ifTrue: + [okToSet := self + cCode: '((sqInt (*)(char *, sqInt))sCSFTfn)(fileNameIndex, fileNameSize)' + inSmalltalk: [true]. + okToSet ifFalse: + [^interpreterProxy primitiveFail]]. - sCSFTfn ~= 0 - ifTrue: [okToSet := self cCode: ' ((sqInt (*)(char *, sqInt))sCSFTfn)(fileNameIndex, fileNameSize)'. - okToSet - ifFalse: [^interpreterProxy primitiveFail]]. (self + cCode: 'dir_SetMacFileTypeAndCreator(fileNameIndex, fileNameSize, typeStringIndex, creatorStringIndex)' + inSmalltalk: [true]) ifFalse: + [^interpreterProxy primitiveFail]. - cCode: 'dir_SetMacFileTypeAndCreator(fileNameIndex, fileNameSize,typeStringIndex, creatorStringIndex)' - inSmalltalk: [true]) - ifFalse: [^interpreterProxy primitiveFail]. interpreterProxy pop: 3! 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 vm getSystemAttribute: attr. - attribute := Smalltalk getSystemAttribute: attr. attribute ifNil: [ ^self primitiveFail ]. s := self instantiateClass: (self splObj: ClassByteString) 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" thenPush: s]. - self pop: 2. "rcvr, attr" - self push: s]. ! 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 vm getSystemAttribute: attr. - attribute := Smalltalk getSystemAttribute: attr. attribute ifNil: [ ^self primitiveFail ]. s := self instantiateClass: (self splObj: ClassByteString) 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" thenPush: s]. - self pop: 2. "rcvr, attr" - self push: s]. ! Item was added: + ----- Method: ObjectMemory>>postSnapshot (in category 'image save/restore') ----- + postSnapshot + "No op for Spur compatibility."! Item was added: + ----- Method: SpurMemoryManager>>abstractCompaction (in category 'compaction - analysis') ----- + abstractCompaction + "This method answers a rough estimate of compactibility." + <doNotGenerate> + | lowestFree freeChunks used movable | + lowestFree := SmallInteger maxVal. + freeChunks := Set new. + used := Set new. + movable := Set new. + self allObjectsInFreeTreeDo: + [:f| + (self addressAfter: f) < endOfMemory ifTrue: + [freeChunks add: f. + f < lowestFree ifTrue: [lowestFree := f]]]. + self allOldSpaceObjectsFrom: lowestFree do: + [:o| | size delta best | + size := self bytesInObject: o. + delta := SmallInteger maxVal. + freeChunks do: [:f| | fs | + ((fs := self bytesInObject: f) >= size) ifTrue: + [delta > (fs - size) ifTrue: + [delta := fs - size. best := f]]]. + best ifNotNil: + [movable add: o. + used add: (freeChunks remove: best)]]. + ^{ totalFreeOldSpace. movable inject: 0 into: [:s :o| s + (self bytesInObject: o)]. used inject: 0 into: [:s :o| s + (self bytesInObject: o)] }! Item was added: + ----- Method: SpurMemoryManager>>abstractPigCompaction (in category 'compaction - analysis') ----- + abstractPigCompaction + "This method answers a rough estimate of compactibility using a pig (a large free chunk)." + <doNotGenerate> + | pig pork moved unmoved nmoved nunmoved | + pig := self findAPig. + pork := self bytesInObject: pig. + moved := unmoved := nmoved := nunmoved := 0. + self allOldSpaceObjectsFrom: pig do: + [:o| | bytes | + bytes := self bytesInObject: o. + bytes <= pork + ifTrue: + [moved := moved + bytes. + nmoved := nmoved + 1. + pork := pork - bytes] + ifFalse: + [unmoved := unmoved + bytes. + nunmoved := nunmoved + 1]]. + ^{ self bytesInObject: pig. pork. moved. nmoved. unmoved. nunmoved }! Item was added: + ----- Method: SpurMemoryManager>>biggies (in category 'compaction - analysis') ----- + biggies + "This method answers a sorted collection of the objects >= 1,000,000 bytes long, + above the lowest large free chunk, sandwiched between nilObj and the end of memory." + <doNotGenerate> + | lowestFree biggies | + lowestFree := SmallInteger maxVal. + self allObjectsInFreeTreeDo: + [:f| (self addressAfter: f) < endOfMemory ifTrue: [f < lowestFree ifTrue: [lowestFree := f]]]. + biggies := SortedCollection new. + self allOldSpaceObjectsFrom: lowestFree do: + [:f| + (self bytesInObject: f) >= 1000000 ifTrue: + [biggies add: f]]. + ^{{nilObj hex. #nil}}, (biggies collect: [:f| {f hex. self bytesInObject: f}]), {{endOfMemory hex. #endOfMemory}}! Item was changed: ----- Method: SpurMemoryManager>>compact (in category 'compaction') ----- compact "We'd like to use exact fit followed by best fit, but best-fit is complex to implement and potentially expensive. So just use exactFit followed, if necessary, by first-fit." <inline: false> + self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]). self exactFitCompact. + self assert: (firstFreeChunk = 0 + or: [(self isFreeObject: firstFreeChunk) + or: [self isValidClassIndex: (self classIndexOf: firstFreeChunk)]]). highestObjects usedSize > 0 ifTrue: [self firstFitCompact]! Item was added: + ----- Method: SpurMemoryManager>>compactionIssues (in category 'compaction - analysis') ----- + compactionIssues + <doNotGenerate> + "Compaction isn't working well. It rarely moves more than a few tens of kilobytes. Why? + Load an image and before you run it, or just before a GC, run these anaylsis routines. + e.g. + self abstractCompaction #(63230272 75456 63210648) + shows we can move 75456 bytes of objects, but that would use 63210648 of free space. + i.e. there are lots of big free chunks in play, not many small ones that fit the bill. + + self largeFreeChunkDistribution + #( #('16r31C788' #nil) + #('16r1423AC0' 2061864) + #('16r1B705E8' 1515200) + #('16r1D31D20' 2011152) + #('16r1F37818' 1491480) + #('16r2225968' 1450512) + #('16r24C92C8' 48575672) (16r24C92C8 + 48575672) hex '16r531C780' a free chunk + #('16r531C788' #endOfMemory)) + shows there's plenty of large free chunks. And the trailing 16-byte free chunk shows coallescing is not working properly. + + self biggies #(#('16r31C788' #nil) #('16r531C788' #endOfMemory)) + shows there are no large objects to be moved. + + So... looks like compaction should hold onto the lowest large chunk and preferentially move objects into that. + Let's call it a pig. Compaction needs to whittle away at the pig. + + e.g. + self abstractPigCompaction #(2061864 0 2061864 18759 2018224 34757) + shows we can move 18759 objects that will occupy 2018224 bytes into that + low pig of 2061864 bytes."! Item was changed: ----- Method: SpurMemoryManager>>emptyObjStack: (in category 'obj stacks') ----- emptyObjStack: objStack "Remove all the entries on the stack. Do so by setting Topx to 0 on the first page, and adding all subsequent pages to the free list." | nextPage nextNextPage | + objStack = nilObj ifTrue: + [^self]. self assert: (self isValidObjStack: objStack). self storePointer: ObjStackTopx ofObject: objStack withValue: 0. nextPage := self fetchPointer: ObjStackNextx ofObject: objStack. [nextPage ~= 0] whileTrue: [nextNextPage := self fetchPointer: ObjStackNextx ofObject: nextPage. self storePointer: ObjStackFreex ofObjStack: nextPage withValue: (self fetchPointer: ObjStackFreex ofObject: objStack). self storePointer: ObjStackNextx ofObjStack: nextPage withValue: 0. self storePointer: ObjStackFreex ofObjStack: objStack withValue: nextPage. nextPage := nextNextPage]. self storePointer: ObjStackNextx ofObjStack: objStack withValue: 0. self assert: (self isValidObjStack: objStack)! Item was changed: ----- Method: SpurMemoryManager>>exactFitCompact (in category 'compaction') ----- exactFitCompact "Compact all of memory above firstFreeChunk using exact-fit, assuming free space is sorted and that as many of the the highest objects as will fit are recorded in highestObjects. Don't move pinned objects. Note that we don't actually move; we merely copy and forward. Eliminating forwarders will be done in a final pass. Leave the objects that don't fit exactly (the misfits), and hence aren't moved, in highestObjects." <inline: false> | misfits first nfits nmiss nHighest nMisses savedLimit | <var: #misfits type: #usqInt> self checkFreeSpace. totalFreeOldSpace = 0 ifTrue: [^self]. highestObjects isEmpty ifTrue: [^self]. nfits := nmiss := 0. misfits := highestObjects last + self wordSize. [statCompactPassCount := statCompactPassCount + 1. highestObjects from: misfits - self wordSize reverseDo: [:o| | b | (self oop: o isGreaterThan: firstFreeChunk) ifFalse: [highestObjects first: misfits. coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr. ^self]. ((self isForwarded: o) or: [self isPinned: o]) ifFalse: [b := self bytesInObject: o. (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o]) ifNil: [nmiss := nmiss + 1. misfits := misfits - self wordSize. misfits < highestObjects start ifTrue: [misfits := highestObjects limit - self wordSize]. self longAt: misfits put: o] ifNotNil: [:f| nfits := nfits + 1. self copyAndForward: o withBytes: b toFreeChunk: f. "here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk is a large chunk then firstFreeChunk will no longer point to an object header. So check and adjust firstFreeChunk if it is assigned to." f = firstFreeChunk ifTrue: [firstFreeChunk := self objectStartingAt: f]]]]. self checkFreeSpace. "now highestObjects contains only misfits, if any, from misfits to last. set first to first failure and refill buffer. next cycle will add more misfits. give up on exact-fit when half of the highest objects fail to fit." first := self longAt: highestObjects first. self assert: (self oop: first isGreaterThan: firstFreeChunk). nHighest := highestObjects usedSize. highestObjects first: misfits. nMisses := highestObjects usedSize. nMisses > (nHighest // 2) ifTrue: [coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr. ^self]. savedLimit := self moveMisfitsToTopOfHighestObjects: misfits. + self fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo: first. - self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first. misfits := self moveMisfitsInHighestObjectsBack: savedLimit. highestObjects usedSize > 0] whileTrue! Item was removed: - ----- Method: SpurMemoryManager>>fillHighestObjectsWithMovableObjectsFrom:upTo: (in category 'compaction') ----- - fillHighestObjectsWithMovableObjectsFrom: startObj upTo: limitObj - "Refill highestObjects with movable objects up to, but not including limitObj. - c.f. the loop in freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace." - | lastHighest highestObjectsWraps firstFree | - highestObjects resetAsEmpty. - lastHighest := highestObjects last. - highestObjectsWraps := firstFree := 0. - self allOldSpaceEntitiesFrom: startObj do: - [:o| - (self oop: o isGreaterThanOrEqualTo: limitObj) ifTrue: - [highestObjects last: lastHighest. - (firstFree ~= 0 and: [(self isFreeObject: firstFreeChunk) not]) ifTrue: - [firstFreeChunk := firstFree]. - ^self]. - (self isFreeObject: o) - ifTrue: [firstFree = 0 ifTrue: - [firstFree := o]] - ifFalse: - [((self isForwarded: o) or: [self isPinned: o]) ifFalse: - [false "conceptually...: " - ifTrue: [highestObjects addLast: o] - ifFalse: "but we inline so we can use the local lastHighest" - [(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue: - [highestObjectsWraps := highestObjectsWraps + 1. - lastHighest := highestObjects start]. - self longAt: lastHighest put: o]]]]. - highestObjects last: lastHighest. - (firstFree ~= 0 and: [(self isFreeObject: firstFreeChunk) not]) ifTrue: - [firstFreeChunk := firstFree]! Item was added: + ----- Method: SpurMemoryManager>>fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo: (in category 'compaction') ----- + fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo: limitObj + "Refill highestObjects with movable objects up to, but not including limitObj. + c.f. the loop in freeUnmarkedObjectsAndSortAndCoalesceFreeSpace." + | lastHighest highestObjectsWraps firstFree | + self assert: (firstFreeChunk = 0 + or: [(self isFreeObject: firstFreeChunk) + or: [self isValidClassIndex: (self classIndexOf: firstFreeChunk)]]). + highestObjects resetAsEmpty. + lastHighest := highestObjects last. + highestObjectsWraps := firstFree := 0. + self allOldSpaceEntitiesFrom: firstFreeChunk do: + [:o| + (self oop: o isGreaterThanOrEqualTo: limitObj) ifTrue: + [highestObjects last: lastHighest. + (self isFreeObject: firstFreeChunk) ifFalse: + [firstFreeChunk := firstFree = 0 ifTrue: [limitObj] ifFalse: [firstFree]]. + ^self]. + (self isFreeObject: o) + ifTrue: [firstFree = 0 ifTrue: + [firstFree := o]] + ifFalse: + [((self isForwarded: o) or: [self isPinned: o]) ifFalse: + [false "conceptually...: " + ifTrue: [highestObjects addLast: o] + ifFalse: "but we inline so we can use the local lastHighest" + [(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue: + [highestObjectsWraps := highestObjectsWraps + 1. + lastHighest := highestObjects start]. + self longAt: lastHighest put: o]]]]. + highestObjects last: lastHighest. + (self isFreeObject: firstFreeChunk) ifFalse: + [firstFreeChunk := firstFree = 0 ifTrue: [limitObj] ifFalse: [firstFree]]. + self assert: (firstFreeChunk = 0 + or: [(self isFreeObject: firstFreeChunk) + or: [self isValidClassIndex: (self classIndexOf: firstFreeChunk)]])! Item was added: + ----- Method: SpurMemoryManager>>findAPig (in category 'compaction - analysis') ----- + findAPig + "Answer a large low free chuink." + <doNotGenerate> + | pig | + self allObjectsInFreeTreeDo: + [:f| + (self bytesInObject: f) >= 1000000 ifTrue: + [(pig isNil or: [pig > f]) ifTrue: + [pig := f]]]. + ^pig! Item was changed: ----- Method: SpurMemoryManager>>firstFitCompact (in category 'compaction') ----- firstFitCompact "Compact all of memory above firstFreeChunk using first-fit, assuming free space is sorted and that as many of the the highest objects as will fit are recorded in highestObjects. Don't move pinned objects. Note that we don't actually move; we merely copy and forward. Eliminating forwarders will be done in a final pass." <inline: false> | first nhits nmisses | self checkFreeSpace. totalFreeOldSpace = 0 ifTrue: [^self]. highestObjects isEmpty ifTrue: [^self]. nhits := nmisses := 0. [statCompactPassCount := statCompactPassCount + 1. highestObjects reverseDo: [:o| | b | (self oop: o isLessThanOrEqualTo: firstFreeChunk) ifTrue: [coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr. ^self]. ((self isForwarded: o) or: [self isPinned: o]) ifFalse: [b := self bytesInObject: o. (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNil: [nmisses := nmisses + 1] ifNotNil: [:f| nhits := nhits + 1. self copyAndForward: o withBytes: b toFreeChunk: f. "here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk is a large chunk then firstFreeChunk will no longer point to an object header. So check and adjust firstFreeChunk if it is assigned to." f = firstFreeChunk ifTrue: [firstFreeChunk := self objectStartingAt: f]. self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: (self objectStartingAt: f)) = lastSubdividedFreeChunk])]]]. self checkFreeSpace. first := self longAt: highestObjects first. self assert: (self oop: first isGreaterThan: firstFreeChunk). + self fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo: first. - self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first. highestObjects usedSize > 0] whileTrue. coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr! Item was changed: ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpace (in category 'gc - global') ----- freeUnmarkedObjectsAndSortAndCoalesceFreeSpace "Sweep all of old space, freeing unmarked objects, coalescing free chunks, and sorting free space. Small free chunks are sorted in address order on each small list head. Large free chunks are sorted on the sortedFreeChunks list. Record as many of the highest objects as there is room for in highestObjects, a circular buffer, for the use of exactFitCompact. Use unused eden space for highestObjects. If highestObjects does not wrap, store 0 at highestObjects last. Record the lowest free object in firstFreeChunk. Let the segmentManager mark which segments contain pinned objects via notePinned:." | lastLargeFree lastHighest highestObjectsWraps sortedFreeChunks | <inline: false> <var: #lastHighest type: #usqInt> self checkFreeSpace. scavenger forgetUnmarkedRememberedObjects. segmentManager prepareForGlobalSweep."for notePinned:" "for sorting free space throw away the list heads, rebuilding them for small free chunks below." self resetFreeListHeads. highestObjects initializeStart: freeStart limit: scavenger eden limit. lastHighest := highestObjects start - self wordSize. "a.k.a. freeStart - wordSize" highestObjectsWraps := 0. self assert: highestObjects limit - highestObjects start // self wordSize >= 1024. firstFreeChunk := sortedFreeChunks := lastLargeFree := 0. "Note that if we were truly striving for performance we could split the scan into two phases, one up to the first free object and one after, which would remove the need to test firstFreeChunk when filling highestObjects." self allOldSpaceEntitiesForCoalescingDo: [:o| + self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]). + (self isMarked: o) - (self isMarked: o) ifTrue: "forwarders should have been followed in markAndTrace:" [self assert: (self isForwarded: o) not. self setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:" (self isPinned: o) ifTrue: [segmentManager notePinned: o]. firstFreeChunk ~= 0 ifTrue: [false "conceptually...: " ifTrue: [highestObjects addLast: o] ifFalse: "but we inline so we can use the local lastHighest" [(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue: [highestObjectsWraps := highestObjectsWraps + 1. lastHighest := highestObjects start]. self longAt: lastHighest put: o]]] ifFalse: "unmarked; two cases, an unreachable object or a free chunk." [| here limit next | self assert: (self isRemembered: o) not. "scavenger should have cleared this above" here := o. limit := endOfMemory - self bridgeSize. next := self objectAfter: here limit: limit. [next = limit or: [self isMarked: next]] whileFalse: "coalescing; rare case" [self assert: (self isRemembered: o) not. statCoalesces := statCoalesces + 1. here := self coalesce: here and: next. next := self objectAfter: here limit: limit]. - firstFreeChunk = 0 ifTrue: - [firstFreeChunk := here]. (self isLargeFreeObject: here) ifTrue: [self setFree: here. lastLargeFree = 0 ifTrue: [sortedFreeChunks := lastLargeFree := here] ifFalse: [self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here]. lastLargeFree := here] ifFalse: + [self freeSmallObject: here]. + firstFreeChunk = 0 ifTrue: + [self assert: (self isFreeObject: here). + firstFreeChunk := here]]]. - [self freeSmallObject: here]]]. highestObjects last: lastHighest. highestObjectsWraps ~= 0 ifTrue: [highestObjects first: (lastHighest + self wordSize >= highestObjects limit ifTrue: [highestObjects start] ifFalse: [lastHighest + self wordSize])]. lastLargeFree ~= 0 ifTrue: [self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0]. totalFreeOldSpace := self reverseSmallListHeads. totalFreeOldSpace := totalFreeOldSpace + (self rebuildFreeTreeFrom: sortedFreeChunks). self checkFreeSpace. self touch: highestObjectsWraps! Item was changed: ----- Method: SpurMemoryManager>>garbageCollectForSnapshot (in category 'snapshot') ----- garbageCollectForSnapshot self flushNewSpace. "There is no place to put newSpace in the snapshot file." + self fullGC. + segmentManager prepareForSnapshot! - self fullGC! Item was changed: ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') ----- globalGarbageCollect self runLeakCheckerForFullGC: true. self assert: self validObjStacks. self markObjects. self nilUnmarkedWeaklingSlots. self freeUnmarkedObjectsAndSortAndCoalesceFreeSpace. self runLeakCheckerForFullGC: true excludeUnmarkedNewSpaceObjs: true. self compact. self eliminateAndFreeForwarders. self assert: self validObjStacks. + self assert: (self isEmptyObjStack: weaklingStack). self assert: self allObjectsUnmarked. self runLeakCheckerForFullGC: true! Item was changed: ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') ----- initializeObjectMemory: bytesToShift "Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks." "Assume: image reader initializes the following variables: memory memoryLimit specialObjectsOop lastHash " <inline: false> | freeListObj | "Catch mis-initializations leading to bad translations to C" self assert: BaseHeaderSize = self baseHeaderSize. self bootstrapping ifFalse: [self initSegmentBridgeWithBytes: self bridgeSize at: endOfMemory - self bridgeSize]. segmentManager adjustSegmentSwizzlesBy: bytesToShift. "image may be at a different address; adjust oops for new location" self adjustAllOopsBy: bytesToShift. specialObjectsOop := segmentManager swizzleObj: specialObjectsOop. "heavily used special objects" nilObj := self splObj: NilObject. falseObj := self splObj: FalseObject. trueObj := self splObj: TrueObject. "In Cog we insist that nil, true & false are next to each other (Cogit generates tighter conditional branch code as a result). In addition, Spur places the free lists and class table root page immediately following them." self assert: nilObj = oldSpaceStart. self assert: falseObj = (self objectAfter: nilObj). self assert: trueObj = (self objectAfter: falseObj). freeListObj := self objectAfter: trueObj. self reInitializeClassTablePostLoad: (self objectAfter: freeListObj). markStack := self swizzleObjStackAt: MarkStackRootIndex. weaklingStack := self swizzleObjStackAt: WeaklingStackRootIndex. ephemeronQueue := self swizzleObjStackAt: EphemeronQueueRootIndex. + self assert: self validObjStacks. + self assert: (self isEmptyObjStack: weaklingStack). self initializeFreeSpacePostLoad: freeListObj. segmentManager collapseSegmentsPostSwizzle. self computeFreeSpacePostSwizzle. self bootstrapping ifFalse: [self initializeNewSpaceVariables]. self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart" segmentManager checkSegments. "These defaults should depend on machine size; e.g. too small on a powerful laptop, too big on a Pi." growHeadroom := 16*1024*1024. "headroom when growing" shrinkThreshold := 32*1024*1024. "free space before shrinking"! Item was changed: ----- Method: SpurMemoryManager>>isEmptyObjStack: (in category 'obj stacks') ----- isEmptyObjStack: objStack + objStack = nilObj ifTrue: + [^true]. self assert: (self isValidObjStack: objStack). + ^0 = (self fetchPointer: ObjStackTopx ofObject: objStack) + and: [0 = (self fetchPointer: ObjStackNextx ofObject: objStack)]! - ^0 = (self fetchPointer: ObjStackTopx ofObject: objStack)! Item was added: + ----- Method: SpurMemoryManager>>isValidClassIndex: (in category 'class table') ----- + isValidClassIndex: classIndex + | classTablePage | + classIndex <= 0 ifTrue: + [^false]. + (classIndex <= self tagMask or: [classIndex >= self arrayClassIndexPun]) ifFalse: + [^false]. + classIndex >= (1 << self classIndexFieldWidth) ifTrue: + [^false]. + classTablePage := self fetchPointer: classIndex >> self classTableMajorIndexShift + ofObject: hiddenRootsObj. + classTablePage = nilObj ifTrue: + [^false]. + (self addressCouldBeObj: classTablePage) ifFalse: + [false]. + ^coInterpreter addressCouldBeClassObj: + (self + fetchPointer: (classIndex bitAnd: self classTableMinorIndexMask) + ofObject: classTablePage)! Item was added: + ----- Method: SpurMemoryManager>>largeFreeChunkDistribution (in category 'compaction - analysis') ----- + largeFreeChunkDistribution + "This method answers a sorted collection of the free chunks >= 1,000,000 bytes long, + sandwiched between nilObj and the end of memory (ignoring the large chunk often found at the end of the heap)." + <doNotGenerate> + | freeChunks | + freeChunks := SortedCollection new. + self allObjectsInFreeTreeDo: + [:f| + ((self addressAfter: f) < endOfMemory + and: [(self bytesInObject: f) >= 1000000]) ifTrue: + [freeChunks add: f]]. + ^{{nilObj hex. #nil}}, (freeChunks collect: [:f| {f hex. self bytesInObject: f}]), {{endOfMemory hex. #endOfMemory}}! Item was changed: ----- Method: SpurMemoryManager>>nilUnmarkedWeaklingSlots (in category 'weakness and ephemerality') ----- nilUnmarkedWeaklingSlots "Nil the unmarked slots in the weaklings on the weakling stack, finalizing those that lost references. Finally, empty the weaklingStack." <inline: false> + weaklingStack = nilObj ifTrue: + [^self]. self objStack: weaklingStack from: 0 do: [:weakling| (self nilUnmarkedWeaklingSlotsIn: weakling) ifTrue: [coInterpreter signalFinalization: weakling]]. self emptyObjStack: weaklingStack! Item was added: + ----- Method: SpurMemoryManager>>postSnapshot (in category 'snapshot') ----- + postSnapshot + <doNotGenerate> + segmentManager postSnapshot! Item was changed: VMStructType subclass: #SpurSegmentInfo + instanceVariableNames: 'segStart segSize swizzle containsPinned savedSegSize lastFreeObject' - instanceVariableNames: 'segStart segSize swizzle containsPinned' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-SpurMemoryManager'! Item was added: + ----- Method: SpurSegmentInfo>>lastFreeObject (in category 'accessing') ----- + lastFreeObject + "Answer the value of lastFreeObject" + + ^ lastFreeObject! Item was added: + ----- Method: SpurSegmentInfo>>lastFreeObject: (in category 'accessing') ----- + lastFreeObject: anObject + "Set the value of lastFreeObject" + + ^lastFreeObject := anObject! Item was added: + ----- Method: SpurSegmentInfo>>savedSegSize (in category 'accessing') ----- + savedSegSize + "Answer the value of savedSegSize" + + ^ savedSegSize! Item was added: + ----- Method: SpurSegmentInfo>>savedSegSize: (in category 'accessing') ----- + savedSegSize: anObject + "Set the value of savedSegSize" + + ^savedSegSize := anObject! Item was added: + ----- Method: SpurSegmentManager>>postSnapshot (in category 'snapshot') ----- + postSnapshot + "Restore all shortened segments to their proper size, + re-freeing the trailing space." + numSegments - 1 to: 0 by: -1 do: + [:i| + (segments at: i) lastFreeObject ifNotNil: + [:freeChunk| | address | + address := (segments at: i) segLimit - manager bridgeSize. + (segments at: i) segSize: (segments at: i) savedSegSize. + self bridgeFrom: (self addressOf: (segments at: i)) + to: (i < (numSegments - 1) ifTrue: [self addressOf: (segments at: i + 1)]). + manager + addFreeChunkWithBytes: (segments at: i) segLimit - address - manager bridgeSize + at: address]]. + + "perhaps this should read + manager setEndOfMemory: 0; assimilateNewSegment: (segments at: numSegments - 1)" + manager setEndOfMemory: (segments at: numSegments - 1) segLimit - manager bridgeSize! Item was added: + ----- Method: SpurSegmentManager>>prepareForSnapshot (in category 'snapshot') ----- + prepareForSnapshot + "shorten all segments by any trailing free space." + <var: #seg type: #'SpurSegmentInfo *'> + 0 to: numSegments - 1 do: + [:i| + (segments at: i) + savedSegSize: (segments at: i) segSize; + lastFreeObject: nil]. + + "Ideally finding the lastFreeObject of each segment would be + done in some linear pass through the heap. But for now KISS." + manager freeTreeNodesDo: + [:freeChunk| | next seg | + next := manager objectAfter: freeChunk limit: manager endOfMemory. + (manager isSegmentBridge: next) ifTrue: + [seg := self segmentContainingObj: freeChunk. + seg lastFreeObject: freeChunk]. + freeChunk]. + + 0 to: numSegments - 1 do: + [:i| + (segments at: i) lastFreeObject ifNotNil: + [:freeChunk| + manager detachFreeObject: freeChunk. + (segments at: i) + segSize: (manager startOfObject: freeChunk) + + manager bridgeSize + - (segments at: i) segStart. + self bridgeFrom: (self addressOf: (segments at: i)) + to: (i < (numSegments - 1) ifTrue: [self addressOf: (segments at: i + 1)])]]. + + "perhaps this should read + manager setEndOfMemory: 0; assimilateNewSegment: (segments at: numSegments - 1)" + manager setEndOfMemory: (segments at: numSegments - 1) segLimit - manager bridgeSize! Item was added: + ----- Method: SpurSegmentManager>>segmentContainingObj: (in category 'accessing') ----- + segmentContainingObj: objOop + <returnTypeC: #'SpurSegmentInfo *'> + numSegments - 1 to: 0 by: -1 do: + [:i| + objOop >= (segments at: i) segStart ifTrue: + [^self addressOf: (segments at: i)]]. + ^nil! Item was added: + ----- Method: StackInterpreter>>codeGeneratorToComputeAccessorDepth (in category 'primitive support') ----- + codeGeneratorToComputeAccessorDepth + ^VMMaker new + buildCodeGeneratorForInterpreter: StackInterpreterPrimitives + includeAPIMethods: false + initializeClasses: false! Item was changed: ----- Method: StackInterpreter>>snapshot: (in category 'image save/restore') ----- snapshot: embedded "update state of active context" | activeContext activeProc rcvr setMacType stackIndex | <var: #setMacType type: #'void *'> "For now the stack munging below doesn't deal with more than one argument. It can, and should." argumentCount ~= 0 ifTrue: [^self primitiveFailFor: PrimErrBadNumArgs]. "Need to convert all frames into contexts since the snapshot file only holds objects." self push: instructionPointer. activeContext := self voidVMStateForSnapshotFlushingExternalPrimitivesIf: true. "update state of active process" activeProc := self activeProcess. objectMemory storePointer: SuspendedContextIndex ofObject: activeProc withValue: activeContext. tempOop := activeContext. objectMemory garbageCollectForSnapshot. "Nothing moves from here on so it is safe to grab the activeContext again." activeContext := tempOop. tempOop := 0. self successful ifTrue: ["Without contexts or stacks simulate rcvr := self popStack. ''pop rcvr'' self push: trueObj. to arrange that the snapshot resumes with true. N.B. stackIndex is one-relative." stackIndex := self quickFetchInteger: StackPointerIndex ofObject: activeContext. rcvr := objectMemory fetchPointer: stackIndex + CtxtTempFrameStart - 1 ofObject: activeContext. objectMemory storePointerUnchecked: stackIndex + CtxtTempFrameStart - 1 ofObject: activeContext withValue: objectMemory trueObject. "now attempt to write the snapshot file" self writeImageFileIO. (self successful and: [embedded not]) ifTrue: ["set Mac file type and creator; this is a noop on other platforms" setMacType := self ioLoadFunction: 'setMacFileTypeAndCreator' From: 'FilePlugin'. setMacType = 0 ifFalse: [self cCode: '((sqInt (*)(char *, char *, char *))setMacType)(imageName, "STim", "FAST")']]. "Without contexts or stacks simulate self pop: 1" objectMemory storePointerUnchecked: StackPointerIndex ofObject: activeContext withValue: (objectMemory integerObjectOf: stackIndex - 1)]. + objectMemory postSnapshot. self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext. self successful ifTrue: [self push: objectMemory falseObject] ifFalse: [self push: rcvr. self justActivateNewMethod]! Item was changed: ----- Method: StackInterpreter>>tryLoadNewPlugin:pluginEntries: (in category 'primitive support') ----- tryLoadNewPlugin: pluginString pluginEntries: pluginEntries "Load the plugin and if on Spur, populate pluginEntries with the prmitives in the plugin." <doNotGenerate> | plugin plugins simulatorClasses | self transcript cr; show: 'Looking for module ', pluginString. "Defeat loading of the FloatArrayPlugin & Matrix2x3Plugin since complications with 32-bit float support prevent simulation. If you feel up to tackling this start by implementing cCoerce: value to: cType ^cType = 'float' ifTrue: [value asIEEE32BitWord] ifFalse: [value] in FloatArrayPlugin & Matrix2x3Plugin and then address the issues in the BalloonEnginePlugin. See http://forum.world.st/Simulating-the-BalloonEnginePlugin-FloatArrayPlugin-a…" (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: pluginString) ifTrue: [self transcript show: ' ... defeated'. ^nil]. pluginString isEmpty ifTrue: [plugin := self] ifFalse: [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: [self transcript show: ' ... not found'. ^nil]. simulatorClasses size > 1 ifTrue: [^self error: 'This won''t work...']. plugins size > 1 ifTrue: [self 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 respondsTo: #initialiseModule) ifTrue: [plugin initialiseModule ifFalse: [self transcript show: ' ... initialiser failed'. ^nil]]]. "module initialiser failed" self transcript show: ' ... loaded'. objectMemory hasSpurMemoryManagerAPI ifTrue: [| realPlugin cg | self transcript show: '...computing accessor depths'. plugin class isPluginClass ifTrue: [realPlugin := plugin class withAllSuperclasses detect: [:class| class shouldBeTranslated]. cg := realPlugin buildCodeGeneratorUpTo: realPlugin] ifFalse: + [cg := self codeGeneratorToComputeAccessorDepth. + primitiveTable withIndexDo: + [:prim :index| | depth | + prim isSymbol ifTrue: + [depth := cg accessorDepthForSelector: prim. + self assert: depth isInteger. + primitiveAccessorDepthTable at: index - 1 put: depth]]]. - [cg := VMMaker new - buildCodeGeneratorForInterpreter: StackInterpreter - includeAPIMethods: false - initializeClasses: false]. cg exportedPrimitiveNames do: [:primName| | fnSymbol | fnSymbol := primName asSymbol. pluginEntries addLast: {plugin. fnSymbol. [plugin perform: fnSymbol. self]. cg accessorDepthForSelector: fnSymbol}]. self transcript show: '...done']. ^pluginString asString -> plugin! Item was changed: ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') ----- initialize "Initialize the StackInterpreterSimulator when running the interpreter inside Smalltalk. The primary responsibility of this method is to allocate Smalltalk Arrays for variables that will be declared as statically-allocated global arrays in the translated code." bootstrapping := false. + transcript := Transcript. objectMemory ifNil: [objectMemory := self class objectMemoryClass simulatorClass new]. objectMemory coInterpreter: self. "Note: we must initialize ConstMinusOne differently for simulation, due to the fact that the simulator works only with +ve 32-bit values" ConstMinusOne := objectMemory integerObjectOf: -1. methodCache := Array new: MethodCacheSize. atCache := Array new: AtCacheTotalSize. self flushMethodCache. gcSemaphoreIndex := 0. externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #(). externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize). externalPrimitiveTableFirstFreeIndex := 0. primitiveTable := self class primitiveTable copy. + mappedPluginEntries := OrderedCollection new. objectMemory hasSpurMemoryManagerAPI ifTrue: + [primitiveAccessorDepthTable := Array new: primitiveTable size. + pluginList := {}. + self loadNewPlugin: ''] - [primitiveAccessorDepthTable := self class primitiveAccessorDepthTable. - pluginList := {}] ifFalse: [pluginList := {'' -> self }]. - mappedPluginEntries := OrderedCollection new. desiredNumStackPages := desiredEdenBytes := 0. "This is initialized on loading the image, but convenient for testing stack page values..." numStackPages := self defaultNumStackPages. startMicroseconds := Time totalSeconds * 1000000. "initialize InterpreterSimulator variables used for debugging" byteCount := 0. sendCount := 0. quitBlock := [^ self]. traceOn := true. printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false. myBitBlt := BitBltSimulator new setInterpreter: self. - transcript := Transcript. displayForm := 'Display has not yet been installed' asDisplayText form. + eventQueue := SharedQueue new. suppressHeartbeatFlag := false. systemAttributes := Dictionary new. extSemTabSize := 256. + disableBooleanCheat := false! - disableBooleanCheat := false. - - "Forward events from the host to the Simulator tty" - eventQueue := SharedQueue new.! 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." | index s attribute | index := self stackIntegerValue: 0. self successful ifTrue: [ + attribute := systemAttributes at: index ifAbsent: [Smalltalk vm getSystemAttribute: index]. - attribute := systemAttributes at: index ifAbsent: [Smalltalk getSystemAttribute: index]. attribute ifNil: [ ^self primitiveFail ]. s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) 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" thenPush: s]! - self pop: 2. "rcvr, attr" - self push: s]! Item was changed: ----- Method: StackInterpreterSimulator>>transcript (in category 'accessing') ----- transcript + ^transcript! - "tty accessor needed by StackInstperpeterSimulatorMorphicModel" - ^transcript! Item was changed: ----- Method: StackInterpreterSimulator>>transcript: (in category 'accessing') ----- transcript: aTranscript + transcript := aTranscript! - "tty accessor needed by StackInstperpeterSimulatorMorphicModel" - transcript := aTranscript! Item was added: + ----- Method: VMClass class>>initializationOptions (in category 'initialization') ----- + initializationOptions + ^initializationOptions!

1 0

← Newer
1
2
3
4
5
6
7
8
9
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev February 2014