System-Bootstrap.st

OMeta2 subclass: #BootStrapEncoder
	instanceVariableNames: 'instVars className message arguments temporaries blockTemps maxTemporaries literals collection currentPos maxPos classNamePrefix'
	classVariableNames: 'Bfp BtpLong CodeBases CodeLimits DblExtDoAll Dup EndMethod EndRemote Jmp JmpLimit JmpLong LdFalse LdInstLong LdInstType LdLitIndType LdLitType LdMinus1 LdNil LdSelf LdSuper LdTempType LdThisContext LdTrue LoadLong LongLongDoAll NodeFalse NodeNil NodeSelf NodeSuper NodeThisContext NodeTrue Pop Send SendLimit SendLong SendLong2 SendPlus SendType ShortStoP StdLiterals StdSelectors StdVariables Store StorePop'
	poolDictionaries: ''
	category: 'System-Bootstrap'!

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/14/2010 02:12'!
array

	= arrayEncode*:a
		[self emitLitVariable: a asArray]! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/7/2010 19:57'!
arrayEncode

	= ({#array arrayEncode*:v [v asArray]:v}
	| {#symbol anything:v}
	| {#string anything:v}
	| {#integer anything:v}) [v]
! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/14/2010 15:13'!
assign

	= {#variable anything:v} encode:e [
		[| ind code |
		($A <= (v at: 1) and: [(v at: 1) <= $Z]) ifTrue: [
			code := (self litIndex: (v asSymbol -> v asSymbol)) + (CodeBases at: LdLitIndType)].
		(ind := instVars indexOf: v) > 0 ifTrue: [
			code := ind - 1.
			(CodeLimits at: LdInstType) > code ifTrue: [
				code := code + (CodeBases at: LdInstType)]
			ifFalse: [code := LdInstType * 256 + code]].
		(ind := temporaries indexOf: v) > 0 ifTrue: [
			code := (ind - 1) + (arguments size) + (CodeBases at: LdTempType)].
			^ e, (self emitVariableLong: Store with: code).
	] value]! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/14/2010 13:45'!
block

	= params:p temps:t 
		[[
			self pushBlockTemps.
			temporaries addAll: p.
			temporaries addAll: t.
			maxTemporaries := maxTemporaries max: temporaries size + arguments size] value]
		(sequence1:v [v]
		| {#return return:v} [{ByteArray new: 0. v}]:v
		|  encode:v [{v. nil}]:v)
		[[|ret|
			ret := self emitBlock: v first args: p returns: v second.
			self popBlockTemps.
			ret.
		] value]
! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/14/2010 13:47'!
blockInline

	= {#block params:p temps:t 
		[[
			self pushBlockTemps.
			temporaries addAll: p.
			temporaries addAll: t.
			maxTemporaries := maxTemporaries max: temporaries size + arguments size] value]
		(sequence1:v [v]
		| {#return return:v} [{ByteArray new: 0. v}]:v
		|  encode:v [{v. nil}]:v)}
		[[
			self popBlockTemps.
			v first, (v second ifNil: [#()])
		] value]
! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/10/2010 14:22'!
cascade

	= encode:rec encode*:rest
		[[|ret |
		ret := WriteStream on: (ByteArray new: 10).
		ret nextPutAll: rec.
		1 to: rest size - 1 do: [:i |
			ret nextPut: Dup. ret nextPutAll: (rest at: i). ret nextPut: Pop].
		ret nextPutAll: rest last.
		ret contents] value]! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/10/2010 14:22'!
cascadeSend

	= anything:sel encode*:args
		[self send: sel receiver: (ByteArray new: 0) arguments: args supered: false]
! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/14/2010 02:11'!
character

	= anything:v
		[self emitLitVariable: v]! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/10/2010 14:22'!
encode

	= {anything:h [self apply: h]:v} [v]! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/24/2010 22:52'!
encodeMethodBlock

	= {#block params temps
		(sequence1
		| {#return return:v} [{ByteArray new: 0. v}]
		| encode:v [{v. nil}]):v} [v]! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/14/2010 02:14'!
integer

	= anything:v
		[self emitInteger: v]! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/23/2010 13:26'!
method
	= :cn :iv [[className := cn. instVars := iv] value]
		{#message anything:sel [message := sel asSymbol] anything:args [arguments := args]}
		temps:t [temporaries := t asOrderedCollection]
		[maxTemporaries := temporaries size + arguments size]
		[blockTemps := OrderedCollection new]
		[literals := OrderedCollection new]
		encodeMethodBlock:e
		[[|tail|
		tail := e second ifNil: [ByteArray with: Pop with: 120].
		e first, tail] value]

// 120 is return self
! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/10/2010 14:37'!
method1

	= :cn :iv
		#method method(cn. iv):m [m]
! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 11/30/2010 17:50'!
params
	= {#params anything*:l} [l]
! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/10/2010 14:23'!
return
	= encode:l [l copyWith: EndMethod]! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/24/2010 02:15'!
send

	= macroExpand
		| anything:sel encode:rec encode*:args
		[[| supered receiver |
		supered := rec = (ByteArray with: LdSuper).
		receiver := supered ifTrue: [ByteArray with: LdSelf] ifFalse: [rec].
		self send: sel receiver: receiver arguments: args supered: supered] value]! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/13/2010 10:43'!
sequence
	= encode:l
		(sequence1:r [{(l copyWith: Pop), r first. r second}]
		| {#return return:r} [{l copyWith: Pop. r}]
		| encode:r [{(l copyWith: Pop), r. nil}])! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/10/2010 14:40'!
sequence1
	= {#sequence sequence:v} [v]
! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/23/2010 19:28'!
start = 
	{#classDef anything:p anything:c anything:iv anything:cv}
		[self classDef: c parent: p instVars: iv classVars: cv]
	| {#methodDef {anything:c (' class' | ''):meta}
		[[className := c, meta.
		(className beginsWith: classNamePrefix) ifTrue: [
			className := className copyFrom: classNamePrefix size + 1 to: className size]] value]
		{#instVars anything*:i}
		[instVars := i asArray]
		{method1(className. instVars):m}}
			[[literals add: message.
			literals add: className asSymbol ->className asSymbol.
			self generate: m, #(0 0 0 0)] value]
	| 	{#init anything:i} [self init: i]
	| 	{#doit anything:e} [self doIt: e]
! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/23/2010 22:54'!
startAll =
	:fileName :classNamePrefix
	[(FileStream newFileNamed: fileName) binary]:file
	(start:c [file nextPutAll: c])* [[file close. true] value]
! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/14/2010 02:11'!
string

	= anything:v
		[self emitLitVariable: v]! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/14/2010 02:11'!
symbol

	= anything:v
		[ self emitLitVariable: v asSymbol]! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 11/30/2010 17:50'!
temps
	= {#temps anything*:l} [l]
! !

!BootStrapEncoder methodsFor: 'rules' stamp: 'yo 12/14/2010 15:11'!
variable

	= anything:v
		[[|ind|
		($A <= (v at: 1) and: [(v at: 1) <= $Z]) ifTrue: [
			ind := self litIndex: (v asSymbol -> v asSymbol).
			^ self emitLoad: ind + (CodeBases at: LdLitIndType)].
		(ind := #('self' 'thisContext' 'super' 'nil' 'false' 'true') indexOf: v) > 0 ifTrue: [
			^ ByteArray with: ({LdSelf. LdThisContext. LdSuper. LdNil. LdFalse. LdTrue} at: ind)].
		(ind := arguments indexOf: v) > 0 ifTrue: [
			^ self emitVariable: ind - 1 + (CodeBases at: LdTempType)].
		(ind := temporaries indexOf: v) > 0 ifTrue: [
			^ self emitVariable: (ind - 1) + (arguments size) + (CodeBases at: LdTempType)].
		(ind := instVars indexOf: v) > 0 ifTrue: [
			ind := ind - 1.
			(CodeLimits at: LdInstType) > ind ifTrue: [
				ind := ind + (CodeBases at: LdInstType)]
			ifFalse: [ind := LdInstType * 256 + ind].
			^ self emitVariable: ind].
		] value]! !


!BootStrapEncoder methodsFor: 'code generation' stamp: 'yo 12/14/2010 13:59'!
emitBlock: block args: args returns: returns

	| aStream argsCode |
	aStream := WriteStream on: (ByteArray new: 10).
	aStream nextPut: LdThisContext.
	aStream nextPutAll: (self emitInteger: args size).
	aStream nextPut: 16rC8.  "'send blockCopy".
	argsCode := args reverse inject: #() into: [:s :arg |
		s, (self emitStorePopVariable: (self blockTempCode: arg) + (CodeBases at: LdTempType))].
	"Force a two byte jump."
	aStream nextPutAll: (self emitJumpLong: block size + argsCode size + (returns ifNotNil: [returns size] ifNil: [1]) code: JmpLong).
	aStream nextPutAll: argsCode.
	aStream nextPutAll: block.
	returns == nil ifTrue: [
		aStream nextPut: EndRemote.
	] ifFalse: [
		aStream nextPutAll: returns].
	^ aStream contents
! !

!BootStrapEncoder methodsFor: 'code generation' stamp: 'yo 12/4/2010 16:00'!
emitBranchOn: condition dist: dist
	| |
	dist = 0 ifTrue: [^ ByteArray with: Pop].
	^ condition
		ifTrue: [self emitJumpLong: dist code: BtpLong]
		ifFalse: [self emitJumpShortOrLong: dist code: Bfp]! !

!BootStrapEncoder methodsFor: 'code generation' stamp: 'yo 12/14/2010 02:09'!
emitInteger: v

	|ind|
	(ind := #(-1 0 1 2) indexOf: v) > 0 ifTrue: [
		^ ByteArray with: (LdMinus1 + ind - 1)].
	^ self emitLitVariable: v.
! !

!BootStrapEncoder methodsFor: 'code generation' stamp: 'yo 11/30/2010 09:59'!
emitJumpLong: dist code: longCode
	"Force a two-byte jump."
	| code distance aStream |
	aStream := WriteStream on: (ByteArray new: 2).
	code _ longCode.
	distance _ dist.
	distance < 0
		ifTrue: 
			[distance _ distance + 1024.
			code _ code - 4]
		ifFalse: 
			[distance > 1023 ifTrue: [distance _ -1]].
	distance < 0
		ifTrue: 
			[self error: 'A block compiles more than 1K bytes of code']
		ifFalse: 
			[aStream nextPut: distance // 256 + code.
			aStream nextPut: distance \\ 256].
	^ aStream contents.! !

!BootStrapEncoder methodsFor: 'code generation' stamp: 'yo 12/4/2010 16:13'!
emitJumpShortOrLong: dist code: shortCode

	| strm |
	strm := WriteStream on: (ByteArray new: 2).
	(1 <= dist and: [dist <= JmpLimit])
		ifTrue: [strm nextPut: shortCode + dist - 1]
		ifFalse: [strm nextPutAll: (self emitJumpLong: dist code: shortCode + (JmpLong-Jmp))].
	^ strm contents.! !

!BootStrapEncoder methodsFor: 'code generation' stamp: 'yo 12/14/2010 02:09'!
emitLitVariable: v

	|ind|
	ind := self litIndex: v.
	(CodeLimits at: LdLitType) > ind ifTrue: [
		ind := ind + (CodeBases at: LdLitType)]
	ifFalse: [
		ind := LdLitType * 256 + ind].
	^ self emitVariable: ind
! !

!BootStrapEncoder methodsFor: 'code generation' stamp: 'yo 12/5/2010 01:44'!
emitLoad: code
	code < 256
		ifTrue: [^ ByteArray with: code]
		ifFalse: [^ self emitVariableLong: LoadLong with: code].
! !

!BootStrapEncoder methodsFor: 'code generation' stamp: 'yo 11/30/2010 18:07'!
emitSend: code args: nArgs super: supered
	| index aStream |
	aStream := WriteStream on: (ByteArray new: 10).
	(supered not and: [code - Send < SendLimit and: [nArgs < 3]]) ifTrue:
		["short send"
		code < Send
			ifTrue: [aStream nextPut: code "special". ^ aStream contents]
			ifFalse: [aStream nextPut: nArgs * 16 + code. ^ aStream contents]].
	index _ code < 256 ifTrue: [code - Send] ifFalse: [code \\ 256].
	(index <= 31 and: [nArgs <= 7]) ifTrue: 
		["extended (2-byte) send [131 and 133]"
		aStream nextPut: SendLong + (supered ifTrue: [2] ifFalse: [0]).
		aStream nextPut: nArgs * 32 + index. ^ aStream contents].
	(supered not and: [index <= 63 and: [nArgs <= 3]]) ifTrue:
		["new extended (2-byte) send [134]"
		aStream nextPut: SendLong2.
		aStream nextPut: nArgs * 64 + index. ^ aStream contents].
	"long (3-byte) send"
	aStream nextPut: DblExtDoAll.
	aStream nextPut: nArgs + (supered ifTrue: [32] ifFalse: [0]).
	aStream nextPut: index.
	^ aStream contents.! !

!BootStrapEncoder methodsFor: 'code generation' stamp: 'yo 12/14/2010 13:58'!
emitStorePopVariable: code
	| strm |
	strm := WriteStream on: (ByteArray new: 10).
	(code between: 0 and: 7)
		ifTrue: 
			[strm nextPut: ShortStoP + code "short stopop inst"]
		ifFalse:
			[(code between: 16 and: 23)
				ifTrue: [strm nextPut: ShortStoP + 8 + code - 16 "short stopop temp"]
				ifFalse: [strm nextPutAll: ((code >= 256 and: [code \\ 256 > 63 and: [code // 256 = 4]])
						ifTrue: [self emitVariableLong: Store with: code. strm nextPut: Pop]
						ifFalse: [self emitVariableLong: StorePop with: code])]].
	^ strm contents
! !

!BootStrapEncoder methodsFor: 'code generation' stamp: 'yo 11/30/2010 21:16'!
emitVariableLong: mode with: code
	"Emit extended variable access."
	| type index aStream |
	aStream := WriteStream on: (ByteArray new: 2).
	code < 256
		ifTrue:
			[code < 16
			ifTrue: [type _ 0.
					index _ code]
			ifFalse: [code < 32
					ifTrue: [type _ 1.
							index _ code - 16]
					ifFalse: [code < 96
							ifTrue: [type _ code // 32 + 1.
									index _ code \\ 32]
							ifFalse: [self error: 
									'Sends should be handled in SelectorNode']]]]
		ifFalse: 
			[index _ code \\ 256.
			type _ code // 256 - 1].
	index <= 63 ifTrue:
		[aStream nextPut: mode.
		aStream nextPut: type * 64 + index. ^ aStream contents].
	"Compile for Double-exetended Do-anything instruction..."
	mode = LoadLong ifTrue:
		[aStream nextPut: DblExtDoAll.
		aStream nextPut: (#(64 0 96 128) at: type+1).  "Cant be temp (type=1)"
		aStream nextPut: index. ^ aStream contents].
	mode = Store ifTrue:
		[aStream nextPut: DblExtDoAll.
		aStream nextPut: (#(160 0 0 224) at: type+1).  "Cant be temp or const (type=1 or 2)"
		aStream nextPut: index. ^ aStream contents].
	mode = StorePop ifTrue:
		[aStream nextPut: DblExtDoAll.
		aStream nextPut: (#(192 0 0 0) at: type+1).  "Can only be inst"
		aStream nextPut: index. ^ aStream contents].
! !

!BootStrapEncoder methodsFor: 'code generation' stamp: 'yo 12/14/2010 02:03'!
emitVariable: code

	| strm |
	strm := WriteStream on: (ByteArray new: 2).
	code = 65 ifTrue: [self halt].
	code < 256
		ifTrue: 
			[strm nextPut: (code = LdSuper ifTrue: [LdSelf] ifFalse: [code]). ^ strm contents]
		ifFalse: 
			[^ self emitVariableLong: LoadLong with: code].
! !

!BootStrapEncoder methodsFor: 'code generation' stamp: 'yo 12/14/2010 11:10'!
send: sel receiver: rec arguments: args supered: supered

	| index send |
	index := #(#'+' #'-' #'<' #'>' #'<=' #'>=' #'=' #'~=' #'*' #'/' #'\\' #'@' #'bitShift:' #'//'
			#'bitAnd:' #'bitOr:' #'at:' #'at:put:' #'size' #'next' #'nextPut:' #'atEnd' #'=='
			#'class' #'blockCopy:' #'value' #'value:' #'do:' #'new' #'new:' #'x' #'y') indexOf: sel.
	^ (index > 0 and: [supered not])
		ifTrue: [rec, (args inject: (ByteArray new: 0) into: [:s :t | s, t]), (ByteArray with: index + SendPlus -1)]
		ifFalse: [
			index := (self litIndex: sel) + (CodeBases at: SendType).
			send := self emitSend: index args: args size super: supered.
			rec, (args inject: (ByteArray new: 0) into: [:s :t | s, t]), send]! !


!BootStrapEncoder methodsFor: 'private' stamp: 'yo 12/7/2010 01:36'!
blockTempCode: arg

	^ arguments size + (temporaries indexOf: arg) - 1.
! !

!BootStrapEncoder methodsFor: 'private' stamp: 'yo 12/27/2010 00:22'!
litIndex: lit
	"Just a little hack to avoid needing LiteralDictionary.  Symbols and Strings can be equal but in literals, it should be different."
	| ind |
	(ind := literals indexOf: lit) > 0 ifTrue: [
		((literals at: ind) class == lit class) ifTrue: [^ ind - 1].
		(ind := literals indexOf: lit startingAt: ind + 1 ifAbsent: [0]) > 0 ifTrue: [^ ind - 1]].
	literals add: lit.
	^ literals size - 1.
! !

!BootStrapEncoder methodsFor: 'private' stamp: 'yo 12/10/2010 12:09'!
popBlockTemps

	temporaries := temporaries copyFrom: 1 to: blockTemps removeFirst.

! !

!BootStrapEncoder methodsFor: 'private' stamp: 'yo 12/7/2010 01:06'!
pushBlockTemps

	blockTemps addFirst: temporaries size.! !


!BootStrapEncoder methodsFor: 'macro selector' stamp: 'yo 12/7/2010 02:44'!
emitIf

	=  (
		'ifTrue:ifFalse:' encode:r blockInline:t blockInline:f
		| 'ifFalse:ifTrue:' encode:r  blockInline:f blockInline:t
		| 'ifTrue:' encode:r blockInline:t
		|  'ifFalse:' encode:r blockInline:f)
		[[| ret s falseCode |
		ret := WriteStream on: (ByteArray new: 10).
		(f == nil or: [f size = 0]) ifTrue: [s := 1] ifFalse: [s := f size].
		falseCode := self emitJumpShortOrLong: s code: Jmp.
		ret nextPutAll: r.
		(t == nil or: [t size = 0]) ifTrue: [s := 1] ifFalse: [s := t size].
		ret nextPutAll: (self emitBranchOn: false dist: s + falseCode size).
		(t == nil or: [t size = 0]) ifTrue: [ret nextPut: LdNil] ifFalse: [ret nextPutAll: t].
		ret nextPutAll: falseCode.
		(f == nil or: [f size = 0])
			ifTrue: [ret nextPut: LdNil]
			ifFalse: [ret nextPutAll: f].
		ret contents] value]
! !

!BootStrapEncoder methodsFor: 'macro selector' stamp: 'yo 12/6/2010 15:09'!
emitWhile

	= ('whileTrue:' | 'whileFalse:' | 'whileTrue' | 'whileFalse'):sel blockInline:r  (blockInline | [nil]):body
		[[| ret |
		ret := WriteStream on: (ByteArray new: 10).
		ret nextPutAll: r.
		(body == nil or: [body size = 0]) ifTrue: [
			ret nextPutAll: (self emitBranchOn: (sel = 'whileFalse') dist: 2).
		] ifFalse: [
			ret nextPutAll: (self emitBranchOn: (sel = 'whileFalse:') dist: body size + 3).
			ret nextPutAll: body.
			ret nextPut: Pop].
		ret nextPutAll: (self emitJumpShortOrLong: 0 - ret contents size - 2 code: Jmp).
		ret nextPut: LdNil.
		ret contents] value]
! !

!BootStrapEncoder methodsFor: 'macro selector' stamp: 'yo 12/4/2010 16:24'!
macroExpand

	= emitIf | emitWhile! !


!BootStrapEncoder methodsFor: 'file out' stamp: 'yo 12/23/2010 22:13'!
classDef: c parent: p instVars: iCol classVars: cCol

	| size cn pn iv cv |
	cn := (c beginsWith: classNamePrefix) ifTrue: [
		c copyFrom: classNamePrefix size + 1 to: c size] ifFalse: [c].
	pn := (p beginsWith: classNamePrefix) ifTrue: [
		p copyFrom: classNamePrefix size + 1 to: p size] ifFalse: [p].
	iv := String streamContents: [:strm |  iCol do: [:e | strm nextPutAll: e] separatedBy: [strm space]].
	cv := String streamContents: [:strm |  cCol do: [:e | strm nextPutAll: e] separatedBy: [strm space]].

	size := 4 +
		4 + (pn size roundUpTo: 4) + 
		4 + (cn size roundUpTo: 4) +
		4 + (iv size roundUpTo: 4) +
		4 + (cv size roundUpTo: 4).

	collection := ByteArray new: size.
	currentPos := maxPos := 0.
	self int32: (size bitShift: 8) + 254.
	self string: pn.
	self string: cn.
	self string: iv.
	self string: cv.
	^ collection! !

!BootStrapEncoder methodsFor: 'file out' stamp: 'yo 12/12/2010 10:53'!
doIt: str

	| size |
	size := 4 + 4 + (str size roundUpTo: 4).

	collection := ByteArray new: size.
	currentPos := maxPos := 0.
	self int32: (size bitShift: 8) + 250.
	self string: str.
	^ collection! !

!BootStrapEncoder methodsFor: 'file out' stamp: 'yo 12/27/2010 00:20'!
generate: bytes

	| header literalBytes size |
	collection := ByteArray new: 4096.
	maxPos := currentPos := 0.
	self literal: literals asArray.
	literalBytes := collection copyFrom: 1 to: maxPos.

	size := 4 + 4 +
		4 + className size + ((4 - (className size \\ 4)) \\ 4) +
		4 + message size + ((4 - (message size \\ 4)) \\ 4) +
		4 + bytes size + ((4 - (bytes size \\ 4)) \\ 4) +
		4 + literalBytes size + ((4 - (literalBytes size \\ 4)) \\ 4).

	collection := ByteArray new: size.
	maxPos := currentPos := 0.
	header := (arguments size bitShift: 24) +
				(maxTemporaries bitShift: 18) +
				(1 bitShift: 17) +
				(literals size bitShift: 9) +
				0.

	self int32: (size bitShift: 8) + 252. "methodDef"
	self int32: header.
	self string: className.
	self string: message.
	self string: bytes.
	self string: literalBytes.
	^ collection

	! !

!BootStrapEncoder methodsFor: 'file out' stamp: 'yo 12/16/2010 00:48'!
init: str

	| size |
	size := 4 + 4 + (str size roundUpTo: 4).

	collection := ByteArray new: size.
	currentPos := maxPos := 0.
	self int32: (size bitShift: 8) + 248.
	self string: str.
	^ collection! !

!BootStrapEncoder methodsFor: 'file out' stamp: 'yo 12/14/2010 14:54'!
int32: v

	| val |
	val := v < 0 ifTrue: [16r100000000 + v] ifFalse: [v].
	4 to: 1 by: -1 do: [:i |
		collection at: (currentPos := currentPos + 1) put: (val digitAt: i)].
! !

!BootStrapEncoder methodsFor: 'file out' stamp: 'yo 12/27/2010 00:20'!
literal: lit

	"0 -> GlobalName"
	"2 -> String"
	"4 -> Symbol"
	"6 -> Array"
	"8 -> LargePositiveInteger"
	"10 -> LargeNegativeInteger"
	"12 -> Float"
	"14 -> Character"
	"odd -> Integer"

	| pos newArray end |
	lit isArray ifTrue: [
		pos := currentPos.
		newArray := Array new: lit size.
		collection from: currentPos + 1 to: (end := currentPos + ((lit size + 1) * 4)) put: 0.
		currentPos := end.
		maxPos := currentPos.
		1 to: lit size do: [:i |
			currentPos := maxPos.
			newArray at: i put: (self literal: (lit at: i))].
		currentPos := pos.
		self int32: lit size.
		1 to: newArray size do: [:i |
			self int32: (newArray at: i)].
		maxPos := maxPos max: currentPos.
		^ ((pos bitAnd: 16rFFFFFF) bitShift: 8) + 6].
	lit isSmallInteger ifTrue: [
		^ ((lit bitShift: 1) + 1)].
	lit isVariableBinding ifTrue: [
		pos := currentPos.
		self string: lit key.
		maxPos := maxPos max: currentPos.
		^ ((pos bitAnd: 16rFFFFFF) bitShift: 8) + 0].
	(lit isString and: [lit isSymbol not]) ifTrue: [
		pos := currentPos.
		self string: lit.
		maxPos := maxPos max: currentPos.
		^ ((pos bitAnd: 16rFFFFFF) bitShift: 8) + 2].
	lit isSymbol ifTrue: [
		pos := currentPos.
		self string: lit.
		maxPos := maxPos max: currentPos.
		^ ((pos bitAnd: 16rFFFFFF) bitShift: 8) + 4].
	(lit class == LargePositiveInteger) ifTrue: [
		pos := currentPos.
		self string: lit.
		maxPos := maxPos max: currentPos.
		^ ((pos bitAnd: 16rFFFFFF) bitShift: 8) + 8].
	(lit class == LargeNegativeInteger) ifTrue: [
		pos := currentPos.
		self string: lit.
		maxPos := maxPos max: currentPos.
		^ ((pos bitAnd: 16rFFFFFF) bitShift: 8) + 10].
	(lit class == Float) ifTrue: [
		pos := currentPos.
		self string: (lit as: Bitmap) asByteArray.
		maxPos := maxPos max: currentPos.
		^ ((pos bitAnd: 16rFFFFFF) bitShift: 8) + 12].
	lit isCharacter ifTrue: [
		^ ((lit asciiValue bitAnd: 16rFFFFFF) bitShift: 8) + 14].
! !

!BootStrapEncoder methodsFor: 'file out' stamp: 'yo 12/9/2010 00:19'!
string: val

	| end |
	self int32: val size.
	collection replaceFrom: currentPos + 1 to: (end := currentPos + val size) with: val startingAt: 1.
	currentPos := end.
	[currentPos \\ 4 = 0] whileFalse: [collection at: (currentPos := currentPos + 1) put: 0].
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

BootStrapEncoder class
	instanceVariableNames: ''!

!BootStrapEncoder class methodsFor: 'as yet unclassified' stamp: 'yo 12/13/2010 22:17'!
compileFile: stFilename to: stoFileName

	BootStrapEncoder
		matchAll: {stoFileName. 'M'},
			(BootStrapParser matchAll: (FileStream readOnlyFileNamed: stFilename) contentsOfEntireFile with: #startAll)
		with: #startAll
! !

!BootStrapEncoder class methodsFor: 'as yet unclassified' stamp: 'yo 12/13/2010 22:17'!
compile: csString to: stoFileName

	BootStrapEncoder
		matchAll: {stoFileName. 'M'},
			(BootStrapParser matchAll: csString with: #startAll)
		with: #startAll
! !

!BootStrapEncoder class methodsFor: 'as yet unclassified' stamp: 'yo 12/28/2010 00:29'!
createCompilerFileOut
"
	BootStrapEncoder createCompilerFileOut
"
	| n c aClass latest in m i line |
	c := ChangeSet current.
	n := ChangeSorter basicNewChangeSet: 'AllMCompilerClasses'.
	ChangeSet  newChanges: n.

	(SystemOrganization listAtCategoryNamed: 'MSqueak-Compiler') do: [:e |
		(n changeRecorderFor: e) noteChangeType: #change
	].

	n fileOut.
	ChangeSet  newChanges: c.
	ChangeSorter removeChangeSet: n.
	latest := (FileDirectory default fileNames select: [:f | f beginsWith: 'AllMCompilerClasses']) sort last.
	FileDirectory default rename: latest toBe: 'AllMCompilerClasses.st'.

	n := ChangeSorter basicNewChangeSet: 'AllMCompilerMethods'.
	ChangeSet  newChanges: n.

	(SystemOrganization listAtCategoryNamed: 'MSqueak-Compiler') do: [:e |
		(aClass := Smalltalk at: e) selectors do: [:sel |
			ChangeSet current adoptSelector: sel forClass: aClass].
		(aClass := (Smalltalk at: e) class) selectors do: [:sel |
			ChangeSet current adoptSelector: sel forClass: aClass].
	].

	n fileOut.
	ChangeSet  newChanges: c.
	ChangeSorter removeChangeSet: n.
	latest := (FileDirectory default fileNames select: [:f | f beginsWith: 'AllMCompilerMethods']) sort last.
	in:= FileStream readOnlyFileNamed: latest.
	m := FileStream newFileNamed: 'AllMCompilerMethods.st'.
	i := FileStream newFileNamed: 'MCompilerInitialize.st'.
	[(line := in nextLine) notNil] whileTrue: [
		(line endsWith: 'initialize!!') ifTrue: [
			i nextPutAll: line; cr.
		] ifFalse: [
			m nextPutAll: line; cr.
		]
	].
	in close. m close. i close.
	FileDirectory default deleteFileNamed: latest.
! !

!BootStrapEncoder class methodsFor: 'as yet unclassified' stamp: 'yo 12/5/2010 00:21'!
initialize
	"BootStrapEncoder initialize."
	LdInstType _ 1.
	LdTempType _ 2.
	LdLitType _ 3.
	LdLitIndType _ 4.
	SendType _ 5.
	CodeBases _ #(0 16 32 64 208 ).
	CodeLimits _ #(16 16 32 32 16 ).
	LdSelf _ 112.
	LdTrue _ 113.
	LdFalse _ 114.
	LdNil _ 115.
	LdMinus1 _ 116.
	LoadLong _ 128.
	Store _ 129.
	StorePop _ 130.
	ShortStoP _ 96.
	SendLong _ 131.
	DblExtDoAll _ 132.
	SendLong2 _ 134.
	LdSuper _ 133.
	Pop _ 135.
	Dup _ 136.
	LdThisContext _ 137.
	EndMethod _ 124.
	EndRemote _ 125.
	Jmp _ 144.
	Bfp _ 152.
	JmpLimit _ 8.
	JmpLong _ 164.  "code for jmp 0"
	BtpLong _ 168.
	SendPlus _ 176.
	Send _ 208.
	SendLimit _ 16.
! !


OMeta2 subclass: #BootStrapParser
	instanceVariableNames: 'instVars'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Bootstrap'!

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/23/2010 23:16'!
arrayElement
	= literal
	| selector:s							[{#symbol. s}]
	| $#? literalArray
! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/20/2010 18:06'!
arrayLiteral
	= $# literalArray! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/16/2010 17:58'!
binaryArgument
	= binarySend | unaryArgument! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/12/2010 16:12'!
binaryCharacter
	= &(char:c ?['-+/\\*~<>=@%|&?,`' includes: c]) char! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/12/2010 16:12'!
binaryCharacter2
	= &(char:c ?['-+/\\*~<>=@%|&?!!,`' includes: c]) char! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/6/2010 21:24'!
binarySelector
	= <binaryCharacter+>:s spacing [s asSymbol]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/17/2010 17:32'!
binarySend
	= unaryArgument:r (binarySelector:s unaryArgument:a
		[{#send. s. r. a}]:r)+ [r]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/30/2010 15:35'!
block
	= lbrack (blockInner({#variable. 'nil'})):v rbrack [v]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/30/2010 15:34'!
blockInner
	= :default (blockParameters | [#(params)]):params
		temporaries:temps
		(expressionList | [default]):body	
			[{#block. params. temps. body}]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/15/2010 15:55'!
blockParameter
	= $: spacing identifier! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/17/2010 17:43'!
blockParameters
	= blockParameter+:params bar
		[{#params}, params]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/17/2010 17:44'!
brace
	= lbrace expressionList:a rbrace	 [{#brace. a}]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/20/2010 19:20'!
cascade
	= semicolon (
		(unarySelector:s [{s}]
		| binarySelector:s binaryArgument:a [{s. a}]
		| keywordMessage)):s
	[{#cascadeSend}, s]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/17/2010 17:44'!
characterLiteral
	= $$ :c spacing [{#character. c}]
! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/23/2010 22:46'!
classDefinition
	= identifier:p ``subclass: #'' identifier:c
	``instanceVariableNames: '' $' spacing identifier*:ivar $' spacing
	``classVariableNames: '' $' spacing identifier*:cvar $' spacing
	``poolDictionaries: '' singleString spacing
	``category: '' singleString $!! spacing
	[instVars at: c put: {p. ivar asArray}]
	[{#classDef. p. c. ivar asArray. cvar asArray}]
! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/20/2010 20:44'!
doit

	= <(expression | spacing)>:s $!! spacing [{#doit. s}]
! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/30/2010 22:11'!
expression =
	variable:i assign expression:e		[{#assign. i. e}]
	| messageSend:s [{#cascade. s third}, {{#cascadeSend. s second}, (s copyFrom: 4 to: s size)}]:s (cascade:c [s copyWith: c]:s)+ [s]
	| messageSend
	| primary
! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/30/2010 19:25'!
expressionList
	= hat expression:e dot?				[{#return. e}]
	| expression:s dot  expressionList:l  [{#sequence. s. l}]
	| expression:s dot?					[s]
! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/16/2010 01:01'!
init

	= identifier:i ``initialize'' $!! spacing [{#init. i}]
! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/15/2010 15:36'!
keyword
	= keywordName:k spacing -> [k]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/6/2010 22:37'!
keywordMessage
	= ['']:name [#()]:args
		(keyword:s binaryArgument:a [name, s]:name [args, {a}]:args)+
  			[{name asSymbol}, args]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/15/2010 15:36'!
keywordName
	= <(identifierName $:)>! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/6/2010 21:22'!
keywordSelector
	= ['']:ret (keywordName:k [ret, k]:ret)+ spacing [ret asSymbol]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/6/2010 21:22'!
keywordSend
	= binaryArgument:r [#()]:args ['']:name
		(keyword:s binaryArgument:a [name, s]:name [args, {a}]:args)+
			[#(send), {name asSymbol. r}, args]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/17/2010 17:49'!
literal = singleString:i	 [{#string. i}]
		| number
		| characterLiteral
		| symbolLiteral
		| arrayLiteral
! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/20/2010 18:06'!
literalArray
	= lparen arrayElement*:a rparen	 [{#array}, a]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/20/2010 22:45'!
messagePattern
	= [#()]:args ['']:name (keyword:k identifier:i [name, k]:name [args, {i}]:args)+
			[{#message. name asSymbol. args}]
	| binarySelector:name identifier:arg
			[{#message. name. {arg}}]
	| unarySelector:name
			[{#message. name. {}}]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/16/2010 18:45'!
messageSend = keywordSend | binarySend | unarySend! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/30/2010 15:30'!
method
	= messagePattern:m spacing temporaries:t primitive?:p methodBlock:l -> [{#method. m . t.  l}]
! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/20/2010 20:10'!
methodBlock
	= blockInner({#return. {#variable. 'self'}})! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/17/2010 17:52'!
number = float:r spacing [{#float. r}] | integer:r spacing [{#integer. r}]
! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/14/2010 15:23'!
primary = variable | pseudoVariable | literal | block | brace
				| lparen expression:e rparen	[e]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/16/2010 22:02'!
primitive			= langle <(~rangle anything)*>:body rangle [body]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/17/2010 17:52'!
pseudoVariable = <(``self'' | ``super'')>:s spacing	[{#variable. s}]
! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/16/2010 18:53'!
selector
	= unarySelector | binarySelector | keywordSelector! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/15/2010 15:01'!
semicolon = $; spacing! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/16/2010 18:53'!
space
	= char:a  ?[' 	' includes: a]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/22/2010 11:02'!
stamp
	= $!!
		<identifierName>:s (`` class'' | ['']):t [{s. t}]:s
		spacing ``methodsFor:'' spacing (~$!! anything)*  $!! spacing [s]
! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/23/2010 22:48'!
start = spacing
			(stamp:c method:m
				$!! $  $!! spacing
				[{#methodDef. c. {#instVars}, (self allInstVarNames: c first, c second). m}]
			| classDefinition
			| init
			| doit)
! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/8/2010 19:22'!
startAll = start*! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/17/2010 17:52'!
symbolLiteral
	= $# ( selector | singleString ):s [{#symbol. s}]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/17/2010 17:53'!
temporaries
	= bar identifier*:a bar	-> [#(temps), a]
	| 							-> [#(temps)]
! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/16/2010 23:28'!
unaryArgument			= unarySend | primary! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 12/6/2010 21:20'!
unarySelector = identifierName:name ~$: spacing [name asSymbol]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/17/2010 17:53'!
unarySend	= primary:r (unarySelector:s  [{#send. s. r}]:r)+ 	[r]! !

!BootStrapParser methodsFor: 'rules' stamp: 'yo 11/17/2010 17:53'!
variable = identifier:i [{#variable. i}]! !


!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/16/2010 17:57'!
assign
	= (``:='' | ``_'') spacing! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/16/2010 17:58'!
bar
	= $| spacing! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/16/2010 18:06'!
comment =
	$" <(~$" char)*>:a $" spacing [a]! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/16/2010 18:05'!
dot
	= $. spacing! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/15/2010 14:59'!
endOfFile = ~anything! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/15/2010 15:39'!
endOfLine =
	char:c (?[c = Character cr]
			(~anything [1]
				| &(char:d) ?[d ~= Character lf] [1]
				| char:d ?[d = Character lf] [1])
			| ?[c = Character lf] [1])! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/16/2010 18:38'!
float
	= ($- [-1] | [1]):s <between($0. $9)+>:m $. <between($0. $9)+>:f
		(($e | $E) <($- |) between($0. $9)+> | ['0']):e
		[(m asNumber asFloat+ (f asNumber / (10 raisedTo: f size))) * (10 raisedTo: e asNumber) * s]! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/15/2010 14:59'!
hat = $^ spacing! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/16/2010 18:09'!
identifier
	= identifierName:i spacing [i]! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/16/2010 18:09'!
identifierCharacter
	= between($a. $z) | between($A. $Z)
! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/16/2010 21:09'!
identifierName
	= <identifierCharacter identifierRest*>:i	[i]! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/16/2010 18:09'!
identifierRest
	= identifierCharacter | between($0. $9)! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/16/2010 18:36'!
integer =
	($- [-1]| [1]):s (<between($0. $9) between($0. $9) | between($0. $9)>:b $r [b asNumber]
		| [10]):b
	($- [s * -1] | [s]):s [0]:ret
	((between($0. $9) | between($A. $Z)):c [ret * b + c digitValue]:ret)+
	[ret * s]
! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/15/2010 15:00'!
langle = $< spacing! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/15/2010 15:00'!
lbrace = ${ spacing! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/15/2010 15:00'!
lbrack = $[ spacing! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/17/2010 17:45'!
lparen = $( spacing! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/15/2010 15:01'!
rangle = $> spacing! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/15/2010 15:01'!
rbrace = $} spacing! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/15/2010 15:01'!
rbrack = $] spacing! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/17/2010 17:44'!
rparen = $) spacing! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/17/2010 17:50'!
singleString
	= $' (~$' anything| $' $')*:s $' spacing [String newFrom: s]
! !

!BootStrapParser methodsFor: 'terminals' stamp: 'yo 11/16/2010 18:53'!
spacing
	= (space | comment | endOfLine)*! !


!BootStrapParser methodsFor: 'private' stamp: 'yo 11/16/2010 17:58'!
between :a :b
	= :x ?[x between: a and: b] [x]! !


!BootStrapParser methodsFor: 'initialization' stamp: 'yo 12/23/2010 22:47'!
allInstVarNames: aString

	| pair cls |
	pair := instVars at: aString ifAbsent: [
		cls := Smalltalk at: aString asSymbol ifAbsent: [^ #()].
		{cls superclass name. cls instVarNames}].
	^ (self allInstVarNames: pair first), pair second
! !

!BootStrapParser methodsFor: 'initialization' stamp: 'yo 12/23/2010 21:45'!
initialize

	super initialize.
	instVars := Dictionary new.
! !


Object subclass: #BootStrapReader
	instanceVariableNames: 'class'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Bootstrap'!

!BootStrapReader methodsFor: 'all' stamp: 'yo 12/8/2010 23:59'!
bytes: strm

	| ret size |
	size := self int32: strm.
	ret := strm next: size.
	[strm position \\ 4 = 0] whileFalse: [strm next].
	^ ret.
! !

!BootStrapReader methodsFor: 'all' stamp: 'yo 12/14/2010 14:50'!
int32: strm
	"Answer the next unsigned, 32-bit integer from this (binary) stream."

	| n |
	n  _ strm next.
	n _ (n bitShift: 8) + strm next.
	n _ (n bitShift: 8) + strm next.
	n _ (n bitShift: 8) + strm next.
	^ n > 16r7FFFFFFF ifTrue: [n - 16r100000000] ifFalse: [n]
! !

!BootStrapReader methodsFor: 'all' stamp: 'yo 12/12/2010 10:51'!
pointerFrom: v

	^ v bitShift: -8
! !

!BootStrapReader methodsFor: 'all' stamp: 'yo 12/9/2010 23:57'!
readAllFrom: strm

	| o |
	o := OrderedCollection new.
	[strm atEnd] whileFalse: [o add: (self read: strm)].
	^ o.
! !

!BootStrapReader methodsFor: 'all' stamp: 'yo 12/13/2010 22:06'!
readArrayLiteralsFrom: bytes at: pos

	| newArray strm arraySize v pointer  f base string b |
	strm := ReadStream on: bytes.
	strm position: pos.
	arraySize := self int32: strm.
	newArray := Array new: arraySize.
	1 to: arraySize do: [:i |
		base := pos.
		strm position: base + ((i - 1) * 4) + 4.
		v := self int32: strm.
		v odd ifTrue: [
			newArray at: i put: (v bitShift: -1)].
		(v digitAt: 1) = 0 ifTrue: [
			strm position: (self pointerFrom: v).
			string := self string: strm.
			(string endsWith: ' class') ifTrue: [
				b := nil->((class bindingOf: (string copyFrom: 1 to: string size - 6) asSymbol) value class)]
			ifFalse: [
				b := class bindingOf: string asSymbol].
			newArray at: i put: b].
		(v digitAt: 1) = 2 ifTrue: [
			strm position: (self pointerFrom: v).
			newArray at: i put: (self string: strm)].
		(v digitAt: 1) = 4 ifTrue: [
			strm position: (self pointerFrom: v).
			newArray at: i put: (self string: strm) asSymbol].
		(v digitAt: 1) = 6 ifTrue: [
			pointer := self pointerFrom: v.
			newArray at: i put: (self readArrayLiteralsFrom: bytes at: pointer)].
		(v digitAt: 1) = 8 ifTrue: [
			strm position: (self pointerFrom: v).
			newArray at: i put: (LargePositiveInteger newFrom: (self bytes: strm))].
		(v digitAt: 1) = 10 ifTrue: [
			strm position: (self pointerFrom: v).
			newArray at: i put: (LargeNegativeInteger newFrom: (self bytes: strm))].
		(v digitAt: 1) = 12 ifTrue: [
			strm position: (self pointerFrom: v).
			f := WordArray new: 2.
			f at: 1 put: (self int32: strm).
			f at: 2 put: (self int32: strm).
			newArray at: i put: (f as: Float)].
		(v digitAt: 1) = 14 ifTrue: [
			newArray at: i put: (Character value: (self pointerFrom: v))]].
	^ newArray

! !

!BootStrapReader methodsFor: 'all' stamp: 'yo 12/10/2010 10:25'!
readClassDef: allStrm size: size

	| strm |
	strm :=(allStrm next: size) readStream.
	^ #(#classDef), ((1 to: 4) collect: [:i | self string: strm]). "pName cName iv cv"
! !

!BootStrapReader methodsFor: 'all' stamp: 'yo 12/16/2010 00:55'!
readDoIt: allStrm size: size

	^ #(doit) copyWith: (self string: (allStrm next: size) readStream)! !

!BootStrapReader methodsFor: 'all' stamp: 'yo 12/16/2010 00:48'!
readInit: allStrm size: size

	^ #(init) copyWith: (self string: (allStrm next: size) readStream)! !

!BootStrapReader methodsFor: 'all' stamp: 'yo 12/13/2010 15:31'!
readMethodDef: allStrm size: size

	| header message bytes literals cm strm data n |
	strm :=(allStrm next: size) readStream.
	header := self int32: strm.
	n := self string: strm.
	class := (n endsWith: ' class')
		ifTrue: [(Smalltalk at: (n copyFrom: 1 to: n size - 6) asSymbol) class]
		ifFalse: [Smalltalk at: n asSymbol].
	message := self string: strm.
	bytes := self bytes: strm.
	data := self bytes: strm.
	literals := self readArrayLiteralsFrom: data at: 0.
	cm := CompiledMethod newMethod: bytes size header: header.
	cm replaceFrom: literals size + 1 * 4 + 1 to: cm size with: bytes startingAt: 1.
	1 to: literals size do: [:i | cm literalAt: i put: (literals at: i)].
	^ {#methodDef. class. message asSymbol. cm}! !

!BootStrapReader methodsFor: 'all' stamp: 'yo 12/16/2010 00:48'!
read: strm

	| v |
	v := self int32: strm.  "size + tag"
	(v digitAt: 1) = 254 ifTrue: [^ self readClassDef: strm size: (v bitShift: -8) - 4].
	(v digitAt: 1) = 252 ifTrue: [^ self readMethodDef: strm size: (v bitShift: -8) - 4].
	(v digitAt: 1) = 250 ifTrue: [^ self readDoIt: strm size: (v bitShift: -8) - 4].
	(v digitAt: 1) = 248 ifTrue: [^ self readInit: strm size: (v bitShift: -8) - 4].
	^ nil
! !

!BootStrapReader methodsFor: 'all' stamp: 'yo 12/9/2010 00:49'!
string: strm

	^ (self bytes: strm) asString.
! !


Morph subclass: #BootStrapTester
	instanceVariableNames: 'class selectors index browser'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Bootstrap'!

!BootStrapTester methodsFor: 'all' stamp: 'yo 12/6/2010 23:50'!
class: aClass

	class := aClass.
	selectors := aClass selectors asArray.
	index := 0.
	browser := Browser openBrowser.
! !

!BootStrapTester methodsFor: 'all' stamp: 'yo 12/7/2010 00:21'!
do: aSelector

	index := (selectors indexOf: aSelector) - 1.
	^ self next.
! !

!BootStrapTester methodsFor: 'all' stamp: 'yo 12/7/2010 00:22'!
next

	| selector ret |
	index := index + 1.
	index > selectors size ifTrue: [^ self inform: 'done'].
	selector := selectors at: index.

	ret := (BootStrapReader new read: (BootStrapEncoder matchAll: {class name. class allInstVarNames. (BootStrapParser matchAll: (class sourceCodeAt: selector) string with: #method)} with: #start)).
	browser selectCategoryForClass: class.
	browser selectClass: class.
	browser selectMessageCategoryNamed: selector.
	browser selectedMessageName: selector.
	ret third symbolic inspect.
	^ ret.
! !

!BootStrapTester methodsFor: 'all' stamp: 'yo 12/7/2010 00:08'!
redo

	index := index - 1.
	^ self next.
! !

BootStrapEncoder initialize!