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 /archive/mlprof.1/codegen/backpatch.sml
ViewVC logotype

Annotation of /archive/mlprof.1/codegen/backpatch.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4054 - (view) (download)

1 : dbm 4054 signature BACKPATCH =
2 :     sig
3 :     type Label
4 :     val newlabel : unit -> Label
5 :     type JumpKind
6 :     val emitbyte : int -> unit
7 :     val align : unit -> unit
8 :     val define : Label -> unit
9 :     val jump : JumpKind*Label -> unit
10 :     val mark : unit -> unit
11 :     val finish : ( (JumpKind*int*int*int->int)
12 :     *(JumpKind*int*int*int->unit)
13 :     *(int->unit) )
14 :     -> (int * ((int->unit)->unit))
15 :     end
16 :    
17 :     functor Backpatch(Kind: sig type JumpKind end) : BACKPATCH =
18 :     struct
19 :     structure DBA = Dynamic(struct
20 :     local open ByteArray in
21 :     type array = bytearray
22 :     type elem = int
23 :     exception Subscript = Subscript
24 :     val array = array
25 :     val op sub = op sub
26 :     val update = update
27 :     val length = length
28 :     end
29 :     end)
30 :    
31 :     open System.Tags
32 :     type Label = int ref
33 :     fun newlabel() = ref 0
34 :    
35 :     type JumpKind = Kind.JumpKind
36 :    
37 :     datatype Descriptor
38 :     = JUMP of (JumpKind * Label * int ref)
39 :     | LABEL of Label | ALIGN | MARK
40 :    
41 :     val initialOffset = 0
42 :    
43 :     fun sizeJumps (sizejump : JumpKind * int * int * int -> int)
44 :     (lab : (int * Descriptor) list) =
45 :     let val changed = ref false
46 :     fun labels (offset, (pos, JUMP(k, l, r as ref size))::rest) =
47 :     labels(offset+size, rest)
48 :     | labels (offset, (pos, LABEL l)::rest) =
49 :     (l := offset+pos; labels(offset,rest))
50 :     | labels (offset, lab as (pos,ALIGN)::rest) =
51 :     if (offset+pos) mod 4 = 0 then labels(offset,rest)
52 :     else labels(offset+1, lab)
53 :     | labels (offset, (pos,MARK)::rest) =
54 :     labels(offset+4, rest)
55 :     | labels (offset, nil) = ()
56 :     fun adjust (offset, (pos, JUMP(k, l, r as ref size))::rest) =
57 :     let val s = sizejump(k, size, offset+pos, !l)
58 :     in if s > size then (r := s; changed := true) else ();
59 :     adjust(offset+size, rest)
60 :     end
61 :     | adjust (offset, (pos, LABEL l)::rest) =
62 :     adjust(offset,rest)
63 :     | adjust (offset, lab as (pos,ALIGN)::rest) =
64 :     if (offset+pos) mod 4 = 0 then adjust(offset,rest)
65 :     else adjust(offset+1, lab)
66 :     | adjust (offset, (pos,MARK)::rest) =
67 :     adjust(offset+4, rest)
68 :     | adjust (offset, nil) = ()
69 :     in labels(initialOffset, lab);
70 :     adjust(initialOffset, lab);
71 :     while !changed
72 :     do (changed := false;
73 :     labels(initialOffset, lab);
74 :     adjust(initialOffset, lab))
75 :     end
76 :    
77 :     val bytes = DBA.array 0
78 :     val position = ref 0
79 :     fun emitbyte i = (DBA.update(bytes, !position, i); inc position)
80 :     val refs : (int * Descriptor) list ref = ref nil
81 :     fun addref(d) = refs := (!position, d) :: !refs
82 :     fun align() = addref ALIGN
83 :     fun define lab = addref(LABEL lab)
84 :     fun jump(k,lab) = addref(JUMP(k,lab,ref 0))
85 :     fun mark() = addref MARK
86 :     fun finish(sizejump,emitjump,emitlong) =
87 :     let val endlabel = newlabel()
88 :     val _ = addref(LABEL endlabel)
89 :     val reflist = rev (!refs)
90 :     val scratchpos = !position
91 :     val _ = ErrorMsg.debugmsg "relocating..."
92 :     val _ = sizeJumps sizejump reflist
93 :     in (!endlabel - initialOffset,
94 :     (fn output =>
95 :     let val _ = ErrorMsg.debugmsg "about to output"
96 :     fun copy(start,until) =
97 :     if start=until then ()
98 :     else (output(DBA.sub(bytes,start)); copy(start+1,until))
99 :     fun chunk(lastp, g, (p, JUMP(k, l, ref size))::rest) =
100 :     (copy(lastp, p);
101 :     position := scratchpos;
102 :     emitjump(k,size,p+g,!l);
103 :     copy(scratchpos,!position);
104 :     chunk(p, g+size, rest))
105 :     | chunk(lastp, g, (p, LABEL l)::rest) =
106 :     (copy(lastp, p);
107 :     chunk(p, g, rest))
108 :     | chunk(lastp, g, lab as (p, ALIGN)::rest) =
109 :     (copy(lastp, p);
110 :     if (p+g) mod 4 = 0 then chunk(p, g, rest)
111 :     else (output 0; chunk(p, g+1, lab)))
112 :     | chunk(lastp, g,(p, MARK)::rest) =
113 :     (copy(lastp, p);
114 :     position := scratchpos;
115 :     emitlong (((p+g+4) div 4) * power_tags
116 :     + tag_backptr);
117 :     copy(scratchpos,!position);
118 :     chunk(p, g+4, rest))
119 :     | chunk(lastp, g, nil) =
120 :     copy(lastp, scratchpos)
121 :     in chunk(0,initialOffset,reflist);
122 :     position := 0;
123 :     refs := nil
124 :     end))
125 :     end
126 :     end (* functor BackPatch *)

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