'From Squeak3.1alpha of 7 March 2001 [latest update: #4173] on 28 July 2001 at 2:52:57 pm'! "Change Set: BetterDebugger2 Date: 28 July 2001 Author: Hans-Martin Mosner Fixes related to #mustBeBoolean handling: 1. the sending context is rewound to the jump instruction causing the #mustBeBoolean. This enables the second fix, and avoids a stack inconsistency when proceeding from the exception. 2. #ifTrue:ifFalse, #whileTrue:, #whileFalse: and #to:do: handling is modified to include the PC of the jump instruction, so that the debugger shows the correct source position. This change set requires my earlier BetterDebugger stuff, of course."! !Object methodsFor: 'converting' stamp: 'hmm 7/28/2001 14:41'! mustBeBoolean "Catches attempts to test truth of non-Booleans. This message is sent from the interpreter. The sending context is rewound to just before the jump causing this exception." | pc strm short | pc _ thisContext sender pc. strm _ InstructionStream on: thisContext sender method. strm scanFor: [:byte | ((short _ byte between: 152 and: 159) or: [byte between: 168 and: 175]) and: [strm pc = (short ifTrue: [pc-1] ifFalse: [pc-2])]]. thisContext sender jump: (short ifTrue: [-1] ifFalse: [-2]). self error: 'NonBoolean receiver--proceed for truth.'. ^true! ! !MessageNode methodsFor: 'code generation' stamp: 'hmm 7/28/2001 14:39'! emitForEffect: stack on: strm "For #ifTrue:ifFalse: and #whileTrue: / #whileFalse: style messages, the pc is set to the jump instruction, so that mustBeBoolean exceptions can be shown correctly." special > 0 ifTrue: [pc _ 0. self perform: (MacroEmitters at: special) with: stack with: strm with: false] ifFalse: [super emitForEffect: stack on: strm]! ! !MessageNode methodsFor: 'code generation' stamp: 'hmm 7/28/2001 14:40'! emitForValue: stack on: strm "For #ifTrue:ifFalse: and #whileTrue: / #whileFalse: style messages, the pc is set to the jump instruction, so that mustBeBoolean exceptions can be shown correctly." special > 0 ifTrue: [pc _ 0. self perform: (MacroEmitters at: special) with: stack with: strm with: true] ifFalse: [receiver ~~ nil ifTrue: [receiver emitForValue: stack on: strm]. arguments do: [:argument | argument emitForValue: stack on: strm]. selector emit: stack args: arguments size on: strm super: receiver == NodeSuper. pc _ strm position]! ! !MessageNode methodsFor: 'code generation' stamp: 'hmm 7/28/2001 14:23'! emitIf: stack on: strm value: forValue | thenExpr thenSize elseExpr elseSize | thenSize _ sizes at: 1. elseSize _ sizes at: 2. (forValue not and: [(elseSize*thenSize) > 0]) ifTrue: "Two-armed IFs forEffect share a single pop" [^ super emitForEffect: stack on: strm]. thenExpr _ arguments at: 1. elseExpr _ arguments at: 2. receiver emitForValue: stack on: strm. forValue ifTrue: "Code all forValue as two-armed" [self emitBranchOn: false dist: thenSize pop: stack on: strm. pc _ strm position. thenExpr emitForEvaluatedValue: stack on: strm. stack pop: 1. "then and else alternate; they don't accumulate" thenExpr returns not ifTrue: "Elide jump over else after a return" [self emitJump: elseSize on: strm]. elseExpr emitForEvaluatedValue: stack on: strm] ifFalse: "One arm is empty here (two-arms code forValue)" [thenSize > 0 ifTrue: [self emitBranchOn: false dist: thenSize pop: stack on: strm. pc _ strm position. thenExpr emitForEvaluatedEffect: stack on: strm] ifFalse: [self emitBranchOn: true dist: elseSize pop: stack on: strm. pc _ strm position. elseExpr emitForEvaluatedEffect: stack on: strm]]! ! !MessageNode methodsFor: 'code generation' stamp: 'hmm 7/28/2001 14:42'! emitToDo: stack on: strm value: forValue " var _ rcvr. L1: [var <= arg1] Bfp(L2) [block body. var _ var + inc] Jmp(L1) L2: " | loopSize initStmt limitInit test block incStmt blockSize | initStmt _ arguments at: 4. limitInit _ arguments at: 7. test _ arguments at: 5. block _ arguments at: 3. incStmt _ arguments at: 6. blockSize _ sizes at: 1. loopSize _ sizes at: 2. limitInit == nil ifFalse: [limitInit emitForEffect: stack on: strm]. initStmt emitForEffect: stack on: strm. test emitForValue: stack on: strm. self emitBranchOn: false dist: blockSize pop: stack on: strm. pc _ strm position. block emitForEvaluatedEffect: stack on: strm. incStmt emitForEffect: stack on: strm. self emitJump: 0 - loopSize on: strm. forValue ifTrue: [strm nextPut: LdNil. stack push: 1]! ! !MessageNode methodsFor: 'code generation' stamp: 'hmm 7/28/2001 14:36'! emitWhile: stack on: strm value: forValue " L1: ... Bfp(L2)|Btp(L2) ... Jmp(L1) L2: " | cond stmt stmtSize loopSize | cond _ receiver. stmt _ arguments at: 1. stmtSize _ sizes at: 1. loopSize _ sizes at: 2. cond emitForEvaluatedValue: stack on: strm. self emitBranchOn: (selector key == #whileFalse:) "Bfp for whileTrue" dist: stmtSize pop: stack on: strm. "Btp for whileFalse" pc _ strm position. stmt emitForEvaluatedEffect: stack on: strm. self emitJump: 0 - loopSize on: strm. forValue ifTrue: [strm nextPut: LdNil. stack push: 1]! !