% Send super upper.
%
% Strategy: run-time dynamic binding
% Intercept /supersend and /self. Determine run-time binding, and optimize
% code on the fly.

systemdict begin

systemdict /old_supersend known not {
  systemdict /old_supersend /supersend load put
} if

/supersend { % <args> message object => <results>
    /estack currentprocess /ExecutionStack get
    /dstack currentprocess /DictionaryStack get
    20 dict begin
	def def
	currentprocess /Stdout
	2 copy get /f exch cvlit def console put
	currentprocess /Stdout f put
	/object exch cvlit def
	/message exch cvlit def
	/caller estack dup length 4 sub get cvlit def
	/offset estack dup length 3 sub get cvlit def
	(SUPERSEND:\n) print
	(  caller: { ) print offset 1 sub caller {
	    1 index 0 eq { (=> ) print } if
	    (% ) printf
	    dup 0 eq { (<= ) print } if
	    1 add
	} forall (}\n) print pop
	(  offset: ) print offset ==
	(  message: ) print message =
	(  object: ) print object =
	object isinstance? {
	    (    instance of class: ) print /ClassName object send ==
	} {
	    object isclass? {
		(    class: ) print /ClassName object send ==
	    } if
	} ifelse
	currentprocess /Stdout f put
	message object
    end
    old_supersend
} def

systemdict /old_self known not {
    systemdict /old_self /self load put
} if

/self { % - => obj
    /estack currentprocess /ExecutionStack get
    /dstack currentprocess /DictionaryStack get
    /cd currentdict def
    20 dict begin
	def def def
	currentprocess /Stdout
	2 copy get /f exch cvlit def console put
	/caller estack dup length 4 sub get cvlit def
	/offset estack dup length 3 sub get cvlit def
	(SELF:\n) print
	(  caller: { ) print caller {
	    (% ) printf
	} forall (}\n) print
	(  offset: ) print offset ==
	(  currentdict: ) print cd =
	cd isinstance? {
	    (    instance of class: ) print /ClassName cd send ==
	} {
	    cd isclass? {
		(    class: ) print /ClassName cd send ==
	    } if
	} ifelse
	(  self: ) print old_self =
	old_self isinstance? {
	    (    instance of class: ) print /ClassName old_self send ==
	} {
	    old_self isclass? {
		(    class: ) print /ClassName old_self send ==
	    } if
	} ifelse
	currentprocess /Stdout f put
    end
    old_self
} def

end % systemdict