Object subclass: #BytecodeEngine16
	instanceVariableNames: 'ram screen cache pc receiver task dsp ds rsp rs local op mask ir clock wake ready'
	classVariableNames: 'ATable BTable MainTable NeoFalse NeoLocal NeoMapMap NeoNil NeoSmallIntMap NeoSpecialA NeoSpecialB NeoTrue'
	poolDictionaries: ''
	category: 'Neo'!
!BytecodeEngine16 commentStamp: '<historical>' prior: 0!
I simulate the hardware implementation of the 16 bit version of Neo Smalltalk. This was designed for the Oliver terminal for truck drivers.

'ram' is the main memory and everything written to its highest region is reflected to the 'screen' imageMorph.

'cache', 'ds' and 'rs' are the instruction/data cache, the data stack cache and the return stack cache respectively. The stack caches hold 16 entries for 8 hardware tasks each plus 64 entries each for two software tasks. 'local' is an additional intruction/data memory which is used to avoid having the hardware tasks mess up the main cache.

'pc', 'receiver', 'dsp', and 'rsp' are pointers (with a copy for each task) for the data needed to excute the current task, which is indicated by 'task'.

'op', 'mask', and 'ir' hold the operand, operand mask and instruction for the currently executing bytecode.

'clock' is the current cycle count (16 bits) in the simulation (50MHz clock) though it is only an approximation and when that matches 'wake' then task 15 is enabled.

'ready' has one bit for each of the 16 tasks and if the corresponding bit is 1 then that task is ready to be executed. Higher numbered ready tasks always execute before lower numbered ones.!


!BytecodeEngine16 methodsFor: 'input-output' stamp: 'jecel 11/24/2005 12:56'!
incClock: delta
	"advance the clock by requested ammount and see if it is time to wake up"

	| newClock |
	newClock _ clock + delta.
     newClock >= (1<<16) ifTrue: [newClock _ newClock - (1<<16)]. "wrap around"
     ((clock < wake and: [wake <= newClock]) or: "normal case"
     [clock > newClock and: [clock > wake and: [wake <= newClock]]]) "wrapped"
            ifTrue: [ready _ ready bitOr: 1<<15].
     clock _ newClock! !

!BytecodeEngine16 methodsFor: 'input-output' stamp: 'jecel 12/5/2005 21:24'!
ioAt: field
	"reads the indicated io port"

	field = 0 ifTrue: [ ^ ready ].
     field = 14 "7" ifTrue: [ ^ clock bitAnd: 16r0FFFE "fix me!!!!!!!!" ].
     ^ self error: 'invalid io port'! !

!BytecodeEngine16 methodsFor: 'input-output' stamp: 'jecel 12/5/2005 20:09'!
ioAt: field put: obj
	"writes to the indicated io port"

	field = 0 ifTrue: [ ^ ready _ obj ].
     field = 14 "7" ifTrue: [ ^ wake _ obj ].
     ^ self error: 'invalid io port'! !


!BytecodeEngine16 methodsFor: 'initialize-release' stamp: 'jecel 11/23/2005 19:01'!
initialize
	"set the default RAM size"

	self initializeRam: 8*1024*1024. "the size of the Oliver board"! !

!BytecodeEngine16 methodsFor: 'initialize-release' stamp: 'jecel 11/28/2005 21:27'!
initializeRam: bytes
	"creates memories and sets all the variables to their initial values"

 	ram := ZArray new: bytes // 2.
     screen := ImageMorph new.
     screen image: (Form extent: 640@480 depth: 32).
     screen image fillBlack.
     screen openInWorld. 
     cache := ZArray new: 1024.
     pc := ZArray new: 16. "entries 1,2,3,5,6 and 7 are not used"
     receiver := ZArray new: 16.
     dsp := ZArray new: 16.
     ds := ZArray new: 256.
     rsp := ZArray new: 16.
     rs := ZArray new: 256.
     local := ZArray new: 512.
     self reset! !

!BytecodeEngine16 methodsFor: 'initialize-release' stamp: 'jecel 12/7/2005 18:42'!
reset
	"sets all the variables to their initial values"

     | boot |
     0 to: cache size - 1 do: [:i | cache at: i put: 16r0FFFF].
     task := 15.
     pc at: task put: 0.
     receiver at: task put: NeoLocal. "local memory"
     ready := 1<<task. "only task 15 is initially ready to execute"
     clock := 0. "simulation starts from the begining"
     wake := 0. "task 15 is ready anyway"
     dsp at: task put: 0.
     rsp at: task put: 0.
     op := 0.
     mask := 0.
     ir := 0.
     boot := #(
             16r8610 "literal 6, push 0"
             16r9191 "loop: tmp 1, tmp 1"
             16r20D0 "add, pop"
             16r1291 "push 1, tmp 1"
             16r30D1 "sub, tmpPut 1"
             16r525B "jump loop"
             16rC1A0

            16r84A0 "literal 4, ind 0"
            16r01E1 "indPut 1,1"
            16r8546 "literal 5, send 6"
            16r5657 "jump here"
            16r0003 "obj 1"
            16r000A "integer 5"
            16r0008 "factorial"

           16r8C08 "0 literal C"
           16r0000 16rFE8B "2 varPut receiver14, literal B"
           16r0800 16r01FE "6 varPut pc14"
           16rB789 "A loop: var clock, literal 9"
           16r20F7 "C add, varPut wake"
           16r8AF0 "E literal A, varPut ready"
           16r005A "10 jump loop"
           16r0030 "12 raw integer 48"
           16r4000 "14 integer task 14"
           16r003C "16 fact"
           16r002C "18 NeoLocal"
           16r000E "1A integer 7"
           16r0000  "1C  nop"
           16r1288 "1E fact: push 1, literal 8 - pc has been incremented!!!!!!"
           16r9191 "20 tmp 1, tmp 1"
           16r21D2 "22 mult, tmpPut 2"
           16r1291 "24 push 1, tmp 1"
           16r30D1 "26 sub, tmpPut 1"
           16r9012 "28 tmp 0, push 1"
           16r2470 "2A less, jumpTrue 0"
           16r91FE "2C tmp 1, varPut 14 (nop antes)"
           16r5E5E "2E jump here, jump here"
           16r000E "30 integer 7"
     ).
     1 to: boot size do: [:i | local at: i-1 put: (boot at: i) ].! !


!BytecodeEngine16 methodsFor: 'testing' stamp: 'jecel 11/22/2005 21:00'!
isIntegerObject: oop
	"checks that an object reference is an encoded small integer"

	^ (oop bitAnd: 1) = 0! !


!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 11/30/2005 17:36'!
add
	"bytecode 20"

	self combineIntsUsing: [:a :b | a + b ] else: [ ^self send: 16r00 to: NeoSpecialA ]
           "0 + 0 = 0 so tag should be ok"! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 11/30/2005 17:36'!
and
	"bytecode 22"

	self combineIntsUsing: [:a :b | a bitAnd: b ] else: [ ^self send: 16r04 to: NeoSpecialA ]
             "0 bitAnd: 0 = 0 so tag should be ok"! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 11/30/2005 17:37'!
andnot
	"bytecode 32"

	self combineIntsUsing: [:a :b | (a bitAnd: b bitInvert) bitAnd: 16r0FFFE] "force tag"
                                     else: [ ^self send: 16r04 to: NeoSpecialB ]! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 06:52'!
at
	"bytecode 28"

	| obj index |
     obj _ receiver at: task.
     index _ self dsPop.
     self checkBound: obj index: index else: [ ^ self send: 16r10 to: NeoSpecialA ].
     self dsPush: (self object: obj offset: index+6). "skip headers"! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 09:27'!
atEnd
	"bytecode 2A"

	| vec |
     vec := self dsPop.
     (self object: vec offset: 4 "2") = 8 "4" ifFalse: [ ^ self send: 16r14 to: NeoSpecialA ].
     (self object: vec offset: 8 "4 = field 1") >
     (self object: vec offset: 12 "field 3") ifTrue: [ ^ NeoTrue ] ifFalse: [ ^ NeoFalse ] 
! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 06:54'!
atPut
	"bytecode 38"

	| obj index |
     obj := receiver at: task.
     index := self dsPop.
     self checkBound: obj index: index else: [ ^ self send: 16r10 to: NeoSpecialB ].
     self object: obj offset: index+6 put: self dsPop. "skip headers"! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 1/11/2006 20:36'!
block
	"bytecode 2F"

	| items blk |
     (self isIntegerObject: (self dsAt: 1)) ifFalse: [ ^ self send: 16r1E to: NeoSpecialA ].
     items := self asInt: self dsPop.
     blk := self allocType: 1 size: 5+items else: [ ^ self send: 16r1E to: NeoSpecialA ].
     1 to: items+1 do: [ :i | self object: blk offset: 6+(2*i) put: self dsPop ].
     self object: blk offset: 6 put: (receiver at: task).
     self dsPush: blk.! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 07:04'!
clear
	"bytecode 36"

	| port |
     port _ task bitAnd: 7.
     self ioAt: port put: (((self ioAt: port) bitAnd: (self dsPop bitInvert)) bitAnd: 16r0FFFF)! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 11/30/2005 11:29'!
equal
	"bytecode 25"

	self dsPop = self dsPop ifTrue: [self dsPush: NeoTrue] ifFalse: [self dsPush: NeoFalse]! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 2/9/2006 20:34'!
error
	"undefined - currently 2B, 2C, 2D, 3B"

	self error: 'this bytecode has not been defined'! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 11/30/2005 21:00'!
greater
	"bytecode 34"

	| arg1 arg2 |
	arg1 := self dsAt: 1.
     arg2 := self dsAt: 2.
     (((self isIntegerObject: arg1) not) or:
     [(self isIntegerObject: arg2) not]) ifTrue: [ ^self send: 16r08 to: NeoSpecialB ].
     self dsPop. self dsPop.
     (self asInt: arg1) > (self asInt: arg2) ifTrue: [self dsPush: NeoTrue]
                                                                      ifFalse: [self dsPush: NeoFalse]
! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 11/30/2005 17:40'!
int
	"bytecode 35"

	(self isIntegerObject: self dsPop) ifTrue: [self dsPush: NeoTrue] 
                                                               ifFalse: [self dsPush: NeoFalse]! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 1/11/2006 20:44'!
jumpInd
	"bytecode 2D"

     (self isIntegerObject: (self dsAt: 1)) ifFalse: [ ^ self send: 16r1A to: NeoSpecialA ].
     pc at: task put: self dsPop.
! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 11/30/2005 21:00'!
less
	"bytecode 24"

	| arg1 arg2 |
	arg1 := self dsAt: 1.
     arg2 := self dsAt: 2.
     (((self isIntegerObject: arg1) not) or:
     [(self isIntegerObject: arg2) not]) ifTrue: [ ^self send: 16r08 to: NeoSpecialA ].
     self dsPop. self dsPop.
     (self asInt: arg1) < (self asInt: arg2) ifTrue: [self dsPush: NeoTrue]
                                                                      ifFalse: [self dsPush: NeoFalse]
! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 1/11/2006 20:37'!
mkind
	"bytecode 3E"

	| items ind |
     (self isIntegerObject: (self dsAt: 1)) ifFalse: [ ^ self send: 16r1C to: NeoSpecialB ].
     items := self asInt: self dsPop.
     ind := self allocType: 0 size: 3+items else: [ ^ self send: 16r1C to: NeoSpecialB ].
     0 to: items do: [ :i | self object: ind offset: 6+(2*i) put: self dsPop ].
     self dsPush: ind.! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 11/29/2005 20:36'!
mult
	"bytecode 21"

	self combineIntsUsing: [:a :b | a * (b>>1) ] else: [ ^self send: 16r02 to: NeoSpecialA ]! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 09:27'!
next
	"bytecode 29"

	| vec index limit |
     vec := self dsPop.
     (self object: vec offset: 4 "2") = 8 "4" ifFalse: [ ^ self send: 16r12 to: NeoSpecialA ].
     index := self object: vec offset: 8 "4 = field 1".
     limit := self object: vec offset: 12.
     index > limit ifTrue: [ index := index \\ limit ]. "wrap around"
     self dsPush: (self object: (self object: vec offset: 6) offset: index+6). "skip headers"
     self object: vec offset: 8 put: (index + (self object: vec offset: 10)). "step"
    ! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 09:27'!
nextPut
	"bytecode 39"

	| vec index limit |
     vec := self dsPop.
     (self object: vec offset: 4 "2") = 8 "4" ifFalse: [ ^ self send: 16r12 to: NeoSpecialB ].
     index := self object: vec offset: 8 "4 = field 1".
     limit := self object: vec offset: 12.
     index > limit ifTrue: [ index := index \\ limit ]. "wrap around"
     self object: (self object: vec offset: 6) offset: index+6 put: self dsPop. "skip headers"
     self object: vec offset: 8 put: (index + (self object: vec offset: 10)). "step"
    ! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 11/30/2005 17:37'!
or
	"bytecode 23"

	self combineIntsUsing: [:a :b | a bitOr: b ] else: [ ^self send: 16r06 to: NeoSpecialA ]
           "0 bitOr: 0 = 0 so tag should be ok"! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 1/11/2006 20:47'!
perform
	"bytecode 3D"

     | selector |
     (self isIntegerObject: (self dsAt: 1)) ifFalse: [ ^ self send: 16r1A to: NeoSpecialB ].
     selector _ self dsPop.
     self send: selector to: (self dsAt: 1)! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 10/2/2006 21:22'!
pushSelf
	"bytecode 3C"

     self dsPush: (receiver at: task)! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 08:30'!
rawAdd
	"bytecode 0120"

	| arg1 arg2 |
     arg1 _ self dsPop.
     arg2 _ self dsPop.
     self dsPush: ((arg1+arg2) bitAnd: 16r0FFFF)! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 08:31'!
rawAnd
	"bytecode 0122"

	| arg1 arg2 |
     arg1 := self dsPop.
     arg2 := self dsPop.
     self dsPush: ((arg1 bitAnd: arg2) bitAnd: 16r0FFFF)! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 08:31'!
rawAndnot
	"bytecode 0132"

	| arg1 arg2 |
     arg1 := self dsPop.
     arg2 := self dsPop.
     self dsPush: ((arg1 bitAnd: arg2 bitInvert) bitAnd: 16r0FFFF)! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 08:32'!
rawMult
	"bytecode 0121"

	| arg1 arg2 |
     arg1 := self dsPop.
     arg2 := self dsPop.
     self dsPush: ((arg1 * arg2) bitAnd: 16r0FFFF)! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 08:32'!
rawOr
	"bytecode 0123"

	| arg1 arg2 |
     arg1 := self dsPop.
     arg2 := self dsPop.
     self dsPush: ((arg1 bitOr: arg2) bitAnd: 16r0FFFF)! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 09:01'!
rawRotate
	"bytecode 0131"

	| arg1 arg2 rot |
     arg1 := self dsPop.
     arg2 := self dsPop bitAnd: 16r0FFFE. "pretend it is an integer in any case"
     rot := self asInt: arg1.
     self dsPush: ((rot < 0 ifTrue: [ arg2 >> rot negated ]
                                          ifFalse: [ (arg2 << rot) bitOr: (arg2 >> (16 - rot)) ])
                                     bitAnd: 16r0FFFF).! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 08:33'!
rawSub
	"bytecode 0130"

	| arg1 arg2 |
     arg1 := self dsPop.
     arg2 := self dsPop.
     self dsPush: ((arg1 - arg2) bitAnd: 16r0FFFF)! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 08:33'!
rawXor
	"bytecode 0133"

	| arg1 arg2 |
     arg1 := self dsPop.
     arg2 := self dsPop.
     self dsPush: ((arg1 bitXor: arg2) bitAnd: 16r0FFFF)! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 1/11/2006 20:38'!
retblk
	"bytecode 3F"

	| items blk |
     (self isIntegerObject: (self dsAt: 1)) ifFalse: [ ^ self send: 16r1E to: NeoSpecialB ].
     items := self asInt: self dsPop.
     blk := self allocType: 2 size: 7+items else: [ ^ self send: 16r1E to: NeoSpecialB ].
     3 to: items+3 do: [ :i | self object: blk offset: 6+(2*i) put: self dsPop ].
     self object: blk offset: 6 put: (rsp at: task).
     self object: blk offset: 8 put: (dsp at: task).
     self object: blk offset: 10 put: (receiver at: task).
     self dsPush: blk.! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 09:14'!
rewind
	"bytecode 3A"

	| vec obj |
     vec _ self dsPop.
     (self object: vec offset: 4 "2") = 8 "4" ifFalse: [ ^ self send: 16r14 to: NeoSpecialB ].
     obj _ self object: vec offset: 6 "3 = field 0".
     self object: vec offset: 8 "4 = field 1" put: 0. "initial index"
     self object: vec offset: 10 "field 2" put: 2. "step = 1"
     self object: vec offset: 12 "field 3" put:
             (self object: obj offset: 4 "size"). "assume obj is a vector"! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 08:14'!
rotate
	"bytecode 31"

	| arg1 arg2 rot sarg2 |
     arg1 := self dsAt: 1.
     arg2 := self dsAt: 2.
     rot := self asInt: arg1.
     ((self isIntegerObject: arg1) not or:
     [(self isIntegerObject: arg2) not or:
     [rot > 14 or:
     [rot < -15]]]) ifTrue: [ ^ self send: 16r02 to: NeoSpecialB ].
     self dsPop.
     self dsPop.
     sarg2 := arg2 >> 1.
     self dsPush: ((rot < 0 ifTrue: [ arg2 >> rot negated ]
                                          ifFalse: [ ((sarg2 << rot) bitOr: (sarg2 >> (15 - rot)))<<1 ])
                            bitAnd: 16r0FFFE).! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 07:05'!
set
	"bytecode 27"

	| port |
     port := task bitAnd: 7.
     self ioAt: port put: (((self ioAt: port) bitOr: self dsPop) bitAnd: 16r0FFFF)! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 11/29/2005 20:36'!
sub
	"bytecode 30"

	self combineIntsUsing: [:a :b | a - b ] else: [ ^self send: 16r00 to: NeoSpecialB ]! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 07:02'!
test
	"bytecode 26"

	self dsPush: (((self ioAt: (task bitAnd: 7)) bitAnd: self dsPop) bitAnd: 16r0FFFF) "raw"! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 10/2/2006 21:08'!
thisCtx
	"bytecode 2C"

     | context |
	(self isIntegerObject: (self rsAt: 1)) ifFalse: [ ^ self dsPush: (self rsAt: 1) ].
                     "if a context object was previously created, just use that"
     context := self allocType: 3 size: 6 else: [ ^ self send: 16r18 to: NeoSpecialA ].
     self object: context offset: 6 put: (rsp at: task).
     self object: context offset: 8 put: (dsp at: task).
     self dsPush: context.
     self rsPush: context.  "just a marker for reuse - return pops this"! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 12/7/2005 07:06'!
toggle
	"bytecode 37"

	| port |
     port := task bitAnd: 7.
     self ioAt: port put: (((self ioAt: port) bitXor: self dsPop) bitAnd: 16r0FFFF)! !

!BytecodeEngine16 methodsFor: 'zero address bytecodes' stamp: 'jecel 11/30/2005 17:38'!
xor
	"bytecode 33"

	self combineIntsUsing: [:a :b | a bitXor: b ] else: [ ^self send: 16r06 to: NeoSpecialB ]
           "0 bitXor: 0 = 0 so tag should be ok"! !


!BytecodeEngine16 methodsFor: 'bytecode helpers' stamp: 'jecel 1/19/2006 20:56'!
allocType: map size: words else: block
	"create a new vector-like object with the indicated size"

     | oop oopp segment segp addr addrlow sv0 sv1 |
     oopp := 2*(16r01F0+map).
     segp := 2*(16r01F0+words).
     oop := self object: NeoLocal offset: oopp.
     oop = NeoNil ifTrue: [ ^ block value ].
     self object: NeoLocal offset: oopp put: (self object: oop offset: 6). "save next in list"
     words > 4 ifTrue: [
                           segment := self object: NeoLocal offset: segp.
                           segment = NeoNil ifTrue: [ ^ block value ].
                           addrlow := (self object: NeoLocal offset: segp-32).
                           addr := ((segment bitAnd: 16r0FFF) << 16) + addrlow.
                           sv0 := ram at: addr. "remember next in list"
                           sv1 := ram at: addr+1.
                           self object: oop offset: 0 put: (segment bitOr: 16rC000).  "put old free memory in object"
                           self object: oop offset: 2 put: addrlow.
                           self object: NeoLocal offset: segp put: sv0.  "save next in list"
                           self object: NeoLocal offset: segp-32 put: sv1.
                    ]
                    ifFalse: [
                           self object: oop offset: 0 put: 16rC000. "mark as black, vector"
                           self object: oop offset: 2 put: 0. "no extra memory"
                    ].
      self object: oop offset: 4 put: 2*(words-3).
      ^ oop! !

!BytecodeEngine16 methodsFor: 'bytecode helpers' stamp: 'jecel 11/30/2005 21:04'!
asInt: oop
	"return the signed SmallInteger corresponding to oop (which
       must have been previously verified to actually be an integer)"

	((oop bitAnd: 16r08000) = 0) ifTrue: [ ^ oop>>1 ].
     ^ (16r07FFF bitInvert) bitOr: (oop>>1)! !

!BytecodeEngine16 methodsFor: 'bytecode helpers' stamp: 'jecel 4/12/2006 11:27'!
checkBound: obj index: num else: block
	"see if num is a valid index for vector obj"

	| limit |
	(self isIntegerObject: num) ifFalse: [ ^ block value ].
     "check that obj is a vector"
     ((self object: obj offset: 0) bitAnd: 16r1000) = 0 ifFalse: [ ^ block value ].
     limit := self object: obj offset: 4. "field 2 is the size"
     num < limit ifFalse: [ ^ block value ].
     ^ true! !

!BytecodeEngine16 methodsFor: 'bytecode helpers' stamp: 'jecel 11/29/2005 21:03'!
combineIntsUsing: mathBlock else: sendBlock
	"combine two integers using the block into another integer. If
      either an argument or the result are not the right type then
      a regular message send is done instead"

	| arg1 arg2 result highBits |
	arg1 := self dsAt: 1.
     arg2 := self dsAt: 2.
     result := mathBlock value: arg1 value: arg2.
     highBits := result bitAnd: (16r0FFFE bitInvert).
     (((self isIntegerObject: arg1) not) or:
     [((self isIntegerObject: arg2) not) or:
     [(highBits ~= 0) and: [highBits ~= 16r0FFFF bitInvert]]]) ifTrue: [^ sendBlock value].
     self dsPop. "throw away arg1"
     self dsAt: 1 put: result. "replace arg2"! !

!BytecodeEngine16 methodsFor: 'bytecode helpers' stamp: 'jecel 11/29/2005 17:40'!
lit
	"get the literal indicated by op"

	| addr |
	addr _ (((pc at: task)>>1) bitAnd: mask<<1) bitOr: op<<1.
     ^ self object: (self getCode: (receiver at: task)) 
                 offset: addr.
! !

!BytecodeEngine16 methodsFor: 'bytecode helpers' stamp: 'jecel 12/7/2005 03:20'!
send: selector to: obj
	"send the indicated message to obj"

	self rsPush: (receiver at: task).
     self rsPush: (pc at: task).
     receiver at: task put: obj.
     pc at: task put: ((selector<<2) bitAnd: 16r0FFFE). "4 bytes per entry"
     self incClock: 1.
! !


!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 12/7/2005 05:11'!
constant
	"bytecode 1X"

	self dsPush: (#(16r0000  "0"
                                 16r0001 "map for small integers"
                                 16r0002  "1"
                                 16r000B "nil"
                                 16r0004  "2"
                                 16r0013  "false"
                                 16r0006  "3"
                                 16r001B  "true"
                                 16rFFF0  "-4"
                                 16r0021   "map for maps"
                                 16rFFF2  "-3"
                                 16r002B  "local memory"
                                 16rFFF4  "-2"
                                 16r0033  "special A"
                                 16rFFF6  "-1"
                                 16r003B  "special B"
                                ) at: op+1)! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 12/7/2005 03:42'!
indirect
	"bytecode AX"

	| indVec index |
     indVec _ self dsAt: (op bitAnd: 16r0F) + 1.
     index _ (op >> 4) << 1. "normally zero"
     self checkBound: indVec index: index else: [ ^ self error: 'invalid index' ].
     self dsPush: (self object: indVec offset: index + 6). "three header words"! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 12/7/2005 03:45'!
indirectPut
	"bytecode EX"

	| indVec index |
     indVec := self dsAt: (op bitAnd: 16r0F) + 1.
     index := (op >> 4) << 1. "normally zero"
     self checkBound: indVec index: index else: [ ^ self error: 'invalid index' ].
     self object: indVec offset: index + 6 put: self dsPop. "three header words"! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 11/28/2005 21:18'!
jump
	"bytecode 5X"

	pc at: task put: (((pc at: task) bitAnd: mask<<1) bitOr: op<<1)! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 11/29/2005 17:25'!
jumpFalse
	"bytecode 6X"

	self dsPop = NeoFalse ifTrue: [self jump]! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 11/29/2005 17:26'!
jumpTrue
	"bytecode 7X"

	self dsPop = NeoTrue ifTrue: [self jump]! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 11/29/2005 17:43'!
literal
	"bytecode 8X"

	self dsPush: self lit! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 11/24/2005 20:40'!
prefix
	"bytecode 0X"

	self error: 'prefix is handled in main loop'! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 12/7/2005 06:02'!
return
	"bytecode CX"

	| aPC newSP |
     [ aPC := self rsPop. self isIntegerObject: aPC ] whileFalse. "eliminate contexts"
     pc at: task put: aPC.
     receiver at: task put: self rsPop.
     self dsAt: op+1 put: (self dsAt: 1). "return the value"
     newSP _ (dsp at: task) - op. "cut back the stack"
     self checkSP: newSP.
     dsp at: task put: newSP.
     self incClock: 2. "this is the best case"! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 12/7/2005 03:49'!
send
	"bytecode 4X"

	self send: self lit to: (self dsAt: 1)! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 11/24/2005 20:40'!
specialA
	"bytecode 2X"

	self error: 'specialA is handled in main loop'! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 11/24/2005 20:41'!
specialB
	"bytecode 3X"

	self error: 'specialB is handled in main loop'! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 11/29/2005 17:52'!
tmp
	"bytecode 9X"

	 self dsPush: (self dsAt: op+1)! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 11/29/2005 17:49'!
tmpPut
	"bytecode DX"

	self dsAt: op put: self dsPop  "after pop (dsAt: 0) points previous (dsAt: 1)"! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 11/29/2005 17:51'!
var
	"bytecode BX"

	self dsPush: (self object: (receiver at: task) offset: op<<1)! !

!BytecodeEngine16 methodsFor: 'one address bytecodes' stamp: 'jecel 11/29/2005 17:53'!
varPut
	"bytecode FX"

	self object: (receiver at: task) offset: op<<1 put: self dsPop! !


!BytecodeEngine16 methodsFor: 'stacks' stamp: 'jecel 11/24/2005 20:03'!
checkSP: sp
	"see if the selected address is valid in the stack"

	task > 7 ifTrue: [ "hardware task"
                            sp < 0 ifTrue: [self error: 'underflow'].
                            sp > 15 ifTrue: [self error: 'overflow'].
                   ] ifFalse: [ "software task"
                            sp < 0 ifTrue: [self error: 'underflow - please fix'].
                            sp > 63 ifTrue: [self error: 'overflow - please fix'].
                   ].! !

!BytecodeEngine16 methodsFor: 'stacks' stamp: 'jecel 11/24/2005 20:28'!
dsAt: offset
	"reads the data at offset depth in the data stack"

	| sp |
     sp := (dsp at: task) - offset.
     self checkSP: sp.
	^ ds at: (16*task)+sp! !

!BytecodeEngine16 methodsFor: 'stacks' stamp: 'jecel 11/24/2005 20:28'!
dsAt: offset put: obj
	"writes the data at offset depth in the data stack"

	| sp |
     sp := (dsp at: task) - offset.
     self checkSP: sp.
	ds at: (16*task)+sp put: obj! !

!BytecodeEngine16 methodsFor: 'stacks' stamp: 'jecel 11/24/2005 20:22'!
dsPop
	"pops an element from the data stack"

	| sp |
     sp := (dsp at: task) - 1.
	self checkSP: sp.
     dsp at: task put: sp.
     ^ ds at: (16*task)+sp! !

!BytecodeEngine16 methodsFor: 'stacks' stamp: 'jecel 11/24/2005 20:22'!
dsPush: obj
	"pushes an element into the data stack"

	| sp |
     sp := dsp at: task.
     ds at: (16*task)+sp put: obj.
     sp := sp + 1.
	self checkSP: sp.
     dsp at: task put: sp.
! !

!BytecodeEngine16 methodsFor: 'stacks' stamp: 'jecel 11/24/2005 20:29'!
rsAt: offset
	"reads the data at offset depth in the return stack"

	| sp |
     sp := (rsp at: task) - offset.
     self checkSP: sp.
	^ rs at: (16*task)+sp! !

!BytecodeEngine16 methodsFor: 'stacks' stamp: 'jecel 11/24/2005 20:29'!
rsAt: offset put: obj
	"writes the data at offset depth in the return stack"

	| sp |
     sp := (rsp at: task) - offset.
     self checkSP: sp.
	rs at: (16*task)+sp put: obj! !

!BytecodeEngine16 methodsFor: 'stacks' stamp: 'jecel 11/24/2005 20:21'!
rsPop
	"pops an element from the return stack"

	| sp |
     sp := (rsp at: task) - 1.
	self checkSP: sp.
     rsp at: task put: sp.
     ^ rs at: (16*task)+sp! !

!BytecodeEngine16 methodsFor: 'stacks' stamp: 'jecel 11/24/2005 20:21'!
rsPush: obj
	"pushes an element into the return stack"

	| sp |
     sp := rsp at: task.
     rs at: (16*task)+sp put: obj.
     sp := sp + 1.
	self checkSP: sp.
     rsp at: task put: sp.
! !


!BytecodeEngine16 methodsFor: 'files' stamp: 'jecel 11/24/2005 16:17'!
hex2for: num on: stream
	"write num as two hexadecimal digits on stream"

	| digits |
     digits := '0123456789ABCDEF'.
     stream nextPut: (digits at: 1+((num >> 4) bitAnd: 16r0F)).
     stream nextPut: (digits at: 1+(num bitAnd: 16r0F)).! !

!BytecodeEngine16 methodsFor: 'files' stamp: 'jecel 11/24/2005 18:22'!
hex2in: line startingAt: index
	"read two hexadecimal digits from line and return an integer"

     | digits |
     digits := '0123456789abcdef'.
	^ (((digits indexOf: (line at: index) asLowercase ifAbsent: [self error: 'invalid hex'])-1)<<4) +
           ((digits indexOf: (line at: index+1) asLowercase ifAbsent: [self error: 'invalid hex'])-1).! !

!BytecodeEngine16 methodsFor: 'files' stamp: 'jecel 11/24/2005 18:15'!
hex4for: num on: stream
	"write num as four hexadecimal digits on stream"

	self hex2for: num>>8 on: stream. "big endian"
     self hex2for: num on: stream. "hex2for:on: does the needed masking"! !

!BytecodeEngine16 methodsFor: 'files' stamp: 'jecel 11/24/2005 18:25'!
hex4in: line startingAt: index
	"read four hexadecimal digits from line and return an integer"

	^ ((self hex2in: line startingAt: index)<<8) + "big endian"
           (self hex2in: line startingAt: index+2).! !

!BytecodeEngine16 methodsFor: 'files' stamp: 'jecel 11/24/2005 18:35'!
loadFileNamed: name
	"the contents of ram is read from the indicated file in Intel HEX format"

	| segment addr check bytes type stream line data wordAddr |
	segment := 0.
     addr := 0.
     check := 0.
     stream := StandardFileStream readOnlyFileNamed: name.
     [stream atEnd or: [line := stream nextLine. line = ':00000001FF' "end record"]] whileFalse: [
         line first = $: ifFalse: [self error: 'bad line in file - expecting colon'].
         bytes := self hex2in: line startingAt: 2.
         check := bytes.
         addr := self hex4in: line startingAt: 4.
         check := check + addr + (addr>>8).
         line size = (11+(2*bytes)) ifFalse: [self error: 'bad line in file - wrong size'].
         type := self hex2in: line startingAt: 8.
         check := check + type.
         type caseOf: {
              [0]->[ "data record"
                          bytes odd ifTrue: [self error: 'please implement odd byte counts'].
                          1 to: bytes//2 do: [:i|
                               data := self hex4in: line startingAt: 6+(4*i).
                               check := check + data + (data>>8).
                               wordAddr _ segment+addr+(i-1).
                               ram at: wordAddr put: data.
                               (wordAddr + 153600 "video size") > ram size 
                                               ifTrue: [self updateVideo: wordAddr].
                          ].
                          check := check + (self hex2in: line startingAt: 10+(2*bytes)).
                       ].
              [1]->[ "end of file"
                          self error: 'end of file should be handled elsewhere'
                       ].
              [2]->[ "extended segment"
                          segment := self hex4in: line startingAt: 10.
                          check := check + segment + (segment>>8).
                          segment := segment<<4. "8086 addressing"
                          check := check + (self hex2in: line startingAt: 14).
                       ].
              [3]->[ "start segment - we ignore that"
                          check := 0. "we won't actually check this line"
                       ].
              [4]->[ "extended linear address"
                          segment := self hex4in: line startingAt: 10.
                          check := check + segment + (segment>>8).
                          segment := segment<<16. "386 addressing"
                          check := check + (self hex2in: line startingAt: 14).
                       ].
              [5]->[ "start linear address - we ignore that"
                          check := 0. "we won't actually check this line"
                       ].
         }.
         (check bitAnd: 16r0FF) = 0 ifFalse: [self error: 'checksum error'].
     ].
     stream close.! !

!BytecodeEngine16 methodsFor: 'files' stamp: 'jecel 11/24/2005 16:52'!
saveFileNamed: name
	"the contents of ram is saved on the indicated file in Intel HEX format"

	| segment addr check words stream data |
	segment := 0.
     addr := 0.
     check := 0.
     words := 0.
     stream := StandardFileStream newFileNamed: name.
     [addr < ram size] whileTrue: [
         "skip empty regions"
         [(addr < ram size) and: [(ram at: addr) isNil]] whileTrue: [addr := addr + 1].
         "check record size"
         [words <= 8 and: "split into blocks of 16 bytes or less"
         [((addr+words) < ram size) and: "that are still in memory"
         [(ram at: addr+words) isNil not]]] "and have valid data"
                       whileTrue: [words := words + 1]. "first word is checked again - no harm done"
         words > 0 ifTrue: [
             segment = (addr>>16) ifFalse: [  "changed segment"
                  segment := addr>>16.
                  stream nextPutAll: ':02000004'. "extended linear address record"
                  self hex4for: segment on: stream.
                  self hex2for: 256 - ((2+4+segment+(segment>>8)) bitAnd: 16r0FF) on: stream.
                  stream cr.
             ].
             stream nextPutAll: ':'. "start of data record"
             check := words*2.  "checksum includes everything except first character"
             self hex2for: words*2 on: stream.
             check := check + addr + (addr>>8).
             self hex4for: addr on: stream.
             stream nextPutAll: '00'.
             0 to: words-1 do: [:i |
                 data := ram at: addr + i.
                 self hex4for: data on: stream.
                 check := check + data + (data>>8).
             ].
             self hex2for: 256 - (check bitAnd: 16r0FF) on: stream.
             stream cr.
         ].
         addr := addr + words.
         words := 0.
     ].
     stream nextPutAll: ':00000001FF'. "end record"
     stream close.! !


!BytecodeEngine16 methodsFor: 'execution' stamp: 'jecel 11/24/2005 21:32'!
checkTask
	"selects the highest priority ready task to run next"

	(ready>>task) = 1 ifTrue: [ ^ self ]. "optimizes the most common case"
     15 to: 0 by: -1 do: [:i | (ready>>i) = 1 ifTrue: [ ^ task _ i ]].
     self error: 'no tasks ready to run'! !

!BytecodeEngine16 methodsFor: 'execution' stamp: 'jecel 11/28/2005 21:35'!
doBytecode
	"executes one bytecode (not counting prefixes)"

	self checkTask. "time to switch yet?"
     self fetchByte.
     [(ir bitAnd: 16r0F0) = 0] whileTrue: [ "prefixes are handled here"
          mask := (mask<<4) bitOr: 16r0F.
          op := (op<<4) bitOr: (ir bitAnd: 16r0F).
          self fetchByte.
     ].
     mask := ((mask<<4) bitOr: 16r0F) bitInvert.
     op := (op<<4) bitOr: (ir bitAnd: 16r0F).
     (ir bitAnd: 16r0F0) = 16r20 ifTrue: [ "specialA is handled here"
           self perform: (ATable at: op+1)
     ] ifFalse: [ (ir bitAnd: 16r0F0) = 16r30 ifTrue: [ "specialB is handled here"
           self perform: (BTable at: op+1)
     ] ifFalse: [
           self perform: (MainTable at: (ir>>4)+1)
     ]].
     op := 0.
     mask := 0.! !

!BytecodeEngine16 methodsFor: 'execution' stamp: 'jecel 11/26/2005 21:41'!
fetchByte
	"gets the next bytecode from the instruction stream"

	| word |
	word := self object: (self getCode: (receiver at: task)) 
                            offset: (((pc at: task)>>1) bitAnd: 16r0FFFE).
     ((pc at: task) bitAnd: 2) = 0 ifTrue: [ ir := word>>8 ] ifFalse: [ ir := word bitAnd: 16r0FF ]. "high byte is even - big endian"
     pc at: task put: (pc at: task) + 2. "increment by 1"
     self incClock: 1.
! !

!BytecodeEngine16 methodsFor: 'execution' stamp: 'jecel 12/6/2005 11:33'!
getCode: oop
	"gets the code object associated with oop"

     | map |
     (oop bitAnd: 1) = 0 ifTrue: [ ^ NeoSmallIntMap ]. "small integers"
     map := (
	(oop bitAnd: 16r08000) = 0 ifFalse: [ oop bitAnd: 16r0FC01 ] ifTrue: [
     (oop bitAnd: 16r04000) = 0 ifFalse: [ oop bitAnd: 16r0FFC1 ] ifTrue: [
     oop bitAnd: 16r0FFF9]]).
	oop = map ifFalse: [ ^ map ].
     ^ NeoMapMap! !


!BytecodeEngine16 methodsFor: 'memory access' stamp: 'jecel 1/19/2006 20:57'!
cachedObject: oop offset: field
	"reads the indicated field in the object through the cache"

	| index tag slot data addr addrHigh addrLow addrStart |
	(self isIntegerObject: oop) ifTrue: [ ^ self error: 'integers do not have fields' ].
     (self isIntegerObject: field) ifFalse: [ ^ self error: 'fields must be integer' ].
     index := (oop << 1) bitAnd: 16r0FC.
     tag := ((oop >> 7) << 13) bitOr: ((self oopToInt: field)>>2).
     slot := self matchTag: tag for: index.
     slot > 0 ifTrue: [ ^ cache at: (256*slot) + index + ((self oopToInt: field) bitAnd: 3) ].  "found in cache"
     (field bitAnd: 16r8000) = 0 ifTrue: [slot := #(1 2 3) atRandom] ifFalse: [slot := 1].
     field > 6 "3" ifTrue: [ "rest of object"
                               addrHigh := (self cachedObject: oop offset: 0) bitAnd: 16r0FFF.
                               addrLow := self cachedObject: oop offset: 2. "1"
                           ] ifFalse: [ "field in object table"
                               addrHigh := oop >> 15.
                               addrLow := (oop << 1) bitAnd: 16r0FFFC.
                           ].
     addr := (addrHigh <<16) + addrLow + (self oopToInt: field).
     addrStart := addr bitAnd: 16r0FFFFFC.
     data := ram at: addr.
     "fill cache line"
     0 to: 3 do: [:word | cache at: (256*slot) + index + word put: (ram at: addrStart+word)].
     self incClock: 10. "sdram access time for four words"
     self setTag: slot for: index to: tag.
     ^ data! !

!BytecodeEngine16 methodsFor: 'memory access' stamp: 'jecel 1/19/2006 20:57'!
cachedObject: oop offset: field put: obj
	"writes the indicated field in the object through the cache"

	| index tag slot addr addrHigh addrLow addrStart mustFill |
	(self isIntegerObject: oop) ifTrue: [ ^ self error: 'integers do not have fields' ].
     (self isIntegerObject: field) ifFalse: [ ^ self error: 'fields must be integer' ].
     index := (oop << 1) bitAnd: 16r0FC.
     tag := ((oop >> 7) << 13) bitOr: ((self oopToInt: field)>>2).
     slot := self matchTag: tag for: index.
     mustFill := slot = 0.
     mustFill ifTrue: [(field bitAnd: 16r8000) = 0 ifTrue: [slot := #(1 2 3) atRandom]
                                                                                 ifFalse: [slot := 1]
                                ].
     field > 6 "3" ifTrue: [ "rest of object"
                               addrHigh := (self cachedObject: oop offset: 0) bitAnd: 16r0FFF.
                               addrLow := self cachedObject: oop offset: 2. "1"
                               mustFill ifFalse: [
                                      slot := self matchTag: tag for: index.
                                      mustFill := slot = 0.
                                      mustFill ifTrue: [(field bitAnd: 16r8000) = 0 ifTrue: [slot := #(1 2 3) atRandom]
                                                                                                                 ifFalse: [slot := 1]
                                      ].

                               ]. "check if still valid after above two accesses"
                           ] ifFalse: [ "field in object table"
                               addrHigh := oop >> 15.
                               addrLow := (oop << 1) bitAnd: 16r0FFFC.
                           ].
     addr := (addrHigh <<16) + addrLow + (self oopToInt: field).
     addrStart := addr bitAnd: 16r0FFFFFC.
     mustFill ifTrue: ["fill cache line"
         0 to: 3 do: [:word | cache at: (256*slot) + index + word 
                                                      put: (ram at: addrStart+word)].
         self incClock: 10. "memory write time for four words"
      ].
     self setTag: slot for: index to: tag.
     ram at: addr put: obj.
     cache at: (256*slot) + index + ((self oopToInt: field) bitAnd: 3) put: obj.
     (addr + 153600 "video size") > ram size ifTrue: [self updateVideo: addr].! !

!BytecodeEngine16 methodsFor: 'memory access' stamp: 'jecel 11/23/2005 16:44'!
matchTag: tag for: index
	"finds the matching (if any) slot in the cache"

	tag = ((cache at: index) bitOr: (((cache at: index+1)<<16) bitAnd: 16r3F)) "22 bits - 21:0"
                   ifTrue: [ ^ 1 ].
	tag = (((cache at: index+1)>>6) bitOr: (((cache at: index+2)<<10) bitAnd: 16r7FF)) "21 bits - 42:22"
                   ifTrue: [ ^ 2 ].
	tag = (((cache at: index+2)>>11) bitOr: ((cache at: index+3)<<5)) "21 bits - 63:43"
                   ifTrue: [ ^ 3 ].
     ^ 0! !

!BytecodeEngine16 methodsFor: 'memory access' stamp: 'jecel 12/8/2005 21:39'!
object: oop offset: field
	"handles special objects"

     | addr |
	oop = NeoLocal ifTrue: [ "local memory"
          (self isIntegerObject: field) ifFalse: [ ^ self error: 'fields must be integer' ].
          addr := (self oopToInt: field).
          self incClock: 1.
          addr <= 16r0007 ifTrue: [ ^ self ioAt: field ].
          addr <= 16r01FF ifTrue: [ ^ local at: addr ].
          addr <= 16r02FF ifTrue: [ ^ ds at: addr-16r0200 ].
          addr <= 16r03FF ifTrue: [ ^ rs at: addr-16r0300 ].
          addr <= 16r04FF ifTrue: [ ^ cache at: addr-16r0400 ].
          addr < 16r8000 ifTrue: [ ^ self error: 'invalid local address' ].
          addr <= 16r800F ifTrue: [ ^ receiver at: addr-16r8000 ].
          addr <= 16r801F ifTrue: [ ^ pc at: addr-16r8010 ].
          addr <= 16r802F ifTrue: [ ^ dsp at: addr-16r8020 ].
          addr <= 16r803F ifTrue: [ ^ rsp at: addr-16r8030 ].
          ^ self error: 'invalid local address'.
     ].
     oop = (self getCode: NeoLocal) ifTrue: [ ^ local at: (self oopToInt: field) ].
     ^ self cachedObject: oop offset: field! !

!BytecodeEngine16 methodsFor: 'memory access' stamp: 'jecel 12/8/2005 21:39'!
object: oop offset: field put: obj
	"handles special objects"

     | addr |
	oop = NeoLocal ifTrue: [ "local memory"
          (self isIntegerObject: field) ifFalse: [ ^ self error: 'fields must be integer' ].
          addr := (self oopToInt: field).
          self incClock: 1.
          addr <= 16r0007 ifTrue: [ ^ self ioAt: field put: obj ].
          addr <= 16r01FF ifTrue: [ ^ local at: addr put: obj ].
          addr <= 16r02FF ifTrue: [ ^ ds at: addr-16r0200 put: obj ].
          addr <= 16r03FF ifTrue: [ ^ rs at: addr-16r0300 put: obj ].
          addr <= 16r04FF ifTrue: [ ^ cache at: addr-16r0400 put: obj ].
          addr < 16r8000 ifTrue: [ ^ self error: 'invalid local address' ].
          addr <= 16r800F ifTrue: [ ^ receiver at: addr-16r8000 put: obj ].
          addr <= 16r801F ifTrue: [ ^ pc at: addr-16r8010 put: obj ].
          addr <= 16r802F ifTrue: [ ^ dsp at: addr-16r8020 put: obj ].
          addr <= 16r803F ifTrue: [ ^ rsp at: addr-16r8030 put: obj ].
          ^ self error: 'invalid local address'.
     ].
     self cachedObject: oop offset: field put: obj! !

!BytecodeEngine16 methodsFor: 'memory access' stamp: 'jecel 11/22/2005 21:04'!
oopToInt: oop
	"returns the number value encoded in the reference"

	(self isIntegerObject: oop) ifFalse: [^ self error: 'must be integer' ].
     ^ oop >> 1! !

!BytecodeEngine16 methodsFor: 'memory access' stamp: 'jecel 11/23/2005 19:39'!
setTag: slot for: index to: tag
	"sets the indicate slot in the cache"

	slot = 1 ifTrue: [ cache at: index put: (tag bitAnd: 16r0FFFF).
                                  cache at: index+1 put: (((cache at: index+1) bitAnd: 16r0FFC0) bitOr:
                                                                           ((tag >> 16) bitAnd: 16r3F)).
                                  ^ slot
                               ]. "22 bits - 21:0"
	slot = 2 ifTrue: [ cache at: index+1 put: (((cache at: index+1) bitAnd: 16r3F) bitOr:
                                                                           ((tag << 6) bitAnd: 16r0FFC0)).
                                  cache at: index+2 put: (((cache at: index+2) bitAnd: 16r0F800) bitOr:
                                                                           ((tag >> 10) bitAnd: 16r7FF)).
                                  ^ slot
                               ]. "21 bits - 42:22"
	slot = 3 ifTrue: [ cache at: index+2 put: (((cache at: index+2) bitAnd: 16r7FF) bitOr:
                                                                           ((tag << 11) bitAnd: 16r0F800)).
                                  cache at: index+3 put: ((tag >> 5) bitAnd: 16r0FFFF).
                                  ^ slot

                               ]. "21 bits - 63:43"
     ^ self error: 'invalid cache slot number'! !

!BytecodeEngine16 methodsFor: 'memory access' stamp: 'jecel 3/7/2006 20:20'!
updateVideo: addr
	"addr has changed in ram, so change the associated image"

	| wordAddr word pixAddr |
	wordAddr := ((320*480) + addr) - ram size.
     pixAddr := (2*(wordAddr \\ 320))@(wordAddr // 320).
     word := ram at: addr.
     screen image colorAt: pixAddr put: (Color r:((word >>12) bitAnd: 3)
                                                                                g:((word >>10) bitAnd: 3)
                                                                                b:((word >>8) bitAnd: 3)
                                                                                range: 3). "big endian"
     screen image colorAt: (pixAddr+(1@0)) put:  (Color r:((word >>4) bitAnd: 3)
                                                                                g:((word >>2) bitAnd: 3)
                                                                                b:(word bitAnd: 3)
                                                                                range: 3).
     screen changed.! !

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

BytecodeEngine16 class
	instanceVariableNames: ''!

!BytecodeEngine16 class methodsFor: 'class initialization' stamp: 'jecel 10/2/2006 21:20'!
initialize
	"set the class variables to their constant values"
     "BytecodeEngine16 initialize"

	ATable := #(add mult and or
                         less equal test set
                         at next atEnd error
                         thisCtx jumpInd error block
                         rawAdd rawMult rawAnd rawOr).
     BTable := #(sub rotate andnot xor
                          greater int clear toggle
                          atPut nextPut rewind error
                          pushSelf perform mkind retblk
                          rawSub rawRotate rawAndnot rawXor).
     MainTable := #(prefix constant specialA specialB
                                 send jump jumpFalse jumpTrue
                                 literal tmp indirect var
                                 return tmpPut indirectPut varPut).
     NeoSmallIntMap := 16r01.
     NeoNil := 16r0B.
     NeoFalse := 16r13.
     NeoTrue := 16r1B.
     NeoMapMap := 16r21.
     NeoLocal := 16r2B.
     NeoSpecialA :=16r33.
     NeoSpecialB := 16r3B.
! !


BytecodeEngine16 subclass: #Ram16Inspector
	instanceVariableNames: 'gui english ansi portugues lastGlobal lastLocal'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Neo'!
!Ram16Inspector commentStamp: '<historical>' prior: 0!
I extend the simulation of the 16 bit stack processor for Neo Smalltalk to have a friendlier user interface. Helper FacetInspector instances deal with the source code for individual objects while I take care of more global things like the object table, memory allocation and symbols.

"gui" is the window which allows memory to be inspected and changed at a relatively high level.

"numGlobals" and "numLocals" indicate how many symbols have been defined in the system. The limit is 8192 of each, with global symbols being stored starting with index 0 and locals at 8192. Each symbol has three versions stored in the "english", "portugues" and "ansi" arrays. The first two are Neo Smalltalk flexible symbols while the third is the traditional Smalltalk-80 equivalent. One of the three is also stored in the simulated RAM. The vectors contain regular Squeak strings while the simulated RAM version is a more complicated structure with multi-level arrays to reduce the number of distinct objects required.!


!Ram16Inspector methodsFor: 'user interface' stamp: 'jecel 12/18/2005 16:44'!
buildWindow
	"create a user interface for me"

	| window |
	window _ SystemWindow labelled: '16 Bit RAM Inspector'.
     window model: self.
     "insert buttons and fields"
     ^ window! !

!Ram16Inspector methodsFor: 'user interface' stamp: 'jecel 12/18/2005 16:40'!
window
	"return my window, creating it if needed"

	gui ifNil: [ gui _ self buildWindow ].
     ^ gui! !


!Ram16Inspector methodsFor: 'initialize-release' stamp: 'jecel 12/20/2005 06:16'!
clearEmptyLists
	"supposes that the whole RAM is free space and sets everything up"

	| bottom top segment offset |
	bottom := 4 * 32 * 1024. "skip the object table"
     top := ram size - (320*480). "up to the frame buffer"
     5 to: 15 do: [ :size | | segp nextBottom |
         segp := 2*(16r1F0+size).
         self object: NeoLocal offset: segp put: bottom>>16. "head of the list"
         self object: NeoLocal offset: segp-32 put: (bottom bitAnd: 16r0FFFF).
         64 timesRepeat: [ "a reasonable number of each size"
              nextBottom := bottom+size.
              ram at: bottom put: nextBottom>>16.
              ram at: bottom+1 put: (nextBottom bitAnd: 16r0FFFF).
              bottom := nextBottom.
         ].
         ram at: bottom put: NeoNil. "end of list"
         ram at: bottom+1 put: 0.
         bottom := bottom + size.
     ].
     segment := bottom>>16.
     offset := bottom bitAnd: 16r0FFFF.
     ram at: 10 put: segment. "first empty segment"
     ram at: 11 put: offset.
     ram at: 14 put: segment. "last empty segment"
     ram at: 15 put: offset.
     ram at: bottom put: (top-bottom)>>16.  "size"
     ram at: bottom+1 put: ((top-bottom) bitAnd: 16r0FFFF).
     ram at: bottom+2 put: segment. "previous empty is me"
     ram at: bottom+3 put: offset.
     ram at: bottom+4 put: segment. "next empty is also me"
     ram at: bottom+5 put: offset. "we are 15 words and up so this field is ok"! !

!Ram16Inspector methodsFor: 'initialize-release' stamp: 'jecel 12/20/2005 06:38'!
clearObjectTable
	"set the object table to an entirely empty state"

	0 to: 16r7FFF do: [ :halfoop | | index |
       index := halfoop * 4.
       ram at: index put: NeoNil. "note that the flags are all zero"
       ram at: index + 1 put: 0.
     ].
     "note that the cache is not consistent with what we did"
     "16rFC01 is the mask for the following kinds of objects"
      #(0 16r200 16r400 16r600) do: [ :typeOffset |
         16r4001 to: 16r41FE do: [ :halfoop | | index |
            index := (halfoop+typeOffset) * 4.
            ram at: index+3 put: ((halfoop+typeOffset)*2)+3.  "make linked list"
         ].
         ram at: "(4*16r41FF)+3" 16r107FF + (4*typeOffset) put: NeoNil. "end of the list"
     ].
     self object: NeoLocal offset: "2*16r01F0" 16r3E0 put: 16r8003. "list header"
     self object: NeoLocal offset: 16r3E2 put: 16r8403.
     self object: NeoLocal offset: 16r3E4 put: 16r8803.
     self object: NeoLocal offset: 16r3E6 put: 16r8C03.! !

!Ram16Inspector methodsFor: 'initialize-release' stamp: 'jecel 12/18/2005 16:38'!
initialize
	"set up my instance variables"

	super initialize.
     lastGlobal := 0.
     lastLocal := 0.
     ansi := ZArray new: 16384.
     english := ZArray new: 16384.
     portugues := ZArray new: 16384.! !

!Ram16Inspector methodsFor: 'initialize-release' stamp: 'jecel 12/19/2005 01:53'!
makeBasicObjects
	"given a totally empty memory, set up well known objects"

     "code for code"
	"small integer and symbol code"
     "nil and code"
     "false and code"
     "true and code"
     "local, specials and code"
     "symbol table"
     "frame buffer"! !


!Ram16Inspector methodsFor: 'documentation' stamp: 'jecel 12/18/2005 17:17'!
commentMemoryAllocation
	"no code - just an explanation of how new objects are created"

	"
      There are two steps to create a new object:

        1) get an OOP for it (allocate an object table entry)
        2) get a memory segment with just the right size for it

      Objects of four words or less (two fields with constant size or
      one field with variable size) live entirely in the object table
      and don't need step 2.

      There are four special kinds of objects that can be allocated
      in a bytecode: contexts, blocks, return blocks and indirection
      arrays. A number of free entries of each type are linked
      into lists pointed to from local memory.

      All other kinds of objects are created by copying some existing
      one. Step 1 starts out by finding the code object for the original
      and scanning all object table entries that share that looking
      for one that is free. If none can be found then a new code
      object entry is allocated shared with the original's and the
      process is repeated. This time object entry right after the new
      code entry should be free so it quickly yields the desired
      result. Note that there are three categories of code object
      entries (associated with 3, 31 and 511 instances each) and the
      new code entry for the same type is of a larger kind if
      possible.

      In step 2 there are two options: for objects between 5 and 15
      words there are linked lists pointed to from local memory
      with a number of free segments for each size. This is also
      used by the four bytecodes mentioned above. Any of these
      lists might be empty or the object could be larger than 15 words
      and in that case a global doubly linked list of free segments
      (sorted in address order) is searched for the first one large
      enough to fit the object.

      When memory is freed by the garbage collector it is either
      just added to the start of a list in local memory if it is
      between 5 and 15 words or inserted into the proper place
      in the global list. If this insertion makes it the neighbor
      of one (or two) free segments then they are merged back
      into a single free segment.

      The first two words in a global free segment are its size. The
      next two words are the address of the previous free segment
      and the following two the address of the next free segment.
     "! !

!Ram16Inspector methodsFor: 'documentation' stamp: 'jecel 4/12/2006 11:20'!
commentMemoryLayout
	"no code - just a description of the main memory structures"

    "
     The first bytes in RAM are part of the object table. There is one
     four word entry in the table for each object that isn't a small
     integer/symbol. These words also happen to be the first words in
     the object itself, so an extra indirection is avoided for the most
     frequently accessed fields and for small objects no other memory
     has to be allocated at all.

     The first two words combine to form a 32 bit field with the address
     of the memory area (if any) allocated for this object. Only the lowest
     28 bits are used as an address and the rest contain a few flags which
     are described below.

     For objects with variable length, such as Arrays, the third word is
     used to indicate the length and the fourth word is the field addressed
     by index zero. For objects with a constant length this information is
     stored in the code for the object (always in the sixth word of the code
     object corresponding to the slot for symbol 16r0004) and the third and
     fourth words are the first and second fields. Bit 12 in the first word is
     zero for the first kind of object and one for the second. For code objects
     the third word indicates the length and the fourth word points to the
     next (if any) code object representing the same type (their object table
     entries are different but the rest of the object is shared among them).

     The address in the object table entry points to a memory segment
     where the first four words have exactly the same contents as the
     entry itself. Since all writes to and reads from these four words are
     actually diverted to the object table entry it doesn't really matter
     what is stored in those words. This normally isn't important but in
     the case of the frame buffer the eight subobjects that represent it
     use this fact to overlap by four words so that the hardware doesn't
     have to know about and skip the object headers.

     The top three bits in the 32 bit object address field are used by the
     garbage collector. The first two indicate the status of a given entry:

        0 - entry is free
        1 - white (gc hasn't seen this object yet)
        2 - grey (gc should follow pointers in this object)
        3 - black (new object or already handled by gc)

     The next bit is set to indicate that an object doesn't have any pointers
     and should go from white directly to black. The following bit indicates
     the encoding of the object's size and was described above.
    "! !


ArrayedCollection variableSubclass: #ZArray
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Neo'!
!ZArray commentStamp: '<historical>' prior: 0!
I am roughly like regular arrays but my indexes start at 0 instead of 1!


!ZArray methodsFor: 'accessing' stamp: 'jecel 11/22/2005 21:25'!
at: index
	"fetch the indicated word"

	^ super at: index+1! !

!ZArray methodsFor: 'accessing' stamp: 'jecel 11/22/2005 21:25'!
at: index put: obj
	"store the indicated word"

	^ super at: index+1 put: obj! !


!ZArray methodsFor: 'enumerating' stamp: 'jecel 11/23/2005 19:21'!
do: aBlock 
	"Refer to the comment in Collection|do:."
	0 to: self size - 1 do:
		[:index | aBlock value: (self at: index)]! !

BytecodeEngine16 initialize!