Return to backpatch.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / codegen

Annotation of researchv10no/cmd/sml/src/codegen/backpatch.sml, revision 1.1

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.