![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to backpatch.sml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / codegen|
Return to backpatch.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / codegen |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: signature BACKPATCH =
3: sig
4: eqtype Label
5: val newlabel : unit -> Label
6: type JumpKind
7: val emitstring : string -> unit
8: val align : unit -> unit
9: val define : Label -> unit
10: val jump : JumpKind*Label -> unit
11: val mark : unit -> unit
12: val finish : unit -> string
13: end
14:
15: signature JUMPS =
16: sig
17: type JumpKind
18: val sizejump : JumpKind*int*int*int -> int
19: val emitjump : JumpKind*int*int*int -> string
20: val emitlong : int -> string
21: end
22:
23: functor Backpatch(Kind: JUMPS) : BACKPATCH =
24: struct
25: open Kind System.Tags
26: type Label = int ref
27: fun newlabel() = ref 0
28:
29: datatype Desc
30: = BYTES of string * Desc | JUMP of JumpKind * Label * int ref * Desc
31: | LABEL of Label * Desc | ALIGN of Desc | MARK of Desc | NIL
32:
33: fun compress(len, sl as [s], r0 as BYTES(t,r)) =
34: let val lent = size t
35: in if len+len > lent andalso lent < 500 andalso len<500
36: then compress(len+lent, t::sl, r)
37: else BYTES(s, r0)
38: end
39: | compress(len, sl, r0 as BYTES(t,r)) =
40: let val lent = size t
41: in if len+len > lent andalso lent < 500
42: then compress(len+lent, t::sl, r)
43: else BYTES(implode sl, r0)
44: end
45: | compress(len, sl, r0) = BYTES(implode sl, r0)
46:
47: val refs = ref NIL
48: fun emitstring s = refs := compress(size s, [s],!refs)
49: fun align() = refs := ALIGN(!refs)
50: fun mark() = refs := MARK(!refs)
51: fun define lab = refs := LABEL(lab, !refs)
52: fun jump(k,lab) = refs := JUMP(k,lab,ref 0, !refs)
53:
54: fun reverse(r,NIL) = r
55: | reverse(r,BYTES(s,q)) = reverse(BYTES(s,r),q)
56: | reverse(r,ALIGN q) = reverse(ALIGN r, q)
57: | reverse(r,MARK q) = reverse(MARK r, q)
58: | reverse(r,LABEL(lab,q)) = reverse(LABEL(lab,r), q)
59: | reverse(r,JUMP(k,lab,x,q)) = reverse(JUMP(k,lab,x,r),q)
60:
61: fun finish() =
62: let val changed = ref true
63:
64: fun labels (pos, BYTES(s,rest)) = labels(pos+size s,rest)
65: | labels (pos, JUMP(k,l,ref size, rest)) = labels(pos+size, rest)
66: | labels (pos, LABEL(l,rest)) = (l := pos; labels(pos,rest))
67: | labels (pos, lab as ALIGN rest) = labels(((pos+3)div 4)*4, rest)
68: | labels (pos, MARK rest) = labels(pos+4, rest)
69: | labels (pos, NIL) = ()
70:
71: fun adjust (pos, BYTES(s,rest)) = adjust(pos+size s,rest)
72: | adjust (pos, JUMP(k, l, r as ref size, rest)) =
73: let val s = sizejump(k, size, pos, !l)
74: in if s > size then (r := s; changed := true) else ();
75: adjust(pos+size, rest)
76: end
77: | adjust (pos, LABEL(l,rest)) = adjust(pos,rest)
78: | adjust (pos, ALIGN rest) = adjust(((pos+3)div 4)*4, rest)
79: | adjust (pos, MARK rest) = adjust(pos+4, rest)
80: | adjust (pos, NIL) = ()
81:
82: fun chunk(pos, BYTES(s,r)) = s :: chunk(pos+size s,r)
83: | chunk(pos, JUMP(k,l,ref size, r)) =
84: emitjump(k,size,pos,!l) :: chunk(pos+size,r)
85: | chunk(pos, LABEL(l, rest)) = chunk(pos,rest)
86: | chunk(pos, ALIGN rest) =
87: (case pos mod 4
88: of 0 => chunk(pos,rest)
89: | 1 => "\000\000\000" :: chunk(pos+3,rest)
90: | 2 => "\000\000" :: chunk(pos+2,rest)
91: | 3 => "\000" :: chunk(pos+1,rest))
92: | chunk(pos, MARK r) =
93: emitlong(((pos+4)div 4)*power_tags+tag_backptr)
94: :: chunk(pos+4, r)
95: | chunk(pos, NIL) = nil
96:
97: val reflist = reverse (ALIGN NIL, !refs) before refs := NIL
98: in ErrorMsg.debugmsg "relocating...";
99: while !changed
100: do (changed := false; labels(0, reflist); adjust(0, reflist));
101: ErrorMsg.debugmsg "about to output";
102: implode(chunk(0, reflist))
103: end
104: end (* functor BackPatch *)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.