% supersend souper upper.
%
% Strategy: run-time dynamic binding
% Intercept /supersend, determine run-time binding, and optimize
% code on the fly.

systemdict begin

systemdict /tracelog known not {
    systemdict /tracelog (tracelog) (w) file put
} if

/supersendto { % <args> method obj => <results>
  exch get exec
} def

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 get
	/f exch cvlit def
	currentprocess /Stdout tracelog 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 isarray?  message type /nametype eq  and {
	    caller offset 1 sub get /supersend eq {
	      object isclass? {
	        object /ParentDictArray get 0 1 index length 1 sub getinterval
	      } {
	        object /ParentDictArray get
	      } ifelse
	      mark exch aload pop
	      { message 1 index known {
	          caller offset 2 sub 3 -1 roll put
		  caller offset 1 sub /supersendto cvx put
	        } if
		pop
		dup mark eq { exit } if
	      } loop
	      cleartomark
	    } if
	    (  caller: { ) print offset 1 sub caller {
	        1 index 0 eq { (=> ) print } if
	        (% ) printf
	        dup 0 eq { (<= ) print } if
	        1 sub
	    } forall (}\n) print pop
	} {
	    (  caller: ) print caller =
	} ifelse
	(  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
	tracelog flushfile
	currentprocess /Stdout f put
	message object
    end
    old_supersend
} def

end % systemdict