Object subclass: #CaslAssembler instanceVariableNames: 'labels address errors consts' classVariableNames: '' poolDictionaries: '' category: 'Comet-GUI'! !CaslAssembler methodsFor: 'private' stamp: 'e-itoh 10/28/2007 21:38'! addGeneratedConstTo: aCollection | tile const | consts do: [:each | labels at: (each at: 1) put: address. const := each at: 2. tile := CaslCodeTileDC new dataText: const. address := address + (tile sizeFor: const). aCollection add: (Array with: tile with: 0 with: (self constantOfPass1From: const))]! ! !CaslAssembler methodsFor: 'private' stamp: 'e-itoh 11/1/2007 23:14'! assemblePass1: aCollection | result const | result := OrderedCollection new. aCollection doWithIndex: [:each :index | (each isKindOf: CaslCodeTile) ifTrue: [self updateLabel: each label line: index. const := self constantOfPass1From: each const. address := address + (each sizeFor: const). result add: (Array with: each with: index with: const)]]. self addGeneratedConstTo: result. ^ result! ! !CaslAssembler methodsFor: 'private' stamp: 'e-itoh 10/28/2007 21:40'! assemblePass2: aCollection | tile index const error result code decoder | decoder := CometDecoder new. error := false. result := aCollection collect: [:each | tile := each at: 1. index := each at: 2. const := each at: 3. (labels includesKey: const) ifTrue: [const := labels at: const]. code := tile codeWithConst: const decoder: decoder. code ifNil: [error := true. errors add: (Array with: index with: #invalidCode)]. code]. error ifTrue: [^ nil]. ^ result concatenation! ! !CaslAssembler methodsFor: 'private' stamp: 'e-itoh 10/31/2007 21:29'! constantOfPass1From: aString | label | aString isNil ifTrue: [^ nil]. aString isAllDigits ifTrue: [^ aString asNumber]. ((aString beginsWith: '-') and: [aString copyWithoutFirst isAllDigits]) ifTrue: [^ aString asNumber]. (aString beginsWith: '#') ifTrue: [^ Number readFrom: aString copyWithoutFirst base: 16]. (aString beginsWith: '=') ifTrue: [label := 'ZYX' , 1000 atRandom asString. consts add: (Array with: label with: aString copyWithoutFirst). ^ label]. ^ aString! ! !CaslAssembler methodsFor: 'private' stamp: 'e-itoh 11/1/2007 23:13'! updateLabel: aString line: aNumber | ret | aString ifNil: [^ self]. aString isEmpty ifTrue: [^ self]. ret := labels at: aString ifAbsentPut: address. ret ~= address ifTrue: [errors add: (Array with: aNumber with: #duplicateLabel)]! ! !CaslAssembler methodsFor: 'accessing' stamp: 'e-itoh 11/1/2007 23:16'! assembleFromMorphs: aCollection startAddress: aNumber labels: aDictionary | result code | address := aNumber. labels := aDictionary ifNil: [Dictionary new] ifNotNil: [aDictionary copy]. errors := OrderedCollection new. consts := OrderedCollection new. result := self assemblePass1: aCollection. errors notEmpty ifTrue: [^ Array with: nil with: nil with: errors asArray with: aDictionary]. code := self assemblePass2: result. ^ Array with: code with: aNumber with: errors asArray with: labels! ! BorderedMorph subclass: #CaslCodeTile instanceVariableNames: 'label opcode' classVariableNames: '' poolDictionaries: '' category: 'Comet-GUI'! !CaslCodeTile methodsFor: 'initialization' stamp: 'e-itoh 10/26/2007 19:32'! defaultBackgroundColor ^ Color green! ! !CaslCodeTile methodsFor: 'initialization' stamp: 'e-itoh 10/27/2007 21:45'! initialize super initialize. self extent: 200 @ 20; changeProportionalLayout; color: Color paleGreen; borderWidth: 1; borderColor: Color green. label := ''. self addControls. self addCloseButton! ! !CaslCodeTile methodsFor: 'private' stamp: 'e-itoh 10/31/2007 23:19'! addCloseButton | e | e := EllipseMorph new. e extent: 17 @ 17; color: Color paleRed. e addMorphCentered: (StringMorph contents: 'x') lock. e on: #mouseDown send: #delete to: self. e beSticky. self addMorphFront: e! ! !CaslCodeTile methodsFor: 'private' stamp: 'e-itoh 10/27/2007 19:16'! addControls | frame morph | frame := LayoutFrame fractions: (0 @ 0 corner: 0.35 @ 1) offsets: (20 @ 2 corner: -2 @ -2). morph := UpdatingStringMorph on: self selector: #labelText. morph contents: self labelText; putSelector: #labelText:; useStringFormat. self addMorph: morph fullFrame: frame. frame := LayoutFrame fractions: (0.35 @ 0 corner: 0.53 @ 1) offsets: (2 @ 2 corner: -2 @ -2). morph := StringMorph contents: self opcodeText. morph on: #mouseDown send: #opcodeMouseDown:to: to: self. self addMorph: morph fullFrame: frame. frame := LayoutFrame fractions: (0.53 @ 0 corner: 1 @ 1). morph := self makeOprandMorph. morph ifNotNil: [self addMorph: morph fullFrame: frame]! ! !CaslCodeTile methodsFor: 'private' stamp: 'e-itoh 10/26/2007 19:31'! labelText ^ label! ! !CaslCodeTile methodsFor: 'private' stamp: 'e-itoh 10/27/2007 10:31'! labelText: aString | str | str := aString asString. str size > 8 ifTrue: [str := str copyFrom: 1 to: 8]. label := str asUppercase! ! !CaslCodeTile methodsFor: 'private' stamp: 'e-itoh 10/26/2007 22:23'! makeOprandMorph ^ nil! ! !CaslCodeTile methodsFor: 'private' stamp: 'e-itoh 10/30/2007 11:02'! op1stDecoder: aDecoder | high low | high := aDecoder opHighOfOpcode: opcode oprand: self oprandClassName. low := self opLow. high ifNil: [^ nil]. low ifNil: [^ nil]. ^ (high bitShift: 8) bitOr: low! ! !CaslCodeTile methodsFor: 'private' stamp: 'e-itoh 10/27/2007 10:12'! opcodeStringFrom: aSymbol ^ (aSymbol asString copyWithout: $:) asUppercase! ! !CaslCodeTile methodsFor: 'private' stamp: 'e-itoh 10/27/2007 10:13'! opcodeText opcode ifNil: [^ '???']. ^ self opcodeStringFrom: opcode! ! !CaslCodeTile methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:52'! opLow ^ 0! ! !CaslCodeTile methodsFor: 'private' stamp: 'e-itoh 10/26/2007 21:16'! oprandClass ^ Smalltalk at: self oprandClassName! ! !CaslCodeTile methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:17'! oprandClassName ^ #CometOprand! ! !CaslCodeTile methodsFor: 'private' stamp: 'e-itoh 10/26/2007 22:35'! rList ^ #('GR0' 'GR1' 'GR2' 'GR3' 'GR4' 'GR5' 'GR6' 'GR7' )! ! !CaslCodeTile methodsFor: 'private' stamp: 'e-itoh 10/26/2007 22:35'! xList ^ #('0' 'GR1' 'GR2' 'GR3' 'GR4' 'GR5' 'GR6' 'GR7' )! ! !CaslCodeTile methodsFor: 'accessing' stamp: 'e-itoh 10/31/2007 22:22'! codeWithConst: aString decoder: aDecoder | ret | ret := self op1stDecoder: aDecoder. ret ifNil: [^ nil]. ^ Array with: ret! ! !CaslCodeTile methodsFor: 'accessing' stamp: 'e-itoh 10/28/2007 20:12'! const ^ nil! ! !CaslCodeTile methodsFor: 'accessing' stamp: 'e-itoh 10/26/2007 20:26'! label ^ label! ! !CaslCodeTile methodsFor: 'accessing' stamp: 'e-itoh 10/26/2007 20:26'! opcode ^ opcode! ! !CaslCodeTile methodsFor: 'accessing' stamp: 'e-itoh 10/26/2007 19:42'! opcode: aSymbol opcode := aSymbol! ! !CaslCodeTile methodsFor: 'accessing' stamp: 'e-itoh 10/28/2007 13:16'! sizeFor: aString ^ 1! ! !CaslCodeTile methodsFor: 'event handling' stamp: 'e-itoh 10/27/2007 21:49'! opcodeMouseDown: anEvent to: aMorph | opcodes ret list | opcodes := self oprandClass opcodes. list := opcodes collect: [:each | self opcodeStringFrom: each]. ret := PopUpMenu withCaption: 'Select opcode' chooseFrom: list. ret = 0 ifTrue: [^ self]. opcode := opcodes at: ret. aMorph contents: self opcodeText! ! !CaslCodeTile methodsFor: 'event handling' stamp: 'e-itoh 10/26/2007 19:37'! wantsKeyboardFocusFor: aSubmorph ^ true! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CaslCodeTile class instanceVariableNames: ''! !CaslCodeTile class methodsFor: 'parts bin' stamp: 'e-itoh 10/27/2007 21:19'! descriptionForPartsBin ^ self partName: 'CaslCode' categories: #('Comet' ) documentation: 'A Casl code tile without oprands' translated! ! CaslCodeTile subclass: #CaslCodeTileAdrX instanceVariableNames: 'adr x' classVariableNames: '' poolDictionaries: '' category: 'Comet-GUI'! !CaslCodeTileAdrX methodsFor: 'event handling' stamp: 'e-itoh 10/27/2007 21:42'! xMouseDown: anEvent to: aMorph | ret collection | collection := self xList. ret := PopUpMenu withCaption: 'Select X' chooseFrom: collection. ret = 0 ifTrue: [^ self]. x := ret - 1. aMorph contents: self xText! ! !CaslCodeTileAdrX methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:39'! adrText adr ifNil: [^ 'ADR']. ^ adr asString! ! !CaslCodeTileAdrX methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:39'! adrText: aString adr := aString asString asUppercase! ! !CaslCodeTileAdrX methodsFor: 'private' stamp: 'e-itoh 10/31/2007 23:20'! makeOprandMorph | row morph | row := AlignmentMorph newRow color: Color transparent. "row hResizing: #spaceFill; vResizing: #spaceFill." morph := UpdatingStringMorph on: self selector: #adrText. morph contents: self adrText; putSelector: #adrText:; useStringFormat. morph hResizing: #spaceFill. row addMorphBack: morph. row addMorphBack: (StringMorph contents: ','). morph := StringMorph contents: self xText. morph on: #mouseDown send: #xMouseDown:to: to: self. morph hResizing: #shrinkWrap. row addMorphBack: morph. ^ row! ! !CaslCodeTileAdrX methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:53'! opLow x ifNil: [^ nil]. ^ x! ! !CaslCodeTileAdrX methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:17'! oprandClassName ^ #CometOprandAdrX! ! !CaslCodeTileAdrX methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:39'! xText x ifNil: [^ 'X']. ^ self xList at: x + 1! ! !CaslCodeTileAdrX methodsFor: 'accessing' stamp: 'e-itoh 10/31/2007 22:57'! codeWithConst: aNumber decoder: aDecoder aNumber isNumber ifFalse: [^ nil]. ^ Array with: (self op1stDecoder: aDecoder) with: aNumber! ! !CaslCodeTileAdrX methodsFor: 'accessing' stamp: 'e-itoh 10/28/2007 20:13'! const ^ adr! ! !CaslCodeTileAdrX methodsFor: 'accessing' stamp: 'e-itoh 10/28/2007 13:16'! sizeFor: aString ^ 2! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CaslCodeTileAdrX class instanceVariableNames: ''! !CaslCodeTileAdrX class methodsFor: 'parts bin' stamp: 'e-itoh 10/27/2007 21:20'! descriptionForPartsBin ^ self partName: 'CaslCode ADR,X' categories: #('Comet' ) documentation: 'A Casl code tile with adr and x oprands' translated! ! CaslCodeTile subclass: #CaslCodeTileDC instanceVariableNames: 'data' classVariableNames: '' poolDictionaries: '' category: 'Comet-GUI'! !CaslCodeTileDC methodsFor: 'initialization' stamp: 'e-itoh 10/27/2007 23:34'! initialize opcode := #dc:. super initialize! ! !CaslCodeTileDC methodsFor: 'private' stamp: 'e-itoh 10/28/2007 20:13'! const ^ data! ! !CaslCodeTileDC methodsFor: 'private' stamp: 'e-itoh 10/27/2007 23:16'! dataText data ifNil: [^ 'DATA']. ^ data asString! ! !CaslCodeTileDC methodsFor: 'private' stamp: 'e-itoh 10/27/2007 23:16'! dataText: aString data := aString asString! ! !CaslCodeTileDC methodsFor: 'private' stamp: 'e-itoh 10/27/2007 23:16'! makeOprandMorph | row morph | row := AlignmentMorph newRow color: Color transparent. morph := UpdatingStringMorph on: self selector: #dataText. morph contents: self dataText; putSelector: #dataText:; useStringFormat. morph hResizing: #spaceFill. row addMorphBack: morph. ^ row! ! !CaslCodeTileDC methodsFor: 'accessing' stamp: 'e-itoh 10/28/2007 21:12'! codeWithConst: aNumberOrString decoder: aDecoder | str | aNumberOrString isString ifTrue: [(aNumberOrString beginsWith: '''') ifFalse: [^ nil]. str := aNumberOrString copyFrom: 2 to: aNumberOrString size - 1. ^ str asByteArray asArray]. ^ Array with: aNumberOrString! ! !CaslCodeTileDC methodsFor: 'accessing' stamp: 'e-itoh 10/28/2007 21:12'! sizeFor: aStringOrNumber | str | (aStringOrNumber isString and: [aStringOrNumber beginsWith: '''']) ifTrue: [str := aStringOrNumber copyFrom: 2 to: aStringOrNumber size - 1. str := str copyReplaceAll: '''''' with: ''''. ^ str size]. ^ 1! ! CaslCodeTile subclass: #CaslCodeTileR instanceVariableNames: 'r' classVariableNames: '' poolDictionaries: '' category: 'Comet-GUI'! !CaslCodeTileR methodsFor: 'private' stamp: 'e-itoh 10/26/2007 22:44'! makeOprandMorph | row morph | row := AlignmentMorph newRow color: Color transparent. morph := StringMorph contents: self rText. morph on: #mouseDown send: #rMouseDown:to: to: self. morph hResizing: #shrinkWrap. row addMorphFront: morph. ^ row! ! !CaslCodeTileR methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:53'! opLow r ifNil: [^ nil]. ^ r bitShift: 4! ! !CaslCodeTileR methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:17'! oprandClassName ^ #CometOprandR! ! !CaslCodeTileR methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:43'! rMouseDown: anEvent to: aMorph | ret collection | collection := self rList. ret := PopUpMenu withCaption: 'Select R' chooseFrom: collection. ret = 0 ifTrue: [^ self]. r := ret - 1. aMorph contents: self rText! ! !CaslCodeTileR methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:40'! rText r ifNil: [^ 'R']. ^ self rList at: r + 1! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CaslCodeTileR class instanceVariableNames: ''! !CaslCodeTileR class methodsFor: 'parts bin' stamp: 'e-itoh 10/27/2007 21:20'! descriptionForPartsBin ^ self partName: 'CaslCode R' categories: #('Comet' ) documentation: 'A Casl code tile with register oprands' translated! ! CaslCodeTileAdrX subclass: #CaslCodeTileRadrX instanceVariableNames: 'r' classVariableNames: '' poolDictionaries: '' category: 'Comet-GUI'! !CaslCodeTileRadrX methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:43'! makeOprandMorph | row morph | row := super makeOprandMorph. row addMorphFront: (StringMorph contents: ','). morph := StringMorph contents: self rText. morph on: #mouseDown send: #rMouseDown:to: to: self. morph hResizing: #shrinkWrap. row addMorphFront: morph. ^ row! ! !CaslCodeTileRadrX methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:53'! opLow r ifNil: [^ nil]. x ifNil: [^ nil]. ^ (r bitShift: 4) bitOr: x! ! !CaslCodeTileRadrX methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:17'! oprandClassName ^ #CometOprandRadrX! ! !CaslCodeTileRadrX methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:43'! rMouseDown: anEvent to: aMorph | ret collection | collection := self rList. ret := PopUpMenu withCaption: 'Select R' chooseFrom: collection. ret = 0 ifTrue: [^ self]. r := ret - 1. aMorph contents: self rText! ! !CaslCodeTileRadrX methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:42'! rText r ifNil: [^ 'R']. ^ self rList at: r + 1! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CaslCodeTileRadrX class instanceVariableNames: ''! !CaslCodeTileRadrX class methodsFor: 'parts bin' stamp: 'e-itoh 10/27/2007 21:21'! descriptionForPartsBin ^ self partName: 'CaslCode R,ADR,X' categories: #('Comet' ) documentation: 'A Casl code tile with r, adr and x oprands' translated! ! CaslCodeTile subclass: #CaslCodeTileRR instanceVariableNames: 'r1 r2' classVariableNames: '' poolDictionaries: '' category: 'Comet-GUI'! !CaslCodeTileRR methodsFor: 'private' stamp: 'e-itoh 10/26/2007 22:49'! makeOprandMorph | row morph | row := AlignmentMorph newRow color: Color transparent. morph := StringMorph contents: self r1Text. morph on: #mouseDown send: #r1MouseDown:to: to: self. morph hResizing: #shrinkWrap. row addMorphBack: morph. row addMorphBack: (StringMorph contents: ' , '). morph := StringMorph contents: self r2Text. morph on: #mouseDown send: #r2MouseDown:to: to: self. morph hResizing: #shrinkWrap. row addMorphBack: morph. ^ row! ! !CaslCodeTileRR methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:53'! opLow r1 ifNil: [^ nil]. r2 ifNil: [^ nil]. ^ (r1 bitShift: 4) bitOr: r2! ! !CaslCodeTileRR methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:17'! oprandClassName ^ #CometOprandRR! ! !CaslCodeTileRR methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:45'! r1Text r1 ifNil: [^ '?']. ^ self rList at: r1 + 1! ! !CaslCodeTileRR methodsFor: 'private' stamp: 'e-itoh 10/27/2007 21:44'! r2Text r2 ifNil: [^ '?']. ^ self rList at: r2 + 1! ! !CaslCodeTileRR methodsFor: 'event handling' stamp: 'e-itoh 10/27/2007 21:44'! r1MouseDown: anEvent to: aMorph | ret collection | collection := self rList. ret := PopUpMenu withCaption: 'Select R1' chooseFrom: collection. ret = 0 ifTrue: [^ self]. r1 := ret - 1. aMorph contents: self r1Text! ! !CaslCodeTileRR methodsFor: 'event handling' stamp: 'e-itoh 10/27/2007 21:44'! r2MouseDown: anEvent to: aMorph | ret collection | collection := self rList. ret := PopUpMenu withCaption: 'Select R2' chooseFrom: collection. ret = 0 ifTrue: [^ self]. r2 := ret - 1. aMorph contents: self r2Text! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CaslCodeTileRR class instanceVariableNames: ''! !CaslCodeTileRR class methodsFor: 'parts bin' stamp: 'e-itoh 10/27/2007 21:21'! descriptionForPartsBin ^ self partName: 'CaslCode R,R' categories: #('Comet' ) documentation: 'A Casl code tile with r1 and r2 oprands' translated! ! BorderedMorph subclass: #CometSimulator instanceVariableNames: 'cpu isAuto isFast disassembledCode message labels' classVariableNames: '' poolDictionaries: '' category: 'Comet-GUI'! !CometSimulator methodsFor: 'morphic interface' stamp: 'e-itoh 10/24/2007 22:52'! buttonMorphLabel: aString selector: aSymbol | aButton | aButton := SimpleButtonMorph new. aButton target: self; label: aString; actionSelector: aSymbol; borderColor: #raised; borderWidth: 2; color: Color transparent. ^ aButton! ! !CometSimulator methodsFor: 'morphic interface' stamp: 'e-itoh 10/25/2007 22:54'! makeFlagMorph | row morph | row := AlignmentMorph newRow color: Color transparent. row addMorphBack: AlignmentMorph newVariableTransparentSpacer. morph := UpdatingStringMorph on: self selector: #fr. morph contents: self fr; useStringFormat. row addMorphBack: morph. ^ row! ! !CometSimulator methodsFor: 'morphic interface' stamp: 'e-itoh 10/25/2007 23:16'! makeHaltButton | row morph onColor offColor | onColor := Color red. offColor := Color lightGray. row := AlignmentMorph newRow color: Color transparent. row addMorphBack: AlignmentMorph newVariableTransparentSpacer. morph := PluggableButtonMorph on: self getState: #haltIndicated action: nil. morph label: 'Halt'; askBeforeChanging: false; borderWidth: 0; onColor: onColor offColor: offColor. row addMorphBack: morph. ^ row! ! !CometSimulator methodsFor: 'morphic interface' stamp: 'e-itoh 10/31/2007 22:01'! makeLeftPane | col row text selector putSelector | col := AlignmentMorph newColumn color: Color transparent. col hResizing: #shrinkWrap; vResizing: #spaceFill. col cellPositioning: #topCenter. col addMorphBack: (StringMorph contents: 'Register'). col addMorphBack: (self makeRegisterMorph: 'PR=' selector: #pr putSelector: nil). col addMorphBack: (self makeRegisterMorph: 'SP=' selector: #sp putSelector: nil). 1 to: 8 do: [:each | text := 'GR' , (each - 1) asString , '='. selector := 'gr' , (each - 1) asString. putSelector := selector , ':'. col addMorphBack: (self makeRegisterMorph: text selector: selector asSymbol putSelector: putSelector asSymbol)]. col addMorphBack: self makeFlagMorph. col addMorphBack: self makeHaltButton. col addMorphBack: self makeSlowFastButtons. col addMorphBack: self makeManualAutoButtons. row := AlignmentMorph newRow color: Color transparent. row addMorphBack: ((self buttonMorphLabel: 'Reset' selector: #reset) color: Color red; yourself). row addMorphBack: AlignmentMorph newVariableTransparentSpacer. row addMorphBack: ((self buttonMorphLabel: 'Step' selector: #clock) color: Color green; yourself). col addMorphBack: row. ^ col! ! !CometSimulator methodsFor: 'morphic interface' stamp: 'e-itoh 10/25/2007 22:49'! makeManualAutoButtons | row morph onColor offColor | onColor := Color cyan. offColor := Color lightGray. row := AlignmentMorph newRow color: Color transparent. row addMorphBack: AlignmentMorph newVariableTransparentSpacer. morph := PluggableButtonMorph on: self getState: #manualIndicated action: #beManual. morph label: 'manual'; askBeforeChanging: false; borderWidth: 0; onColor: onColor offColor: offColor. row addMorphBack: morph. morph := PluggableButtonMorph on: self getState: #autoIndicated action: #beAuto. morph label: 'auto'; askBeforeChanging: false; borderWidth: 0; onColor: onColor offColor: offColor. row addMorphBack: morph. ^ row! ! !CometSimulator methodsFor: 'morphic interface' stamp: 'e-itoh 10/31/2007 22:00'! makeRegisterMorph: aString selector: aSymbol1 putSelector: aSymbol2 | row morph | row := AlignmentMorph newRow color: Color transparent. row addMorphBack: AlignmentMorph newVariableTransparentSpacer. row addMorphBack: (StringMorph contents: aString). morph := UpdatingStringMorph on: self selector: aSymbol1. morph contents: (self perform: aSymbol1). aSymbol2 ifNotNil: [morph putSelector: aSymbol2]. morph useStringFormat. row addMorphBack: morph. ^ row! ! !CometSimulator methodsFor: 'morphic interface' stamp: 'e-itoh 11/1/2007 23:45'! makeRightPane | col morph row | col := AlignmentMorph newColumn color: Color transparent. col hResizing: #spaceFill; vResizing: #spaceFill. col addMorphBack: (StringMorph contents: 'Memory'). morph := PluggableListMorph on: self list: #memoryList selected: #memorySel changeSelected: #memorySel:. morph extent: 180@10. morph hResizing: #rigid; vResizing: #spaceFill. col addMorphBack: morph. morph := UpdatingStringMorph on: self selector: #message. morph hResizing: #spaceFill; vResizing: #shrinkWrap. col addMorphBack: morph. morph := PluggableListMorph on: self list: #labelsList selected: #labelsSel changeSelected: #labelsSel:. morph extent: 180@80. morph hResizing: #rigid; vResizing: #rigid. col addMorphBack: morph. row := AlignmentMorph newRow color: Color transparent. row hResizing: #shrinkWrap; vResizing: #shrinkWrap. row addMorphBack: (self buttonMorphLabel: 'Clear' selector: #clearMemory). row addMorphBack: (self buttonMorphLabel: 'Program' selector: #openHolder). row addMorphBack: (self buttonMorphLabel: 'Data' selector: #enterData). row addMorphBack: (self buttonMorphLabel: '?' selector: #openAbout). col addMorphBack: row. ^ col! ! !CometSimulator methodsFor: 'morphic interface' stamp: 'e-itoh 10/25/2007 22:49'! makeSlowFastButtons | row morph onColor offColor | onColor := Color cyan. offColor := Color lightGray. row := AlignmentMorph newRow color: Color transparent. row addMorphBack: AlignmentMorph newVariableTransparentSpacer. morph := PluggableButtonMorph on: self getState: #slowIndicated action: #beSlow. morph label: 'slow'; askBeforeChanging: false; borderWidth: 0; onColor: onColor offColor: offColor. row addMorphBack: morph. morph := PluggableButtonMorph on: self getState: #fastIndicated action: #beFast. morph label: 'fast'; askBeforeChanging: false; borderWidth: 0; onColor: onColor offColor: offColor. row addMorphBack: morph. ^ row! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/24/2007 22:52'! autoIndicated ^ isAuto! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/29/2007 22:06'! beAuto isAuto := true. self changed: #beAuto! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/29/2007 22:06'! beFast isFast := true. self changed: #beFast! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/29/2007 22:06'! beManual isAuto := false. self changed: #beManual! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/29/2007 22:06'! beSlow isFast := false. self changed: #beSlow! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 11/1/2007 23:21'! clearMemory cpu memory clear. self updateMemory. labels := nil. self changed: #labelsList. self reset! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 11/1/2007 23:21'! clock cpu memory modified: false. cpu clock. self changed: #memorySel. cpu halted ifTrue: [isAuto := false. self changed]. cpu memory modified ifTrue: [self updateMemory]! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 11/1/2007 23:21'! enterData | addr ret | addr := cpu pr logicalValue. ret := (cpu memory wordAt: addr) printStringBase: 16 length: 4 padded: true. ret := FillInTheBlank request: 'Enter data' initialAnswer: ret. (ret isNil or: [ret isEmpty]) ifTrue: [^ self]. ret := self numberFromHex: ret. ret ifNil: [^ self]. cpu memory wordAt: addr put: ret. self updateMemory! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/24/2007 22:52'! fastIndicated ^ isFast! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/25/2007 22:52'! fr | w | w := WriteStream on: ''. w nextPutAll: 'OF='. w nextPut: (cpu fr of ifTrue: [$1] ifFalse: [$0]). w nextPutAll: ' SF='. w nextPut: (cpu fr sf ifTrue: [$1] ifFalse: [$0]). w nextPutAll: ' ZF='. w nextPut: (cpu fr zf ifTrue: [$1] ifFalse: [$0]). ^ w contents! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/30/2007 11:34'! gr0 ^ (cpu grn: 0) asHexString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/31/2007 21:37'! gr0: aString self grn: 0 put: aString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/30/2007 11:34'! gr1 ^ (cpu grn: 1) asHexString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/31/2007 21:37'! gr1: aString self grn: 1 put: aString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/30/2007 11:34'! gr2 ^ (cpu grn: 2) asHexString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/31/2007 21:37'! gr2: aString self grn: 2 put: aString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/30/2007 11:34'! gr3 ^ (cpu grn: 3) asHexString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/31/2007 21:37'! gr3: aString self grn: 3 put: aString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/30/2007 11:34'! gr4 ^ (cpu grn: 4) asHexString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/31/2007 21:37'! gr4: aString self grn: 4 put: aString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/30/2007 11:34'! gr5 ^ (cpu grn: 5) asHexString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/31/2007 21:37'! gr5: aString self grn: 5 put: aString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/30/2007 11:34'! gr6 ^ (cpu grn: 6) asHexString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/31/2007 21:38'! gr6: aString self grn: 6 put: aString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/30/2007 11:34'! gr7 ^ (cpu grn: 7) asHexString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/31/2007 21:39'! gr7: aString self grn: 7 put: aString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/31/2007 21:36'! grn: aNumber put: aString | value | value := self numberFromHex: aString. value ifNil: [^ self]. ^ (cpu grn: aNumber) logicalValue: value! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/25/2007 23:12'! haltIndicated ^ cpu halted! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 11/1/2007 23:34'! labelsList | collection | labels ifNil: [^ #()]. collection := OrderedCollection new. labels keysAndValuesDo: [:key :value | collection add: ((value printStringBase: 16 length: 4 padded: true), ' = ', key asString)]. ^ collection asSortedCollection! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 11/1/2007 22:28'! labelsSel ^ 0! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 11/1/2007 23:39'! labelsSel: aNumber | address | labels ifNil: [^ self]. aNumber = 0 ifTrue: [^ self]. address := (self labelsList at: aNumber) copyFrom: 1 to: 4. disassembledCode doWithIndex: [:each :index | (each beginsWith: address) ifTrue: [self memorySel: index]]! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/24/2007 22:52'! manualIndicated ^ isAuto not! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/25/2007 21:22'! memoryList disassembledCode ifNil: [disassembledCode := cpu memory disassemble asArray]. ^ disassembledCode! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/30/2007 11:35'! memorySel | x | x := cpu pr asHexString. disassembledCode doWithIndex: [:each :index | (each beginsWith: x) ifTrue: [^ index]]. ^ 0! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/30/2007 11:24'! memorySel: aNumber | line address | disassembledCode ifNil: [^ self]. isAuto ifTrue: [^ self]. cpu halted ifTrue: [^ self]. aNumber = 0 ifTrue: [^ self]. line := disassembledCode at: aNumber. address := Number readFrom: (line copyFrom: 1 to: 4) base: 16. cpu pr logicalValue: address. self changed: #memorySel! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/31/2007 23:14'! message ^ message! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/31/2007 21:34'! numberFromHex: aString | ret | [ret := Number readFrom: aString asUppercase base: 16] on: Error do: [:err | self inform: err messageText. ^ nil]. ^ ret! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/30/2007 11:35'! pr ^ cpu pr asHexString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/31/2007 23:16'! reset cpu reset. self changed: #memorySel. self beManual. self changed: #beManual. message := ''! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/24/2007 22:52'! slowIndicated ^ isFast not! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 10/30/2007 11:35'! sp ^ cpu sp asHexString! ! !CometSimulator methodsFor: 'private' stamp: 'e-itoh 11/1/2007 23:21'! updateMemory disassembledCode := nil. self changed: #memoryList! ! !CometSimulator methodsFor: 'initialization' stamp: 'e-itoh 10/31/2007 23:14'! initialize super initialize. cpu := CometMachine new. isAuto := false. isFast := false. disassembledCode := nil. message := 'Welcome to Comet/Squeak!!'. cpu setup. self extent: 200 @ 300; changeTableLayout; color: Color paleGreen; borderWidth: 1; borderColor: Color green. self listDirection: #leftToRight; listCentering: #center; wrapDirection: #none; wrapCentering: #center; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 2. self addMorphBack: self makeLeftPane. self addMorphBack: self makeRightPane! ! !CometSimulator methodsFor: 'stepping' stamp: 'e-itoh 10/31/2007 23:15'! step isAuto ifFalse: [^ self]. [self clock] on: Error do: [:err | message := err messageText. cpu halted: true]! ! !CometSimulator methodsFor: 'stepping' stamp: 'e-itoh 10/29/2007 22:08'! stepTime isFast ifTrue: [^ 100]. ^ 1000! ! !CometSimulator methodsFor: 'stepping' stamp: 'e-itoh 10/24/2007 22:52'! wantsSteps ^ true! ! !CometSimulator methodsFor: 'copyright' stamp: 'e-itoh 11/1/2007 22:19'! about ^ 'CometSimulator: Comet II Simulator for Squeak V0.01. Copyright (C) 2007 Eiichiro ITO(GHC02331 at nifty.com). This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see .'! ! !CometSimulator methodsFor: 'copyright' stamp: 'e-itoh 10/25/2007 20:46'! openAbout (Workspace new contents: self about) openLabel: 'CometSimulator: about'! ! !CometSimulator methodsFor: 'copyright' stamp: 'e-itoh 10/30/2007 11:41'! openHolder ScriptingSystem prototypicalHolder openInHand! ! !CometSimulator methodsFor: 'accessing' stamp: 'e-itoh 10/25/2007 21:09'! cpu ^ cpu! ! !CometSimulator methodsFor: 'dropping/grabbing' stamp: 'e-itoh 11/1/2007 23:31'! acceptDroppingMorph: aMorph event: anEvent | address collection result code | address := cpu pr logicalValue. (aMorph isKindOf: CaslCodeTile) ifTrue: [collection := Array with: aMorph] ifFalse: [collection := aMorph actualObject costume submorphs]. result := CaslAssembler new assembleFromMorphs: collection startAddress: address labels: labels. code := result at: 1. code ifNil: [^ message := (result at: 3) first asString]. self beep. cpu pr logicalValue: address + code size. cpu memory readFrom: code startAddress: address. self updateMemory. labels := result at: 4. self changed: #labelsList! ! !CometSimulator methodsFor: 'dropping/grabbing' stamp: 'e-itoh 10/31/2007 22:08'! wantsDroppedMorph: aMorph event: anEvent ^ ((aMorph isKindOf: TileMorph) and: [aMorph type = #objRef]) or: [aMorph isKindOf: CaslCodeTile]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CometSimulator class instanceVariableNames: ''! !CometSimulator class methodsFor: 'examples' stamp: 'e-itoh 11/1/2007 23:21'! sample1 "CometSimulator sample1" | morph | morph := CometSimulator new. CometMachine putSample1To: morph cpu. morph updateMemory. morph openInWorld! ! !CometSimulator class methodsFor: 'parts bin' stamp: 'e-itoh 10/30/2007 11:44'! descriptionForPartsBin ^ self partName: 'Comet Simulator' categories: #('Comet' ) documentation: 'A Comet Simulator' translated! !