Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/CodeGen/cpscompile/mkRecord.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/CodeGen/cpscompile/mkRecord.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 16 - (view) (download)

1 : monnier 16 (* mk-record.sml --- translate a CPS.RECORD to MLRISC
2 :     *
3 :     * COPYRIGHT (c) 1996 AT&T Bell Laboratories.
4 :     *
5 :     *)
6 :    
7 :     (* TODO:
8 :     * Some CPS.RECORDs can be created using a tight loop implementing
9 :     * a block copy.
10 :     *)
11 :    
12 :     functor MkRecord
13 :     (structure C: CPSREGS where T.Region = CPSRegions
14 :     structure MLTreeComp : MLTREECOMP
15 :     sharing C.T = MLTreeComp.T) : MK_RECORD =
16 :     struct
17 :     structure T : MLTREE = C.T
18 :     structure R = CPSRegions
19 :    
20 :     fun error msg = ErrorMsg.impossible ("MkRecord." ^ msg)
21 :    
22 :     val emit = MLTreeComp.mlriscComp
23 :    
24 :     val dummyRegion = (R.RVAR 0, R.RO_MEM, CPS.OFFp 0)
25 :    
26 :     val T.REG allocptrR = C.allocptr
27 :    
28 :     fun ea(r, 0) = r
29 :     | ea(r, n) = T.ADD(r, T.LI(n))
30 :    
31 :     fun indexEA(r, 0) = r
32 :     | indexEA(r, n) = T.ADD(r, T.LI(n*4))
33 :    
34 :     fun record {desc, fields, ans, mem, hp} = let
35 :     val descRegion::regions =
36 :     case mem
37 :     of R.RO_MEM => dummyRegion:: map (fn _ => dummyRegion) fields
38 :     | R.RECORD vl => vl
39 :    
40 :     fun getfield(r, CPS.SELp(n, p), R.RO_MEM) =
41 :     getfield(T.LOAD32(indexEA(r, n), R.RO_MEM), p, R.RO_MEM)
42 :     | getfield(r, CPS.SELp(n, p), R.RECORD vl) = let
43 :     val (def, root, ap) = List.nth(vl, n+1)
44 :     in getfield(T.LOAD32(indexEA(r, n), def), p, R.trace(root, ap))
45 :     end
46 :     | getfield(r, CPS.SELp(n, p), R.OFFSET(i, vl)) = let
47 :     val (def, root, ap) = List.nth(vl, n+i+1)
48 :     in getfield(T.LOAD32(indexEA(r, n), def), p, R.trace(root, ap))
49 :     end
50 :     | getfield(r, CPS.OFFp 0, _) = r
51 :     | getfield(r, CPS.OFFp n, _) = T.ADD(r, T.LI(n*4))
52 :    
53 :     fun storeFields ([], _, []) = ()
54 :     | storeFields ((v, p)::rest, n, (def, root, _)::regions) =
55 :     (emit(T.STORE32(T.ADD(C.allocptr, T.LI n), getfield(v,p,root), def));
56 :     storeFields(rest, n + 4, regions))
57 :     in
58 :     emit(T.STORE32(ea(C.allocptr, hp), desc, #1 descRegion));
59 :     storeFields(fields, hp+4, regions);
60 :     emit(T.MV(ans, T.ADD(C.allocptr, T.LI(hp+4))))
61 :     end
62 :    
63 :     fun frecord {desc, fields, ans, mem, hp} = let
64 :     val descRegion::regions =
65 :     case mem
66 :     of R.RO_MEM => dummyRegion:: map (fn _ => dummyRegion) fields
67 :     | R.RECORD vl => vl
68 :    
69 :     fun fgetfield(T.FPR fp, CPS.OFFp 0, _) = fp
70 :     | fgetfield(T.GPR r, path, mem) = let
71 :     fun fea(r, 0) = r
72 :     | fea(r, n) = T.ADD(r, T.LI(n*8))
73 :    
74 :     fun chase(r, CPS.SELp(n, CPS.OFFp 0), R.RO_MEM) =
75 :     T.LOADD(fea(r,n), R.RO_MEM)
76 :     | chase(r, CPS.SELp(n, CPS.OFFp 0), R.RECORD vl) = let
77 :     val (def, _, _) = List.nth(vl, n+1)
78 :     in T.LOADD(fea(r, n), def)
79 :     end
80 :     | chase(r, CPS.SELp(n, CPS.OFFp 0), R.OFFSET(i, vl)) = let
81 :     val (def, _, _) = List.nth(vl, n+i+1)
82 :     in T.LOADD(fea(r, n), def)
83 :     end
84 :     | chase(r, CPS.SELp(n,p), R.RO_MEM) =
85 :     chase(T.LOAD32(indexEA(r, n), R.RO_MEM), p, R.RO_MEM)
86 :     | chase(r, CPS.SELp(j,p), R.RECORD vl) = let
87 :     val (def, root, ap) = List.nth(vl, j+1)
88 :     in chase(T.LOAD32(indexEA(r,j), def), p, R.trace(root, ap))
89 :     end
90 :     | chase(r, CPS.SELp(j,p), R.OFFSET(i, vl)) = let
91 :     val (def, root, ap) = List.nth(vl, i+j+1)
92 :     in chase(T.LOAD32(indexEA(r,j), def), p, R.trace(root, ap))
93 :     end
94 :     in chase(r, path, mem)
95 :     end
96 :    
97 :     fun fstoreFields ([], _, []) = ()
98 :     | fstoreFields ((v, p)::rest, n, (def, root, _)::regions) =
99 :     (emit(T.STORED(T.ADD(C.allocptr, T.LI n), fgetfield(v,p,root), def));
100 :     fstoreFields(rest, n + 8, regions))
101 :     in
102 :     emit(T.STORE32(ea(C.allocptr, hp), desc, #1 descRegion));
103 :     fstoreFields(fields, hp+4, regions);
104 :     emit(T.MV(ans, T.ADD(C.allocptr, T.LI(hp+4))))
105 :     end
106 :     end
107 :    
108 :     (*
109 :     * $Log: mkRecord.sml,v $
110 :     * Revision 1.7 1997/08/27 17:53:49 george
111 :     * More accurate memory disambiguation maintenance.
112 :     *
113 :     * Revision 1.6 1997/08/11 18:38:03 george
114 :     * Implemented correct but very conservative alias information for
115 :     * reference cells.
116 :     *
117 :     * Revision 1.5 1997/08/07 21:04:34 george
118 :     * fixed bugs in memory disambiguation
119 :     *
120 :     * Revision 1.4 1997/08/07 02:10:51 george
121 :     * Refined region information to the granularity of words in the allocation space
122 :     *
123 :     * Revision 1.3 1997/08/03 14:16:00 george
124 :     * Allocation pointer increments are performed at function exit
125 :     * if possible.
126 :     *
127 :     * Revision 1.2 1997/07/28 20:04:58 george
128 :     * Added support for regions
129 :     *
130 :     * Revision 1.1.1.1 1997/01/14 01:38:34 george
131 :     * Version 109.24
132 :     *
133 :     *)

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