/* *****************************************************************
*								   *
*	SB-Prolog						   *
*	Copyright SUNY at Stony Brook, 1986			   *
*								   *
****************************************************************** */

/*-----------------------------------------------------------------
SB-Prolog is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY.  No author or distributor
accepts responsibility to anyone for the consequences of using it
or for whether it serves any particular purpose or works at all,
unless he says so in writing.  Refer to the SB-Prolog General Public
License for full details.

Everyone is granted permission to copy, modify and redistribute
SB-Prolog, but only under the conditions described in the
SB-Prolog General Public License.   A copy of this license is
supposed to have been given to you along with SB-Prolog so you
can know your rights and responsibilities.  It should be in a
file named COPYING.  Among other things, the copyright notice
and this notice must be preserved on all copies. 
------------------------------------------------------------------ */



/**************************************************************************
*									  *
*		some code for peephole optimization			  *
*									  *
**************************************************************************/

/*  "peephole_opt" is the top-level optimizer, it calls various others.	  */

/* **********************************************************************
$peephole1_export([$compile_peephole_opt/2]).

$peephole1_use($blist,[_,_,$member1/2]).
********************************************************************** */

$compile_peephole_opt(Pil, OptPil) :-
		$compile_popt1(Pil, Pil1),
		$compile_popt2(Pil1, Pil2),
		$compile_popt3(Pil2,Pil3),
		$compile_popt4(Pil3,[],_,OptPil).


$compile_popt1([], []).
$compile_popt1([Inst|Rest], Pil1) :- $compile_popt11(Inst, Rest, Pil1).
$compile_popt11(puttvar(T,R), [getstr(S,R)|PilRest], [putstr(S,T)|OptPilRest]) :-
		$compile_popt1a(PilRest, OptPilRest).
$compile_popt11(movreg(T,R), [getstr(S,R)|PilRest], OptInstList) :-
		(($peep_chk(PilRest,R),
		  OptInstList = [getstr(S,T)|OptPilRest]
		 ) ;
		 OptInstList = [movreg(T,R),getstr(S,R)|OptPilRest]
		),
		$compile_popt1(PilRest, OptPilRest).
$compile_popt11(movreg(T,R), [puttbreg(R)|PilRest], OptInstList) :-
		(($peep_chk(PilRest,R),
		  OptInstList = [puttbreg(T)|OptPilRest]
		 ) ;
		 OptInstList = [movreg(T,R),puttbreg(R)|OptPilRest]
		),
		$compile_popt1(PilRest, OptPilRest).
$compile_popt11(movreg(T,R), [addreg(R,S)|PilRest], OptInstList) :-
		(($peep_chk(PilRest,R),
		  OptInstList = [addreg(T,S)|OptPilRest]
		 ) ;
		 OptInstList = [movreg(T,R),addreg(R,S)|OptPilRest]
		),
		$compile_popt1(PilRest, OptPilRest).
$compile_popt11(movreg(T,R), [subreg(R,S)|PilRest], OptInstList) :-
		(($peep_chk(PilRest,R),
		  OptInstList = [subreg(T,S)|OptPilRest]
		 ) ;
		 OptInstList = [movreg(T,R),subreg(R,S)|OptPilRest]
		),
		$compile_popt1(PilRest, OptPilRest).
$compile_popt11(movreg(T,R), [mulreg(R,S)|PilRest], OptInstList) :-
		(($peep_chk(PilRest,R),
		  OptInstList = [mulreg(T,S)|OptPilRest]
		 ) ;
		 OptInstList = [movreg(T,R),mulreg(R,S)|OptPilRest]
		),
		$compile_popt1(PilRest, OptPilRest).
$compile_popt11(movreg(T,R), [divreg(R,S)|PilRest], OptInstList) :-
		(($peep_chk(PilRest,R),
		  OptInstList = [divreg(T,S)|OptPilRest]
		 ) ;
		 OptInstList = [movreg(T,R),divreg(R,S)|OptPilRest]
		),
		$compile_popt1(PilRest, OptPilRest).
$compile_popt11(putpvar(V,R), [getpval(V,R)|PilRest], [putpvar(V,R)|OptPilRest]) :-
		$compile_popt1(PilRest, OptPilRest).
$compile_popt11(putpval(V,R), [getstr(Str,R)|PilRest], [getstrv(Str,V)|OptPilRest]) :-
		not(Str = ('.',2)),		/* to enable list opt */
		$compile_popt1(PilRest, OptPilRest).
$compile_popt11(putpvar(V,R), [getstr(Str,R)|PilRest], [putstrv(Str,V)|OptPilRest]) :-
		not(Str = ('.',2)),		/* to enable list opt */
		$compile_popt1a(PilRest, OptPilRest).
$compile_popt11(gettval(R,R), PRest,OptPRest) :- $compile_popt1(PRest, OptPRest).
$compile_popt11(movreg(R,R), PRest,OptPRest) :- $compile_popt1(PRest, OptPRest).
$compile_popt11(jump(L), [label(L)|PRest],  [label(L)|OptPRest]) :-
		$compile_popt1(PRest,OptPRest).
$compile_popt11(jump(Addr), [jump(_)|PRest],  [jump(Addr)|OptPRest]) :-
		$compile_popt1(PRest,OptPRest).
$compile_popt11(jumpz(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
		$compile_popt1(PRest,OptPRest).
$compile_popt11(jumpnz(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
		$compile_popt1(PRest,OptPRest).
$compile_popt11(jumplt(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
		$compile_popt1(PRest, OptPRest).
$compile_popt11(jumple(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
		$compile_popt1(PRest, OptPRest).
$compile_popt11(jumpgt(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
		$compile_popt1(PRest,OptPRest).
$compile_popt11(jumpge(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
		$compile_popt1(PRest,OptPRest).
$compile_popt11(Inst, PilRest, [Inst|OptPilRest]) :- 
		$compile_popt1(PilRest, OptPilRest).


$compile_popt1a([], []).
$compile_popt1a([Inst|PilRest], Pil1) :- $compile_popt1a1(Inst, PilRest, Pil1).
$compile_popt1a1(unipvar(X), PilRest, [bldpvar(X)|OptPilRest]) :-
		$compile_popt1a(PilRest, OptPilRest).
$compile_popt1a1(unipval(X), PilRest, [bldpval(X)|OptPilRest]) :-
		$compile_popt1a(PilRest, OptPilRest).
$compile_popt1a1(unitvar(X), PilRest, [bldtvar(X)|OptPilRest]) :-
		$compile_popt1a(PilRest, OptPilRest).
$compile_popt1a1(unitval(X), PilRest, [bldtval(X)|OptPilRest]) :-
		$compile_popt1a(PilRest, OptPilRest).
$compile_popt1a1(unicon(X), PilRest, [bldcon(X)|OptPilRest]) :-
		$compile_popt1a(PilRest, OptPilRest).
$compile_popt1a1(uninumcon(X), PilRest, [bldnumcon(X)|OptPilRest]) :-
		$compile_popt1a(PilRest, OptPilRest).
$compile_popt1a1(unifloatcon(X), PilRest, [bldfloatcon(X)|OptPilRest]) :-
		$compile_popt1a(PilRest, OptPilRest).
$compile_popt1a1(gettval(R,R), PRest,OptPRest) :- $compile_popt1a(PRest, OptPRest).
$compile_popt1a1(movreg(R,R), PRest,OptPRest) :- $compile_popt1a(PRest, OptPRest).
$compile_popt1a1(jump(L),[label(L)|PRest], [jump(Addr)|OptPRest]) :-
		$compile_popt1a(PRest,OptPRest).
$compile_popt1a1(jump(Addr),[jump(_)|PRest],  [jump(Addr)|OptPRest]) :-
		$compile_popt1a(PRest,OptPRest).
$compile_popt1a1(jumpz(_,L),[label(L)|PRest],  [label(L)|OptPRest]) :-
		$compile_popt1a(PRest,OptPRest).
$compile_popt1a1(jumpnz(_,L),[label(L)|PRest],  [label(L)|OptPRest]) :-
		$compile_popt1a(PRest,OptPRest).
$compile_popt1a1(jumplt(_,L),[label(L)|PRest],  [label(L)|OptPRest]) :-
		$compile_popt1a(PRest, OptPRest).
$compile_popt1a1(jumple(_,L),[label(L)|PRest],  [label(L)|OptPRest]) :-
		$compile_popt1a(PRest, OptPRest).
$compile_popt1a1(jumpgt(_,L),[label(L)|PRest],  [label(L)|OptPRest]) :-
		$compile_popt1a(PRest,OptPRest).
$compile_popt1a1(jumpge(_,L),[label(L)|PRest],  [label(L)|OptPRest]) :-
		$compile_popt1a(PRest,OptPRest).
$compile_popt1a1(Inst, PilRest, OptPilRest) :- $compile_popt1([Inst|PilRest], OptPilRest).


/*  "$compile_popt2" optimizes list instructions: (put|get)str '.' are replaced by
     (put|get)list, and (get|put|uni|bld)con '[]' are replaced by
     (get|put|uni|bld)nil, respectively.				*/

$compile_popt2([], []).
$compile_popt2([Inst|PilRest], Pil1) :- $compile_popt21(Inst, PilRest, Pil1).
$compile_popt21(getstr(('.',2), R), PilRest, [getlist(R)|OptPilRest]) :-
		$compile_popt2(PilRest, OptPilRest).
$compile_popt21(putstr(('.',2), R), PilRest, [putlist(R)|OptPilRest]) :-
		$compile_popt2(PilRest, OptPilRest).

$compile_popt21(getcon('[]',R), PilRest, [getnil(R)|OptPilRest]) :-
		$compile_popt2(PilRest, OptPilRest).
$compile_popt21(putcon('[]',R), PilRest, [putnil(R)|OptPilRest]) :-
		$compile_popt2(PilRest, OptPilRest).

$compile_popt21(unicon('[]'), PilRest, [uninil|OptPilRest]) :-
		$compile_popt2(PilRest, OptPilRest).
$compile_popt21(bldcon('[]'), PilRest, [bldnil|OptPilRest]) :-
		$compile_popt2(PilRest, OptPilRest).

$compile_popt21(Inst, PilRest, [Inst|OptPilRest]) :-
		$compile_popt2(PilRest, OptPilRest).


$compile_popt3([],[]).
$compile_popt3([Inst|Rest], Pil) :- $compile_popt31(Inst, Rest, Pil).
$compile_popt31(getlist(R0),[unitvar(R1),unitvar(R2)|Rest],
      [getlist_tvar_tvar(R0,R1,R2)|OptRest]) :-
		$compile_popt3(Rest,OptRest).
$compile_popt31(getcomma(R0),[unitvar(R1),unitvar(R2)|Rest],
      [getcomma_tvar_tvar(R0,R1,R2)|OptRest]) :-
		$compile_popt3(Rest,OptRest).
$compile_popt31(Inst, Rest,[Inst|OptRest]) :- $compile_popt3(Rest,OptRest).

/*	  "popt4" eliminates some redundant instructions.	*/


$compile_popt4([],_,_,[]).
$compile_popt4([Inst|IRest],RCont,Seen,OList) :-
	$peep_redundant(Inst,IRest,RCont,RCont1,Seen,El),
	(El =:= 1 -> OList = ORest ; OList = [Inst|ORest]),
	$compile_popt4(IRest,RCont1,Seen,ORest).

$popt_chkmember(P,L,Flag) :-
	(var(L), L = [P|_], Flag = 1) ;
	(nonvar(L), L = [P1|L1],
	 (P = P1 -> Flag = 0 ; $popt_chkmember(P,L1,Flag))
	).

/*  these instrs use the contents of a reg */

$peep_use(getcon(_,R),R).
$peep_use(getnumcon(_,R),R).
$peep_use(getfloatcon(_,R),R).
$peep_use(getpval(_,R),R).
$peep_use(gettval(_,R),R).
$peep_use(gettval(R,_),R).
$peep_use(gettbreg(R),R).
$peep_use(getpbreg(R),R).
$peep_use(getstr(_,R),R).
$peep_use(getstrv(_,R),R).
$peep_use(getlist(R),R).
$peep_use(getlist_tvar_tvar(R,_,_),R).
$peep_use(getcomma(R),R).
$peep_use(getcomma_tvar_tvar(R,_,_),R).
$peep_use(unitval(R),R).
$peep_use(unipval(R),R).
$peep_use(bldtval(R),R).
$peep_use(bldpval(R),R).
$peep_use(and(R,_),R).
$peep_use(and(_,R),R).
$peep_use(negate(R),R).
$peep_use(or(R,_),R).
$peep_use(or(_,R),R).
$peep_use(logshiftl(R,_),R).
$peep_use(logshiftl(_,R),R).
$peep_use(logshiftr(R,_),R).
$peep_use(logshiftr(_,R),R).
$peep_use(addreg(R,_),R).
$peep_use(addreg(_,R),R).
$peep_use(subreg(R,_),R).
$peep_use(subreg(_,R),R).
$peep_use(mulreg(R,_),R).
$peep_use(mulreg(_,R),R).
$peep_use(divreg(R,_),R).
$peep_use(divreg(_,R),R).
$peep_use(movreg(R,_),R).
$peep_use(switchonterm(R,_,_),R).
$peep_use(switchoncon(R,_,_),R).
$peep_use(switchonstr(R,_,_),R).
$peep_use(switchonbound(R,_,_),R).
$peep_use(jump(_),_).		/* too lazy to chase jumps! */
$peep_use(jumpeq(_,_),_).
$peep_use(jumpne(_,_),_).
$peep_use(jumplt(_,_),_).
$peep_use(jumple(_,_),_).
$peep_use(jumpgt(_,_),_).
$peep_use(jumpge(_,_),_).

$peep_chk([],_).
$peep_chk([Inst|Rest],R) :-
	not($peep_use(Inst,R)), 
	(($peep_term(Inst,R), !) ; $peep_chk(Rest,R)).



$peep_term(call(_,_),_).
$peep_term(calld(_,_),_).
$peep_term(execute(_),_).
$peep_term(putcon(R),R).	/* these instrs change contents of reg */
$peep_term(putnumcon(R),R).
$peep_term(putfloatcon(R),R).
$peep_term(puttvar(R,_),R).
$peep_term(putpvar(_,R),R).
$peep_term(putdval(_,R),R).
$peep_term(putuval(_,R),R).
$peep_term(puttbreg(R),R).
$peep_term(putpval(_,R),R).
$peep_term(putstr(_,R),R).
$peep_term(putstrv(_,R),R).
$peep_term(putlist(R),R).
$peep_term(putnil(R),R).
$peep_term(movreg(_,R),R).
$peep_term(bldtvar(R),R).

$peep_redundant(Inst,IRest,RCont,RCont1,Seen,El) :-
	$peep_elim(Inst,IRest,RCont,RCont1,Seen,El) ->
		true ;
		(RCont1 = RCont, El = 0).

$peep_elim(getpvar(V,R),_,RCont,[r(R,v(V))|RCont],_,0).
$peep_elim(getpval(V,R),_,RCont,RCont1,Seen,El) :-
	$member1(r(R,v(V)),RCont) ->
		(El = 1, RCont1 = Rcont) ;
		(El = 0, RCont1 = [r(R,v(V))|RCont]).
$peep_elim(getcon(C,R),_,RCont,RCont1,Seen,El) :-
	$member1(r(R,c(C)),RCont) ->
		(El = 1, RCont1 = Rcont) ;
		(El = 0, RCont1 = [r(R,c(C))|RCont]).
$peep_elim(getnumcon(N,R),_,RCont,RCont1,Seen,El) :-
	$member1(r(R,n(N)),RCont) ->
		(El = 1, RCont1 = Rcont) ;
		(El = 0, RCont1 = [r(R,n(N))|RCont]).
$peep_elim(getfloatcon(N,R),_,RCont,RCont1,Seen,El) :-
	$member1(r(R,nf(N)),RCont) ->
		(El = 1, RCont1 = Rcont) ;
		(El = 0, RCont1 = [r(R,nf(N))|RCont]).
$peep_elim(getnil(R),_,RCont,RCont1,Seen,El) :-
	$member1(r(R,c(nil)),RCont) ->
		(El = 1, RCont1 = Rcont) ;
		(El = 0, RCont1 = [r(R,c(nil))|RCont]).
$peep_elim(putpvar(V,R),_,L0,L1,_,0) :- $peep_elim_upd(L0,R,v(V),L1).
$peep_elim(putpval(V,R),_,RCont,RCont1,_,El) :-
	$member1(r(R,v(V)),RCont) ->
		(El = 1, RCont1 = RCont) ;
		(El = 0, $peep_elim_upd(RCont,R,v(V),RCont1)).
$peep_elim(puttvar(R,R1),_,L0,L1,_,0) :-
	$peep_del(L0,r(R,_),L2), $peep_del(L2,r(R1,_),L1).
$peep_elim(putcon(C,R),_,RCont,RCont1,_,El) :-
	$member1(r(R,c(C)),RCont) ->
		(El = 1, RCont1 = RCont) ;
		(El = 0, $peep_elim_upd(RCont,R,c(C),RCont1)).
$peep_elim(putnumcon(N,R),_,RCont,RCont1,_,El) :-
	$member1(r(R,n(N)),RCont) ->
		(El = 1, RCont1 = RCont);
		(El = 0, $peep_elim_upd(RCont,R,n(N),RCont1)).
$peep_elim(putfloatcon(N,R),_,RCont,RCont1,_,El) :-
	$member1(r(R,nf(N)),RCont) ->
		(El = 1, RCont1 = RCont) ;
		(El = 0, $peep_elim_upd(RCont,R,nf(N),RCont1)).
$peep_elim(putnil(R),_,RCont,RCont1,_,El) :-
	$member1(r(R,c(nil)),RCont) ->
		(El = 1, RCont1 = RCont);
		(El = 0, $peep_elim_upd(RCont,R,c(nil),RCont1)).
$peep_elim(putstr(F,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
$peep_elim(putlist(R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
$peep_elim(and(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
$peep_elim(or(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
$peep_elim(negate(R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
$peep_elim(logshiftr(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
$peep_elim(logshiftl(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
$peep_elim(addreg(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
$peep_elim(subreg(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
$peep_elim(mulreg(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
$peep_elim(divreg(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
$peep_elim(movreg(R,R1),_,L0,L1,_,0) :- $peep_elim_upd(L0,R1,r(R),L1).
$peep_elim(gettbreg(R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
$peep_elim(putdval(V,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
$peep_elim(putuval(V,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
$peep_elim(label((P,N,K)),_,_,[],Seen,0) :-
	N >= 0 -> $member1((P,N),Seen) ; true.
$peep_elim(call(_,_),_,_,[],_,0).
$peep_elim(proceed,_,_,[],_,0).
$peep_elim(execute((P,N)),IRest,_,[],Seen,El) :-
	(IRest = [label((P,N,K))|_], N >= 0) ->
		$popt_chkmember((P,N),Seen,El) ;
		El = 0.
$peep_elim(calld(_,_),_,_,[],_,0).
$peep_elim(builtin(_),_,_,[],_,0).
$peep_elim(trymeelse(_,_),_,_,[],_,0).
$peep_elim(retrymeelse(_,_),_,_,[],_,0).
$peep_elim(trustmeelsefail(_),_,_,[],_,0).
$peep_elim(try(_,_),_,_,[],_,0).
$peep_elim(retry(_,_),_,_,[],_,0).
$peep_elim(trust(_),_,_,[],_,0).
$peep_elim(jump(_),_,_,[],_,0).
$peep_elim(jumpz(_,_),_,_,[],_,0).
$peep_elim(jumpnz(_,_),_,_,[],_,0).
$peep_elim(jumplt(_,_),_,_,[],_,0).
$peep_elim(jumple(_,_),_,_,[],_,0).
$peep_elim(jumpgt(_,_),_,_,[],_,0).
$peep_elim(jumpge(_,_),_,_,[],_,0).
$peep_elim(switchonterm(_,_,_),_,_,[],_,0).
$peep_elim(switchonbound(_,_,_),_,_,[],_,0).
$peep_elim(switchoncon(_),_,_,[],_,0).
$peep_elim(switchonstr(_),_,_,[],_,0).


$peep_del([],_,[]).
$peep_del([X|L],Y,L1) :- 
	(X = Y -> L1 = L1Rest ; L1 = [X|L1Rest]),
	$peep_del(L,Y,L1Rest).

$peep_elim_upd(L0,R,Cont,[r(R,Cont)|L1]) :- $peep_del(L0,r(R,_),L1).

/* ------------------------------ peephole.P ------------------------------ */