home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / sbprolog / _peephol.p < prev    next >
Encoding:
Text File  |  1993-10-23  |  13.5 KB  |  395 lines
  1. /************************************************************************
  2. *                                    *
  3. * The SB-Prolog System                            *
  4. * Copyright SUNY at Stony Brook, 1986; University of Arizona, 1987    *
  5. *                                    *
  6. ************************************************************************/
  7.  
  8. /*-----------------------------------------------------------------
  9. SB-Prolog is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY.  No author or distributor
  11. accepts responsibility to anyone for the consequences of using it
  12. or for whether it serves any particular purpose or works at all,
  13. unless he says so in writing.  Refer to the SB-Prolog General Public
  14. License for full details.
  15.  
  16. Everyone is granted permission to copy, modify and redistribute
  17. SB-Prolog, but only under the conditions described in the
  18. SB-Prolog General Public License.   A copy of this license is
  19. supposed to have been given to you along with SB-Prolog so you
  20. can know your rights and responsibilities.  It should be in a
  21. file named COPYING.  Among other things, the copyright notice
  22. and this notice must be preserved on all copies. 
  23. ------------------------------------------------------------------ */
  24. /* $peephole1.P */
  25.  
  26. /*  "peephole_opt" is the top-level optimizer, it calls various others.      */
  27.  
  28. /* **********************************************************************
  29. $peephole1_export([$comp_peepopt/3]).
  30.  
  31. $peephole1_use($blist,[_,_,$member1/2,$not_member1/2]).
  32. ********************************************************************** */
  33.  
  34. :- mode($comp_peepopt,3,[c,d,c]).
  35.  
  36. $comp_peepopt(Pil,OptPil,Preds) :-
  37.      $comp_popt1(Pil, Pil1),
  38.      $comp_popt4(Pil1,[],_,Preds,OptPil).
  39.  
  40. :- mode($comp_popt1,2,[c,d]).
  41.  
  42. $comp_popt1([], []).
  43. $comp_popt1([Inst|Rest], Pil1) :- $comp_popt11(Inst, Rest, Pil1).
  44.  
  45. :- mode($comp_popt11,3,[c,c,d]).
  46.  
  47. $comp_popt11(puttvar(T,R), [getstr(S,R)|PRest], [putstr(S,T)|OptPRest]) :-
  48.     !,
  49.     $comp_popt1a(PRest, OptPRest).
  50. $comp_popt11(puttvar(T,R), [getlist(R)|PRest], [putlist(T)|OptPRest]) :-
  51.     !,
  52.     $comp_popt1a(PRest, OptPRest).
  53. $comp_popt11(movreg(T,R),[Inst|PRest],OptInstList) :-
  54.     !,
  55.     T =:= R ->
  56.          $comp_popt11(Inst,PRest,OptInstList) ;
  57.          $popt_movreg(Inst,R,T,PRest,OptInstList).
  58. $comp_popt11(putpvar(V,R), [getpval(V,R)|PRest], [putpvar(V,R)|OptPRest]) :-
  59.     !,
  60.     $comp_popt1(PRest, OptPRest).
  61. $comp_popt11(putpvar(V,R), [getstr(Str,R)|PRest], [putstrv(Str,V)|OptPRest]) :-
  62.     !,
  63.     $comp_popt1a(PRest, OptPRest).
  64. $comp_popt11(putpval(V,R), [getstr(Str,R)|PRest], [getstrv(Str,V)|OptPRest]) :-
  65.     !,
  66.     $comp_popt1(PRest, OptPRest).
  67. $comp_popt11(getlist(R), [unitvar(R1),unitvar(R2)|PRest],[getlist_tvar_tvar(R,R1,R2)|OptPRest]) :-
  68.     !,
  69.     $comp_popt1(PRest,OptPRest).
  70. $comp_popt11(getcomma(R), [unitvar(R1),unitvar(R2)|PRest],[getcomma_tvar_tvar(R,R1,R2)|OptPRest]) :-
  71.     !,
  72.     $comp_popt1(PRest,OptPRest).
  73. $comp_popt11(getlist_k(R), [unitvar(R1),unitvar(R2)|PRest],[getlist_k_tvar_tvar(R,R1,R2)|OptPRest]) :-
  74.     !,
  75.     $comp_popt1(PRest,OptPRest).
  76. $comp_popt11(gettval(R,R), PRest,OptPRest) :-
  77.     !,
  78.     $comp_popt1(PRest, OptPRest).
  79. $comp_popt11(unitvar(R), [movreg(R,S)|PRest], OptInstList) :-
  80.     !,
  81.     ($peep_chk(PRest,R) ->
  82.          OptInstList = [unitvar(S)|OptPRest] ;
  83.          OptInstList = [unitvar(R),movreg(R,S)|OptPRest]
  84.     ),
  85.     $comp_popt1(PRest, OptPRest).
  86. $comp_popt11(jump(L), [label(L)|PRest],  [label(L)|OptPRest]) :-
  87.     !,
  88.     $comp_popt1(PRest,OptPRest).
  89. $comp_popt11(jump(Addr), [jump(_)|PRest],  [jump(Addr)|OptPRest]) :-
  90.     !,
  91.     $comp_popt1(PRest,OptPRest).
  92. $comp_popt11(jumpz(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
  93.     !,
  94.     $comp_popt1(PRest,OptPRest).
  95. $comp_popt11(jumpnz(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
  96.     !,
  97.     $comp_popt1(PRest,OptPRest).
  98. $comp_popt11(jumplt(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
  99.     !,
  100.     $comp_popt1(PRest, OptPRest).
  101. $comp_popt11(jumple(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
  102.     !,
  103.     $comp_popt1(PRest, OptPRest).
  104. $comp_popt11(jumpgt(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
  105.     !,
  106.     $comp_popt1(PRest,OptPRest).
  107. $comp_popt11(jumpge(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
  108.     !,
  109.     $comp_popt1(PRest,OptPRest).
  110. $comp_popt11(Inst, PRest, [Inst|OptPRest]) :- 
  111.     $comp_popt1(PRest, OptPRest).
  112.  
  113. :- mode($comp_popt1a,2,[c,d]).
  114.  
  115. $comp_popt1a([], []).
  116. $comp_popt1a([Inst|PRest], OptPList) :-
  117.      $popt_uni2bld(Inst,BldInst) ->
  118.           (OptPList = [BldInst|OptPRest],
  119.        $comp_popt1a(PRest,OptPRest)
  120.       ) ;
  121.       $comp_popt11(Inst,PRest,OptPList).
  122.  
  123. :- mode($popt_uni2bld,2,[c,d]).
  124.  
  125. $popt_uni2bld(unipvar(X), bldpvar(X)).
  126. $popt_uni2bld(unipval(X), bldpval(X)).
  127. $popt_uni2bld(unitvar(X), bldtvar(X)).
  128. $popt_uni2bld(unitval(X), bldtval(X)).
  129. $popt_uni2bld(unicon(X), bldcon(X)).
  130. $popt_uni2bld(uninil, bldnil).
  131. $popt_uni2bld(uninumcon(X), bldnumcon(X)).
  132. $popt_uni2bld(unifloatcon(X), bldfloatcon(X)).
  133.  
  134. /*      "popt4" eliminates some redundant instructions.    */
  135.  
  136.  
  137. $comp_popt4([],_,_,Preds,[]).
  138. $comp_popt4([Inst|IRest],RCont,Seen,Preds,OList) :-
  139.     ($popt_builtin(Inst,Preds,OList,ORest) ->
  140.         RCont1 = RCont ;
  141.         ($peep_redundant(Inst,IRest,RCont,RCont1,Seen,El),
  142.          (El =:= 1 -> OList = ORest ; OList = [Inst|ORest])
  143.         )
  144.     ),
  145.     $comp_popt4(IRest,RCont1,Seen,Preds,ORest).
  146.  
  147. :- mode($popt_builtin,4,[c,c,d,d]).
  148.  
  149. $popt_builtin(call(P,N,_),Preds,[builtin(Bno)|IRest],IRest) :-
  150.      $comp_builtin(P,N,Bno),
  151.      $not_member1('/'(P,N),Preds),
  152.      !.
  153. $popt_builtin(calld(P,N,_),Preds,[builtin(Bno)|IRest],IRest) :-
  154.      $comp_builtin(P,N,Bno),
  155.      $not_member1('/'(P,N),Preds),
  156.      !.
  157. $popt_builtin(execute((P,N)),Preds,[builtin(Bno),proceed|IRest],IRest) :-
  158.      $comp_builtin(P,N,Bno),
  159.      $not_member1('/'(P,N),Preds).
  160.  
  161. :- mode($popt_movreg,5,[c,c,c,c,d]).
  162.  
  163. $popt_movreg(Inst,R,T,PRest,OptInstList) :-
  164.     ( ($popt_movreg0(Inst,R,T,OptInst), $peep_chk(PRest,R))  ->
  165.          OptInstList = [OptInst|OptInstRest] ;
  166.          OptInstList = [movreg(T,R),Inst|OptInstRest]
  167.     ),
  168.     $comp_popt1(PRest, OptInstRest).
  169.  
  170. :- mode($popt_movreg0,4,[c,c,c,d]).
  171.  
  172. $popt_movreg0(getstr(S,R),R,T,getstr(S,T)).
  173. $popt_movreg0(puttbreg(R),R,T,puttbreg(T)).
  174. $popt_movreg0(addreg(R,S),R,T,addreg(T,S)).
  175. $popt_movreg0(subreg(R,S),R,T,subreg(T,S)).
  176. $popt_movreg0(mulreg(R,S),R,T,mulreg(T,S)).
  177. $popt_movreg0(divreg(R,S),R,T,divreg(T,S)).
  178. $popt_movreg0(idivreg(R,S),R,T,idivreg(T,S)).
  179. $popt_movreg0(get_tag(R,S),R,T,get_tag(T,S)).
  180. $popt_movreg0(arg(R,R2,R3),R,T,arg(T,R2,R3)).
  181. $popt_movreg0(arg(R1,R,R3),R,T,arg(R1,T,R3)).
  182. $popt_movreg0(arg(R1,R2,R),R,T,arg(R1,R2,T)).
  183. $popt_movreg0(arg0(R,R2,R3),R,T,arg0(T,R2,R3)).
  184. $popt_movreg0(arg0(R1,R,R3),R,T,arg0(R1,T,R3)).
  185. $popt_movreg0(arg0(R1,R2,R),R,T,arg0(R1,R2,T)).
  186. $popt_movreg0(test_unifiable(R,R2,R3),R,T,test_unifiable(T,R2,R3)).
  187. $popt_movreg0(test_unifiable(R1,R,R3),R,T,test_unifiable(R1,T,R3)).
  188. $popt_movreg0(test_unifiable(R1,R2,R),R,T,test_unifiable(R1,R2,T)).
  189.  
  190.  
  191. $popt_chkmember(P,L,Flag) :-
  192.     (var(L), L = [P|_], Flag = 1) ;
  193.     (nonvar(L), L = [P1|L1],
  194.      (P = P1 -> Flag = 0 ; $popt_chkmember(P,L1,Flag))
  195.     ).
  196.  
  197. /*  these instrs use the contents of a reg */
  198.  
  199. :- mode($peep_use,2,[c,d]).
  200.  
  201. $peep_use(getcon(_,R),R).
  202. $peep_use(getnumcon(_,R),R).
  203. $peep_use(getfloatcon(_,R),R).
  204. $peep_use(getpval(_,R),R).
  205. $peep_use(gettval(_,R),R).
  206. $peep_use(gettval(R,_),R).
  207. $peep_use(gettbreg(R),R).
  208. $peep_use(getpbreg(R),R).
  209. $peep_use(getstr(_,R),R).
  210. $peep_use(getstrv(_,R),R).
  211. $peep_use(getlist(R),R).
  212. $peep_use(getlist_tvar_tvar(R,_,_),R).
  213. $peep_use(getcomma(R),R).
  214. $peep_use(getcomma_tvar_tvar(R,_,_),R).
  215. $peep_use(get_tag(R,_),R).
  216. $peep_use(unitval(R),R).
  217. $peep_use(unipval(R),R).
  218. $peep_use(bldtval(R),R).
  219. $peep_use(bldpval(R),R).
  220. $peep_use(arg(R,_,_),R).
  221. $peep_use(arg(_,R,_),R).
  222. $peep_use(arg(_,_,R),R).
  223. $peep_use(arg0(R,_,_),R).
  224. $peep_use(arg0(_,R,_),R).
  225. $peep_use(arg0(_,_,R),R).
  226. $peep_use(test_unifiable(R,_,_),R).
  227. $peep_use(test_unifiable(_,R,_),R).
  228. $peep_use(and(R,_),R).
  229. $peep_use(and(_,R),R).
  230. $peep_use(negate(R),R).
  231. $peep_use(or(R,_),R).
  232. $peep_use(or(_,R),R).
  233. $peep_use(lshiftl(R,_),R).
  234. $peep_use(lshiftl(_,R),R).
  235. $peep_use(lshiftr(R,_),R).
  236. $peep_use(lshiftr(_,R),R).
  237. $peep_use(addreg(R,_),R).
  238. $peep_use(addreg(_,R),R).
  239. $peep_use(subreg(R,_),R).
  240. $peep_use(subreg(_,R),R).
  241. $peep_use(mulreg(R,_),R).
  242. $peep_use(mulreg(_,R),R).
  243. $peep_use(divreg(R,_),R).
  244. $peep_use(divreg(_,R),R).
  245. $peep_use(idivreg(R,_),R).
  246. $peep_use(idivreg(_,R),R).
  247. $peep_use(movreg(R,_),R).
  248. $peep_use(switchonterm(R,_,_),R).
  249. $peep_use(switchonlist(R,_,_),R).
  250. $peep_use(switchonbound(R,_,_),R).
  251. $peep_use(jump(_),_).        /* too lazy to chase jumps! */
  252. $peep_use(jumpeq(R,L),R) :- L \= abs(-1).
  253. $peep_use(jumpne(R,L),R) :- L \= abs(-1).
  254. $peep_use(jumplt(R,L),R) :- L \= abs(-1).
  255. $peep_use(jumple(R,L),R) :- L \= abs(-1).
  256. $peep_use(jumpgt(R,L),R) :- L \= abs(-1).
  257. $peep_use(jumpge(R,L),R) :- L \= abs(-1).
  258.  
  259. $peep_chk([],_).
  260. $peep_chk([Inst|Rest],R) :-
  261.     not($peep_use(Inst,R)), 
  262.     (($peep_term(Inst,R), !) ; $peep_chk(Rest,R)).
  263.  
  264. :- mode($peep_term,2,[c,d]).
  265.  
  266. /* these instrs change contents of reg */
  267.  
  268. $peep_term(call(_,_,_),_).
  269. $peep_term(calld(_,_,_),_).
  270. $peep_term(execute(_),_).
  271. $peep_term('_$execmarker',_).
  272. $peep_term(putcon(R),R).
  273. $peep_term(putnumcon(R),R).
  274. $peep_term(putfloatcon(R),R).
  275. $peep_term(puttvar(R,_),R).
  276. $peep_term(putpvar(_,R),R).
  277. $peep_term(putdval(_,R),R).
  278. $peep_term(putuval(_,R),R).
  279. $peep_term(puttbreg(R),R).
  280. $peep_term(putpval(_,R),R).
  281. $peep_term(putstr(_,R),R).
  282. $peep_term(putstrv(_,R),R).
  283. $peep_term(putlist(R),R).
  284. $peep_term(putnil(R),R).
  285. $peep_term(get_tag(_,R),R).
  286. $peep_term(movreg(_,R),R).
  287. $peep_term(bldtvar(R),R).
  288. $peep_term(test_unifiable(_,_,R),R).
  289.  
  290. $peep_redundant('_$execmarker',_,R,R,_,1).
  291. $peep_redundant(Inst,IRest,RCont,RCont1,Seen,El) :-
  292.     $peep_elim(Inst,IRest,RCont,RCont1,Seen,El) ->
  293.         true ;
  294.         (RCont1 = RCont, El = 0).
  295.  
  296. :- mode($peep_elim,6,[c,c,d,d,d,d]).
  297.  
  298. $peep_elim(getpvar(V,R),_,RCont,[r(R,v(V))|RCont],_,0).
  299. $peep_elim(getpval(V,R),_,RCont,RCont1,Seen,El) :-
  300.     $member1(r(R,v(V)),RCont) ->
  301.         (El = 1, RCont1 = Rcont) ;
  302.         (El = 0, RCont1 = [r(R,v(V))|RCont]).
  303. $peep_elim(getcon(C,R),_,RCont,RCont1,Seen,El) :-
  304.     $member1(r(R,c(C)),RCont) ->
  305.         (El = 1, RCont1 = Rcont) ;
  306.         (El = 0, RCont1 = [r(R,c(C))|RCont]).
  307. $peep_elim(getnumcon(N,R),_,RCont,RCont1,Seen,El) :-
  308.     $member1(r(R,n(N)),RCont) ->
  309.         (El = 1, RCont1 = Rcont) ;
  310.         (El = 0, RCont1 = [r(R,n(N))|RCont]).
  311. $peep_elim(getfloatcon(N,R),_,RCont,RCont1,Seen,El) :-
  312.     $member1(r(R,nf(N)),RCont) ->
  313.         (El = 1, RCont1 = Rcont) ;
  314.         (El = 0, RCont1 = [r(R,nf(N))|RCont]).
  315. $peep_elim(getnil(R),_,RCont,RCont1,Seen,El) :-
  316.     $member1(r(R,c(nil)),RCont) ->
  317.         (El = 1, RCont1 = Rcont) ;
  318.         (El = 0, RCont1 = [r(R,c(nil))|RCont]).
  319. $peep_elim(putpvar(V,R),_,L0,L1,_,0) :- $peep_elim_upd(L0,R,v(V),L1).
  320. $peep_elim(putpval(V,R),_,RCont,RCont1,_,El) :-
  321.     $member1(r(R,v(V)),RCont) ->
  322.         (El = 1, RCont1 = RCont) ;
  323.         (El = 0, $peep_elim_upd(RCont,R,v(V),RCont1)).
  324. $peep_elim(puttvar(R,R1),_,L0,L1,_,0) :-
  325.     $peep_del(L0,r(R,_),L2), $peep_del(L2,r(R1,_),L1).
  326. $peep_elim(putcon(C,R),_,RCont,RCont1,_,El) :-
  327.     $member1(r(R,c(C)),RCont) ->
  328.         (El = 1, RCont1 = RCont) ;
  329.         (El = 0, $peep_elim_upd(RCont,R,c(C),RCont1)).
  330. $peep_elim(putnumcon(N,R),_,RCont,RCont1,_,El) :-
  331.     $member1(r(R,n(N)),RCont) ->
  332.         (El = 1, RCont1 = RCont);
  333.         (El = 0, $peep_elim_upd(RCont,R,n(N),RCont1)).
  334. $peep_elim(putfloatcon(N,R),_,RCont,RCont1,_,El) :-
  335.     $member1(r(R,nf(N)),RCont) ->
  336.         (El = 1, RCont1 = RCont) ;
  337.         (El = 0, $peep_elim_upd(RCont,R,nf(N),RCont1)).
  338. $peep_elim(putnil(R),_,RCont,RCont1,_,El) :-
  339.     $member1(r(R,c(nil)),RCont) ->
  340.         (El = 1, RCont1 = RCont);
  341.         (El = 0, $peep_elim_upd(RCont,R,c(nil),RCont1)).
  342. $peep_elim(putstr(F,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  343. $peep_elim(putlist(R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  344. $peep_elim(and(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  345. $peep_elim(or(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  346. $peep_elim(negate(R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  347. $peep_elim(lshiftr(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  348. $peep_elim(lshiftl(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  349. $peep_elim(addreg(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  350. $peep_elim(subreg(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  351. $peep_elim(mulreg(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  352. $peep_elim(divreg(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  353. $peep_elim(idivreg(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  354. $peep_elim(movreg(R,R1),_,L0,L1,_,0) :- $peep_elim_upd(L0,R1,r(R),L1).
  355. $peep_elim(gettbreg(R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  356. $peep_elim(putdval(V,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  357. $peep_elim(putuval(V,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  358. $peep_elim(label((P,N,K)),_,_,[],Seen,0) :-
  359.     N >= 0 -> $member1((P,N),Seen) ; true.
  360. $peep_elim(call(_,_,_),_,_,[],_,0).
  361. $peep_elim(proceed,_,_,[],_,0).
  362. $peep_elim(execute((P,N)),IRest,_,[],Seen,El) :-
  363.     (IRest = [label((P,N,K))|_], N >= 0) ->
  364.         $popt_chkmember((P,N),Seen,El) ;
  365.         El = 0.
  366. $peep_elim(calld(_,_,_),_,_,[],_,0).
  367. $peep_elim(builtin(_),_,_,[],_,0).
  368. $peep_elim(trymeelse(_,_),_,_,[],_,0).
  369. $peep_elim(retrymeelse(_,_),_,_,[],_,0).
  370. $peep_elim(trustmeelsefail(_),_,_,[],_,0).
  371. $peep_elim(try(_,_),_,_,[],_,0).
  372. $peep_elim(retry(_,_),_,_,[],_,0).
  373. $peep_elim(trust(_),_,_,[],_,0).
  374. $peep_elim(jump(_),_,_,[],_,0).
  375. $peep_elim(jumpz(_,L),_,R0,R1,_,0) :- L ?= abs(-1) -> R1 = R0 ; R1 = [].
  376. $peep_elim(jumpnz(_,L),_,R0,R1,_,0) :- L ?= abs(-1) -> R1 = R0 ; R1 = [].
  377. $peep_elim(jumplt(_,L),_,R0,R1,_,0) :- L ?= abs(-1) -> R1 = R0 ; R1 = [].
  378. $peep_elim(jumple(_,L),_,R0,R1,_,0) :- L ?= abs(-1) -> R1 = R0 ; R1 = [].
  379. $peep_elim(jumpgt(_,L),_,R0,R1,_,0) :- L ?= abs(-1) -> R1 = R0 ; R1 = [].
  380. $peep_elim(jumpge(_,L),_,R0,R1,_,0) :- L ?= abs(-1) -> R1 = R0 ; R1 = [].
  381. $peep_elim(switchonterm(_,_,_),_,_,[],_,0).
  382. $peep_elim(switchonlist(_,_,_),_,_,[],_,0).
  383. $peep_elim(switchonbound(_,_,_),_,_,[],_,0).
  384.  
  385. $peep_del([],_,[]).
  386. $peep_del([X|L],Y,L1) :- 
  387.     (X ?= Y -> L1 = L1Rest ; L1 = [X|L1Rest]),
  388.     $peep_del(L,Y,L1Rest).
  389.  
  390. $peep_elim_upd(L0,R,Cont,[r(R,Cont)|L1]) :- $peep_del(L0,r(R,_),L1).
  391.  
  392. /* ------------------------------ peephole.P ------------------------------ */
  393.  
  394.  
  395.