Annotation of /sml/trunk/src/compiler/FLINT/main/flintcomp.sml

Parent Directory | Revision Log

---

Revision 95 - (view) (download)

1 :	monnier	16	(* COPYRIGHT (c) 1998 YALE FLINT PROJECT *)
2 :			(* flintcomp.sml *)
3 :
4 :			functor FLINTComp (structure Gen: CPSGEN
5 :			val collect: unit -> Word8Vector.vector) : CODEGENERATOR =
6 :			struct
7 :
8 :			local structure CB = CompBasic
9 :			structure CGC = Control.CG
10 :			structure MachSpec = Gen.MachSpec
11 :			structure Convert = Convert(MachSpec)
12 :			structure CPStrans = CPStrans(MachSpec)
13 :			structure CPSopt = CPSopt(MachSpec)
14 :			structure NewClosure = NClosure(MachSpec)
15 :			structure Spill = Spill(MachSpec)
16 :			structure CpsSplit = CpsSplitFun (MachSpec)
17 :			in
18 :
19 :			val architecture = Gen.MachSpec.architecture
20 :			fun bug s = ErrorMsg.impossible ("FLINTComp:" ^ s)
21 :			val say = Control.Print.say
22 :
23 :			fun phase x = Stats.doPhase (Stats.makePhase x)
24 :
25 :	monnier	71	val fcollect = phase "Compiler 052 collect" (fn le => (Collect.collect le; le))
26 :	monnier	84	(* val fcontract = phase "Compiler 052 fcontract" FContract.contract *)
27 :	monnier	71	val lcontract = phase "Compiler 052 lcontract" LContract.lcontract
28 :			val specialize= phase "Compiler 053 specialize" Specialize.specialize
29 :			val wrapping = phase "Compiler 054 wrapping" Wrapping.wrapping
30 :			val reify = phase "Compiler 055 reify" Reify.reify
31 :	monnier	16	(* val lambdaopt = phase "Compiler 057 lambdaopt" LContract.lcontract *)
32 :
33 :	monnier	71	val convert = phase "Compiler 060 convert" Convert.convert
34 :			val cpstrans = phase "Compiler 065 cpstrans" CPStrans.cpstrans
35 :	monnier	16	val cpsopt = phase "Compiler 070 cpsopt" CPSopt.reduce
36 :			val closure = phase "Compiler 080 closure" NewClosure.closeCPS
37 :			val globalfix = phase "Compiler 090 globalfix" GlobalFix.globalfix
38 :			val spill = if MachSpec.spillAreaSz < 500 * MachSpec.valueSize
39 :			then phase "Compiler 100 spill" Spill.spill
40 :			else fn x => x
41 :			val limit = phase "Compiler 110 limit" Limit.nolimit
42 :			val codegen = phase "Compiler 120 cpsgen" Gen.codegen
43 :
44 :
45 :	monnier	71	(** pretty printing for the FLINT and CPS code *)
46 :			val (prF, prC) =
47 :			let fun prGen (flag,printE) s e =
48 :			if !flag then (say ("\n\n[After " ^ s ^ " ...]\n\n"); printE e; e)
49 :			else e
50 :			in (prGen (CGC.printFlint, PPFlint.printProg),
51 :			prGen (CGC.printit, PPCps.printcps0))
52 :			end
53 :	monnier	16
54 :	monnier	71	(** writing out a term into a error output file *)
55 :			fun dumpTerm (printE, s, le) =
56 :			let val outS = TextIO.openAppend s;
57 :			val saveOut = !Control.Print.out
58 :			fun done () =
59 :			(TextIO.closeOut outS; Control.Print.out := saveOut)
60 :			in Control.Print.out := {say = fn s => TextIO.output(outS,s),
61 :			flush = fn () => TextIO.flushOut outS};
62 :			printE le handle x => (done () handle _ => (); raise x);
63 :			done ()
64 :			end (* function dumpTerm *)
65 :
66 :	monnier	16	(** compiling FLINT code into the binary machine code *)
67 :			fun flintcomp(flint, compInfo as {error, sourceName=src, ...}: CB.compInfo) =
68 :			let fun err severity s =
69 :			error (0,0) severity (concat["Real constant out of range: ",s,"\n"])
70 :
71 :			fun check (checkE,printE,chkId) (enableChk,lvl,logId) e =
72 :			(if !enableChk andalso checkE (e,lvl) then
73 :	monnier	71	(dumpTerm (printE, src ^ "." ^ chkId ^ logId, e);
74 :			bug (chkId ^ " typing errors " ^ logId))
75 :	monnier	16	else ();
76 :			e)
77 :	monnier	71	fun chkF (b, s) =
78 :			check (ChkFlint.checkTop, PPFlint.printFundec,
79 :			"FLINT") (CGC.checkFlint, b, s)
80 :	monnier	16
81 :	monnier	71	val _ = (chkF (false,"1") o prF "Translation") flint
82 :			val flint = (chkF (false,"2") o prF "Lcontract" o lcontract) flint
83 :	monnier	16	val flint =
84 :			if !CGC.specialize then
85 :	monnier	71	(chkF (false,"3") o prF "Specialization" o specialize) flint
86 :	monnier	16	else flint
87 :
88 :	monnier	71	val flint = (chkF (false, "4") o prF "Wrapping" o wrapping) flint
89 :			val flint = (chkF (true, "5") o prF "Reify" o reify) flint
90 :			val function = convert flint
91 :			val (nc0, ncn) =
92 :			let val _ = prC "convert" function
93 :			val function = (prC "cpstrans" o cpstrans) function
94 :			local exception ZZZ
95 :			in
96 :			val table : FLINT.lty Intmap.intmap = Intmap.new(32, ZZZ)
97 :			end
98 :			val (function,table) =
99 :			if !CGC.cpsopt then cpsopt (function,table,NONE,false)
100 :			else (function,table)
101 :			val _ = prC "cpsopt" function
102 :	monnier	45
103 :	monnier	71	fun gen fx =
104 :			let val fx = (prC "closure" o closure) fx
105 :			val carg = globalfix fx
106 :			val carg = spill carg
107 :			val (carg, limit) = limit carg
108 :			in codegen (carg, limit, err);
109 :			collect ()
110 :			end
111 :			in case CpsSplit.cpsSplit function
112 :			of (fun0 :: funn) => (gen fun0, map gen funn)
113 :			| [] => bug "unexpected case on gen in flintcomp"
114 :			end
115 :			in {c0=nc0, cn=ncn , name=ref (SOME src)}
116 :	monnier	16	end (* function flintcomp *)
117 :
118 :	monnier	71	val flintcomp = phase "Compiler 050 flintcomp" flintcomp
119 :	monnier	16
120 :			end (* local *)
121 :			end (* structure FLINTComp *)
122 :	monnier	95
123 :			(*
124 :			* $Log: flintcomp.sml,v $
125 :			* Revision 1.1.1.1 1998/04/08 18:39:40 george
126 :			* Version 110.5
127 :			*
128 :			*)

---

root@smlnj-gforge.cs.uchicago.edu	ViewVC Help
Powered by ViewVC 1.0.0